[submodule "vendor/company-mode"]
path = vendor/company-mode
url = https://github.com/company-mode/company-mode.git
+[submodule "vendor/haskell-mode"]
+ path = vendor/haskell-mode
+ url = https://github.com/haskell/haskell-mode.git
+[submodule "vendor/swank-js"]
+ path = vendor/swank-js
+ url = https://github.com/swank-js/swank-js.git
+[submodule "themes/solarized"]
+ path = themes/solarized
+ url = https://github.com/bbatsov/solarized-emacs.git
+[submodule "themes/zenburn"]
+ path = themes/zenburn
+ url = https://github.com/bbatsov/zenburn-emacs.git
--- /dev/null
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; Simple Python Completion Source for Auto-Complete
+;;;;; =================================================
+;;;;;
+;;;;; This file provides a completion source for Auto-Complete:
+;;;;; http://www.emacswiki.org/emacs/AutoComplete
+;;;;;
+;;;;; Installation
+;;;;; ------------
+;;;;;
+;;;;; Setup Auto-Complete in the usual fashion, and make sure it gets loaded for
+;;;;; python buffers. Then, place this file in your load-path, and add
+;;;;;
+;;;;; (require 'ac-python)
+;;;;;
+;;;;; to your .emacs file (after loading Auto-Complete).
+;;;;;
+;;;;; Usage
+;;;;; -----
+;;;;;
+;;;;; Python symbols will be completed by Auto-Complete, once Emacs learns about
+;;;;; these symbols. This is the short-coming of the plugin, but it's a small
+;;;;; price to pay.
+;;;;;
+;;;;; To teach Emacs about symbols in imported modules, Emacs needs to execute
+;;;;; the Python source. This can be accomplished with `python-send-buffer` for
+;;;;; example, often bound to `C-c C-c`. If a python process is already running,
+;;;;; this is essentially instantaneous.
+;;;;;
+;;;;; ---
+;;;;;
+;;;;; Version: 20110519
+;;;;; License: MIT
+;;;;; Author: Chris Poole <chris@chrispoole.com>
+;;;;; More information: http://chrispoole.com/project/ac-python
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defun ac-get-python-symbol-at-point ()
+ "Return python symbol at point.
+
+Assumes symbol can be alphanumeric, `.' or `_'."
+ (let ((end (point))
+ (start (ac-python-start-of-expression)))
+ (buffer-substring-no-properties start end)))
+
+(defun ac-python-completion-at-point ()
+ "Returns a possibly empty list of completions for the symbol at
+point."
+ (python-symbol-completions (ac-get-python-symbol-at-point)))
+
+(defun ac-python-start-of-expression ()
+ "Return point of the start of python expression at point.
+
+Assumes symbol can be alphanumeric, `.' or `_'."
+ (save-excursion
+ (and (re-search-backward
+ (rx (or buffer-start (regexp "[^[:alnum:]._]"))
+ (group (1+ (regexp "[[:alnum:]._]"))) point)
+ nil t)
+ (match-beginning 1))))
+
+(defvar ac-source-python
+ '((candidates . ac-python-completion-at-point)
+ (prefix . ac-python-start-of-expression)
+ (symbol . "f")
+ (requires . 2))
+ "Source for python completion.")
+
+(add-hook 'python-mode-hook (lambda () (add-to-list 'ac-sources 'ac-source-python)))
+
+(provide 'ac-python)
\ No newline at end of file
--- /dev/null
+;; basic-mode.el --- A mode for editing Visual Basic programs.
+
+;; Copyright (C) 1996, Fred White <fwhite@world.std.com>
+
+;; Author: Fred White <fwhite@world.std.com>
+;; Version: 1.0 (April 18, 1996)
+;; Keywords: languages basic
+
+;; LCD Archive Entry:
+;; basic-mode|Fred White|fwhite@world.std.com|
+;; A mode for editing Visual Basic programs.|
+;; 18-Apr-96|1.0|~/modes/basic-mode.el.Z|
+
+;; This file is NOT part of GNU Emacs but the same permissions apply.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of the
+;; License, or (at your option) any later version.
+
+
+;; Purpose of this package:
+;; This is a mode for editing programs written in The World's Most
+;; Successful Programming Language. It features automatic
+;; indentation, font locking, keyword capitalization, and some minor
+;; convenience functions.
+
+;; Installation instructions
+;; Put basic-mode.el somewhere in your path, compile it, and add the
+;; following to your init file:
+
+;; (autoload 'basic-mode "basic-mode" "Basic mode." t)
+;; (setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\)$" .
+;; basic-mode)) auto-mode-alist))
+
+;; Of course, under Windows 3.1, you'll have to name this file
+;; something shorter than basic-mode.el
+
+
+
+;; Known bugs:
+;; Doesn't know about ":" separated stmts
+;; Doesn't know about single-line IF stmts
+
+
+;; todo:
+;; fwd/back-compound-statement
+;; completion over OCX methods and properties.
+;; ensure Then at the end of IF statements.
+;; IDE integration
+;; etc.
+
+
+(provide 'basic-mode)
+
+(defvar basic-xemacs-p (string-match "XEmacs\\|Lucid" (emacs-version)))
+(defvar basic-winemacs-p (string-match "Win-Emacs" (emacs-version)))
+
+;; Variables you may want to customize.
+(defvar basic-mode-indent 2 "*Default indentation per nesting level")
+(defvar basic-fontify-p t "*Whether to fontify Basic buffers.")
+(defvar basic-capitalize-keywords-p t
+ "*Whether to capitalize BASIC keywords.")
+(defvar basic-wild-files "*.frm *.bas *.cls"
+ "*Wildcard pattern for BASIC source files")
+(defvar basic-ide-pathname nil
+ "*The full pathname of your Visual Basic exe file, if any.")
+
+
+(defvar basic-keywords-to-highlight
+ '("Dim" "If" "Then" "Else" "ElseIf" "End If")
+ "*A list of keywords to highlight in Basic mode, or T, meaning all keywords")
+
+(defvar basic-defn-templates
+ (list "Public Sub ()\nEnd Sub\n\n"
+ "Public Function () As Variant\nEnd Function\n\n"
+ "Public Property Get ()\nEnd Property\n\n")
+ "*List of function templates though which basic-new-sub cycles.")
+
+
+
+(defvar basic-mode-syntax-table nil)
+(if basic-mode-syntax-table
+ ()
+ (setq basic-mode-syntax-table (make-syntax-table))
+ (modify-syntax-entry ?\' "\<" basic-mode-syntax-table) ; Comment starter
+ (modify-syntax-entry ?\n ">" basic-mode-syntax-table)
+ (modify-syntax-entry ?\\ "w" basic-mode-syntax-table)
+ (modify-syntax-entry ?_ "w" basic-mode-syntax-table))
+
+
+(defvar basic-mode-map nil)
+(if basic-mode-map
+ ()
+ (setq basic-mode-map (make-sparse-keymap))
+ (define-key basic-mode-map "\t" 'basic-indent-line)
+ (define-key basic-mode-map "\r" 'basic-newline-and-indent)
+ (define-key basic-mode-map "\M-\C-a" 'basic-beginning-of-defun)
+ (define-key basic-mode-map "\M-\C-e" 'basic-end-of-defun)
+ (define-key basic-mode-map "\M-\C-h" 'basic-mark-defun)
+ (define-key basic-mode-map "\M-\C-\\" 'basic-indent-region)
+ (define-key basic-mode-map "\M-q" 'basic-fill-or-indent)
+ (if basic-xemacs-p
+ (progn
+ (if basic-winemacs-p
+ (define-key basic-mode-map '(control C) 'basic-start-ide))
+ (define-key basic-mode-map "\M-G" 'basic-grep)
+ (define-key basic-mode-map '(meta backspace) 'backward-kill-word)
+ (define-key basic-mode-map '(control meta /) 'basic-new-sub))))
+
+
+;; These abbrevs are valid only in a code context.
+(defvar basic-mode-abbrev-table nil)
+
+(defvar basic-mode-hook ())
+
+
+;; Is there a way to case-fold all regexp matches?
+
+(defconst basic-defun-start-regexp
+ (concat
+ "^[ \t]*\\([Pp]ublic \\|[Pp]rivate \\|[Ss]tatic \\)*"
+ "\\([Ss]ub\\|[Ff]unction\\|[Pp]roperty +[GgSsLl]et\\|[Tt]ype\\)"
+ "[ \t]+\\(\\w+\\)[ \t]*(?"))
+
+(defconst basic-defun-end-regexp
+ "^[ \t]*[Ee]nd \\([Ss]ub\\|[Ff]unction\\|[Pp]roperty\\|[Tt]ype\\)")
+
+
+;; Includes the compile-time #if variation.
+(defconst basic-if-regexp "^[ \t]*#?[Ii]f")
+(defconst basic-else-regexp "^[ \t]*#?[Ee]lse\\([Ii]f\\)?")
+(defconst basic-endif-regexp "[ \t]*#?[Ee]nd[ \t]*[Ii]f")
+
+(defconst basic-continuation-regexp "^.*\\_[ \t]*$")
+(defconst basic-label-regexp "^[ \t]*[a-zA-Z0-9_]+:$")
+
+(defconst basic-select-regexp "^[ \t]*[Ss]elect[ \t]+[Cc]ase")
+(defconst basic-case-regexp "^[ \t]*[Cc]ase")
+(defconst basic-select-end-regexp "^[ \t]*[Ee]nd[ \t]+[Ss]elect")
+
+(defconst basic-for-regexp "^[ \t]*[Ff]or")
+(defconst basic-next-regexp "^[ \t]*[Nn]ext")
+
+(defconst basic-do-regexp "^[ \t]*[Dd]o")
+(defconst basic-loop-regexp "^[ \t]*[Ll]oop")
+
+(defconst basic-while-regexp "^[ \t]*[Ww]hile")
+(defconst basic-wend-regexp "^[ \t]*[Ww]end")
+
+(defconst basic-with-regexp "^[ \t]*[Ww]ith")
+(defconst basic-end-with-regexp "^[ \t]*[Ee]nd[ \t]+[Ww]ith")
+
+(defconst basic-blank-regexp "^[ \t]*$")
+(defconst basic-comment-regexp "^[ \t]*\\s<.*$")
+
+
+;; This is some approximation of the set of reserved words in Visual Basic.
+(defconst basic-all-keywords
+ '("Aggregate" "And" "App" "AppActivate" "Application" "Array" "As"
+ "Asc" "AscB" "Atn" "Beep" "BeginTrans" "ByVal" "CBool" "CByte" "CCur"
+ "CDate" "CDbl" "CInt" "CLng" "CSng" "CStr" "CVErr" "CVar" "Call"
+ "Case" "ChDir" "ChDrive" "Character" "Choose" "Chr" "ChrB"
+ "ClassModule" "Clipboard" "Close" "Collection" "Column" "Columns"
+ "Command" "CommitTrans" "CompactDatabase" "Component" "Components"
+ "Const" "Container" "Containers" "Cos" "CreateDatabase" "CreateObject"
+ "CurDir" "Currency" "DBEngine" "DDB" "Data" "Database" "Databases"
+ "Date" "DateAdd" "DateDiff" "DatePart" "DateSerial" "DateValue" "Day"
+ "Debug" "Declare" "Deftype" "DeleteSetting" "Dim" "Dir" "Do" "Domain"
+ "Double" "Dynaset" "EOF" "Each" "Else" "End" "Environ" "Erase" "Err"
+ "Error" "Exit" "Exp" "FV" "False" "Field" "Fields" "FileAttr"
+ "FileCopy" "FileDateTime" "FileLen" "Fix" "Font" "For" "Form"
+ "FormTemplate" "Format" "Forms" "FreeFile" "FreeLocks" "Function"
+ "Get" "GetAllSettings" "GetAttr" "GetObject" "GetSetting" "GoSub"
+ "GoTo" "Group" "Groups" "Hex" "Hour" "IIf" "IMEStatus" "IPmt" "IRR"
+ "If" "InStr" "Input" "Int" "Integer" "Is" "IsArray" "IsDate" "IsEmpty"
+ "IsError" "IsMissing" "IsNull" "IsNumeric" "IsObject" "Kill" "LBound"
+ "LCase" "LOF" "LSet" "LTrim" "Left" "Len" "Let" "Like" "Line" "Load"
+ "LoadPicture" "LoadResData" "LoadResPicture" "LoadResString" "Loc"
+ "Lock" "Log" "Long" "Loop" "MDIForm" "MIRR" "Me" "MenuItems"
+ "MenuLine" "Mid" "Minute" "MkDir" "Month" "MsgBox" "NPV" "NPer" "Name"
+ "New" "Next" "Now" "Oct" "On" "Open" "OpenDatabase" "Operator"
+ "Option" "PPmt" "PV" "Parameter" "Parameters" "Partition" "Picture"
+ "Pmt" "Print" "Printer" "Printers" "Private" "ProjectTemplate"
+ "Properties" "Public" "Put" "QBColor" "QueryDef" "QueryDefs" "RGB"
+ "RSet" "RTrim" "Randomize" "Rate" "ReDim" "Recordset" "Recordsets"
+ "RegisterDatabase" "Relation" "Relations" "Rem" "RepairDatabase"
+ "Reset" "Resume" "Return" "Right" "RmDir" "Rnd" "Rollback" "RowBuffer"
+ "SLN" "SYD" "SavePicture" "SaveSetting" "Screen" "Second" "Seek"
+ "SelBookmarks" "Select" "SelectedComponents" "SendKeys" "Set"
+ "SetAttr" "SetDataAccessOption" "SetDefaultWorkspace" "Sgn" "Shell"
+ "Sin" "Single" "Snapshot" "Space" "Spc" "Sqr" "Static" "Stop" "Str"
+ "StrComp" "StrConv" "String" "Sub" "SubMenu" "Switch" "Tab" "Table"
+ "TableDef" "TableDefs" "Tan" "Then" "Time" "TimeSerial" "TimeValue"
+ "Timer" "To" "Trim" "True" "Type" "TypeName" "UBound" "UCase" "Unload"
+ "Unlock" "Val" "VarType" "Verb" "Weekday" "Wend"
+ "While" "Width" "With" "Workspace" "Workspaces" "Write" "Year"))
+
+
+(defun basic-word-list-regexp (keys)
+ (let ((re "\\b\\(")
+ (key nil))
+ (while keys
+ (setq key (car keys)
+ keys (cdr keys))
+ (setq re (concat re key (if keys "\\|" ""))))
+ (concat re "\\)\\b")))
+
+(defun basic-keywords-to-highlight ()
+ (if (eq basic-keywords-to-highlight t)
+ basic-all-keywords
+ basic-keywords-to-highlight))
+
+
+(defvar basic-font-lock-keywords
+ (list
+ ;; Names of functions.
+ (list basic-defun-start-regexp 3 'font-lock-function-name-face)
+
+ ;; Statement labels
+ (cons basic-label-regexp 'font-lock-keyword-face)
+
+ ;; Case values
+ ;; String-valued cases get font-lock-string-face regardless.
+ (list "^[ \t]*[Cc]ase[ \t]+\\([^'\n]+\\)" 1 'font-lock-keyword-face t)
+
+ ;; Any keywords you like.
+ (cons (basic-word-list-regexp (basic-keywords-to-highlight))
+ 'font-lock-keyword-face)))
+
+
+
+(defun basic-mode ()
+ "A mode for editing Microsoft Visual Basic programs.
+Features automatic indentation, font locking, keyword capitalization,
+and some minor convenience functions.
+Commands:
+\\{basic-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map basic-mode-map)
+ (setq major-mode 'basic-mode)
+ (setq mode-name "Basic")
+ (set-syntax-table basic-mode-syntax-table)
+
+ (add-hook 'write-file-hooks 'basic-untabify)
+
+ (setq local-abbrev-table basic-mode-abbrev-table)
+ (if basic-capitalize-keywords-p
+ (progn
+ (make-local-variable 'pre-abbrev-expand-hook)
+ (add-hook 'pre-abbrev-expand-hook 'basic-pre-abbrev-expand-hook)
+ (abbrev-mode 1)))
+
+
+ (make-local-variable 'comment-start)
+ (setq comment-start "' ")
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip "'+ *")
+ (make-local-variable 'comment-column)
+ (setq comment-column 40)
+ (make-local-variable 'comment-end)
+ (setq comment-end "")
+
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'basic-indent-line)
+
+ (make-local-variable 'font-lock-keywords)
+ (setq font-lock-keywords basic-font-lock-keywords)
+
+ (if basic-fontify-p
+ (font-lock-mode 1))
+
+ (run-hooks 'basic-mode-hook))
+
+
+(defun basic-construct-keyword-abbrev-table ()
+ (if basic-mode-abbrev-table
+ nil
+ (let ((words basic-all-keywords)
+ (word nil)
+ (list nil))
+ (while words
+ (setq word (car words)
+ words (cdr words))
+ (setq list (cons (list (downcase word) word) list)))
+
+ (define-abbrev-table 'basic-mode-abbrev-table list))))
+
+(basic-construct-keyword-abbrev-table)
+
+
+(defun basic-in-code-context-p ()
+ (if (fboundp 'buffer-syntactic-context) ; XEmacs function.
+ (null (buffer-syntactic-context))
+ ;; Attempt to simulate buffer-syntactic-context
+ ;; I don't know how reliable this is.
+ (let* ((beg (save-excursion
+ (beginning-of-line)
+ (point)))
+ (list
+ (parse-partial-sexp beg (point))))
+ (and (null (nth 3 list)) ; inside string.
+ (null (nth 4 list)))))) ; inside cocmment
+
+(defun basic-pre-abbrev-expand-hook ()
+ ;; Allow our abbrevs only in a code context.
+ (setq local-abbrev-table
+ (if (basic-in-code-context-p)
+ basic-mode-abbrev-table)))
+
+
+
+(defun basic-newline-and-indent (&optional count)
+ "Insert a newline, updating indentation."
+ (interactive)
+ (expand-abbrev)
+ (basic-indent-line)
+ (call-interactively 'newline-and-indent))
+
+(defun basic-beginning-of-defun ()
+ (interactive)
+ (re-search-backward basic-defun-start-regexp))
+
+(defun basic-end-of-defun ()
+ (interactive)
+ (re-search-forward basic-defun-end-regexp))
+
+(defun basic-mark-defun ()
+ (interactive)
+ (beginning-of-line)
+ (basic-end-of-defun)
+ (set-mark (point))
+ (basic-beginning-of-defun)
+ (if basic-xemacs-p
+ (zmacs-activate-region)))
+
+(defun basic-indent-defun ()
+ (interactive)
+ (save-excursion
+ (basic-mark-defun)
+ (call-interactively 'basic-indent-region)))
+
+
+(defun basic-fill-long-comment ()
+ "Fills block of comment lines around point."
+ ;; Derived from code in ilisp-ext.el.
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (let ((comment-re "^[ \t]*\\s<+[ \t]*"))
+ (if (looking-at comment-re)
+ (let ((fill-prefix
+ (buffer-substring
+ (progn (beginning-of-line) (point))
+ (match-end 0))))
+
+ (while (and (not (bobp))
+ (looking-at basic-comment-regexp))
+ (forward-line -1))
+ (if (not (bobp)) (forward-line 1))
+
+ (let ((start (point)))
+
+ ;; Make all the line prefixes the same.
+ (while (and (not (eobp))
+ (looking-at comment-re))
+ (replace-match fill-prefix)
+ (forward-line 1))
+
+ (if (not (eobp))
+ (beginning-of-line))
+
+ ;; Fill using fill-prefix
+ (fill-region-as-paragraph start (point))))))))
+
+
+(defun basic-fill-or-indent ()
+ "Fill long comment around point, if any, else indent current definition."
+ (interactive)
+ (cond ((save-excursion
+ (beginning-of-line)
+ (looking-at basic-comment-regexp))
+ (basic-fill-long-comment))
+ (t
+ (basic-indent-defun))))
+
+
+(defun basic-new-sub ()
+ "Insert template for a new subroutine. Repeat to cycle through alternatives."
+ (interactive)
+ (beginning-of-line)
+ (let ((templates (cons basic-blank-regexp
+ basic-defn-templates))
+ (tem nil)
+ (bound (point)))
+ (while templates
+ (setq tem (car templates)
+ templates (cdr templates))
+ (cond ((looking-at tem)
+ (replace-match (or (car templates)
+ ""))
+ (setq templates nil))))
+
+ (search-backward "()" bound t)))
+
+
+(defun basic-untabify ()
+ "Do not allow any tabs into the file"
+ (if (eq major-mode 'basic-mode)
+ (untabify (point-min) (point-max)))
+ nil)
+
+(defun basic-default-tag ()
+ (if (and (not (bobp))
+ (save-excursion
+ (backward-char 1)
+ (looking-at "\\w")))
+ (backward-word 1))
+ (let ((s (point))
+ (e (save-excursion
+ (forward-word 1)
+ (point))))
+ (buffer-substring s e)))
+
+(defun basic-grep (tag)
+ "Search BASIC source files in current directory for tag."
+ (interactive
+ (list (let* ((def (basic-default-tag))
+ (tag (read-string
+ (format "Grep for [%s]: " def))))
+ (if (string= tag "") def tag))))
+
+ (grep (format "grep -n %s %s" tag basic-wild-files)))
+
+
+
+(defun basic-start-ide ()
+ "Start Visual Basic (or your favorite IDE, (after Emacs, of course))
+on the project file in the current directory.
+Note: it's not a good idea to leave Visual Basic running while you
+are editing in emacs, since Visual Basic has no provision for reloading
+changed files."
+ (interactive)
+ (let (file)
+ (cond ((not (fboundp 'win-exec))
+ (error "Not available"))
+ ((null basic-ide-pathname)
+ (error "No pathname set for Visual Basic. See basic-ide-pathname"))
+ ((setq file (car (directory-files (pwd) t "\\.vbp")))
+ (iconify-emacs)
+ (win-exec basic-ide-pathname 'win-show-normal file))
+ (t
+ (error "No project file found.")))))
+
+
+
+;;; Indentation-related stuff.
+
+(defun basic-indent-region (start end)
+ "Perform basic-indent-line on each line in region."
+ (interactive "r")
+ (save-excursion
+ (goto-char start)
+ (beginning-of-line)
+ (while (and (not (eobp))
+ (< (point) end))
+ (if (not (looking-at basic-blank-regexp))
+ (basic-indent-line))
+ (forward-line 1)))
+
+ (cond ((fboundp 'zmacs-deactivate-region)
+ (zmacs-deactivate-region))
+ ((fboundp 'deactivate-mark)
+ (deactivate-mark))))
+
+
+
+(defun basic-previous-line-of-code ()
+ (if (not (bobp))
+ (forward-line -1)) ; previous-line depends on goal column
+ (while (and (not (bobp))
+ (or (looking-at basic-blank-regexp)
+ (looking-at basic-comment-regexp)))
+ (forward-line -1)))
+
+
+(defun basic-find-original-statement ()
+ ;; If the current line is a continuation from the previous, move
+ ;; back to the original stmt.
+ (let ((here (point)))
+ (basic-previous-line-of-code)
+ (while (and (not (bobp))
+ (looking-at basic-continuation-regexp))
+ (setq here (point))
+ (basic-previous-line-of-code))
+ (goto-char here)))
+
+(defun basic-find-matching-stmt (open-regexp close-regexp)
+ ;; Searching backwards
+ (let ((level 0))
+ (while (and (>= level 0) (not (bobp)))
+ (basic-previous-line-of-code)
+ (basic-find-original-statement)
+ (cond ((looking-at close-regexp)
+ (setq level (+ level 1)))
+ ((looking-at open-regexp)
+ (setq level (- level 1)))))))
+
+(defun basic-find-matching-if ()
+ (basic-find-matching-stmt basic-if-regexp basic-endif-regexp))
+
+(defun basic-find-matching-select ()
+ (basic-find-matching-stmt basic-select-regexp basic-select-end-regexp))
+
+(defun basic-find-matching-for ()
+ (basic-find-matching-stmt basic-for-regexp basic-next-regexp))
+
+(defun basic-find-matching-do ()
+ (basic-find-matching-stmt basic-do-regexp basic-loop-regexp))
+
+(defun basic-find-matching-while ()
+ (basic-find-matching-stmt basic-while-regexp basic-wend-regexp))
+
+(defun basic-find-matching-with ()
+ (basic-find-matching-stmt basic-with-regexp basic-end-with-regexp))
+
+
+(defun basic-calculate-indent ()
+ (let ((original-point (point)))
+ (save-excursion
+ (beginning-of-line)
+ ;; Some cases depend only on where we are now.
+ (cond ((or (looking-at basic-defun-start-regexp)
+ (looking-at basic-label-regexp)
+ (looking-at basic-defun-end-regexp))
+ 0)
+
+ ;; The outdenting stmts, which simply match their original.
+ ((or (looking-at basic-else-regexp)
+ (looking-at basic-endif-regexp))
+ (basic-find-matching-if)
+ (current-indentation))
+
+ ;; All the other matching pairs act alike.
+ ((looking-at basic-next-regexp) ; for/next
+ (basic-find-matching-for)
+ (current-indentation))
+
+ ((looking-at basic-loop-regexp) ; do/loop
+ (basic-find-matching-do)
+ (current-indentation))
+
+ ((looking-at basic-wend-regexp) ; while/wend
+ (basic-find-matching-while)
+ (current-indentation))
+
+ ((looking-at basic-with-regexp) ; with/end with
+ (basic-find-matching-with)
+ (current-indentation))
+
+ ((looking-at basic-select-end-regexp) ; select case/end select
+ (basic-find-matching-select)
+ (current-indentation))
+
+ ;; A case of a select is somewhat special.
+ ((looking-at basic-case-regexp)
+ (basic-find-matching-select)
+ (+ (current-indentation) basic-mode-indent))
+
+ (t
+ ;; Other cases which depend on the previous line.
+ (basic-previous-line-of-code)
+
+ ;; Skip over label lines, which always have 0 indent.
+ (while (looking-at basic-label-regexp)
+ (basic-previous-line-of-code))
+
+ (cond
+ ((looking-at basic-continuation-regexp)
+ (basic-find-original-statement)
+ ;; Indent continuation line under matching open paren,
+ ;; or else one word in.
+ (let* ((orig-stmt (point))
+ (matching-open-paren
+ (condition-case ()
+ (save-excursion
+ (goto-char original-point)
+ (beginning-of-line)
+ (backward-up-list 1)
+ ;; Only if point is now w/in cont. block.
+ (if (<= orig-stmt (point))
+ (current-column)))
+ (error nil))))
+ (cond (matching-open-paren
+ (1+ matching-open-paren))
+ (t
+ ;; Else, after first word on original line.
+ (back-to-indentation)
+ (forward-word 1)
+ (while (looking-at "[ \t]")
+ (forward-char 1))
+ (current-column)))))
+ (t
+ (basic-find-original-statement)
+ (let ((indent (current-indentation)))
+ ;; All the various +indent regexps.
+ (cond ((looking-at basic-defun-start-regexp)
+ (+ indent basic-mode-indent))
+
+ ((or (looking-at basic-if-regexp)
+ (looking-at basic-else-regexp))
+ (+ indent basic-mode-indent))
+
+ ((or (looking-at basic-select-regexp)
+ (looking-at basic-case-regexp))
+ (+ indent basic-mode-indent))
+
+ ((or (looking-at basic-do-regexp)
+ (looking-at basic-for-regexp)
+ (looking-at basic-while-regexp)
+ (looking-at basic-with-regexp))
+ (+ indent basic-mode-indent))
+
+ (t
+ ;; By default, just copy indent from prev line.
+ indent))))))))))
+
+(defun basic-indent-to-column (col)
+ (let* ((bol (save-excursion
+ (beginning-of-line)
+ (point)))
+ (point-in-whitespace
+ (<= (point) (+ bol (current-indentation))))
+ (blank-line-p
+ (save-excursion
+ (beginning-of-line)
+ (looking-at basic-blank-regexp))))
+
+ (cond ((/= col (current-indentation))
+ (save-excursion
+ (beginning-of-line)
+ (back-to-indentation)
+ (delete-region bol (point))
+ (indent-to col))))
+
+ ;; If point was in the whitespace, move back-to-indentation.
+ (cond (blank-line-p
+ (end-of-line))
+ (point-in-whitespace
+ (back-to-indentation)))))
+
+(defun basic-indent-line ()
+ "Indent current line for BASIC"
+ (interactive)
+ (basic-indent-to-column (basic-calculate-indent)))
--- /dev/null
+;;; cldoc.el --- show Common Lisp operators and variables information in echo area
+
+;; Copyright (C) 1996, 97, 98, 99, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2004 Yuji Minejima
+
+;; This program (cldoc.el) is based on eldoc.el.
+;; Eldoc Author: Noah Friedman <friedman@splode.com>
+;; Keywords: extensions
+
+;; $Id: cldoc.el,v 1.16 2004/12/01 02:06:43 yuji Exp $
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; cldoc.el is basically an eldoc clone for Common Lisp.
+;; The following comment is from eldoc.el
+;; > This program was inspired by the behavior of the "mouse documentation
+;; > window" on many Lisp Machine systems; as you type a function's symbol
+;; > name as part of a sexp, it will print the argument list for that
+;; > function. Behavior is not identical; for example, you need not actually
+;; > type the function name, you need only move point around in a sexp that
+;; > calls it. Also, if point is over a documented variable, it will print
+;; > the one-line documentation for that variable instead, to remind you of
+;; > that variable's meaning.
+;;
+;; cldoc.el has a database of parameters and results of Common Lisp's standard
+;; functions, and syntax rules of standard macros and special operators.
+;; cldoc.el automatically uses SLIME's autodoc facility if available to display
+;; parameters of user defined functions and macros, and the values of global
+;; variables.
+
+
+;; One useful way to enable this minor mode is to put the following in your
+;; .emacs:
+;;
+;; ;; all users
+;; (autoload 'turn-on-cldoc-mode "cldoc" nil t)
+;; (add-hook 'lisp-mode-hook 'turn-on-cldoc-mode)
+;;
+;; ;; ilisp users
+;; (add-hook 'ilisp-mode-hook 'turn-on-cldoc-mode)
+;; (setq ilisp-bindings-*bind-space-p* nil)
+;;
+;; ;; slime users
+;; (add-hook 'slime-repl-mode-hook
+;; #'(lambda ()
+;; (turn-on-cldoc-mode)
+;; (define-key slime-repl-mode-map " " nil)))
+;; (add-hook 'slime-mode-hook
+;; #'(lambda () (define-key slime-mode-map " " nil)))
+;; (setq slime-use-autodoc-mode nil)
+
+;; todo
+;; * handling of operators with multiple syntax rules (e.g. file-position).
+;; * handling of operators which implementations are allowed to extend
+;; (e.g. directory)
+
+
+;;; Code:
+(require 'cl)
+
+;; Use idle timers if available in the version of emacs running.
+;; Please don't change this to use `require'; this package works
+;; as-is in XEmacs 19.14 and later and I am striving to maintain
+;; compatibility between emacs variants.
+(or (featurep 'timer)
+ (load "timer" t))
+
+(defgroup cldoc nil
+ "Show function arglist or variable docstring in echo area."
+ :group 'lisp
+ :group 'extensions)
+
+;;;###autoload
+(defcustom cldoc-mode nil
+ "*If non-nil, show the defined parameters for the elisp function near point.
+
+For the emacs lisp function at the beginning of the sexp which point is
+within, show the defined parameters for the function in the echo area.
+This information is extracted directly from the function or macro if it is
+in pure lisp. If the emacs function is a subr, the parameters are obtained
+from the documentation string if possible.
+
+If point is over a documented variable, print that variable's docstring
+instead.
+
+This variable is buffer-local."
+ :type 'boolean
+ :group 'cldoc)
+(make-variable-buffer-local 'cldoc-mode)
+
+(defcustom cldoc-idle-delay 0.50
+ "*Number of seconds of idle time to wait before printing.
+If user input arrives before this interval of time has elapsed after the
+last input, no documentation will be printed.
+
+If this variable is set to 0, no idle time is required."
+ :type 'number
+ :group 'cldoc)
+
+;;;###autoload
+(defcustom cldoc-minor-mode-string " Cldoc"
+ "*String to display in mode line when Cldoc Mode is enabled."
+ :type 'string
+ :group 'cldoc)
+
+(defcustom cldoc-argument-case 'upcase
+ "Case to display argument names of functions, as a symbol.
+This has two preferred values: `upcase' or `downcase'.
+Actually, any name of a function which takes a string as an argument and
+returns another string is acceptable."
+ :type '(radio (function-item upcase)
+ (function-item downcase)
+ function)
+ :group 'cldoc)
+
+(defcustom cldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit
+ "*Allow long cldoc messages to resize echo area display.
+If value is `t', never attempt to truncate messages; complete symbol name
+and function arglist or 1-line variable documentation will be displayed
+even if echo area must be resized to fit.
+
+If value is any non-nil value other than `t', symbol name may be truncated
+if it will enable the function arglist or documentation string to fit on a
+single line without resizing window. Otherwise, behavior is just like
+former case.
+
+If value is nil, messages are always truncated to fit in a single line of
+display in the echo area. Function or variable symbol name may be
+truncated to make more of the arglist or documentation string visible.
+
+Non-nil values for this variable have no effect unless
+`cldoc-echo-area-multiline-supported-p' is non-nil."
+ :type '(radio (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Yes, but truncate symbol names if it will\
+ enable argument list to fit on one line" truncate-sym-name-if-fit))
+ :group 'cldoc)
+
+;;; No user options below here.
+
+;; Non-nil if this version of emacs supports dynamically resizable echo areas.
+(defvar cldoc-echo-area-multiline-supported-p
+ (and (string-lessp "21" emacs-version)
+ (save-match-data
+ (numberp (string-match "^GNU Emacs" (emacs-version))))))
+
+;; Commands after which it is appropriate to print in the echo area.
+;; Cldoc does not try to print function arglists, etc. after just any command,
+;; because some commands print their own messages in the echo area and these
+;; functions would instantly overwrite them. But self-insert-command as well
+;; as most motion commands are good candidates.
+;; This variable contains an obarray of symbols; do not manipulate it
+;; directly. Instead, use `cldoc-add-command' and `cldoc-remove-command'.
+(defvar cldoc-message-commands nil)
+
+;; This is used by cldoc-add-command to initialize cldoc-message-commands
+;; as an obarray.
+;; It should probably never be necessary to do so, but if you
+;; choose to increase the number of buckets, you must do so before loading
+;; this file since the obarray is initialized at load time.
+;; Remember to keep it a prime number to improve hash performance.
+(defvar cldoc-message-commands-table-size 31)
+
+;; Bookkeeping; elements are as follows:
+;; 0 - contains the last symbol read from the buffer.
+;; 1 - contains the string last displayed in the echo area for that
+;; symbol, so it can be printed again if necessary without reconsing.
+;; 2 - 'function if function args, 'variable if variable documentation.
+(defvar cldoc-last-data (make-vector 3 nil))
+(defvar cldoc-last-message nil)
+
+;; Idle timers are supported in Emacs 19.31 and later.
+(defvar cldoc-use-idle-timer-p (fboundp 'run-with-idle-timer))
+
+;; cldoc's timer object, if using idle timers
+(defvar cldoc-timer nil)
+
+;; idle time delay currently in use by timer.
+;; This is used to determine if cldoc-idle-delay is changed by the user.
+(defvar cldoc-current-idle-delay cldoc-idle-delay)
+
+;; Put minor mode string on the global minor-mode-alist.
+;;;###autoload
+(cond ((fboundp 'add-minor-mode)
+ (add-minor-mode 'cldoc-mode 'cldoc-minor-mode-string))
+ ((assq 'cldoc-mode (default-value 'minor-mode-alist)))
+ (t
+ (setq-default minor-mode-alist
+ (append (default-value 'minor-mode-alist)
+ '((cldoc-mode cldoc-minor-mode-string))))))
+
+\f
+;;;###autoload
+(defun cldoc-mode (&optional prefix)
+ "*Enable or disable cldoc mode.
+See documentation for the variable of the same name for more details.
+
+If called interactively with no prefix argument, toggle current condition
+of the mode.
+If called with a positive or negative prefix argument, enable or disable
+the mode, respectively."
+ (interactive "P")
+ (setq cldoc-last-message nil)
+ (cond (cldoc-use-idle-timer-p
+ (add-hook 'post-command-hook 'cldoc-schedule-timer)
+ (add-hook 'pre-command-hook 'cldoc-pre-command-refresh-echo-area))
+ (t
+ ;; Use post-command-idle-hook if defined, otherwise use
+ ;; post-command-hook. The former is only proper to use in Emacs
+ ;; 19.30; that is the first version in which it appeared, but it
+ ;; was obsolesced by idle timers in Emacs 19.31.
+ (add-hook (if (boundp 'post-command-idle-hook)
+ 'post-command-idle-hook
+ 'post-command-hook)
+ 'cldoc-print-current-symbol-info t t)
+ ;; quick and dirty hack for seeing if this is XEmacs
+ (and (fboundp 'display-message)
+ (add-hook 'pre-command-hook
+ 'cldoc-pre-command-refresh-echo-area t t))))
+ (setq cldoc-mode (if prefix
+ (>= (prefix-numeric-value prefix) 0)
+ (not cldoc-mode)))
+ (and (interactive-p)
+ (if cldoc-mode
+ (message "cldoc-mode is enabled")
+ (message "cldoc-mode is disabled")))
+ (when (and cldoc-mode (and (boundp 'slime-autodoc-mode) slime-autodoc-mode))
+ (slime-autodoc-mode -1))
+ cldoc-mode)
+
+;;;###autoload
+(defun turn-on-cldoc-mode ()
+ "Unequivocally turn on cldoc-mode (see variable documentation)."
+ (interactive)
+ (cldoc-mode 1))
+
+\f
+;; Idle timers are part of Emacs 19.31 and later.
+(defun cldoc-schedule-timer ()
+ (or (and cldoc-timer
+ (memq cldoc-timer timer-idle-list))
+ (setq cldoc-timer
+ (run-with-idle-timer cldoc-idle-delay t
+ 'cldoc-print-current-symbol-info)))
+
+ ;; If user has changed the idle delay, update the timer.
+ (cond ((not (= cldoc-idle-delay cldoc-current-idle-delay))
+ (setq cldoc-current-idle-delay cldoc-idle-delay)
+ (timer-set-idle-time cldoc-timer cldoc-idle-delay t))))
+
+(defun cldoc-message (&rest args)
+ (let ((omessage cldoc-last-message))
+ (cond ((eq (car args) cldoc-last-message))
+ ((or (null args)
+ (null (car args)))
+ (setq cldoc-last-message nil))
+ ;; If only one arg, no formatting to do so put it in
+ ;; cldoc-last-message so eq test above might succeed on
+ ;; subsequent calls.
+ ((null (cdr args))
+ (setq cldoc-last-message (car args)))
+ (t
+ (setq cldoc-last-message (apply 'format args))))
+ ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages
+ ;; are recorded in a log. Do not put cldoc messages in that log since
+ ;; they are Legion.
+ (cond ((fboundp 'display-message)
+ ;; XEmacs 19.13 way of preventing log messages.
+ (cond (cldoc-last-message
+ (display-message 'no-log cldoc-last-message))
+ (omessage
+ (clear-message 'no-log))))
+ (t
+ ;; Emacs way of preventing log messages.
+ (let ((message-log-max nil))
+ (cond (cldoc-last-message
+ (message "%s" cldoc-last-message))
+ (omessage
+ (message nil)))))))
+ cldoc-last-message)
+
+;; This function goes on pre-command-hook for XEmacs or when using idle
+;; timers in Emacs. Motion commands clear the echo area for some reason,
+;; which make cldoc messages flicker or disappear just before motion
+;; begins. This function reprints the last cldoc message immediately
+;; before the next command executes, which does away with the flicker.
+;; This doesn't seem to be required for Emacs 19.28 and earlier.
+(defun cldoc-pre-command-refresh-echo-area ()
+ (and cldoc-last-message
+ (if (cldoc-display-message-no-interference-p)
+ (cldoc-message cldoc-last-message)
+ (setq cldoc-last-message nil))))
+
+;; Decide whether now is a good time to display a message.
+(defun cldoc-display-message-p ()
+ (and (cldoc-display-message-no-interference-p)
+ (cond (cldoc-use-idle-timer-p
+ ;; If this-command is non-nil while running via an idle
+ ;; timer, we're still in the middle of executing a command,
+ ;; e.g. a query-replace where it would be annoying to
+ ;; overwrite the echo area.
+ (and (not this-command)
+ (symbolp last-command)
+ (intern-soft (symbol-name last-command)
+ cldoc-message-commands)))
+ (t
+ ;; If we don't have idle timers, this function is
+ ;; running on post-command-hook directly; that means the
+ ;; user's last command is still on `this-command', and we
+ ;; must wait briefly for input to see whether to do display.
+ (and (symbolp this-command)
+ (intern-soft (symbol-name this-command)
+ cldoc-message-commands)
+ (sit-for cldoc-idle-delay))))))
+
+;; Check various conditions about the current environment that might make
+;; it undesirable to print cldoc messages right this instant.
+(defun cldoc-display-message-no-interference-p ()
+ (and cldoc-mode
+ (not executing-kbd-macro)
+ (not (and (boundp 'edebug-active) edebug-active))
+ ;; Having this mode operate in an active minibuffer/echo area causes
+ ;; interference with what's going on there.
+ (not cursor-in-echo-area)
+ (not (eq (selected-window) (minibuffer-window)))))
+
+\f
+(defun cldoc-print-current-symbol-info ()
+ (and (cldoc-display-message-p)
+ (let* ((current-symbol (cldoc-current-symbol))
+ (current-fnsym (cldoc-fnsym-in-current-sexp))
+ (doc (cond ((eq current-symbol current-fnsym)
+ (or (cldoc-get-fnsym-args-string current-fnsym)
+ (cldoc-get-var-value current-symbol)))
+ (t
+ (or (cldoc-get-var-value current-symbol)
+ (cldoc-get-fnsym-args-string current-fnsym))))))
+ (cldoc-message doc))))
+
+
+(defun cldoc-get-fnsym-signature-from-lisp-process (sym)
+ (cond
+ ((fboundp 'slime-space)
+ ;; from slime.el
+ (when (and slime-space-information-p
+ (slime-connected-p)
+ (or (not (slime-busy-p))))
+ (let ((result (slime-eval
+ `(swank:arglist-for-echo-area '(,(symbol-name sym))))))
+ (when (stringp result) (cdar (read-from-string result))))))
+ ;;((fboundp 'ilisp-arglist-message-lisp-space)
+ ;; (cldoc-ilisp-signature))
+ (t nil)))
+
+;; Return a string containing the function parameter list, or 1-line
+;; docstring if function is a subr and no arglist is obtainable from the
+;; docstring or elsewhere.
+(defun cldoc-get-fnsym-args-string (sym)
+ (let* ((entry (intern-soft (downcase (symbol-name sym)) cl-operator-signatures))
+ (signature (if (and entry (boundp entry))
+ (symbol-value entry)
+ (cldoc-get-fnsym-signature-from-lisp-process sym))))
+ (setq doc
+ (cond
+ ((null signature) nil)
+ ((stringp signature)
+ (cldoc-docstring-format-sym-doc sym signature))
+ (t
+ (let* ((tail (member '=> signature))
+ (result (cldoc-function-resultstring-format (cdr tail)))
+ (args (cldoc-function-argstring-format (ldiff signature tail)))
+ (args-and-result (if tail
+ (format "%s => %s" args result)
+ (format "%s" args))))
+ (cldoc-docstring-format-sym-doc sym args-and-result)))))))
+
+(defun cldoc-function-resultstring-format (results)
+ (let (str)
+ (do* ((results results (cdr results))
+ result)
+ ((endp results))
+ (setq result (funcall cldoc-argument-case (symbol-name (car results))))
+ (if str
+ (setq str (format "%s, %s" str result))
+ (setq str (format "%s" result))))
+ str))
+
+
+;; Return a string containing a brief (one-line) documentation string for
+;; the variable.
+(defun cldoc-get-var-value (sym)
+ (cond
+ ((fboundp 'slime-autodoc) ;; from slime.el
+ (let* ((name (slime-autodoc-global-at-point))
+ (value (when (and name
+ slime-space-information-p
+ (slime-connected-p)
+ (or (not (slime-busy-p)))
+ (slime-global-variable-name-p name))
+ (slime-eval `(swank:variable-desc-for-echo-area ,name)))))
+ value))
+ (t nil)))
+
+(defun cldoc-last-data-store (symbol doc type)
+ (aset cldoc-last-data 0 symbol)
+ (aset cldoc-last-data 1 doc)
+ (aset cldoc-last-data 2 type))
+
+;; Note that any leading `*' in the docstring (which indicates the variable
+;; is a user option) is removed.
+(defun cldoc-docstring-first-line (doc)
+ (and (stringp doc)
+ (substitute-command-keys
+ (save-match-data
+ (let ((start (if (string-match "^\\*" doc) (match-end 0) 0)))
+ (cond ((string-match "\n" doc)
+ (substring doc start (match-beginning 0)))
+ ((zerop start) doc)
+ (t (substring doc start))))))))
+
+;; If the entire line cannot fit in the echo area, the symbol name may be
+;; truncated or eliminated entirely from the output to make room for the
+;; description.
+(defun cldoc-docstring-format-sym-doc (sym doc)
+ (save-match-data
+ (let* ((name (symbol-name sym))
+ (ea-multi (and cldoc-echo-area-multiline-supported-p
+ cldoc-echo-area-use-multiline-p))
+ ;; Subtract 1 from window width since emacs will not write
+ ;; any chars to the last column, or in later versions, will
+ ;; cause a wraparound and resize of the echo area.
+ (ea-width (1- (window-width (minibuffer-window))))
+ (strip (- (+ (length name) (length ": ") (length doc)) ea-width)))
+ (cond ((or (<= strip 0)
+ (eq ea-multi t)
+ (and ea-multi (> (length doc) ea-width)))
+ (format "%s: %s" sym doc))
+ ((> (length doc) ea-width)
+ (substring (format "%s" doc) 0 ea-width))
+ ((>= strip (length name))
+ (format "%s" doc))
+ (t
+ ;; Show the end of the partial symbol name, rather
+ ;; than the beginning, since the former is more likely
+ ;; to be unique given package namespace conventions.
+ (setq name (substring name strip))
+ (format "%s: %s" name doc))))))
+
+\f
+(defun cldoc-fnsym-in-current-sexp ()
+ (let ((p (point)))
+ (cldoc-beginning-of-sexp)
+ (prog1
+ ;; Don't do anything if current word is inside a string.
+ (if (= (or (char-after (1- (point))) 0) ?\")
+ nil
+ (cldoc-current-symbol))
+ (goto-char p))))
+
+(defun cldoc-beginning-of-sexp ()
+ (let ((parse-sexp-ignore-comments t))
+ (condition-case err
+ (while (progn
+ (forward-sexp -1)
+ (or (= (or (char-after (1- (point)))) ?\")
+ (> (point) (point-min)))))
+ (error nil))))
+
+(defun cldoc-current-symbol ()
+ (let ((c (char-after (point))))
+ (and c
+ (memq (char-syntax c) '(?w ?_))
+ (intern (current-word)))))
+
+;; Do indirect function resolution if possible.
+(defun cldoc-symbol-function (fsym)
+ (let ((defn (and (fboundp fsym)
+ (symbol-function fsym))))
+ (and (symbolp defn)
+ (condition-case err
+ (setq defn (indirect-function fsym))
+ (error (setq defn nil))))
+ defn))
+
+(defun cldoc-function-arglist (fn)
+ (let* ((prelim-def (cldoc-symbol-function fn))
+ (def (if (eq (car-safe prelim-def) 'macro)
+ (cdr prelim-def)
+ prelim-def))
+ (arglist (cond ((null def) nil)
+ ((byte-code-function-p def)
+ (cond ((fboundp 'compiled-function-arglist)
+ (funcall 'compiled-function-arglist def))
+ (t
+ (aref def 0))))
+ ((eq (car-safe def) 'lambda)
+ (nth 1 def))
+ (t t))))
+ arglist))
+
+(defun cldoc-function-argstring (fn)
+ (cldoc-function-argstring-format (cldoc-function-arglist fn)))
+
+(defun cldoc-function-arg-format (arg)
+ (typecase arg
+ (symbol (if (memq arg '(&allow-other-keys &aux &body &environment &key &optional
+ &rest &whole))
+ (symbol-name arg)
+ (funcall cldoc-argument-case (symbol-name arg))))
+ (string (if (member arg '("&allow-other-keys" "&aux" "&body" "&environment"
+ "&key" "&optional" "&rest" "&whole"))
+ arg
+ (funcall cldoc-argument-case (symbol-name arg))))
+ (cons (cldoc-function-argstring-format arg))
+ (t (format "%s" arg))))
+
+(defun cldoc-function-argstring-format (arglist)
+ (concat "(" (mapconcat #'cldoc-function-arg-format arglist " ") ")"))
+
+\f
+;; Alist of predicate/action pairs.
+;; Each member of the list is a sublist consisting of a predicate function
+;; used to determine if the arglist for a function can be found using a
+;; certain pattern, and a function which returns the actual arglist from
+;; that docstring.
+;;
+;; The order in this table is significant, since later predicates may be
+;; more general than earlier ones.
+;;
+;; Compiler note for Emacs/XEmacs versions which support dynamic loading:
+;; these functions will be compiled to bytecode, but can't be lazy-loaded
+;; even if you set byte-compile-dynamic; to do that would require making
+;; them named top-level defuns, which is not particularly desirable either.
+(defvar cldoc-function-argstring-from-docstring-method-table
+ (list
+ ;; Try first searching for args starting with symbol name.
+ ;; This is to avoid matching parenthetical remarks in e.g. sit-for.
+ (list (function (lambda (doc fn)
+ (string-match (format "^(%s[^\n)]*)$" fn) doc)))
+ (function (lambda (doc)
+ ;; end does not include trailing ")" sequence.
+ (let ((end (- (match-end 0) 1)))
+ (if (string-match " +" doc (match-beginning 0))
+ (substring doc (match-end 0) end)
+ "")))))
+
+ ;; Try again not requiring this symbol name in the docstring.
+ ;; This will be the case when looking up aliases.
+ (list (function (lambda (doc fn)
+ ;; save-restriction has a pathological docstring in
+ ;; Emacs/XEmacs 19.
+ (and (not (eq fn 'save-restriction))
+ (string-match "^([^\n)]+)$" doc))))
+ (function (lambda (doc)
+ ;; end does not include trailing ")" sequence.
+ (let ((end (- (match-end 0) 1)))
+ (and (string-match " +" doc (match-beginning 0))
+ (substring doc (match-end 0) end))))))
+
+ ;; Emacs subr docstring style:
+ ;; (fn arg1 arg2 ...): description...
+ (list (function (lambda (doc fn)
+ (string-match "^([^\n)]+):" doc)))
+ (function (lambda (doc)
+ ;; end does not include trailing "):" sequence.
+ (let ((end (- (match-end 0) 2)))
+ (and (string-match " +" doc (match-beginning 0))
+ (substring doc (match-end 0) end))))))
+
+ ;; XEmacs subr docstring style:
+ ;; "arguments: (arg1 arg2 ...)
+ (list (function (lambda (doc fn)
+ (string-match "^arguments: (\\([^\n)]+\\))" doc)))
+ (function (lambda (doc)
+ ;; also skip leading paren, but the first word is
+ ;; actually an argument, not the function name.
+ (substring doc (match-beginning 1) (match-end 1)))))
+
+ ;; This finds the argstring for `condition-case'. Any others?
+ (list (function (lambda (doc fn)
+ (string-match
+ (format "^Usage looks like \\((%s[^\n)]*)\\)\\.$" fn)
+ doc)))
+ (function (lambda (doc)
+ ;; end does not include trailing ")" sequence.
+ (let ((end (- (match-end 1) 1)))
+ (and (string-match " +" doc (match-beginning 1))
+ (substring doc (match-end 0) end))))))
+
+ ;; This finds the argstring for `setq-default'. Any others?
+ (list (function (lambda (doc fn)
+ (string-match (format "^[ \t]+\\((%s[^\n)]*)\\)$" fn)
+ doc)))
+ (function (lambda (doc)
+ ;; end does not include trailing ")" sequence.
+ (let ((end (- (match-end 1) 1)))
+ (and (string-match " +" doc (match-beginning 1))
+ (substring doc (match-end 0) end))))))
+
+ ;; This finds the argstring for `start-process'. Any others?
+ (list (function (lambda (doc fn)
+ (string-match "^Args are +\\([^\n]+\\)$" doc)))
+ (function (lambda (doc)
+ (substring doc (match-beginning 1) (match-end 1)))))
+
+ ;; These common subrs don't have arglists in their docstrings. So cheat.
+ (list (function (lambda (doc fn)
+ (memq fn '(and or list + -))))
+ (function (lambda (doc)
+ ;; The value nil is a placeholder; otherwise, the
+ ;; following string may be compiled as a docstring,
+ ;; and not a return value for the function.
+ ;; In interpreted lisp form they are
+ ;; indistinguishable; it only matters for compiled
+ ;; forms.
+ nil
+ "&rest args")))
+ ))
+
+(defun cldoc-function-argstring-from-docstring (fn)
+ (let ((docstring (documentation fn 'raw))
+ (table cldoc-function-argstring-from-docstring-method-table)
+ (doc nil)
+ (doclist nil))
+ (save-match-data
+ (while table
+ (cond ((funcall (car (car table)) docstring fn)
+ (setq doc (funcall (car (cdr (car table))) docstring))
+ (setq table nil))
+ (t
+ (setq table (cdr table)))))
+
+ (cond ((not (stringp doc))
+ nil)
+ ((string-match "&" doc)
+ (let ((p 0)
+ (l (length doc)))
+ (while (< p l)
+ (cond ((string-match "[ \t\n]+" doc p)
+ (setq doclist
+ (cons (substring doc p (match-beginning 0))
+ doclist))
+ (setq p (match-end 0)))
+ (t
+ (setq doclist (cons (substring doc p) doclist))
+ (setq p l))))
+ (cldoc-function-argstring-format (nreverse doclist))))
+ (t
+ (concat "(" (funcall cldoc-argument-case doc) ")"))))))
+
+\f
+;; When point is in a sexp, the function args are not reprinted in the echo
+;; area after every possible interactive command because some of them print
+;; their own messages in the echo area; the cldoc functions would instantly
+;; overwrite them unless it is more restrained.
+;; These functions do display-command table management.
+
+(defun cldoc-add-command (&rest cmds)
+ (or cldoc-message-commands
+ (setq cldoc-message-commands
+ (make-vector cldoc-message-commands-table-size 0)))
+
+ (let (name sym)
+ (while cmds
+ (setq name (car cmds))
+ (setq cmds (cdr cmds))
+
+ (cond ((symbolp name)
+ (setq sym name)
+ (setq name (symbol-name sym)))
+ ((stringp name)
+ (setq sym (intern-soft name))))
+
+ (and (symbolp sym)
+ (fboundp sym)
+ (set (intern name cldoc-message-commands) t)))))
+
+(defun cldoc-add-command-completions (&rest names)
+ (while names
+ (apply 'cldoc-add-command
+ (all-completions (car names) obarray 'fboundp))
+ (setq names (cdr names))))
+
+(defun cldoc-remove-command (&rest cmds)
+ (let (name)
+ (while cmds
+ (setq name (car cmds))
+ (setq cmds (cdr cmds))
+
+ (and (symbolp name)
+ (setq name (symbol-name name)))
+
+ (if (fboundp 'unintern)
+ (unintern name cldoc-message-commands)
+ (let ((s (intern-soft name cldoc-message-commands)))
+ (and s
+ (makunbound s)))))))
+
+(defun cldoc-remove-command-completions (&rest names)
+ (while names
+ (apply 'cldoc-remove-command
+ (all-completions (car names) cldoc-message-commands))
+ (setq names (cdr names))))
+
+\f
+;; Prime the command list.
+(cldoc-add-command-completions
+ "backward-" "beginning-of-" "delete-other-windows" "delete-window"
+ "end-of-" "forward-" "indent-for-tab-command" "goto-" "mouse-set-point"
+ "next-" "other-window" "previous-" "recenter" "scroll-"
+ "self-insert-command" "split-window-"
+ "up-list" "down-list")
+
+\f
+(defvar cl-operator-signatures (make-vector 67 0))
+
+;; note
+;; these symbols are used, => =>|
+(mapcar (lambda (entry)
+ (let ((symbol (intern (symbol-name (car entry)) cl-operator-signatures)))
+ (set symbol (cdr entry))))
+
+ '(;; evaluation and compilation
+ (lambda . "lambda-list [[declaration* | documentation]] form* => function")
+ (compile function-name-or-nil &optional lambda-expression-or-function => function warnings-p failure-p)
+ (eval form => result*)
+ (eval-when . "(situation*) form* => result*")
+ (load-time-value . "form &optional read-only-p => object")
+ (quote object => object)
+ (compiler-macro-function name &optional (environment nil) => function)
+ (define-compiler-macro . "name lambda-list [[declaration* | documentation]] form* => name")
+ (defmacro . "name lambda-list [[declaration* | documentation]] form* => name")
+ (macro-function symbol &optional (environment nil) => macro-function-or-nil)
+ (macroexpand form &optional (environment nil) => expansion expanded-p)
+ (macroexpand-1 form &optional (environment nil) => expansion expanded-p)
+ (define-symbol-macro . "symbol expansion => symbol")
+ (symbol-macrolet . "((symbol expansion)*) declaration* form* => result*")
+ (proclaim declaration-specifier => implementation-dependent)
+ (declaim . "declaration-specifier* => implementation-dependent")
+ (locally declaration* form* => result*)
+ (the value-type form => result*)
+ (special-operator-p symbol => generalized-boolean)
+ (constantp form &optional (environment nil) => generalized-boolean)
+
+
+ ;; types and classes
+ (coerce object result-type => result)
+ (deftype . "name lambda-list [[declaration* | documentation]] form* => name")
+ (subtypep subtype type &optional (environment nil) => subtype-p valid-p)
+ (typep object type-specifier &optional (environment nil) => generalized-boolean)
+ (type-error-datum condition => datum)
+ (type-error-expected-type condition => expected-type)
+
+
+ ;; data and control flow
+ (apply function &rest args+ => result*)
+ (defun . "function-name lambda-list [[declaration* | documentation]] form* => function-name")
+ (fdefinition function-name => definition)
+ (fboundp function-name => generalized-boolean)
+ (fmakunbound function-name => function-name)
+ (flet . "((function-name lambda-list [[local-declaration* | local-documentation]] local-form*)*) declaration* form* => result*")
+ (labels . "((function-name lambda-list [[local-declaration* | local-documentation]] local-form*)*) declaration* form* => result*")
+ (macrolet . "((name lambda-list [[local-declaration* | local-documentation]] local-form*)*) declaration* form* => result*")
+
+ (funcall function &rest args => result*)
+ (function . "function-name-or-lambda-expression => function")
+ (function-lambda-expression function => lambda-expression closure-p name)
+ (functionp object => generalized-boolean)
+ (compiled-function-p object => generalized-boolean)
+ (defconstant . "name initial-value [documentation] => name")
+ (defparameter . "name initial-value [documentation] => name")
+ (defvar . "name [initial-value [documentation]] => name")
+ (destructuring-bind . "destructuring-lambda-list expression declaration* form* => result*")
+ (let . "({var | (var [init-form])}*) declaration* form* => result*")
+ (let* . "({var | (var [init-form])}*) declaration* form* => result*")
+ (progv . "symbols values form* => result*")
+ (setq . "{pair}* => result")
+ (psetq . "{pair}* => nil")
+ (block . "name-symbol form* => result*")
+ (catch . "tag-form form* => result*")
+ (go . "tag =>|")
+ (return-from . "name [result-form] =>|")
+ (return . "[result-form] =>|")
+ (tagbody . "{tag | statement}* => nil")
+ (throw . "tag-form result-form =>|")
+ (unwind-protect . "protected-form cleanup-form* => result*")
+ (not x => boolean)
+ (eq x y => generalized-boolean)
+ (eql x y => generalized-boolean)
+ (equal x y => generalized-boolean)
+ (equalp x y => generalized-boolean)
+ (identity object => object)
+ (complement function => complement-function)
+ (constantly value => function-constantly-returning-value)
+ (every predicate &rest sequences+ => generalized-boolean)
+ (some predicate &rest sequences+ => result)
+ (notevery predicate &rest sequences+ => generalized-boolean)
+ (notany predicate &rest sequences+ => generalized-boolean)
+ (and . "form* => result*")
+ (cond . "{(test-form form*)}* => result*")
+ (if . "test-form then-form [else-form] => result*")
+ (or . "form* => results*")
+ (when . "test-form form* => result*")
+ (unless . "test-form form* => result*")
+ (case . "keyform {(keys form*)}* [({otherwise | t} form*)] => result*")
+ (ccase . "keyplace {(keys form*)}* => result*")
+ (ecase . "keyform {(keys form*)}* => result*")
+ (typecase . "keyform {(type form*)}* [({otherwise | t} form*)] => result*")
+ (ctypecase . "keyplace {(type form*)}* => result*")
+ (etypecase . "keyform {(type form*)}* => result*")
+ (multiple-value-bind . "(var*) values-form declaration* form* => result*")
+ (multiple-value-call . "function-form form* => result*")
+ (multiple-value-list . "form => list")
+ (multiple-value-prog1 . "first-form form* => first-form-results")
+ (multiple-value-setq . "vars form => result")
+ (values &rest object => object*)
+ (values-list list => element*)
+ (nth-value . "n-form form => object")
+ (prog . "({var | (var [init-form])}*) declaration* {tag | statement}* => result*")
+ (prog* . "({var | (var [init-form])}*) declaration* {tag | statement}* => result*")
+ (prog1 . "first-form form* => primary-value-of-evaluated-first-form")
+ (prog2 . "first-form second-form form* => primary-value-of-evaluated-second-form")
+ (progn . "form* => result*")
+ (define-modify-macro . "name lambda-list function [documentation] => name")
+ ;;(defsetf . "access-fn update-fn [documentation] => access-fn")
+ ;;(defsetf . " access-fn lambda-list (store-variable*) [[declaration* | documentation]] form* => access-fn")
+ (define-setf-expander . "access-fn lambda-list [[declaration* | documentation]] form* => access-fn")
+ (get-setf-expansion place &optional (environment nil) => vars vals store-vars writer-form reader-form)
+ (setf . "{place newvalue}* => result*")
+ (psetf . "{place newvalue}* => nil")
+ (shiftf . "place+ newvalue => old-value-1")
+ (rotatef . "place* => nil")
+
+
+ ;; iteration
+ (do . "({var | (var [init-form [step-form]])}*) (end-test-form result-form*) declaration* {tag | statement}* => result*")
+ (do* . "({var | (var [init-form [step-form]])}*) (end-test-form result-form*) declaration* {tag | statement}* => result*")
+ (dotimes . "(var count-form [result-form]) declaration* {tag | statement}* => result*")
+ (dolist . "(var list-form [result-form]) declaration* {tag | statement}* => result*")
+ ;;(loop . "compound-form* => result*")
+ ;;(loop . "[name-clause] {variable-clause}* {main-clause}* => result*")
+ (loop-finish . " =>|")
+
+
+ ;; objects
+ (function-keywords method => keys allow-other-keys-p)
+ (ensure-generic-function function-name &key argument-precedence-order declare documentation environment generic-function-class lambda-list method-class method-combination => generic-function)
+ (allocate-instance class &rest initargs &key &allow-other-keys => new-instance)
+ (reinitialize-instance instance &rest initargs &key &allow-other-keys => instance)
+ (shared-initialize instance slot-names &rest initargs &key &allow-other-keys => instance)
+ (update-instance-for-different-class previous current &rest initargs &key &allow-other-keys => implementation-dependent)
+ (update-instance-for-redefined-class instance added-slots discarded-slots property-list &rest initargs &key &allow-other-keys => result*)
+ (change-class instance new-class &key &allow-other-keys => instance)
+ (slot-boundp instance slot-name => generalized-boolean)
+ (slot-exists-p object slot-name => generalized-boolean)
+ (slot-makunbound instance slot-name => instance)
+ (slot-missing class object slot-name operation &optional new-value => result*)
+ (slot-unbound class instance slot-name => result*)
+ (slot-value object slot-name => value)
+ (method-qualifiers method => qualifiers)
+ (no-applicable-method generic-function &rest function-arguments => result*)
+ (no-next-method generic-function method &rest args => result*)
+ (remove-method generic-function method => generic-function)
+ (make-instance class-designator &rest initargs &key &allow-other-keys => instance)
+ (make-instances-obsolete class-designator => class)
+ (make-load-form object &optional (environment nil) => creation-form \[initialization-form\])
+ (make-load-form-saving-slots object &key slot-names (environment nil) => creation-form initialization-form)
+ (with-accessors . "(slot-entry*) instance-form declaration* form* => result*")
+ (with-slots . "({slot-name | (variable-name slot-name)}*) instance-form declaration* form* => result*")
+ (defclass . "class-name ({superclass-name}*) ({slot-specifier}*) [[class-option]] => new-class")
+ (defgeneric . "function-name gf-lambda-list [[option | {method-description}*]] => new-generic)")
+ (defmethod . "function-name {method-qualifier}* specialized-lambda-list [[declaration* | documentation]] form* => new-method")
+ (find-class symbol &optional (errorp t) environment => class)
+ (next-method-p => generalized-boolean)
+ (call-method method &optional next-method-list => result*)
+ (make-method form => method-object)
+ (call-next-method &rest args => result*)
+ (compute-applicable-methods generic-function function-arguments => methods)
+ ;;(define-method-combination . "name [[short-form-option]] => name")
+ ;;(define-method-combination . "name lambda-list (method-group-specifier*) [(:arguments . args-lambda-list)] [(:generic-function generic-function-symbol)] [[declaration* | documentation]] form* => name")
+ (find-method generic-function method-qualifiers specializers &optional (errorp t) => method)
+ (add-method generic-function method => generic-function)
+ (initialize-instance instance &rest initargs &key &allow-other-keys => instance)
+ (class-name class => name)
+ (class-of object => class)
+ (unbound-slot-instance condition => instance)
+
+ ;; structures
+ (defstruct . "name-and-options [documentation] {slot-description}* => structure-name")
+ (copy-structure structure => copy)
+
+
+ ;; conditions
+ (cell-error-name condition => name)
+ (assert . "test-form [(place*) [datum-form argument-form*]] => nil")
+ (error datum &rest arguments =>|)
+ (cerror continue-format-control datum &rest arguments => nil)
+ (check-type . "place typespec [string] => nil")
+ (invalid-method-error method format-control &rest args => implementation-dependent)
+ (method-combination-error format-control &rest args => implementation-dependent)
+ (signal datum &rest arguments => nil)
+ (simple-condition-format-control condition => format-control)
+ (simple-condition-format-arguments condition => format-arguments)
+ (warn datum &rest arguments => nil)
+ (invoke-debugger condition =>|)
+ (break &optional (format-control *implementation-dependent-format-control*) &rest format-arguments => nil)
+ (handler-bind . "({(type handler)}*) form* => result*")
+ (handler-case . "expression [[{error-clause}* | no-error-clause]] => result*
+clause::= error-clause | no-error-clause
+error-clause::= (typespec ([var]) declaration* form*)
+no-error-clause::= (:no-error lambda-list declaration* form*)")
+ (ignore-errors . "form* => result*")
+ (define-condition . "name (parent-type*) ({slot-spec}*) option* => name")
+ (make-condition type &rest slot-initializations => condition)
+ (compute-restarts &optional (condition nil) => restarts)
+ (find-restart identifier &optional (condition nil) => restart)
+ (invoke-restart restart-designator &rest arguments => result*)
+ (invoke-restart-interactively restart-designator => result*)
+ (restart-bind . "({(name function {key-val-pair}*)}) form* => result*")
+ (restart-case . "restartable-form {clause} => result*")
+ (restart-name restart => name)
+ (with-condition-restarts . "condition-form restarts-form form* => result*")
+ (with-simple-restart . "(name format-control format-argument*) form* => result*")
+ (abort &optional (condition nil) =>|)
+ (continue &optional (condition nil) => nil)
+ (muffle-warning &optional (condition nil) =>|)
+ (store-value value &optional (condition nil) => nil)
+ (use-value value &optional (condition nil) => nil)
+
+
+ ;; symbols
+ (symbolp object => generalized-boolean)
+ (keywordp object => generalized-boolean)
+ (make-symbol name-string => new-symbol)
+ (copy-symbol symbol &optional (copy-properties nil) => new-symbol)
+ (gensym &optional string-or-non-negative-integer => new-symbol)
+ (gentemp &optional (prefix "T") (package *package*) => new-symbol)
+ (symbol-function symbol => contents)
+ (symbol-name symbol => name)
+ (symbol-package symbol => package-or-nil)
+ (symbol-plist symbol => plist)
+ (symbol-value symbol => value)
+ (get symbol indicator &optional (default nil) => value)
+ (remprop symbol indicator => generalized-boolean)
+ (boundp symbol => generalized-boolean)
+ (makunbound symbol => symbol)
+ (set symbol value => value)
+
+
+ ;; packages
+ (export designator-for-a-list-of-symbols &optional (package *package*) => t)
+ (find-symbol string &optional (package *package*) => symbol status)
+ (find-package string-designator-or-package => package)
+ (find-all-symbols string-designator => symbols)
+ (import designator-for-a-list-of-symbols &optional (package *package*))
+ (list-all-packages => packages)
+ (rename-package package new-name &optional (new-nicknames '()) => package-object)
+ (shadow symbol-names &optional (package *package*) => t)
+ (shadowing-import designator-for-a-list-of-symbols &optional (package *package*) => t)
+ (delete-package package-designator => generalized-boolean)
+ (make-package package-name &key (nicknames '()) (use *implementation-defined-use-list*) => package)
+ (with-package-iterator . "(name package-list-form &rest symbol-types) declaration* form* => result*")
+ (unexport designator-for-a-list-of-symbols &optional (package *package*) => t)
+ (unintern symbol &optional (package *package*) => generalized-boolean)
+ (in-package . "name => package")
+ (unuse-package packages-to-unuse &optional (package *package*) => t)
+ (use-package packages-to-use &optional (package *package*) => t)
+ (defpackage . "defined-package-name [[option]] => package
+option::= (:nicknames nickname*)* |
+ (:documentation string) |
+ (:use package-name*)* |
+ (:shadow {symbol-name}*)* |
+ (:shadowing-import-from package-name {symbol-name}*)* |
+ (:import-from package-name {symbol-name}*)* |
+ (:export {symbol-name}*)* |
+ (:intern {symbol-name}*)* |
+ (:size integer) ")
+ (do-symbols . "(var [package [result-form]]) declaration* {tag | statement}* => result*")
+ (do-external-symbols . "(var [package [result-form]]) declaration* {tag | statement}* => result*")
+ (do-all-symbols . "(var [result-form]) declaration* {tag | statement}* => result*")
+ (intern string &optional (package *package*) => symbol status)
+ (package-name package-designator => name)
+ (package-nicknames package-designator => nicknames)
+ (package-shadowing-symbols package-designator => symbols)
+ (package-use-list package-designator => use-list)
+ (package-used-by-list package-designator => used-by-list)
+ (packagep object => generalized-boolean)
+ (package-error-package condition => package)
+
+
+ ;; numbers
+ (= &rest numbers+ => generalized-boolean)
+ (/= &rest numbers+ => generalized-boolean)
+ (< &rest numbers+ => generalized-boolean)
+ (> &rest numbers+ => generalized-boolean)
+ (<= &rest numbers+ => generalized-boolean)
+ (>= &rest numbers+ => generalized-boolean)
+ (max &rest reals+ => max-real)
+ (min &rest reals+ => min-real)
+ (minusp real => generalized-boolean)
+ (plusp real => generalized-boolean)
+ (zerop number => generalized-boolean)
+ (floor number &optional (divisor 1) => quotient remainder)
+ (ffloor number &optional (divisor 1) => quotient remainder)
+ (ceiling number &optional (divisor 1) => quotient remainder)
+ (fceiling number &optional (divisor 1) => quotient remainder)
+ (truncate number &optional (divisor 1) => quotient remainder)
+ (ftruncate number &optional (divisor 1) => quotient remainder)
+ (round number &optional (divisor 1) => quotient remainder)
+ (fround number &optional (divisor 1) => quotient remainder)
+ (sin radians => number)
+ (cos radians => number)
+ (tan radians => number)
+ (asin number => radians)
+ (acos number => radians)
+ (atan number1 &optional number2 => radians)
+ (sinh number => result)
+ (cosh number => result)
+ (tanh number => result)
+ (asinh number => result)
+ (acosh number => result)
+ (atanh number => result)
+ (* &rest numbers => product)
+ (+ &rest numbers => sum)
+ ;;(- number => negation)
+ ;;(- minuend &rest subtrahends+ => difference)
+ ;;(/ number => reciprocal)
+ ;;(/ numerator &rest denominators+ => quotient)
+ (1+ number => successor)
+ (1- number => predecessor)
+ (abs number => absolute-value)
+ (evenp integer => generalized-boolean)
+ (oddp integer => generalized-boolean)
+ (exp number => result)
+ (expt base-number power-number => result)
+ (gcd &rest integers => greatest-common-denominator)
+ (incf . "place [delta-form] => new-value")
+ (decf . "place [delta-form] => new-value")
+ (lcm &rest integers => least-common-multiple)
+ (log number &optional (base *E-base-of-the-natural-logarithms*) => logarithm)
+ (mod number divisor => modulus)
+ (rem number divisor => remainder)
+ (signum number => signed-prototype)
+ (sqrt number => root)
+ (isqrt natural => natural-root)
+ (make-random-state &optional (state nil) => new-state)
+ (random limit &optional (random-state *random-state*) => random-number)
+ (random-state-p object => generalized-boolean)
+ (numberp object => generalized-boolean)
+ (cis radians => number)
+ (complex realpart &optional (imagpart (coerce 0 (type-of realpart))) => complex)
+ (complexp object => generalized-boolean)
+ (conjugate number => conjugate)
+ (phase number => phase)
+ (realpart number => real)
+ (imagpart number => real)
+ (upgraded-complex-part-type typespec &optional (environment nil) => upgraded-typespec)
+ (realp object => generalized-boolean)
+ (numerator rational => numerator)
+ (denominator rational => denominator)
+ (rational number => rational)
+ (rationalize number => rational)
+ (rationalp object => generalized-boolean)
+ (ash integer count => shifted-integer)
+ (integer-length integer => number-of-bits)
+ (integerp object => generalized-boolean)
+ (parse-integer string &key (start 0) (end nil) (radix 10) junk-allowed => integer pos)
+ (boole op integer-1 integer-2 => result-integer)
+ (logand &rest integers => result-integer)
+ (logandc1 integer-1 integer-2 => result-integer)
+ (logandc2 integer-1 integer-2 => result-integer)
+ (logeqv &rest integers => result-integer)
+ (logior &rest integers => result-integer)
+ (lognand integer-1 integer-2 => result-integer)
+ (lognor integer-1 integer-2 => result-integer)
+ (lognot integer => result-integer)
+ (logorc1 integer-1 integer-2 => result-integer)
+ (logorc2 integer-1 integer-2 => result-integer)
+ (logxor &rest integers => result-integer)
+ (logbitp index integer => generalized-boolean)
+ (logcount integer => number-of-on-bits)
+ (logtest integer-1 integer-2 => generalized-boolean)
+ (byte size position => bytespec)
+ (byte-size bytespec => size)
+ (byte-position bytespec => position)
+ (deposit-field newbyte bytespec integer => result-integer)
+ (dpb newbyte bytespec integer => result-integer)
+ (ldb bytespec integer => byte)
+ (ldb-test bytespec integer => generalized-boolean)
+ (mask-field bytespec integer => masked-integer)
+ (decode-float float => significand exponent sign)
+ (scale-float float integer => scaled-float)
+ (float-radix float => float-radix)
+ (float-sign float-1 &optional (float-2 (float 1 float-1)) => signed-float)
+ (float-digits float => digits1)
+ (float-precision float => digits2)
+ (integer-decode-float float => significand exponent integer-sign)
+ (float number &optional prototype => float)
+ (floatp object)
+ (arithmetic-error-operands condition => operands)
+ (arithmetic-error-operation condition => operation)
+
+ ;; characters
+ (char= &rest characters+ => generalized-boolean)
+ (char/= &rest characters+ => generalized-boolean)
+ (char< &rest characters+ => generalized-boolean)
+ (char> &rest characters+ => generalized-boolean)
+ (char<= &rest characters+ => generalized-boolean)
+ (char>= &rest characters+ => generalized-boolean)
+ (char-equal &rest characters+ => generalized-boolean)
+ (char-not-equal &rest characters+ => generalized-boolean)
+ (char-lessp &rest characters+ => generalized-boolean)
+ (char-greaterp &rest characters+ => generalized-boolean)
+ (char-not-greaterp &rest characters+ => generalized-boolean)
+ (char-not-lessp &rest characters+ => generalized-boolean)
+ (character character-designator => denoted-character)
+ (characterp object => generalized-boolean)
+ (alpha-char-p character => generalized-boolean)
+ (alphanumericp character => generalized-boolean)
+ (digit-char weight &optional (radix 10) => char)
+ (digit-char-p char &optional (radix 10) => weight)
+ (graphic-char-p char => generalized-boolean)
+ (standard-char-p character => generalized-boolean)
+ (char-upcase character => corresponding-character)
+ (char-downcase character => corresponding-character)
+ (upper-case-p character => generalized-boolean)
+ (lower-case-p character => generalized-boolean)
+ (both-case-p character => generalized-boolean)
+ (char-code character => code)
+ (char-int character => integer)
+ (code-char code => char-p)
+ (char-name character => name)
+ (name-char name => character-or-nil)
+
+
+ ;; conses
+ (cons car cdr => cons)
+ (consp object => generalized-boolean)
+ (atom object => generalized-boolean)
+ (rplaca cons object => cons)
+ (rplacd cons object => cons)
+ (car list => car-of-list)
+ (cdr list => cdr-of-list)
+ (copy-tree tree => new-tree)
+ (sublis alist tree &key key test test-not => new-tree)
+ (nsublis alist tree &key key test test-not => new-tree)
+ (subst new old tree &key key test test-not => new-tree)
+ (subst-if new predicate tree &key key => new-tree)
+ (subst-if-not new predicate tree &key key => new-tree)
+ (nsubst new old tree &key key test test-not => new-tree)
+ (nsubst-if new predicate tree &key key => new-tree)
+ (nsubst-if-not new predicate tree &key key => new-tree)
+ (tree-equal tree-1 tree-2 &key test test-not => generalized-boolean)
+ (copy-list list => copy)
+ (list &rest objects => list)
+ (list* &rest objects+ => result)
+ (list-length list => length)
+ (listp object => generalized-boolean)
+ (make-list size &key (initial-element nil) => list)
+ (push . "item place => new-place-value")
+ (pop . "place => element")
+ (nth n list => object)
+ (endp list => generalized-boolean)
+ (null object => boolean)
+ (nconc &rest lists => concatenated-list)
+ (append &rest lists => result)
+ (revappend list tail => result-list)
+ (nreconc list tail => result-list)
+ (butlast list &optional (n 1) => result-list)
+ (nbutlast list &optional (n 1) => result-list)
+ (last list &optional (n 1) => tail)
+ (ldiff list possible-tail => result-list)
+ (tailp possible-tail list => generalized-boolean)
+ (nthcdr n list => tail)
+ (rest list => tail)
+ (member item list &key key test test-not => tail)
+ (member-if predicate list &key key => tail)
+ (member-if-not predicate list &key key => tail)
+ (mapc function &rest lists+ => list-1)
+ (mapcar function &rest lists+ => result-list)
+ (mapcan function &rest lists+ => concatenated-results)
+ (mapl function &rest lists+ => list-1)
+ (maplist function &rest lists+ => result-list)
+ (mapcon function &rest lists+ => concatenated-results)
+ (acons key datum alist => new-alist)
+ (assoc item alist &key key test test-not => entry)
+ (assoc-if predicate alist &key key => entry)
+ (assoc-if-not predicate alist &key key => entry)
+ (copy-alist alist => new-alist)
+ (pairlis keys data &optional (alist '()) => new-alist)
+ (rassoc item alist &key key test test-not => entry)
+ (rassoc-if predicate alist &key key => entry)
+ (rassoc-if-not predicate alist &key key => entry)
+ (get-properties plist indicator-list => indicator value tail)
+ (getf plist indicator &optional (default nil) => value)
+ (remf place indicator => generalized-boolean)
+ (intersection list-1 list-2 &key key test test-not => result-list)
+ (nintersection list-1 list-2 &key key test test-not => result-list)
+ (adjoin item list &key key test test-not => new-list)
+ (pushnew item place &key key test test-not => new-place-value)
+ (set-difference list-1 list-2 &key key test test-not => result-list)
+ (nset-difference list-1 list-2 &key key test test-not => result-list)
+ (set-exclusive-or list-1 list-2 &key key test test-not => result-list)
+ (nset-exclusive-or list-1 list-2 &key key test test-not => result-list)
+ (subsetp list-1 list-2 &key key test test-not => generalized-boolean)
+ (union list-1 list-2 &key key test test-not => result-list)
+ (nunion list-1 list-2 &key key test test-not => result-list)
+
+ ;; arrays
+ (make-array dimensions &key (element-type t) initial-element initial-contents (adjustable nil) (fill-pointer nil) (displaced-to nil) (displaced-index-offset 0) => new-array)
+ (adjust-array array new-dimensions &key element-type initial-element initial-contents (fill-pointer nil) displaced-to displaced-index-offset => adjusted-array)
+ (adjustable-array-p array => generalized-boolean)
+ (aref array &rest subscripts => element)
+ (array-dimension array axis-number => dimension)
+ (array-dimensions array => dimensions)
+ (array-element-type array => typespec)
+ (array-has-fill-pointer-p array => generalized-boolean)
+ (array-displacement array => displaced-to displaced-index-offset)
+ (array-in-bounds-p array &rest subscripts => generalized-boolean)
+ (array-rank array => rank)
+ (array-row-major-index array &rest subscripts => index)
+ (array-total-size array => size)
+ (arrayp object => generalized-boolean)
+ (fill-pointer vector => fill-pointer)
+ (row-major-aref array index => element)
+ (upgraded-array-element-type typespec &optional (environment nil) => upgraded-typespec)
+ (simple-vector-p object => generalized-boolean)
+ (svref simple-vector index => element)
+ (vector &rest objects => vector)
+ (vector-pop vector => element)
+ (vector-push new-element vector => new-index-p)
+ (vector-push-extend new-element vector &optional (extension *implementation-dependent-extension*) => new-index)
+ (vectorp object => generalized-boolean)
+ (bit bit-array &rest subscripts => bit)
+ (sbit bit-array &rest subscripts => bit)
+ (bit-and bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-andc1 bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-andc2 bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-eqv bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-ior bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-nand bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-nor bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-orc1 bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-orc2 bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-xor bit-array1 bit-array2 &optional (opt-arg nil) => resulting-bit-array)
+ (bit-not bit-array &optional (opt-arg nil) => resulting-bit-array)
+ (bit-vector-p object => generalized-boolean)
+ (simple-bit-vector-p object => generalized-boolean)
+
+
+ ;; strings
+ (simple-string-p object => generalized-boolean)
+ (char string index => character)
+ (schar simple-string index => character)
+ (string string-or-symbol-or-character => string)
+ (string-upcase string-designator &key (start 0) (end nil) => cased-string)
+ (string-downcase string-designator &key (start 0) (end nil) => cased-string)
+ (string-capitalize string-designator &key (start 0) (end nil) => cased-string)
+ (nstring-upcase string &key (start 0) (end nil) => modified-string)
+ (nstring-downcase string &key (start 0) (end nil) => modified-string)
+ (nstring-capitalize string &key (start 0) (end nil) => modified-string)
+
+ (string-trim character-bag string => trimmed-string)
+ (string-left-trim character-bag string => trimmed-string)
+ (string-right-trim character-bag string => trimmed-string)
+ (string= string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => generalized-boolean)
+ (string/= string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (string< string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (string> string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (string<= string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (string>= string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (string-equal string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => generalized-boolean)
+ (string-not-equal string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (string-lessp string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (string-greaterp string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (string-not-greaterp string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (string-not-lessp string1 string2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => mismatch-index)
+ (stringp object => generalized-boolean)
+ (make-string size &key (initial-element *implementation-dependent-character*) (element-type 'character) => string)
+
+
+ ;; sequences
+ (copy-seq proper-sequence => copied-sequence)
+ (elt proper-sequence index => object)
+ (fill proper-sequence item &key (start 0) (end nil) => sequence) ;
+ (make-sequence result-type size &key (initial-element *implementation-dependent-element*) => sequence)
+ (subseq sequence start &optional (end nil) => subsequence)
+ (map result-sequence-type function &rest sequences+ => result)
+ (map-into result-sequence function &rest sequences => result-sequence)
+ (reduce function sequence &key key (from-end nil) (start 0) (end nil) initial-value => result)
+ (count item sequence &key (from-end nil) (start 0) (end nil) key test test-not => n)
+ (count-if predicate sequence &key (from-end nil) (start 0) (end nil) key => n)
+ (count-if-not predicate sequence &key (from-end nil) (start 0) (end nil) key => n)
+ (length sequence => n)
+ (reverse sequence => reversed-sequence)
+ (nreverse sequence => reversed-sequence)
+ (sort sequence predicate &key key => destructively-sorted-sequence)
+ (stable-sort sequence predicate &key key => destructively-sorted-sequence)
+ (find item sequence &key (from-end nil) test test-not (start 0) (end nil) key => element)
+ (find-if predicate sequence &key (from-end nil) (start 0) (end nil) key => element)
+ (find-if-not predicate sequence &key (from-end nil) (start 0) (end nil) key => element)
+ (position item sequence &key (from-end nil) test test-not (start 0) (end nil) key => position)
+ (position-if predicate sequence &key (from-end nil) (start 0) (end nil) key => position)
+ (position-if-not predicate sequence &key (from-end nil) (start 0) (end nil) key => position)
+ (search subsequence sequence &key (from-end nil) test test-not key (start1 0) (start2 0) (end1 nil) (end2 nil) => position)
+ (mismatch sequence-1 sequence-2 &key (from-end nil) test test-not key (start1 0) (start2 0) (end1 nil) (end2 nil) => position)
+ (replace sequence-1 sequence-2 &key (start1 0) (end1 nil) (start2 0) (end2 nil) => destructively-modified-sequence-1)
+ (substitute newitem olditem sequence &key (from-end nil) test test-not (start 0) (end nil) (count nil) key => result-sequence)
+ (substitute-if newitem predicate sequence &key (from-end nil) (start 0) (end nil) (count nil) key => result-sequence)
+ (substitute-if-not newitem predicate sequence &key (from-end nil) (start 0) (end nil) (count nil) key => result-sequence)
+ (nsubstitute newitem olditem sequence &key (from-end nil) test test-not (start 0) (end nil) (count nil) key => sequence)
+ (nsubstitute-if newitem predicate sequence &key (from-end nil) (start 0) (end nil) (count nil) key=> sequence)
+ (nsubstitute-if-not newitem predicate sequence &key (from-end nil) (start 0) (end nil) (count nil) key => sequence)
+ (concatenate result-type &rest sequences => result-sequence)
+ (merge result-type sequence-1 sequence-2 predicate &key key => result-sequence)
+ (remove item sequence &key (from-end nil) test test-not (start 0) (end nil) (count nil) key => result-sequence)
+ (remove-if test sequence &key (from-end nil) (start 0) (end nil) (count nil) key => result-sequence)
+ (remove-if-not test sequence &key (from-end nil) (start 0) (end nil) (count nil) key => result-sequence)
+ (delete item sequence &key (from-end nil) test test-not (start 0) (end nil) (count nil) key => result-sequence)
+ (delete-if test sequence &key (from-end nil) (start 0) (end nil) (count nil) key => result-sequence)
+ (delete-if-not test sequence &key (from-end nil) (start 0) (end nil) (count nil) key => result-sequence)
+ (remove-duplicates sequence &key (from-end nil) test test-not (start 0) (end nil) key => result-sequence)
+ (delete-duplicates sequence &key (from-end nil) test test-not (start 0) (end nil) key => result-sequence)
+
+
+ ;; hash tables
+ (make-hash-table &key (test #'eql) (size *implementation-dependent-size*) (rehash-size *implementation-dependent-rehash-size*) (rehash-threshold *implementation-dependent-threshold) => hash-table)
+ (hash-table-p object => generalized-boolean)
+ (hash-table-count hash-table => count)
+ (hash-table-rehash-size hash-table => rehash-size)
+ (hash-table-rehash-threshold hash-table => rehash-threshold)
+ (hash-table-size hash-table => size)
+ (hash-table-test hash-table => test)
+ (gethash key hash-table &optional (default nil) => value present-p)
+ (remhash key hash-table => generalized-boolean)
+ (maphash function hash-table => nil)
+ (with-hash-table-iterator . "(name hash-table) declaration* form* => result*")
+ (clrhash hash-table => hash-table)
+ (sxhash object => hash-code)
+
+ ;; filenames
+ (pathname pathspec => pathname)
+ (make-pathname &key host device directory name type version defaults case => pathname)
+ (pathnamep object => generalized-boolean)
+ (pathname-host pathname-designator &key (case :local) => host)
+ (pathname-device pathname-designator &key (case :local) => device)
+ (pathname-directory pathname-designator &key (case :local) => directory)
+ (pathname-name pathname-designator &key (case :local) => name)
+ (pathname-type pathname-designator &key (case :local) => type)
+ (pathname-version pathname-designator => version)
+ (load-logical-pathname-translations host => just-loaded)
+ (logical-pathname-translations host => translations)
+ (logical-pathname pathspec => logical-pathname)
+ (namestring pathname-designator => namestring)
+ (file-namestring pathname-designator => namestring)
+ (directory-namestring pathname-designator => namestring)
+ (host-namestring pathname-designator => namestring)
+ (enough-namestring pathname-designator &optional (defaults *default-pathname-defaults*) => namestring)
+ (parse-namestring thing &optional host (default-pathname *default-pathname-defaults*) &key (start 0) (end nil) (junk-allowed nil) => pathname position)
+ (wild-pathname-p pathname &optional (field-key nil) => generalized-boolean)
+ (pathname-match-p pathname wildcard => generalized-boolean)
+ (translate-logical-pathname pathname &key => physical-pathname)
+ (translate-pathname source from-wildcard to-wildcard &key => translated-pathname)
+ (merge-pathnames pathname &optional (default-pathname *default-pathname-defaults*) (default-version :newest) => merged-pathname)
+
+ ;; files
+ (directory pathspec &key => pathnames)
+ (probe-file pathspec => truename)
+ (ensure-directories-exist pathspec &key verbose => pathspec created)
+ (truename filespec => truename)
+ (file-author pathspec => author)
+ (file-write-date pathspec => date)
+ (rename-file filespec new-name => defaulted-new-name old-truename new-truename)
+ (delete-file filespec => t)
+ (file-error-pathname condition => pathspec)
+
+ ;; streams
+ (input-stream-p stream => generalized-boolean)
+ (output-stream-p stream => generalized-boolean)
+ (interactive-stream-p stream => generalized-boolean)
+ (open-stream-p stream => generalized-boolean)
+ (stream-element-type stream => typespec)
+ (streamp object => generalized-boolean)
+ (read-byte stream &optional (eof-error-p t) (eof-value nil) => byte)
+ (write-byte byte stream => byte)
+ (peek-char &optional (peek-type nil) (input-stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil) => char)
+ (read-char &optional (input-stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil) => char)
+ (read-char-no-hang &optional (input-stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil) => char)
+ (terpri &optional (output-stream *standard-output*) => nil)
+ (fresh-line &optional (output-stream *standard-output*) => generalized-boolean)
+ (unread-char character &optional (input-stream *standard-input*) => nil)
+ (write-char character &optional (output-stream *standard-output*) => character)
+ (read-line &optional (input-stream *standard-input*) (eof-error-p t) (eof-value nil) (recursive-p nil) => line missing-newline-p)
+ (write-string string &optional (output-stream *standard-output*) &key (start 0) (end nil) => string)
+ (write-line string &optional (output-stream *standard-output*) &key (start 0) (end nil) => string)
+ (read-sequence sequence stream &key (start 0) (end nil) => position)
+ (write-sequence sequence stream &key (start 0) (end nil) => sequence)
+ (file-length stream => length)
+ ;;(file-position stream => position)
+ ;;(file-position stream position-spec => success-p)
+ (file-string-length stream object => length)
+ (open filespec &key (direction :input) (element-type 'character) if-exists if-does-not-exist external-format => stream)
+ (stream-external-format stream => format)
+ (with-open-file . "(stream filespec options*) declaration* form* => results")
+ (close stream &key (abort nil) => result)
+ (with-open-stream . "(var stream) declaration* form* => result*")
+ (listen &optional (input-stream *standard-input*) => generalized-boolean)
+ (clear-input &optional (input-stream *standard-input*) => nil)
+ (finish-output &optional (output-stream *standard-output*) => nil)
+ (force-output &optional (output-stream *standard-output*) => nil)
+ (clear-output &optional (output-stream *standard-output*) => nil)
+ (y-or-n-p &optional control &rest arguments => generalized-boolean)
+ (yes-or-no-p &optional control &rest arguments => generalized-boolean)
+ (make-synonym-stream symbol => synonym-stream)
+ (synonym-stream-symbol synonym-stream => symbol)
+ (broadcast-stream-streams broadcast-stream => streams)
+ (make-broadcast-stream &rest streams => broadcast-stream)
+ (make-two-way-stream input-stream output-stream => two-way-stream)
+ (two-way-stream-input-stream two-way-stream => input-stream)
+ (two-way-stream-output-stream two-way-stream => output-stream)
+ (echo-stream-input-stream echo-stream => input-stream)
+ (echo-stream-output-stream echo-stream => output-stream)
+ (make-echo-stream input-stream output-stream => echo-stream)
+ (concatenated-stream-streams concatenated-stream => streams)
+ (make-concatenated-stream &rest input-streams => concatenated-stream)
+ (get-output-stream-string string-output-stream => string)
+ (make-string-input-stream string &optional (start 0) (end nil) => string-stream)
+ (make-string-output-stream &key (element-type 'character) => string-stream)
+ (with-input-from-string . "(var string &key index start end) declaration* form* => result*")
+ (with-output-to-string . "(var &optional string-form &key element-type) declaration* form* => result*")
+ (stream-error-stream condition => stream)
+
+ ;; printer
+ (copy-pprint-dispatch &optional (table *print-pprint-dispatch*) => new-table)
+ (formatter control-string => function)
+ (pprint-dispatch object &optional (table *print-pprint-dispatch*) => function found-p)
+ (pprint-exit-if-list-exhausted => nil)
+ (pprint-fill stream object &optional (colon-p t) (at-sign-p *implementation-dependent-at-sign-p*) => nil)
+ (pprint-linear stream object &optional (colon-p t) (at-sign-p *implementation-dependent-at-sign-p*) => nil)
+ (pprint-tabular stream object &optional (colon-p t) (at-sign-p *implementation-dependent-at-sign-p*) (tabsize 16) => nil)
+ (pprint-indent relative-to n &optional (stream *standard-output*) => nil)
+ (pprint-logical-block . "(stream-symbol object &key prefix per-line-prefix suffix) declaration* form* => nil")
+ (pprint-newline kind &optional (stream *standard-output*) => nil)
+ (pprint-pop => object)
+ (pprint-tab kind colnum colinc &optional stream => nil)
+ (print-object object stream => object)
+ (print-unreadable-object . "(object stream &key type identity) form* => nil")
+ (set-pprint-dispatch type-specifier function &optional (priority 0) (table *print-pprint-dispatch*) => nil)
+ (write object &key array base case circle escape gensym length level lines miser-width pprint-dispatch pretty radix readably right-margin (stream *standard-output*) => object)
+ (prin1 object &optional (output-stream *standard-output*) => object)
+ (princ object &optional (output-stream *standard-output*) => object)
+ (print object &optional (output-stream *standard-output*) => object)
+ (pprint object &optional (output-stream *standard-output*) => <no values>)
+ (write-to-string object &key array base case circle escape gensym length level lines miser-width pprint-dispatch pretty radix readably right-margin => string)
+ (prin1-to-string object => string)
+ (princ-to-string object => string)
+ (print-not-readable-object condition => object)
+ (format destination control-string &rest args => result)
+
+ ;; reader
+ (copy-readtable &optional (from-readtable *readtable*) (to-readtable nil) => readtable)
+ (make-dispatch-macro-character char &optional (non-terminating-p nil) (readtable *readtable*) => t)
+ (read &optional input-stream (eof-error-p t) (eof-value nil) (recursive-p nil) => object)
+ (read-preserving-whitespace &optional input-stream (eof-error-p t) (eof-value nil) (recursive-p nil) => object)
+ (read-delimited-list char &optional (input-stream *standard-input*) (recursive-p nil) => list)
+ (read-from-string string &optional (eof-error-p t) (eof-value nil) &key (start 0) (end nil) (preserve-whitespace nil) => object position)
+ (readtable-case readtable => case-sensitivity-mode)
+ (readtablep object => generalized-boolean)
+ (get-dispatch-macro-character disp-char sub-char &optional (readtable *readtable*) => function)
+ (set-dispatch-macro-character disp-char sub-char new-function &optional (readtable *readtable*) => t)
+ (get-macro-character char &optional (readtable *readtable*) => function non-terminating-p)
+ (set-macro-character char new-function &optional (non-terminating-p nil) (readtable *readtable*) => t)
+ (set-syntax-from-char to-char from-char &optional (to-readtable *readtable*) (from-readtable +standard-readtable+) => t)
+ (with-standard-io-syntax . "form* => result*")
+
+ ;; system construction
+ (compile-file input-file &key (output-file *implementation-defined-output-file*) (verbose *compile-verbose*) (print *compile-print*) (external-format :default) => output-truename warnings-p failure-p)
+ (compile-file-pathname input-file &key (output-file *implementation-defined-output-file*) &allow-other-keys => pathname)
+ (load filespec &key (verbose *load-verbose*) (print *load-print*) (if-does-not-exist t) (external-format :default) => generalized-boolean)
+ (with-compilation-unit . "([[:override override-form]]) form* => result*")
+ (provide module-name => implementation-dependent)
+ (require module-name &optional pathname-list => implementation-dependent)
+
+ ;; environment
+ (decode-universal-time universal-time &optional time-zone => second minute hour date month year day daylight-p zone)
+ (encode-universal-time second minute hour date month year &optional time-zone => universal-time)
+ (get-universal-time => universal-time)
+ (get-decoded-time => second minute hour date month year day daylight-p zone)
+ (sleep seconds => nil)
+ (apropos string &optional (package nil) => <no values>)
+ (apropos-list string &optional (package nil) => symbols)
+ (describe object &optional (stream *standard-output*) => <no values>)
+ (describe-object object stream => implementation-dependent)
+ (trace . "function-name* => trace-result")
+ (untrace . "function-name* => untrace-result")
+ (step . "form => result*")
+ (time . "form => result*")
+ (get-internal-real-time => internal-time)
+ (get-internal-run-time => internal-time)
+ (disassemble extended-function-designator-or-lambda-expression => nil)
+ (documentation x doc-type => documentation)
+ (room &optional x => implementation-dependent)
+ (ed &optional x => implementation-dependent)
+ (inspect object => implementation-dependent)
+ (dribble &optional pathname => implementation-dependent)
+ (lisp-implementation-type => description)
+ (lisp-implementation-version => description)
+ (short-site-name => description)
+ (long-site-name => description)
+ (machine-instance => description)
+ (machine-type => description)
+ (machine-version => description)
+ (software-type => description)
+ (software-version => description)
+ (user-homedir-pathname &optional host => pathname)
+ ))
+
+
+(provide 'cldoc)
+
+;;; cldoc.el ends here
--- /dev/null
+;;; espresso.el --- Major mode for editing JavaScript source text
+;; Copyright (C) 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2009 Daniel Colascione <dan.colascione@gmail.com>
+;; Author: Karl Landstrom <karl.landstrom@brgeight.se>
+;; Author: Daniel Colascione <dan.colascione@gmail.com>
+;; Maintainer: Daniel Colascione <dan.colascione@gmail.com>
+;; Version: 4
+;; Date: 2009-01-06
+;; Keywords: languages, oop, javascript
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary
+
+;; This is based on Karl Landstrom's barebones javascript-mode. This
+;; is much more robust and works with cc-mode's comment filling
+;; (mostly).
+;;
+;; The main features of this JavaScript mode are syntactic
+;; highlighting (enabled with `font-lock-mode' or
+;; `global-font-lock-mode'), automatic indentation and filling of
+;; comments, and C preprocessor fontification.
+;;
+;; This package has (only) been tested with GNU Emacs 22 (the latest
+;; stable release).
+;;
+;; Installation:
+;;
+;; Put this file in a directory where Emacs can find it (`C-h v
+;; load-path' for more info). Then add the following lines to your
+;; Emacs initialization file:
+;;
+;; (add-to-list 'auto-mode-alist '("\\.js\\'" . espresso-mode))
+;; (autoload 'espresso-mode "espresso" nil t)
+;;
+;; General Remarks:
+;;
+;; XXX: This mode assumes that block comments are not nested inside block
+;; XXX: comments and that strings do not contain line breaks.
+;;
+;; Exported names start with "espresso-" whereas private names start
+;; with "espresso--".
+;;
+;; Code:
+
+;;; Code
+
+(require 'cc-mode)
+(require 'font-lock)
+(require 'newcomment)
+
+(eval-when-compile
+ (require 'cl))
+
+;;; User customization
+
+(defgroup espresso nil
+ "Customization variables for `espresso-mode'."
+ :tag "JavaScript - Espresso-Mode"
+ :group 'languages)
+
+(defcustom espresso-indent-level 4
+ "Number of spaces for each indentation step."
+ :type 'integer
+ :group 'espresso)
+
+(defcustom espresso-expr-indent-offset 0
+ "Number of additional spaces used for indentation of continued
+expressions. The value must be no less than minus
+`espresso-indent-level'."
+ :type 'integer
+ :group 'espresso)
+
+(defcustom espresso-auto-indent-flag t
+ "Automatic indentation with punctuation characters. If non-nil, the
+current line is indented when certain punctuations are inserted."
+ :type 'boolean
+ :group 'espresso)
+
+;;; KeyMap
+
+(defvar espresso-mode-map nil
+ "Keymap used in Espresso mode.")
+
+(unless espresso-mode-map
+ (setq espresso-mode-map (make-sparse-keymap)))
+
+(when espresso-auto-indent-flag
+ (mapc (lambda (key)
+ (define-key espresso-mode-map key 'espresso-insert-and-indent))
+ '("{" "}" "(" ")" ":" ";" ",")))
+
+(defun espresso-insert-and-indent (key)
+ "Runs the command bound to KEY in the global keymap, and if
+we're not in a string or comment, indents the current line."
+ (interactive (list (this-command-keys)))
+ (call-interactively (lookup-key (current-global-map) key))
+ (let ((syntax (save-restriction (widen) (syntax-ppss))))
+ (unless (nth 8 syntax)
+ (indent-according-to-mode))))
+
+;;; Syntax table and parsing
+
+(defvar espresso-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (c-populate-syntax-table table)
+ (modify-syntax-entry ?$ "_" table)
+ table)
+ "Syntax table used in Espresso mode.")
+
+(defconst espresso--name-start-re "[a-zA-Z_$]"
+ "Matches the first character of a Espresso identifier. No grouping")
+
+(defconst espresso--stmt-delim-chars "^;{}?:")
+
+(defconst espresso--name-re (concat espresso--name-start-re
+ "\\(?:\\s_\\|\\sw\\)*")
+ "Matches a Javascript name. No grouping.")
+
+(defconst espresso--dotted-name-re
+ (concat espresso--name-re "\\(?:\\." espresso--name-re "\\)*")
+ "Matches a dot-separated sequence of Javascript names")
+
+(defconst espresso--cpp-name-re espresso--name-re
+ "Matches a C preprocessor name")
+
+(defconst espresso--opt-cpp-start "^\\s-*#\\s-*\\([[:alnum:]]+\\)"
+ " Regexp matching the prefix of a cpp directive including the directive
+name, or nil in languages without preprocessor support. The first
+submatch surrounds the directive name.")
+
+
+(defconst espresso--class-decls
+ `(; var NewClass = BaseClass.extend(
+ ,(concat "^\\s-*\\_<var\\_>\\s-+"
+ "\\(" espresso--dotted-name-re "\\)"
+ "\\s-*=" "\\s-*"
+ "\\(" espresso--dotted-name-re
+ "\\)\\.extend\\(?:Final\\)?\\s-*(")
+
+ ; NewClass: BaseClass.extend( ; for nested classes
+ ,(concat "^\\s-*"
+ "\\(" espresso--dotted-name-re "\\):"
+ "\\s-*\\(" espresso--dotted-name-re
+ "\\)\\.extend\\(?:Finak\\)?\\s-*("))
+ "List of regular expressions that can match class definitions.
+Each one must set match group 1 to the name of the class being
+defined, and optionally, group 2 to the name of the base class.")
+
+(defun espresso--regexp-opt-symbol (list)
+ "Like regexp-opt, but surround the optimized regular expression
+with `\\\\_<' and `\\\\_>'."
+ (concat "\\_<" (regexp-opt list t) "\\_>"))
+
+(defun espresso--re-search-forward-inner (regexp &optional bound count)
+ "Auxiliary function for `espresso--re-search-forward'."
+ (let ((parse)
+ (orig-macro-end (save-excursion
+ (when (espresso--beginning-of-macro)
+ (c-end-of-macro)
+ (point))))
+ (saved-point (point-min)))
+ (while (> count 0)
+ (re-search-forward regexp bound)
+ (setq parse (parse-partial-sexp saved-point (point)))
+ (cond ((nth 3 parse)
+ (re-search-forward
+ (concat "\\([^\\]\\|^\\)" (string (nth 3 parse)))
+ (save-excursion (end-of-line) (point)) t))
+ ((nth 7 parse)
+ (forward-line))
+ ((or (nth 4 parse)
+ (and (eq (char-before) ?\/) (eq (char-after) ?\*)))
+ (re-search-forward "\\*/"))
+ ((and (not (and orig-macro-end
+ (<= (point) orig-macro-end)))
+ (espresso--beginning-of-macro))
+ (c-end-of-macro))
+ (t
+ (setq count (1- count))))
+ (setq saved-point (point))))
+ (point))
+
+
+(defun espresso--re-search-forward (regexp &optional bound noerror count)
+ "Search forward but ignore strings, cpp macros, and comments.
+Invokes `re-search-forward' but treats the buffer as if strings,
+cpp macros, and comments have been removed.
+
+If invoked while inside a macro, treat the contents of the macro
+as normal text.
+
+"
+ (let ((saved-point (point))
+ (search-expr
+ (cond ((null count)
+ '(espresso--re-search-forward-inner regexp bound 1))
+ ((< count 0)
+ '(espresso--re-search-backward-inner regexp bound (- count)))
+ ((> count 0)
+ '(espresso--re-search-forward-inner regexp bound count)))))
+ (condition-case err
+ (eval search-expr)
+ (search-failed
+ (goto-char saved-point)
+ (unless noerror
+ (error (error-message-string err)))))))
+
+
+(defun espresso--re-search-backward-inner (regexp &optional bound count)
+ "Auxiliary function for `espresso--re-search-backward'."
+ (let ((parse)
+ (orig-macro-start
+ (save-excursion
+ (and (espresso--beginning-of-macro)
+ (point))))
+ (saved-point (point-min)))
+ (while (> count 0)
+ (re-search-backward regexp bound)
+ (when (and (> (point) (point-min))
+ (save-excursion (backward-char) (looking-at "/[/*]")))
+ (forward-char))
+ (setq parse (parse-partial-sexp saved-point (point)))
+ (cond ((nth 3 parse)
+ (re-search-backward
+ (concat "\\([^\\]\\|^\\)" (string (nth 3 parse)))
+ (save-excursion (beginning-of-line) (point)) t))
+ ((nth 7 parse)
+ (goto-char (nth 8 parse)))
+ ((or (nth 4 parse)
+ (and (eq (char-before) ?/) (eq (char-after) ?*)))
+ (re-search-backward "/\\*"))
+ ((and (not (and orig-macro-start
+ (>= (point) orig-macro-start)))
+ (espresso--beginning-of-macro)))
+ (t
+ (setq count (1- count))))))
+ (point))
+
+
+(defun espresso--re-search-backward (regexp &optional bound noerror count)
+ "Search backward but ignore strings, preprocessor macros, and
+comments. Invokes `re-search-backward' but treats the buffer as
+if strings, preprocessor macros, and comments have been removed.
+
+If inside a macro when called, treat the macro as normal text.
+"
+ (let ((saved-point (point))
+ (search-expr
+ (cond ((null count)
+ '(espresso--re-search-backward-inner regexp bound 1))
+ ((< count 0)
+ '(espresso--re-search-forward-inner regexp bound (- count)))
+ ((> count 0)
+ '(espresso--re-search-backward-inner regexp bound count)))))
+ (condition-case err
+ (eval search-expr)
+ (search-failed
+ (goto-char saved-point)
+ (unless noerror
+ (error (error-message-string err)))))))
+
+
+(defun espresso--forward-function-decl ()
+ (assert (looking-at "\\_<function\\_>"))
+ (forward-word)
+ (forward-comment most-positive-fixnum)
+ (skip-chars-forward "^(")
+ (unless (eobp)
+ (forward-list)
+ (forward-comment most-positive-fixnum)
+ (skip-chars-forward "^{"))
+ t)
+
+(defun espresso--beginning-of-defun ()
+ (cond ((espresso--re-search-backward "\\_<function\\_>" (point-min) t)
+ (let ((pos (point)))
+ (save-excursion
+ (forward-line 0)
+ (when (looking-at espresso--function-heading-2-re)
+ (setq pos (match-beginning 1))))
+ (goto-char pos)))
+
+ (t
+ (goto-char (point-min)))))
+
+(defun espresso--end-of-defun ()
+ ;; look for function backward. if we're inside it, go to that
+ ;; function's end. otherwise, search for the next function's end and
+ ;; go there
+ (unless (looking-at "\\_<")
+ (skip-syntax-backward "w_"))
+
+ (let ((orig-point (point)) pos)
+ (when (or (looking-at "\\_<function\\_>")
+ (espresso--re-search-backward "\\_<function\\_>" (point-min) t))
+ (goto-char (match-beginning 0))
+ (let* ((func-loc (point))
+ (opening-brace-loc (progn (espresso--forward-function-decl)
+ (point))))
+
+ (cond ((and (<= func-loc orig-point)
+ (<= orig-point opening-brace-loc))
+ (setq pos opening-brace-loc))
+
+ ((/= 0 (nth 0 (parse-partial-sexp
+ opening-brace-loc orig-point 0)))
+ (setq pos opening-brace-loc)))))
+
+ (cond
+ (pos (goto-char pos)
+ (forward-list))
+
+ ((espresso--re-search-forward "\\_<function\\_>" (point-max) t)
+ (espresso--end-of-defun))
+
+ (t (goto-char (point-max))))))
+
+(defun espresso--beginning-of-macro (&optional lim)
+ (let ((here (point)))
+ (save-restriction
+ (if lim (narrow-to-region lim (point-max)))
+ (beginning-of-line)
+ (while (eq (char-before (1- (point))) ?\\)
+ (forward-line -1))
+ (back-to-indentation)
+ (if (and (<= (point) here)
+ (looking-at espresso--opt-cpp-start))
+ t
+ (goto-char here)
+ nil))))
+
+(defun espresso--backward-syntactic-ws (&optional lim)
+ "Simple implementation of c-backward-syntactic-ws"
+ (save-restriction
+ (when lim (narrow-to-region lim (point-max)))
+
+ (let ((in-macro (save-excursion (espresso--beginning-of-macro)))
+ (pos (point)))
+
+ (while (progn (unless in-macro (espresso--beginning-of-macro))
+ (forward-comment most-negative-fixnum)
+ (/= (point)
+ (prog1
+ pos
+ (setq pos (point)))))))))
+
+(defun espresso--forward-syntactic-ws (&optional lim)
+ "Simple implementation of c-forward-syntactic-ws"
+ (save-restriction
+ (when lim (narrow-to-region (point-min) min))
+ (let ((pos (point)))
+ (while (progn
+ (forward-comment most-positive-fixnum)
+ (when (eq (char-after) ?#)
+ (c-end-of-macro))
+ (/= (point)
+ (prog1
+ pos
+ (setq pos (point)))))))))
+
+;;; Font Lock
+
+(defun espresso--inside-param-list-p ()
+ "Return non-nil iff point is inside a function parameter list."
+ (condition-case err
+ (save-excursion
+ (up-list -1)
+ (and (looking-at "(")
+ (progn (forward-symbol -1)
+ (or (looking-at "function")
+ (progn (forward-symbol -1) (looking-at "function"))))))
+ (error nil)))
+
+(defconst espresso--function-heading-1-re
+ (concat
+ "^\\s-*function\\s-+\\(" espresso--name-re "\\)")
+ "Regular expression matching the start of a function header. Match group 1
+is the name of the function.")
+
+(defconst espresso--function-heading-2-re
+ (concat
+ "^\\s-*\\(" espresso--name-re "\\)\\s-*:\\s-*function\\_>")
+ "Regular expression matching the start of a function entry in
+ an associative array. Match group 1 is the name of the function.")
+
+(defconst espresso--macro-decl-re
+ (concat "^\\s-*#\\s-*define\\s-+\\(" espresso--cpp-name-re "\\)\\s-*(")
+ "Regular expression matching a CPP macro definition up to the opening
+parenthesis. Match group 1 is the name of the function.")
+
+(defconst espresso--keyword-re
+ (espresso--regexp-opt-symbol
+ '("abstract" "break" "case" "catch" "class" "const"
+ "continue" "debugger" "default" "delete" "do" "else"
+ "enum" "export" "extends" "final" "finally" "for"
+ "function" "goto" "if" "implements" "import" "in"
+ "instanceof" "interface" "native" "new" "package"
+ "private" "protected" "public" "return" "static"
+ "super" "switch" "synchronized" "throw"
+ "throws" "transient" "try" "typeof" "var" "void"
+ "volatile" "while" "with" "let"))
+ "Regular expression matching any JavaScript keyword.")
+
+(defconst espresso--basic-type-re
+ (espresso--regexp-opt-symbol
+ '("boolean" "byte" "char" "double" "float" "int" "long"
+ "short" "void"))
+ "Regular expression matching any predefined type in JavaScript.")
+
+(defconst espresso--constant-re
+ (espresso--regexp-opt-symbol '("false" "null" "undefined"
+ "true" "arguments" "this"))
+ "Regular expression matching any future reserved words in JavaScript.")
+
+
+(defconst espresso--font-lock-keywords-1
+ (list
+ "\\_<import\\_>"
+ (list espresso--function-heading-1-re 1 font-lock-function-name-face)
+ (list espresso--function-heading-2-re 1 font-lock-function-name-face))
+ "Level one font lock.")
+
+(defconst espresso--font-lock-keywords-2
+ (append espresso--font-lock-keywords-1
+ (list (list espresso--keyword-re 1 font-lock-keyword-face)
+ (cons espresso--basic-type-re font-lock-type-face)
+ (cons espresso--constant-re font-lock-constant-face)))
+ "Level two font lock.")
+
+
+;; Limitations with variable declarations: There seems to be no
+;; sensible way to highlight variables occuring after an initialized
+;; variable in a variable list. For instance, in
+;;
+;; var x, y = f(a, b), z
+;;
+;; z will not be highlighted. Also, in variable declaration lists
+;; spanning several lines only variables on the first line will be
+;; highlighted. To get correct fontification, every line with variable
+;; declarations must contain a `var' keyword.
+
+(defconst espresso--font-lock-keywords-3
+ `(
+ ;; This goes before keywords-2 so it gets used preferentially
+ ;; instead of the keywords in keywords-2. Don't use override
+ ;; because that will override syntactic fontification too, which
+ ;; will fontify commented-out directives as if they weren't
+ ;; commented out.
+ ,@cpp-font-lock-keywords ; from font-lock.el
+
+ ,@espresso--font-lock-keywords-2
+
+ ;; variable declarations
+ ,(list
+ (concat "\\_<\\(const\\|var\\)\\_>\\|" espresso--basic-type-re)
+ (list (concat "\\(" espresso--name-re "\\)"
+ "\\s-*\\([=;].*\\|\\_<in\\_>.*\\|,\\|/[/*]\\|$\\)")
+ nil
+ nil
+ '(1 font-lock-variable-name-face)))
+
+ ;; class instantiation
+ ,(list
+ (concat "\\_<new\\_>\\s-+\\(" espresso--dotted-name-re "\\)")
+ (list 1 'font-lock-type-face))
+
+ ;; instanceof
+ ,(list
+ (concat "\\_<instanceof\\_>\\s-+\\(" espresso--dotted-name-re "\\)")
+ (list 1 'font-lock-type-face))
+
+ ;; formal parameters
+ ,(list
+ (concat
+ "\\_<function\\_>\\(\\s-+" espresso--name-re "\\)?\\s-*(\\s-*"
+ espresso--name-start-re)
+ (list (concat "\\(" espresso--name-re "\\)\\(\\s-*).*\\)?")
+ '(backward-char)
+ '(end-of-line)
+ '(1 font-lock-variable-name-face)))
+
+ ;; continued formal parameter list
+ ,(list
+ (concat
+ "^\\s-*" espresso--name-re "\\s-*[,)]")
+ (list espresso--name-re
+ '(if (save-excursion (backward-char)
+ (espresso--inside-param-list-p))
+ (forward-symbol -1)
+ (end-of-line))
+ '(end-of-line)
+ '(0 font-lock-variable-name-face)))
+
+ ;; class declarations
+ ,@(mapcar #'(lambda (x)
+ `(,x
+ (1 font-lock-type-face t t)
+ (2 font-lock-type-face t t)))
+
+ espresso--class-decls))
+ "Level three font lock.")
+
+
+(defconst espresso--font-lock-keywords
+ '(espresso--font-lock-keywords-3 espresso--font-lock-keywords-1
+ espresso--font-lock-keywords-2
+ espresso--font-lock-keywords-3)
+ "See `font-lock-keywords'.")
+
+;; Note: Javascript cannot continue a regular expression literal
+;; across lines
+(defconst espresso--regexp-literal
+ "[=(,]\\(?:\\s-\\|\n\\)*\\(/\\)[^/*]\\(?:.*?[^\\]\\)?\\(/\\)"
+ "Match a regular expression literal. Match groups 1 and 2 are
+the characters forming the beginning and end of the literal")
+
+;; we want to match regular expressions only at the beginning of
+;; expressions
+(defconst espresso--font-lock-syntactic-keywords
+ `((,espresso--regexp-literal (1 "|") (2 "|")))
+ "Highlighting of regular expressions. See also the variable
+ `font-lock-keywords'.")
+
+;;; Indentation
+
+(defconst espresso--possibly-braceless-keyword-re
+ (espresso--regexp-opt-symbol
+ '("catch" "do" "else" "finally" "for" "if" "try" "while" "with" "let"))
+ "Regular expression matching keywords that are optionally
+ followed by an opening brace.")
+
+(defconst espresso--indent-operator-re
+ (concat "[-+*/%<>=&^|?:.]\\([^-+*/]\\|$\\)\\|"
+ (espresso--regexp-opt-symbol '("in" "instanceof")))
+ "Regular expression matching operators that affect indentation
+ of continued expressions.")
+
+
+(defun espresso--looking-at-operator-p ()
+ "Return non-nil if text after point is an operator (that is not
+a comma)."
+ (save-match-data
+ (and (looking-at espresso--indent-operator-re)
+ (or (not (looking-at ":"))
+ (save-excursion
+ (and (espresso--re-search-backward "[?:{]\\|\\_<case\\_>" nil t)
+ (looking-at "?")))))))
+
+
+(defun espresso--continued-expression-p ()
+ "Returns non-nil if the current line continues an expression."
+ (save-excursion
+ (back-to-indentation)
+ (or (espresso--looking-at-operator-p)
+ (and (espresso--re-search-backward "\n" nil t)
+ (progn
+ (skip-chars-backward " \t")
+ (or (bobp) (backward-char))
+ (and (> (point) (point-min))
+ (save-excursion (backward-char) (not (looking-at "[/*]/")))
+ (espresso--looking-at-operator-p)
+ (and (progn (backward-char)
+ (not (looking-at "++\\|--\\|/[/*]"))))))))))
+
+
+(defun espresso--end-of-do-while-loop-p ()
+ "Returns non-nil if word after point is `while' of a do-while
+statement, else returns nil. A braceless do-while statement
+spanning several lines requires that the start of the loop is
+indented to the same column as the current line."
+ (interactive)
+ (save-excursion
+ (save-match-data
+ (when (looking-at "\\s-*\\_<while\\_>")
+ (if (save-excursion
+ (skip-chars-backward "[ \t\n]*}")
+ (looking-at "[ \t\n]*}"))
+ (save-excursion
+ (backward-list) (forward-symbol -1) (looking-at "\\_<do\\_>"))
+ (espresso--re-search-backward "\\_<do\\_>" (point-at-bol) t)
+ (or (looking-at "\\_<do\\_>")
+ (let ((saved-indent (current-indentation)))
+ (while (and (espresso--re-search-backward "^\\s-*\\_<" nil t)
+ (/= (current-indentation) saved-indent)))
+ (and (looking-at "\\s-*\\_<do\\_>")
+ (not (espresso--re-search-forward
+ "\\_<while\\_>" (point-at-eol) t))
+ (= (current-indentation) saved-indent)))))))))
+
+
+(defun espresso--ctrl-statement-indentation ()
+ "Returns the proper indentation of the current line if it
+starts the body of a control statement without braces, else
+returns nil."
+ (save-excursion
+ (back-to-indentation)
+ (when (save-excursion
+ (and (not (looking-at "[{]"))
+ (progn
+ (espresso--re-search-backward "[[:graph:]]" nil t)
+ (or (eobp) (forward-char))
+ (when (= (char-before) ?\)) (backward-list))
+ (skip-syntax-backward " ")
+ (skip-syntax-backward "w_")
+ (looking-at espresso--possibly-braceless-keyword-re))
+ (not (espresso--end-of-do-while-loop-p))))
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (+ (current-indentation) espresso-indent-level)))))
+
+
+(defun espresso--proper-indentation (parse-status)
+ "Return the proper indentation for the current line."
+ (save-excursion
+ (back-to-indentation)
+ (let ((ctrl-stmt-indent (espresso--ctrl-statement-indentation))
+ (same-indent-p (looking-at "[]})]\\|\\_<case\\_>\\|\\_<default\\_>"))
+ (continued-expr-p (espresso--continued-expression-p)))
+ (cond (ctrl-stmt-indent)
+ ((eq (char-after) ?#) 0)
+ ((save-excursion (espresso--beginning-of-macro))
+ 4)
+ ((nth 1 parse-status)
+ (goto-char (nth 1 parse-status))
+ (if (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)")
+ (progn
+ (skip-syntax-backward " ")
+ (when (= (char-before) ?\)) (backward-list))
+ (back-to-indentation)
+ (cond (same-indent-p
+ (current-column))
+ (continued-expr-p
+ (+ (current-column) (* 2 espresso-indent-level)
+ espresso-expr-indent-offset))
+ (t
+ (+ (current-column) espresso-indent-level))))
+ (unless same-indent-p
+ (forward-char)
+ (skip-chars-forward " \t"))
+ (current-column)))
+ (continued-expr-p (+ espresso-indent-level
+ espresso-expr-indent-offset))
+ (t 0)))))
+
+
+(defun espresso-indent-line ()
+ "Indent the current line as JavaScript source text."
+ (interactive)
+ (save-restriction
+ (widen)
+ (let* ((parse-status
+ (save-excursion (syntax-ppss (point-at-bol))))
+ (offset (- (current-column) (current-indentation))))
+
+ (if (nth 8 parse-status)
+ (indent-relative-maybe)
+ (indent-line-to (espresso--proper-indentation parse-status))
+ (when (> offset 0) (forward-char offset))))))
+
+;;; Filling
+
+(defun espresso-c-fill-paragraph (&optional justify)
+ "Fill the paragraph with c-fill-paragraph"
+ (interactive "*P")
+
+ ;; FIXME: filling a single-line C-style comment into multiple lines
+ ;; does something horrible to the undo list
+
+ (flet ((c-forward-sws
+ (&optional limit)
+ (espresso--forward-syntactic-ws limit))
+
+ (c-backward-sws
+ (&optional limit)
+ (espresso--backward-syntactic-ws limit))
+
+ (c-beginning-of-macro
+ (&optional limit)
+ (espresso--beginning-of-macro limit)))
+
+ (let ((fill-paragraph-function 'c-fill-paragraph))
+ (c-fill-paragraph justify))))
+
+;;; Imenu
+
+(defun espresso--imenu-create-index ()
+ (let ((search-re (mapconcat (lambda (x)
+ (concat "\\(" x "\\)"))
+ (list espresso--function-heading-1-re
+ espresso--function-heading-2-re
+ (concat "\\(?:"
+ (mapconcat
+ #'identity
+ espresso--class-decls "\\|")
+ "\\)")
+ espresso--macro-decl-re)
+ "\\|"))
+ entries parent-entries ends tmp syntax)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+
+ (while (re-search-forward search-re (point-max) t)
+ (goto-char (match-beginning 0))
+ (setq syntax (syntax-ppss))
+ (unless (or (nth 3 syntax) (nth 4 syntax))
+ (while (and ends (>= (point) (car ends)))
+ (setq tmp (nreverse entries)
+ entries (pop parent-entries))
+
+ (unless tmp
+ (setq tmp (list
+ (cons "[empty]" (set-marker (make-marker)
+ (car ends))))))
+
+ (pop ends)
+
+ (setcdr (car entries) tmp))
+
+ (cond ((and (not parent-entries) ; regular function or macro
+ (or (looking-at espresso--function-heading-1-re)
+ (looking-at espresso--macro-decl-re)))
+
+ (push (cons (match-string-no-properties 1)
+ (set-marker (make-marker) (match-beginning 1)))
+ entries))
+
+ ;; does one of the espresso--class-decls regexps match?
+ ((let ((r espresso--class-decls))
+ (while (and r (not (looking-at (car r) )))
+ (setq r (cdr r)))
+ r)
+
+ (push (cons
+ (match-string-no-properties 1)
+ nil)
+ entries)
+ (push entries parent-entries)
+ (setq entries nil)
+ (goto-char (match-end 1))
+ (condition-case err
+ (forward-list)
+ (error nil))
+ (push (point) ends))
+
+
+ ((and parent-entries
+ (looking-at espresso--function-heading-2-re))
+ (push (cons (match-string-no-properties 1)
+ (set-marker (make-marker) (match-beginning 1)))
+ entries))))
+
+ (goto-char (match-end 0)))
+
+ (while parent-entries
+ (setq tmp (nreverse entries)
+ entries (pop parent-entries))
+ (setcdr (car entries) tmp))))
+
+ (nreverse entries)))
+
+(defun espresso--which-func-joiner (parts)
+ (mapconcat #'identity parts "."))
+
+;;; Main Function
+
+;;;###autoload
+(defun espresso-mode ()
+ "Major mode for editing JavaScript source text.
+
+Key bindings:
+
+\\{espresso-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+
+ (use-local-map espresso-mode-map)
+ (set-syntax-table espresso-mode-syntax-table)
+ (set (make-local-variable 'indent-line-function) 'espresso-indent-line)
+ (set (make-local-variable 'beginning-of-defun-function)
+ 'espresso--beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ 'espresso--end-of-defun)
+
+ (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
+
+ (set (make-local-variable 'font-lock-defaults)
+ (list espresso--font-lock-keywords
+ nil nil nil nil
+ '(font-lock-syntactic-keywords
+ . espresso--font-lock-syntactic-keywords)))
+
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (set (make-local-variable 'which-func-imenu-joiner-function)
+ #'espresso--which-func-joiner)
+
+ ;; Comments
+ (setq comment-start "// ")
+ (setq comment-end "")
+ (set (make-local-variable 'fill-paragraph-function)
+ 'espresso-c-fill-paragraph)
+
+ ;; Imenu
+ (setq imenu-case-fold-search nil)
+ (set (make-local-variable 'imenu-create-index-function)
+ #'espresso--imenu-create-index)
+
+ (setq major-mode 'espresso-mode)
+ (setq mode-name "Espresso")
+
+ ;; for filling, pretend we're cc-mode
+ (setq c-comment-prefix-regexp "//+\\|\\**"
+ c-paragraph-start "$"
+ c-paragraph-separate "$"
+ c-block-comment-prefix "* "
+ c-line-comment-starter "//"
+ c-comment-start-regexp "/[*/]\\|\\s!"
+ comment-start-skip "\\(//+\\|/\\*+\\)\\s *")
+
+ (let ((c-buffer-is-cc-mode t))
+ (c-setup-paragraph-variables))
+
+ ;; Important to fontify the whole buffer syntactically! If we don't,
+ ;; then we might have regular expression literals that aren't marked
+ ;; as strings, which will screw up parse-partial-sexp, scan-lists, etc.
+ ;; and and produce maddening "unbalanced parenthesis" errors. When we attempt
+ ;; to find the error and scroll to the portion of the buffer containing the problem,
+ ;; JIT-lock will apply the correct syntax to the regular expresion literal and
+ ;; the problem will mysteriously disappear.
+ (font-lock-set-defaults)
+
+ (let (font-lock-keywords) ; leaves syntactic keywords intact
+ (font-lock-fontify-buffer))
+
+ (run-mode-hooks 'espresso-mode-hook))
+
+
+(eval-after-load "hideshow"
+ '(add-to-list 'hs-special-modes-alist
+ '(espresso-mode "{" "}" "/[*/]"
+ nil hs-c-like-adjust-block-beginning)))
+
+(eval-after-load "folding"
+ (when (fboundp 'folding-add-to-marks-list)
+ (folding-add-to-marks-list 'espresso-mode "// {{{" "// }}}" )))
+
+
+;;; Emacs
+(provide 'espresso-mode)
+;; Local Variables:
+;; outline-regexp: ";;; "
+;; End:
+;; espresso.el ends here
--- /dev/null
+;;; <pre>
+;;; flyspell.el --- on-the-fly spell checker
+
+;; Copyright (C) 1998, 2000, 2003, 2004, 2005 Free Software Foundation, Inc.
+
+;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
+;; Version: 1.7o
+;; Keywords: convenience
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; Flyspell is a minor Emacs mode performing on-the-fly spelling
+;; checking.
+;;
+;; To enable Flyspell minor mode, type M-x flyspell-mode.
+;; This applies only to the current buffer.
+;;
+;; To enable Flyspell in text representing computer programs, type
+;; M-x flyspell-prog-mode.
+;; In that mode only text inside comments is checked.
+;;
+;; Note: consider setting the variable ispell-parser to `tex' to
+;; avoid TeX command checking; use `(setq ispell-parser 'tex)'.
+;;
+;; Some user variables control the behavior of flyspell. They are
+;; those defined under the `User variables' comment.
+
+;;; Code:
+(require 'ispell)
+
+;*---------------------------------------------------------------------*/
+;* Group ... */
+;*---------------------------------------------------------------------*/
+(defgroup flyspell nil
+ "Spell checking on the fly."
+ :tag "FlySpell"
+ :prefix "flyspell-"
+ :group 'ispell
+ :group 'processes)
+
+;*---------------------------------------------------------------------*/
+;* Which emacs are we currently running */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-emacs
+ (cond
+ ((string-match "XEmacs" emacs-version)
+ 'xemacs)
+ (t
+ 'emacs))
+ "The type of Emacs we are currently running.")
+
+(defvar flyspell-use-local-map
+ (or (eq flyspell-emacs 'xemacs)
+ (not (string< emacs-version "20"))))
+
+;*---------------------------------------------------------------------*/
+;* User configuration ... */
+;*---------------------------------------------------------------------*/
+(defcustom flyspell-highlight-flag t
+ "*How Flyspell should indicate misspelled words.
+Non-nil means use highlight, nil means use minibuffer messages."
+ :group 'flyspell
+ :type 'boolean)
+
+(defcustom flyspell-mark-duplications-flag t
+ "*Non-nil means Flyspell reports a repeated word as an error."
+ :group 'flyspell
+ :type 'boolean)
+
+(defcustom flyspell-sort-corrections nil
+ "*Non-nil means, sort the corrections alphabetically before popping them."
+ :group 'flyspell
+ :version "21.1"
+ :type 'boolean)
+
+(defcustom flyspell-duplicate-distance -1
+ "*The maximum distance for finding duplicates of unrecognized words.
+This applies to the feature that when a word is not found in the dictionary,
+if the same spelling occurs elsewhere in the buffer,
+Flyspell uses a different face (`flyspell-duplicate-face') to highlight it.
+This variable specifies how far to search to find such a duplicate.
+-1 means no limit (search the whole buffer).
+0 means do not search for duplicate unrecognized spellings."
+ :group 'flyspell
+ :version "21.1"
+ :type 'number)
+
+(defcustom flyspell-delay 3
+ "*The number of seconds to wait before checking, after a \"delayed\" command."
+ :group 'flyspell
+ :type 'number)
+
+(defcustom flyspell-persistent-highlight t
+ "*Non-nil means misspelled words remain highlighted until corrected.
+If this variable is nil, only the most recently detected misspelled word
+is highlighted."
+ :group 'flyspell
+ :type 'boolean)
+
+(defcustom flyspell-highlight-properties t
+ "*Non-nil means highlight incorrect words even if a property exists for this word."
+ :group 'flyspell
+ :type 'boolean)
+
+(defcustom flyspell-default-delayed-commands
+ '(self-insert-command
+ delete-backward-char
+ backward-or-forward-delete-char
+ delete-char
+ scrollbar-vertical-drag
+ backward-delete-char-untabify)
+ "The standard list of delayed commands for Flyspell.
+See `flyspell-delayed-commands'."
+ :group 'flyspell
+ :version "21.1"
+ :type '(repeat (symbol)))
+
+(defcustom flyspell-delayed-commands nil
+ "List of commands that are \"delayed\" for Flyspell mode.
+After these commands, Flyspell checking is delayed for a short time,
+whose length is specified by `flyspell-delay'."
+ :group 'flyspell
+ :type '(repeat (symbol)))
+
+(defcustom flyspell-default-deplacement-commands
+ '(next-line
+ previous-line
+ scroll-up
+ scroll-down)
+ "The standard list of deplacement commands for Flyspell.
+See `flyspell-deplacement-commands'."
+ :group 'flyspell
+ :version "21.1"
+ :type '(repeat (symbol)))
+
+(defcustom flyspell-default-ignored-commands
+ '(fill-paragraph)
+ "The standard list of ignored commands for Flyspell.
+ See `flyspell-delayed-commands'."
+ :group 'flyspell
+ :version "21.3"
+ :type '(repeat (symbol)))
+
+ (defcustom flyspell-ignored-commands nil
+ "List of commands that are \"ignored\" for Flyspell mode.
+ The changes in the text made by these commands are ignored. This list is meant for commands that change text in a way that does not affect individual words, such as `fill-paragraph'."
+ :group 'flyspell
+ :version "21.3"
+ :type '(repeat (symbol)))
+
+(defcustom flyspell-deplacement-commands nil
+ "List of commands that are \"deplacement\" for Flyspell mode.
+After these commands, Flyspell checking is performed only if the previous
+command was not the very same command."
+ :group 'flyspell
+ :version "21.1"
+ :type '(repeat (symbol)))
+
+(defcustom flyspell-issue-welcome-flag t
+ "*Non-nil means that Flyspell should display a welcome message when started."
+ :group 'flyspell
+ :type 'boolean)
+
+(defcustom flyspell-issue-message-flag t
+ "*Non-nil means that Flyspell emits messages when checking words."
+ :group 'flyspell
+ :type 'boolean)
+
+(defcustom flyspell-incorrect-hook nil
+ "*List of functions to be called when incorrect words are encountered.
+Each function is given three arguments: the beginning and the end
+of the incorrect region. The third is either the symbol 'doublon' or the list
+of possible corrections as returned by 'ispell-parse-output'.
+
+If any of the functions return non-Nil, the word is not highlighted as
+incorrect."
+ :group 'flyspell
+ :version "21.1"
+ :type 'hook)
+
+(defcustom flyspell-default-dictionary nil
+ "A string that is the name of the default dictionary.
+This is passed to the `ispell-change-dictionary' when flyspell is started.
+If the variable `ispell-local-dictionary' or `ispell-dictionary' is non-nil
+when flyspell is started, the value of that variable is used instead
+of `flyspell-default-dictionary' to select the default dictionary.
+Otherwise, if `flyspell-default-dictionary' is nil, it means to use
+Ispell's ultimate default dictionary."
+ :group 'flyspell
+ :version "21.1"
+ :type '(choice string (const :tag "Default" nil)))
+
+(defcustom flyspell-tex-command-regexp
+ "\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)"
+ "A string that is the regular expression that matches TeX commands."
+ :group 'flyspell
+ :version "21.1"
+ :type 'string)
+
+(defcustom flyspell-check-tex-math-command nil
+ "*Non nil means check even inside TeX math environment.
+TeX math environments are discovered by the TEXMATHP that implemented
+inside the texmathp.el Emacs package. That package may be found at:
+http://strw.leidenuniv.nl/~dominik/Tools"
+ :group 'flyspell
+ :type 'boolean)
+
+(defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter
+ '("francais" "deutsch8" "norsk")
+ "List of dictionary names that consider `-' as word delimiter."
+ :group 'flyspell
+ :version "21.1"
+ :type '(repeat (string)))
+
+(defcustom flyspell-abbrev-p
+ nil
+ "*If non-nil, add correction to abbreviation table."
+ :group 'flyspell
+ :version "21.1"
+ :type 'boolean)
+
+(defcustom flyspell-use-global-abbrev-table-p
+ nil
+ "*If non-nil, prefer global abbrev table to local abbrev table."
+ :group 'flyspell
+ :version "21.1"
+ :type 'boolean)
+
+;;;###autoload
+(defcustom flyspell-mode-line-string " Fly"
+ "*String displayed on the modeline when flyspell is active.
+Set this to nil if you don't want a modeline indicator."
+ :group 'flyspell
+ :type '(choice string (const :tag "None" nil)))
+
+(defcustom flyspell-large-region 1000
+ "*The threshold that determines if a region is small.
+The `flyspell-region' function is invoked if the region is small, the
+word are checked one after the other using regular flyspell check
+means. If the region is large, a new Ispell process is spawned to get
+speed.
+
+if flyspell-large-region is nil, regions are treated as small."
+ :group 'flyspell
+ :version "21.1"
+ :type '(choice number boolean))
+
+(defcustom flyspell-insert-function (function insert)
+ "*Function for inserting word by flyspell upon correction."
+ :group 'flyspell
+ :type 'function)
+
+(defcustom flyspell-before-incorrect-word-string nil
+ "String used to indicate an incorrect word starting."
+ :group 'flyspell
+ :type '(choice string (const nil)))
+
+(defcustom flyspell-after-incorrect-word-string nil
+ "String used to indicate an incorrect word ending."
+ :group 'flyspell
+ :type '(choice string (const nil)))
+
+(defcustom flyspell-use-meta-tab t
+ "*Non-nil means that flyspell uses META-TAB to correct word."
+ :group 'flyspell
+ :type 'boolean)
+
+(defcustom flyspell-auto-correct-binding
+ (cond
+ ((eq flyspell-emacs 'xemacs)
+ [(control \;)])
+ (t
+ [?\C-\;]))
+ "The key binding for flyspell auto correction."
+ :group 'flyspell)
+
+;*---------------------------------------------------------------------*/
+;* Mode specific options */
+;* ------------------------------------------------------------- */
+;* Mode specific options enable users to disable flyspell on */
+;* certain word depending of the emacs mode. For instance, when */
+;* using flyspell with mail-mode add the following expression */
+;* in your .emacs file: */
+;* (add-hook 'mail-mode */
+;* '(lambda () (setq flyspell-generic-check-word-p */
+;* 'mail-mode-flyspell-verify))) */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-generic-check-word-p nil
+ "Function providing per-mode customization over which words are flyspelled.
+Returns t to continue checking, nil otherwise.
+Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
+property of the major mode name.")
+(make-variable-buffer-local 'flyspell-generic-check-word-p)
+
+;*--- mail mode -------------------------------------------------------*/
+(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
+(put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
+(defun mail-mode-flyspell-verify ()
+ "This function is used for `flyspell-generic-check-word-p' in Mail mode."
+ (let ((header-end (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^"
+ (regexp-quote mail-header-separator)
+ "$")
+ nil t)
+ (point)))
+ (signature-begin (save-excursion
+ (goto-char (point-max))
+ (re-search-backward message-signature-separator
+ nil t)
+ (point))))
+ (cond ((< (point) header-end)
+ (and (save-excursion (beginning-of-line)
+ (looking-at "^Subject:"))
+ (> (point) (match-end 0))))
+ ((> (point) signature-begin)
+ nil)
+ (t
+ (save-excursion
+ (beginning-of-line)
+ (not (looking-at "[>}|]\\|To:")))))))
+
+;*--- texinfo mode ----------------------------------------------------*/
+(put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify)
+(defun texinfo-mode-flyspell-verify ()
+ "This function is used for `flyspell-generic-check-word-p' in Texinfo mode."
+ (save-excursion
+ (forward-word -1)
+ (not (looking-at "@"))))
+
+;*--- tex mode --------------------------------------------------------*/
+(put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify)
+(defun tex-mode-flyspell-verify ()
+ "This function is used for `flyspell-generic-check-word-p' in LaTeX mode."
+ (and
+ (not (save-excursion
+ (re-search-backward "^[ \t]*%%%[ \t]+Local" (point-min) t)))
+ (not (save-excursion
+ (let ((this (point-marker))
+ (e (progn (end-of-line) (point-marker))))
+ (beginning-of-line)
+ (if (re-search-forward "\\\\\\(cite\\|label\\|ref\\){[^}]*}" e t)
+ (and (>= this (match-beginning 0))
+ (<= this (match-end 0)) )))))))
+
+;*--- sgml mode -------------------------------------------------------*/
+(put 'sgml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
+(put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
+
+(defun sgml-mode-flyspell-verify ()
+ "This function is used for `flyspell-generic-check-word-p' in SGML mode."
+ (not (save-excursion
+ (let ((this (point-marker))
+ (s (progn (beginning-of-line) (point-marker)))
+ (e (progn (end-of-line) (point-marker))))
+ (or (progn
+ (goto-char this)
+ (and (re-search-forward "[^<]*>" e t)
+ (= (match-beginning 0) this)))
+ (progn
+ (goto-char this)
+ (and (re-search-backward "<[^>]*" s t)
+ (= (match-end 0) this)))
+ (and (progn
+ (goto-char this)
+ (and (re-search-forward "[^&]*;" e t)
+ (= (match-beginning 0) this)))
+ (progn
+ (goto-char this)
+ (and (re-search-backward "&[^;]*" s t)
+ (= (match-end 0) this)))))))))
+
+;*---------------------------------------------------------------------*/
+;* Programming mode */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-prog-text-faces
+ '(font-lock-string-face font-lock-comment-face font-lock-doc-face)
+ "Faces corresponding to text in programming-mode buffers.")
+
+(defun flyspell-generic-progmode-verify ()
+ "Used for `flyspell-generic-check-word-p' in programming modes."
+ (let ((f (get-text-property (point) 'face)))
+ (memq f flyspell-prog-text-faces)))
+
+;;;###autoload
+(defun flyspell-prog-mode ()
+ "Turn on `flyspell-mode' for comments and strings."
+ (interactive)
+ (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify)
+ (flyspell-mode 1)
+ (run-hooks 'flyspell-prog-mode-hook))
+
+;*---------------------------------------------------------------------*/
+;* Overlay compatibility */
+;*---------------------------------------------------------------------*/
+(autoload 'make-overlay "overlay" "Overlay compatibility kit." t)
+(autoload 'overlayp "overlay" "Overlay compatibility kit." t)
+(autoload 'overlays-in "overlay" "Overlay compatibility kit." t)
+(autoload 'delete-overlay "overlay" "Overlay compatibility kit." t)
+(autoload 'overlays-at "overlay" "Overlay compatibility kit." t)
+(autoload 'overlay-put "overlay" "Overlay compatibility kit." t)
+(autoload 'overlay-get "overlay" "Overlay compatibility kit." t)
+(autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t)
+
+;*---------------------------------------------------------------------*/
+;* The minor mode declaration. */
+;*---------------------------------------------------------------------*/
+(eval-when-compile (defvar flyspell-local-mouse-map))
+
+;;;###autoload
+(defvar flyspell-mode nil)
+(make-variable-buffer-local 'flyspell-mode)
+
+(defvar flyspell-mouse-map
+ (let ((map (make-sparse-keymap)))
+ (if flyspell-use-meta-tab
+ (define-key map "\M-\t" #'flyspell-auto-correct-word))
+ (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2])
+ #'flyspell-correct-word)
+ (if (not (featurep 'xemacs))
+ (define-key map [(shift down-mouse-2)] #'flyspell-correct-word))
+ (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
+ (define-key map [(control \,)] 'flyspell-goto-next-error)
+ (define-key map [(control \.)] 'flyspell-auto-correct-word)
+ map))
+
+;;;###autoload
+(defvar flyspell-mode-map (make-sparse-keymap))
+
+;; mouse, keyboard bindings and misc definition
+(when (or (assoc 'flyspell-mode minor-mode-map-alist)
+ (setq minor-mode-map-alist
+ (cons (cons 'flyspell-mode flyspell-mode-map)
+ minor-mode-map-alist)))
+ (if flyspell-use-meta-tab
+ (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word))
+ (cond
+ ((eq flyspell-emacs 'xemacs)
+ (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
+ (define-key flyspell-mode-map [(control \,)] 'flyspell-goto-next-error)
+ (define-key flyspell-mode-map [(control \.)] 'flyspell-auto-correct-word))
+ (flyspell-use-local-map
+ (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
+ (define-key flyspell-mode-map [?\C-\,] 'flyspell-goto-next-error)
+ (define-key flyspell-mode-map [?\C-\.] 'flyspell-auto-correct-word))))
+
+
+;; the name of the overlay property that defines the keymap
+(defvar flyspell-overlay-keymap-property-name 'keymap)
+
+;; dash character machinery
+(defvar flyspell-consider-dash-as-word-delimiter-flag nil
+ "*Non-nil means that the `-' char is considered as a word delimiter.")
+(make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag)
+(defvar flyspell-dash-dictionary nil)
+(make-variable-buffer-local 'flyspell-dash-dictionary)
+(defvar flyspell-dash-local-dictionary nil)
+(make-variable-buffer-local 'flyspell-dash-local-dictionary)
+
+;*---------------------------------------------------------------------*/
+;* Highlighting */
+;*---------------------------------------------------------------------*/
+(defface flyspell-incorrect-face
+ (if (eq flyspell-emacs 'xemacs)
+ '((((class color)) (:foreground "OrangeRed" :bold t :underline t))
+ (t (:bold t)))
+ '((((class color)) (:foreground "OrangeRed" :weight bold :underline t))
+ (t (:weight bold))))
+ "Face used for marking a misspelled word in Flyspell."
+ :group 'flyspell)
+
+(defface flyspell-duplicate-face
+ (if (eq flyspell-emacs 'xemacs)
+ '((((class color)) (:foreground "Gold3" :bold t :underline t))
+ (t (:bold t)))
+ '((((class color)) (:foreground "Gold3" :weight bold :underline t))
+ (t (:weight bold))))
+ "Face used for marking a misspelled word that appears twice in the buffer.
+See also `flyspell-duplicate-distance'."
+ :group 'flyspell)
+
+(defvar flyspell-overlay nil)
+
+;*---------------------------------------------------------------------*/
+;* flyspell-mode ... */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(defun flyspell-mode (&optional arg)
+ "Minor mode performing on-the-fly spelling checking.
+Ispell is automatically spawned on background for each entered words.
+The default flyspell behavior is to highlight incorrect words.
+With no argument, this command toggles Flyspell mode.
+With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive.
+
+Bindings:
+\\[ispell-word]: correct words (using Ispell).
+\\[flyspell-auto-correct-word]: automatically correct word.
+\\[flyspell-auto-correct-previous-word]: automatically correct the last misspelled word.
+\\[flyspell-correct-word] (or down-mouse-2): popup correct words.
+
+Hooks:
+This runs `flyspell-mode-hook' after flyspell is entered.
+
+Remark:
+`flyspell-mode' uses `ispell-mode'. Thus all Ispell options are
+valid. For instance, a personal dictionary can be used by
+invoking `ispell-change-dictionary'.
+
+Consider using the `ispell-parser' to check your text. For instance
+consider adding:
+\(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
+in your .emacs file.
+
+\\[flyspell-region] checks all words inside a region.
+\\[flyspell-buffer] checks the whole buffer."
+ (interactive "P")
+ (let ((old-flyspell-mode flyspell-mode))
+ ;; Mark the mode as on or off.
+ (setq flyspell-mode (not (or (and (null arg) flyspell-mode)
+ (<= (prefix-numeric-value arg) 0))))
+ ;; Do the real work.
+ (unless (eq flyspell-mode old-flyspell-mode)
+ (if flyspell-mode
+ (flyspell-mode-on)
+ (flyspell-mode-off))
+ ;; Force modeline redisplay.
+ (set-buffer-modified-p (buffer-modified-p)))))
+
+;*---------------------------------------------------------------------*/
+;* Autoloading */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(if (fboundp 'add-minor-mode)
+ (add-minor-mode 'flyspell-mode
+ 'flyspell-mode-line-string
+ flyspell-mode-map
+ nil
+ 'flyspell-mode)
+ (or (assoc 'flyspell-mode minor-mode-alist)
+ (setq minor-mode-alist
+ (cons '(flyspell-mode flyspell-mode-line-string)
+ minor-mode-alist)))
+
+ (or (assoc 'flyspell-mode minor-mode-map-alist)
+ (setq minor-mode-map-alist
+ (cons (cons 'flyspell-mode flyspell-mode-map)
+ minor-mode-map-alist))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-buffers ... */
+;* ------------------------------------------------------------- */
+;* For remembering buffers running flyspell */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-buffers nil)
+
+;*---------------------------------------------------------------------*/
+;* flyspell-minibuffer-p ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-minibuffer-p (buffer)
+ "Is BUFFER a minibuffer?"
+ (let ((ws (get-buffer-window-list buffer t)))
+ (and (consp ws) (window-minibuffer-p (car ws)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-version ... */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(defun flyspell-version ()
+ "The flyspell version"
+ (interactive)
+ "1.7o")
+
+;*---------------------------------------------------------------------*/
+;* flyspell-accept-buffer-local-defs ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-accept-buffer-local-defs ()
+ ;; strange problem. If buffer in current window has font-lock turned on,
+ ;; but SET-BUFFER was called to point to an invisible buffer, this ispell
+ ;; call will reset the buffer to the buffer in the current window. However,
+ ;; it only happens at startup (fix by Albert L. Ting).
+ (let ((buf (current-buffer)))
+ (ispell-accept-buffer-local-defs)
+ (set-buffer buf))
+ (if (not (and (eq flyspell-dash-dictionary ispell-dictionary)
+ (eq flyspell-dash-local-dictionary ispell-local-dictionary)))
+ ;; the dictionary has changed
+ (progn
+ (setq flyspell-dash-dictionary ispell-dictionary)
+ (setq flyspell-dash-local-dictionary ispell-local-dictionary)
+ (if (member (or ispell-local-dictionary ispell-dictionary)
+ flyspell-dictionaries-that-consider-dash-as-word-delimiter)
+ (setq flyspell-consider-dash-as-word-delimiter-flag t)
+ (setq flyspell-consider-dash-as-word-delimiter-flag nil)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-mode-on ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-mode-on ()
+ "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead."
+ (setq ispell-highlight-face 'flyspell-incorrect-face)
+ ;; local dictionaries setup
+ (ispell-change-dictionary
+ (or ispell-local-dictionary ispell-dictionary flyspell-default-dictionary))
+ ;; we have to force ispell to accept the local definition or
+ ;; otherwise it could be too late, the local dictionary may
+ ;; be forgotten!
+ (flyspell-accept-buffer-local-defs)
+ ;; we put the `flyspell-delayed' property on some commands
+ (flyspell-delay-commands)
+ ;; we put the `flyspell-deplacement' property on some commands
+ (flyspell-deplacement-commands)
+ ;; we put the `flyspell-ignored' property on some commands
+ (flyspell-ignore-commands)
+ ;; we bound flyspell action to post-command hook
+ (if (eq flyspell-emacs 'xemacs)
+ (make-local-hook 'post-command-hook))
+ (add-hook 'post-command-hook (function flyspell-post-command-hook) t t)
+ ;; we bound flyspell action to pre-command hook
+ (if (eq flyspell-emacs 'xemacs)
+ (make-local-hook 'pre-command-hook))
+ (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
+ ;; we bound flyspell action to after-change hook
+ (make-local-variable 'after-change-functions)
+ (setq after-change-functions
+ (cons 'flyspell-after-change-function after-change-functions))
+ ;; set flyspell-generic-check-word-p based on the major mode
+ (let ((mode-predicate (get major-mode 'flyspell-mode-predicate)))
+ (if mode-predicate
+ (setq flyspell-generic-check-word-p mode-predicate)))
+ ;; work around the fact that the `local-map' text-property replaces the
+ ;; buffer's local map rather than shadowing it.
+ (set (make-local-variable 'flyspell-mouse-map)
+ (let ((map (copy-keymap flyspell-mouse-map)))
+ (set-keymap-parent map (current-local-map))
+ (if (and (eq flyspell-emacs 'emacs)
+ (not (string< emacs-version "20")))
+ (define-key map '[tool-bar] nil))
+ map))
+ (set (make-local-variable 'flyspell-mode-map)
+ (let ((map (copy-keymap flyspell-mode-map)))
+ (set-keymap-parent map (current-local-map))
+ (if (and (eq flyspell-emacs 'emacs)
+ (not (string< emacs-version "20")))
+ (define-key map '[tool-bar] nil))
+ map))
+ ;; the welcome message
+ (if (and flyspell-issue-message-flag
+ flyspell-issue-welcome-flag
+ (interactive-p))
+ (let ((binding (where-is-internal 'flyspell-auto-correct-word
+ nil 'non-ascii)))
+ (message
+ (if binding
+ (format "Welcome to flyspell. Use %s or Mouse-2 to correct words."
+ (key-description binding))
+ "Welcome to flyspell. Use Mouse-2 to correct words."))))
+ ;; we end with the flyspell hooks
+ (run-hooks 'flyspell-mode-hook))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-delay-commands ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-delay-commands ()
+ "Install the standard set of Flyspell delayed commands."
+ (mapcar 'flyspell-delay-command flyspell-default-delayed-commands)
+ (mapcar 'flyspell-delay-command flyspell-delayed-commands))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-delay-command ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-delay-command (command)
+ "Set COMMAND to be delayed, for Flyspell.
+When flyspell `post-command-hook' is invoked because a delayed command
+as been used the current word is not immediately checked.
+It will be checked only after `flyspell-delay' seconds."
+ (interactive "SDelay Flyspell after Command: ")
+ (put command 'flyspell-delayed t))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-deplacement-commands ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-deplacement-commands ()
+ "Install the standard set of Flyspell deplacement commands."
+ (mapcar 'flyspell-deplacement-command flyspell-default-deplacement-commands)
+ (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-deplacement-command ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-deplacement-command (command)
+ "Set COMMAND that implement cursor movements, for Flyspell.
+When flyspell `post-command-hook' is invoked because of a deplacement command
+as been used the current word is checked only if the previous command was
+not the very same deplacement command."
+ (interactive "SDeplacement Flyspell after Command: ")
+ (put command 'flyspell-deplacement t))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-ignore-commands ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-ignore-commands ()
+ "Install the standard set of Flyspell ignored commands."
+ (mapcar 'flyspell-ignore-command flyspell-default-ignored-commands)
+ (mapcar 'flyspell-ignore-command flyspell-ignored-commands))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-ignore-command ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-ignore-command (command)
+ "Set COMMAND to be ignored, for Flyspell.
+When flyspell `post-command-hook' is invoked because of an
+ignored command having been used, the changes in the text made by
+that command are ignored. This feature is meant for commands that
+change text in a way that does not affect individual words, such
+as `fill-paragraph'."
+ (interactive "SMake Flyspell ignore changes made by Command: ")
+ (put command 'flyspell-ignored t))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-word-cache ... */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-word-cache-start nil)
+(defvar flyspell-word-cache-end nil)
+(defvar flyspell-word-cache-word nil)
+(defvar flyspell-word-cache-result '_)
+(make-variable-buffer-local 'flyspell-word-cache-start)
+(make-variable-buffer-local 'flyspell-word-cache-end)
+(make-variable-buffer-local 'flyspell-word-cache-word)
+(make-variable-buffer-local 'flyspell-word-cache-result)
+
+;*---------------------------------------------------------------------*/
+;* The flyspell pre-hook, store the current position. In the */
+;* post command hook, we will check, if the word at this position */
+;* has to be spell checked. */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-pre-buffer nil)
+(defvar flyspell-pre-point nil)
+(defvar flyspell-pre-column nil)
+(defvar flyspell-pre-pre-buffer nil)
+(defvar flyspell-pre-pre-point nil)
+
+;*---------------------------------------------------------------------*/
+;* flyspell-previous-command ... */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-previous-command nil
+ "The last interactive command checked by Flyspell.")
+
+;*---------------------------------------------------------------------*/
+;* flyspell-pre-command-hook ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-pre-command-hook ()
+ "Save the current buffer and point for Flyspell's post-command hook."
+ (interactive)
+ (setq flyspell-pre-buffer (current-buffer))
+ (setq flyspell-pre-point (point))
+ (setq flyspell-pre-column (current-column)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-mode-off ... */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(defun flyspell-mode-off ()
+ "Turn Flyspell mode off."
+ ;; we remove the hooks
+ (remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
+ (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
+ (setq after-change-functions (delq 'flyspell-after-change-function
+ after-change-functions))
+ ;; we remove all the flyspell hilightings
+ (flyspell-delete-all-overlays)
+ ;; we have to erase pre cache variables
+ (setq flyspell-pre-buffer nil)
+ (setq flyspell-pre-point nil)
+ ;; we mark the mode as killed
+ (setq flyspell-mode nil))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-check-pre-word-p ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-check-pre-word-p ()
+ "Return non-nil if we should check the word before point.
+More precisely, it applies to the word that was before point
+before the current command."
+ (cond
+ ((or (not (numberp flyspell-pre-point))
+ (not (bufferp flyspell-pre-buffer))
+ (not (buffer-live-p flyspell-pre-buffer)))
+ nil)
+ ((and (eq flyspell-pre-pre-point flyspell-pre-point)
+ (eq flyspell-pre-pre-buffer flyspell-pre-buffer))
+ nil)
+ ((or (and (= flyspell-pre-point (- (point) 1))
+ (eq (char-syntax (char-after flyspell-pre-point)) ?w))
+ (= flyspell-pre-point (point))
+ (= flyspell-pre-point (+ (point) 1)))
+ nil)
+ ((and (symbolp this-command)
+ (not executing-kbd-macro)
+ (or (get this-command 'flyspell-delayed)
+ (and (get this-command 'flyspell-deplacement)
+ (eq flyspell-previous-command this-command)))
+ (or (= (current-column) 0)
+ (= (current-column) flyspell-pre-column)
+ (eq (char-syntax (char-after flyspell-pre-point)) ?w)))
+ nil)
+ ((not (eq (current-buffer) flyspell-pre-buffer))
+ t)
+ ((not (and (numberp flyspell-word-cache-start)
+ (numberp flyspell-word-cache-end)))
+ t)
+ (t
+ (or (< flyspell-pre-point flyspell-word-cache-start)
+ (> flyspell-pre-point flyspell-word-cache-end)))))
+
+;*---------------------------------------------------------------------*/
+;* The flyspell after-change-hook, store the change position. In */
+;* the post command hook, we will check, if the word at this */
+;* position has to be spell checked. */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-changes nil)
+
+;*---------------------------------------------------------------------*/
+;* flyspell-after-change-function ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-after-change-function (start stop len)
+ "Save the current buffer and point for Flyspell's post-command hook."
+ (interactive)
+ (unless (and (symbolp this-command) (get this-command 'flyspell-ignored))
+ (setq flyspell-changes (cons (cons start stop) flyspell-changes))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-check-changed-word-p ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-check-changed-word-p (start stop)
+ "Return t when the changed word has to be checked.
+The answer depends of several criteria.
+Mostly we check word delimiters."
+ (cond
+ ((and (memq (char-after start) '(?\n ? )) (> stop start))
+ t)
+ ((not (numberp flyspell-pre-point))
+ t)
+ ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop))
+ nil)
+ ((let ((pos (point)))
+ (or (>= pos start) (<= pos stop) (= pos (1+ stop))))
+ nil)
+ (t
+ t)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-check-word-p ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-check-word-p ()
+ "Return t when the word at `point' has to be checked.
+The answer depends of several criteria.
+Mostly we check word delimiters."
+ (cond
+ ((<= (- (point-max) 1) (point-min))
+ ;; the buffer is not filled enough
+ nil)
+ ((and (and (> (current-column) 0)
+ (not (eq (current-column) flyspell-pre-column)))
+ (save-excursion
+ (backward-char 1)
+ (and (looking-at (flyspell-get-not-casechars))
+ (or flyspell-consider-dash-as-word-delimiter-flag
+ (not (looking-at "\\-"))))))
+ ;; yes because we have reached or typed a word delimiter.
+ t)
+ ((symbolp this-command)
+ (cond
+ ((get this-command 'flyspell-deplacement)
+ (not (eq flyspell-previous-command this-command)))
+ ((get this-command 'flyspell-delayed)
+ ;; the current command is not delayed, that
+ ;; is that we must check the word now
+ (if (or (fboundp 'about-xemacs) (featurep 'xemacs))
+ (sit-for flyspell-delay nil)
+ (sit-for flyspell-delay 0 nil)))
+ (t t)))
+ (t t)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-debug-signal-no-check ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-debug-signal-no-check (msg obj)
+ (setq debug-on-error t)
+ (save-excursion
+ (let ((buffer (get-buffer-create "*flyspell-debug*")))
+ (set-buffer buffer)
+ (erase-buffer)
+ (insert "NO-CHECK:\n")
+ (insert (format " %S : %S\n" msg obj)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-debug-signal-pre-word-checked ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-debug-signal-pre-word-checked ()
+ (setq debug-on-error t)
+ (save-excursion
+ (let ((buffer (get-buffer-create "*flyspell-debug*")))
+ (set-buffer buffer)
+ (insert "PRE-WORD:\n")
+ (insert (format " pre-point : %S\n" flyspell-pre-point))
+ (insert (format " pre-buffer : %S\n" flyspell-pre-buffer))
+ (insert (format " cache-start: %S\n" flyspell-word-cache-start))
+ (insert (format " cache-end : %S\n" flyspell-word-cache-end))
+ (goto-char (point-max)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-debug-signal-word-checked ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-debug-signal-word-checked ()
+ (setq debug-on-error t)
+ (save-excursion
+ (let ((oldbuf (current-buffer))
+ (buffer (get-buffer-create "*flyspell-debug*"))
+ (point (point)))
+ (set-buffer buffer)
+ (insert "WORD:\n")
+ (insert (format " this-cmd : %S\n" this-command))
+ (insert (format " delayed : %S\n" (and (symbolp this-command)
+ (get this-command 'flyspell-delayed))))
+ (insert (format " ignored : %S\n" (and (symbolp this-command)
+ (get this-command 'flyspell-ignored))))
+ (insert (format " point : %S\n" point))
+ (insert (format " prev-char : [%c] %S\n"
+ (progn
+ (set-buffer oldbuf)
+ (let ((c (if (> (point) (point-min))
+ (save-excursion
+ (backward-char 1)
+ (char-after (point)))
+ ? )))
+ (set-buffer buffer)
+ c))
+ (progn
+ (set-buffer oldbuf)
+ (let ((c (if (> (point) (point-min))
+ (save-excursion
+ (backward-char 1)
+ (and (and (looking-at (flyspell-get-not-casechars)) 1)
+ (and (or flyspell-consider-dash-as-word-delimiter-flag
+ (not (looking-at "\\-"))) 2))))))
+ (set-buffer buffer)
+ c))))
+ (insert (format " because : %S\n"
+ (cond
+ ((not (and (symbolp this-command)
+ (get this-command 'flyspell-delayed)))
+ ;; the current command is not delayed, that
+ ;; is that we must check the word now
+ 'not-delayed)
+ ((progn
+ (set-buffer oldbuf)
+ (let ((c (if (> (point) (point-min))
+ (save-excursion
+ (backward-char 1)
+ (and (looking-at (flyspell-get-not-casechars))
+ (or flyspell-consider-dash-as-word-delimiter-flag
+ (not (looking-at "\\-"))))))))
+ (set-buffer buffer)
+ c))
+ ;; yes because we have reached or typed a word delimiter.
+ 'separator)
+ ((not (integerp flyspell-delay))
+ ;; yes because the user had set up a no-delay configuration.
+ 'no-delay)
+ (t
+ 'sit-for))))
+ (goto-char (point-max)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-debug-signal-changed-checked ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-debug-signal-changed-checked ()
+ (setq debug-on-error t)
+ (save-excursion
+ (let ((buffer (get-buffer-create "*flyspell-debug*"))
+ (point (point)))
+ (set-buffer buffer)
+ (insert "CHANGED WORD:\n")
+ (insert (format " point : %S\n" point))
+ (goto-char (point-max)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-post-command-hook ... */
+;* ------------------------------------------------------------- */
+;* It is possible that we check several words: */
+;* 1- the current word is checked if the predicate */
+;* FLYSPELL-CHECK-WORD-P is true */
+;* 2- the word that used to be the current word before the */
+;* THIS-COMMAND is checked if: */
+;* a- the previous word is different from the current word */
+;* b- the previous word as not just been checked by the */
+;* previous FLYSPELL-POST-COMMAND-HOOK */
+;* 3- the words changed by the THIS-COMMAND that are neither the */
+;* previous word nor the current word */
+;*---------------------------------------------------------------------*/
+(defun flyspell-post-command-hook ()
+ "The `post-command-hook' used by flyspell to check a word in-the-fly."
+ (interactive)
+ (let ((command this-command))
+ (if (flyspell-check-pre-word-p)
+ (save-excursion
+ '(flyspell-debug-signal-pre-word-checked)
+ (set-buffer flyspell-pre-buffer)
+ (save-excursion
+ (goto-char flyspell-pre-point)
+ (flyspell-word))))
+ (if (flyspell-check-word-p)
+ (progn
+ '(flyspell-debug-signal-word-checked)
+ (flyspell-word)
+ ;; we remember which word we have just checked.
+ ;; this will be used next time we will check a word
+ ;; to compare the next current word with the word
+ ;; that as been registered in the pre-command-hook
+ ;; that is these variables are used within the predicate
+ ;; FLYSPELL-CHECK-PRE-WORD-P
+ (setq flyspell-pre-pre-buffer (current-buffer))
+ (setq flyspell-pre-pre-point (point)))
+ (progn
+ (setq flyspell-pre-pre-buffer nil)
+ (setq flyspell-pre-pre-point nil)
+ ;; when a word is not checked because of a delayed command
+ ;; we do not disable the ispell cache.
+ (if (and (symbolp this-command) (get this-command 'flyspell-delayed))
+ (progn
+ (setq flyspell-word-cache-end -1)
+ (setq flyspell-word-cache-result '_)))))
+ (while (consp flyspell-changes)
+ (let ((start (car (car flyspell-changes)))
+ (stop (cdr (car flyspell-changes))))
+ (if (flyspell-check-changed-word-p start stop)
+ (save-excursion
+ '(flyspell-debug-signal-changed-checked)
+ (goto-char start)
+ (flyspell-word)))
+ (setq flyspell-changes (cdr flyspell-changes))))
+ (setq flyspell-previous-command command)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-notify-misspell ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-notify-misspell (start end word poss)
+ (let ((replacements (if (stringp poss)
+ poss
+ (if flyspell-sort-corrections
+ (sort (car (cdr (cdr poss))) 'string<)
+ (car (cdr (cdr poss)))))))
+ (if flyspell-issue-message-flag
+ (message (format "mispelling `%s' %S" word replacements)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-word-search-backward ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-word-search-backward (word bound)
+ (save-excursion
+ (let ((r '())
+ p)
+ (while (and (not r) (setq p (search-backward word bound t)))
+ (let ((lw (flyspell-get-word '())))
+ (if (and (consp lw) (string-equal (car lw) word))
+ (setq r p)
+ (goto-char p))))
+ r)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-word-search-forward ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-word-search-forward (word bound)
+ (save-excursion
+ (let ((r '())
+ p)
+ (while (and (not r) (setq p (search-forward word bound t)))
+ (let ((lw (flyspell-get-word '())))
+ (if (and (consp lw) (string-equal (car lw) word))
+ (setq r p)
+ (goto-char (1+ p)))))
+ r)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-word ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-word (&optional following)
+ "Spell check a word."
+ (interactive (list current-prefix-arg))
+ (if (interactive-p)
+ (setq following ispell-following-word))
+ (save-excursion
+ ;; use the correct dictionary
+ (flyspell-accept-buffer-local-defs)
+ (let* ((cursor-location (point))
+ (flyspell-word (flyspell-get-word following))
+ start end poss word)
+ (if (or (eq flyspell-word nil)
+ (and (fboundp flyspell-generic-check-word-p)
+ (not (funcall flyspell-generic-check-word-p))))
+ t
+ (progn
+ ;; destructure return flyspell-word info list.
+ (setq start (car (cdr flyspell-word))
+ end (car (cdr (cdr flyspell-word)))
+ word (car flyspell-word))
+ ;; before checking in the directory, we check for doublons.
+ (cond
+ ((and (or (not (eq ispell-parser 'tex))
+ (and (> start (point-min))
+ (not (eq (char-after (1- start)) ?}))
+ (not (eq (char-after (1- start)) ?\\))))
+ flyspell-mark-duplications-flag
+ (save-excursion
+ (goto-char (1- start))
+ (let ((p (flyspell-word-search-backward
+ word
+ (- start (1+ (- end start))))))
+ (and p (/= p (1- start))))))
+ ;; yes, this is a doublon
+ (flyspell-highlight-incorrect-region start end 'doublon)
+ nil)
+ ((and (eq flyspell-word-cache-start start)
+ (eq flyspell-word-cache-end end)
+ (string-equal flyspell-word-cache-word word))
+ ;; this word had been already checked, we skip
+ flyspell-word-cache-result)
+ ((and (eq ispell-parser 'tex)
+ (flyspell-tex-command-p flyspell-word))
+ ;; this is a correct word (because a tex command)
+ (flyspell-unhighlight-at start)
+ (if (> end start)
+ (flyspell-unhighlight-at (- end 1)))
+ t)
+ (t
+ ;; we setup the cache
+ (setq flyspell-word-cache-start start)
+ (setq flyspell-word-cache-end end)
+ (setq flyspell-word-cache-word word)
+ ;; now check spelling of word.
+ (process-send-string ispell-process "%\n")
+ ;; put in verbose mode
+ (process-send-string ispell-process
+ (concat "^" word "\n"))
+ ;; we mark the ispell process so it can be killed
+ ;; when emacs is exited without query
+ (if (fboundp 'process-kill-without-query)
+ (process-kill-without-query ispell-process))
+ ;; wait until ispell has processed word
+ (while (progn
+ (accept-process-output ispell-process)
+ (not (string= "" (car ispell-filter)))))
+ ;; (process-send-string ispell-process "!\n")
+ ;; back to terse mode.
+ (setq ispell-filter (cdr ispell-filter))
+ (if (consp ispell-filter)
+ (setq poss (ispell-parse-output (car ispell-filter))))
+ (let ((res (cond ((eq poss t)
+ ;; correct
+ (setq flyspell-word-cache-result t)
+ (flyspell-unhighlight-at start)
+ (if (> end start)
+ (flyspell-unhighlight-at (- end 1)))
+ t)
+ ((and (stringp poss) flyspell-highlight-flag)
+ ;; correct
+ (setq flyspell-word-cache-result t)
+ (flyspell-unhighlight-at start)
+ (if (> end start)
+ (flyspell-unhighlight-at (- end 1)))
+ t)
+ ((null poss)
+ (setq flyspell-word-cache-result t)
+ (flyspell-unhighlight-at start)
+ (if (> end start)
+ (flyspell-unhighlight-at (- end 1)))
+ t)
+ ((or (and (< flyspell-duplicate-distance 0)
+ (or (save-excursion
+ (goto-char start)
+ (flyspell-word-search-backward
+ word
+ (point-min)))
+ (save-excursion
+ (goto-char end)
+ (flyspell-word-search-forward
+ word
+ (point-max)))))
+ (and (> flyspell-duplicate-distance 0)
+ (or (save-excursion
+ (goto-char start)
+ (flyspell-word-search-backward
+ word
+ (- start
+ flyspell-duplicate-distance)))
+ (save-excursion
+ (goto-char end)
+ (flyspell-word-search-forward
+ word
+ (+ end
+ flyspell-duplicate-distance))))))
+ (setq flyspell-word-cache-result nil)
+ (if flyspell-highlight-flag
+ (flyspell-highlight-duplicate-region
+ start end)
+ (message (format "duplicate `%s'" word)))
+ nil)
+ (t
+ (setq flyspell-word-cache-result nil)
+ ;; incorrect highlight the location
+ (if flyspell-highlight-flag
+ (flyspell-highlight-incorrect-region
+ start end poss)
+ (flyspell-notify-misspell start end word poss))
+ nil))))
+ ;; return to original location
+ (goto-char cursor-location)
+ (if ispell-quit (setq ispell-quit nil))
+ res))))))))
+
+;* {*---------------------------------------------------------------------*} */
+;* {* flyspell-tex-math-initialized ... *} */
+;* {*---------------------------------------------------------------------*} */
+;* (defvar flyspell-tex-math-initialized nil) */
+;* */
+;* {*---------------------------------------------------------------------*} */
+;* {* flyspell-math-tex-command-p ... *} */
+;* {* ------------------------------------------------------------- *} */
+;* {* This function uses the texmathp package to check if (point) *} */
+;* {* is within a tex command. In order to avoid using *} */
+;* {* condition-case each time we use the variable *} */
+;* {* flyspell-tex-math-initialized to make a special case the first *} */
+;* {* time that function is called. *} */
+;* {*---------------------------------------------------------------------*} */
+;* (defun flyspell-math-tex-command-p () */
+;* (cond */
+;* (flyspell-check-tex-math-command */
+;* nil) */
+;* ((eq flyspell-tex-math-initialized t) */
+;* (texmathp)) */
+;* ((eq flyspell-tex-math-initialized 'error) */
+;* nil) */
+;* (t */
+;* (setq flyspell-tex-math-initialized t) */
+;* (condition-case nil */
+;* (texmathp) */
+;* (error (progn */
+;* (setq flyspell-tex-math-initialized 'error) */
+;* nil)))))) */
+
+;*---------------------------------------------------------------------*/
+;* flyspell-math-tex-command-p ... */
+;* ------------------------------------------------------------- */
+;* This function uses the texmathp package to check if point */
+;* is within a TeX math environment. `texmathp' can yield errors */
+;* if the document is currently not valid TeX syntax. */
+;*---------------------------------------------------------------------*/
+(defun flyspell-math-tex-command-p ()
+ (when (fboundp 'texmathp)
+ (if flyspell-check-tex-math-command
+ nil
+ (condition-case nil
+ (texmathp)
+ (error nil)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-tex-command-p ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-tex-command-p (word)
+ "Return t if WORD is a TeX command."
+ (or (save-excursion
+ (let ((b (car (cdr word))))
+ (and (re-search-backward "\\\\" (- (point) 100) t)
+ (or (= (match-end 0) b)
+ (and (goto-char (match-end 0))
+ (looking-at flyspell-tex-command-regexp)
+ (>= (match-end 0) b))))))
+ (flyspell-math-tex-command-p)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-casechars-cache ... */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-casechars-cache nil)
+(defvar flyspell-ispell-casechars-cache nil)
+(make-variable-buffer-local 'flyspell-casechars-cache)
+(make-variable-buffer-local 'flyspell-ispell-casechars-cache)
+
+;*---------------------------------------------------------------------*/
+;* flyspell-get-casechars ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-get-casechars ()
+ "This function builds a string that is the regexp of word chars.
+In order to avoid one useless string construction,
+this function changes the last char of the `ispell-casechars' string."
+ (let ((ispell-casechars (ispell-get-casechars)))
+ (cond
+ ((eq ispell-parser 'tex)
+ (setq flyspell-ispell-casechars-cache ispell-casechars)
+ (setq flyspell-casechars-cache
+ (concat (substring ispell-casechars
+ 0
+ (- (length ispell-casechars) 1))
+ "]"))
+ flyspell-casechars-cache)
+ (t
+ (setq flyspell-ispell-casechars-cache ispell-casechars)
+ (setq flyspell-casechars-cache ispell-casechars)
+ flyspell-casechars-cache))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-get-not-casechars-cache ... */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-not-casechars-cache nil)
+(defvar flyspell-ispell-not-casechars-cache nil)
+(make-variable-buffer-local 'flyspell-not-casechars-cache)
+(make-variable-buffer-local 'flyspell-ispell-not-casechars-cache)
+
+;*---------------------------------------------------------------------*/
+;* flyspell-get-not-casechars ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-get-not-casechars ()
+ "This function builds a string that is the regexp of non-word chars."
+ (let ((ispell-not-casechars (ispell-get-not-casechars)))
+ (cond
+ ((eq ispell-parser 'tex)
+ (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
+ (setq flyspell-not-casechars-cache
+ (concat (substring ispell-not-casechars
+ 0
+ (- (length ispell-not-casechars) 1))
+ "]"))
+ flyspell-not-casechars-cache)
+ (t
+ (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
+ (setq flyspell-not-casechars-cache ispell-not-casechars)
+ flyspell-not-casechars-cache))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-get-word ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-get-word (following &optional extra-otherchars)
+ "Return the word for spell-checking according to Ispell syntax.
+If optional argument FOLLOWING is non-nil or if `flyspell-following-word'
+is non-nil when called interactively, then the following word
+\(rather than preceding\) is checked when the cursor is not over a word.
+Optional second argument contains otherchars that can be included in word
+many times.
+
+Word syntax described by `flyspell-dictionary-alist' (which see)."
+ (let* ((flyspell-casechars (flyspell-get-casechars))
+ (flyspell-not-casechars (flyspell-get-not-casechars))
+ (ispell-otherchars (ispell-get-otherchars))
+ (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
+ (word-regexp (concat flyspell-casechars
+ "+\\("
+ (if (not (string= "" ispell-otherchars))
+ (concat ispell-otherchars "?"))
+ (if extra-otherchars
+ (concat extra-otherchars "?"))
+ flyspell-casechars
+ "+\\)"
+ (if (or ispell-many-otherchars-p
+ extra-otherchars)
+ "*" "?")))
+ did-it-once prevpt
+ start end word)
+ ;; find the word
+ (if (not (looking-at flyspell-casechars))
+ (if following
+ (re-search-forward flyspell-casechars (point-max) t)
+ (re-search-backward flyspell-casechars (point-min) t)))
+ ;; move to front of word
+ (re-search-backward flyspell-not-casechars (point-min) 'start)
+ (while (and (or (and (not (string= "" ispell-otherchars))
+ (looking-at ispell-otherchars))
+ (and extra-otherchars (looking-at extra-otherchars)))
+ (not (bobp))
+ (or (not did-it-once)
+ ispell-many-otherchars-p)
+ (not (eq prevpt (point))))
+ (if (and extra-otherchars (looking-at extra-otherchars))
+ (progn
+ (backward-char 1)
+ (if (looking-at flyspell-casechars)
+ (re-search-backward flyspell-not-casechars (point-min) 'move)))
+ (setq did-it-once t
+ prevpt (point))
+ (backward-char 1)
+ (if (looking-at flyspell-casechars)
+ (re-search-backward flyspell-not-casechars (point-min) 'move)
+ (backward-char -1))))
+ ;; Now mark the word and save to string.
+ (if (not (re-search-forward word-regexp (point-max) t))
+ nil
+ (progn
+ (setq start (match-beginning 0)
+ end (point)
+ word (buffer-substring-no-properties start end))
+ (list word start end)))))
+
+(defun flyspell-get-word.old (following)
+ "Return the word for spell-checking according to Ispell syntax.
+If argument FOLLOWING is non-nil or if `ispell-following-word'
+is non-nil when called interactively, then the following word
+\(rather than preceding\) is checked when the cursor is not over a word.
+Optional second argument contains other chars that can be included in word
+many times.
+
+Word syntax described by `ispell-dictionary-alist' (which see)."
+ (let* ((flyspell-casechars (flyspell-get-casechars))
+ (flyspell-not-casechars (flyspell-get-not-casechars))
+ (ispell-otherchars (ispell-get-otherchars))
+ (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
+ (word-regexp (if (string< "" ispell-otherchars)
+ (concat flyspell-casechars
+ "+\\("
+ ispell-otherchars
+ (if (> (length ispell-otherchars) 0) "?")
+ flyspell-casechars
+ "+\\)"
+ (if ispell-many-otherchars-p
+ "*" "?"))
+ (concat flyspell-casechars "+")))
+ did-it-once
+ start end word)
+ ;; find the word
+ (if (not (looking-at flyspell-casechars))
+ (if following
+ (re-search-forward flyspell-casechars (point-max) t)
+ (re-search-backward flyspell-casechars (point-min) t)))
+ ;; move to front of word
+ (re-search-backward flyspell-not-casechars (point-min) 'start)
+ (let ((pos nil))
+ (if (string< "" ispell-otherchars)
+ (while (and (looking-at ispell-otherchars)
+ (not (bobp))
+ (or (not did-it-once)
+ ispell-many-otherchars-p)
+ (not (eq pos (point))))
+ (setq pos (point))
+ (setq did-it-once t)
+ (backward-char 1)
+ (if (looking-at flyspell-casechars)
+ (re-search-backward flyspell-not-casechars (point-min) 'move)
+ (backward-char -1)))))
+ ;; Now mark the word and save to string.
+ (if (eq (re-search-forward word-regexp (point-max) t) nil)
+ nil
+ (progn
+ (setq start (match-beginning 0)
+ end (point)
+ word (buffer-substring-no-properties start end))
+ (list word start end)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-small-region ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-small-region (beg end)
+ "Flyspell text between BEG and END."
+ (save-excursion
+ (if (> beg end)
+ (let ((old beg))
+ (setq beg end)
+ (setq end old)))
+ (goto-char beg)
+ (let ((count 0))
+ (while (< (point) end)
+ (if (and flyspell-issue-message-flag (= count 100))
+ (progn
+ (message "Spell Checking...%d%%"
+ (* 100 (/ (float (- (point) beg)) (- end beg))))
+ (setq count 0))
+ (setq count (+ 1 count)))
+ (flyspell-word)
+ (sit-for 0)
+ (let ((cur (point)))
+ (forward-word 1)
+ (if (and (< (point) end) (> (point) (+ cur 1)))
+ (backward-char 1)))))
+ (backward-char 1)
+ (if flyspell-issue-message-flag (message "Spell Checking completed."))
+ (flyspell-word)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-external-ispell-process ... */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-external-ispell-process '()
+ "The external Flyspell Ispell process.")
+
+;*---------------------------------------------------------------------*/
+;* flyspell-external-ispell-buffer ... */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-external-ispell-buffer '())
+(defvar flyspell-large-region-buffer '())
+(defvar flyspell-large-region-beg (point-min))
+(defvar flyspell-large-region-end (point-max))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-external-point-words ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-external-point-words ()
+ (let ((buffer flyspell-external-ispell-buffer))
+ (set-buffer buffer)
+ (beginning-of-buffer)
+ (let ((size (- flyspell-large-region-end flyspell-large-region-beg))
+ (start flyspell-large-region-beg)
+ (pword "")
+ (pcount 1))
+ ;; now we are done with ispell, we have to find the word in
+ ;; the initial buffer
+ (while (< (point) (- (point-max) 1))
+ ;; we have to fetch the incorrect word
+ (if (re-search-forward "\\([^\n]+\\)\n" (point-max) t)
+ (let ((word (match-string 1)))
+ (if (string= word pword)
+ (setq pcount (1+ pcount))
+ (progn
+ (setq pword word)
+ (setq pcount 1)))
+ (goto-char (match-end 0))
+ (if flyspell-issue-message-flag
+ (message "Spell Checking...%d%% [%s]"
+ (* 100 (/ (float (point)) (point-max)))
+ word))
+ (set-buffer flyspell-large-region-buffer)
+ (goto-char flyspell-large-region-beg)
+ (let ((keep t)
+ (n 0))
+ (while (and (or (< n pcount) keep)
+ (search-forward word flyspell-large-region-end t))
+ (progn
+ (goto-char (- (point) 1))
+ (setq n (1+ n))
+ (setq keep (flyspell-word))))
+ (if (= n pcount)
+ (setq flyspell-large-region-beg (point))))
+ (set-buffer buffer))
+ (goto-char (point-max)))))
+ ;; we are done
+ (if flyspell-issue-message-flag (message "Spell Checking completed."))
+ ;; ok, we are done with pointing out incorrect words, we just
+ ;; have to kill the temporary buffer
+ (kill-buffer flyspell-external-ispell-buffer)
+ (setq flyspell-external-ispell-buffer nil)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-process-localwords ... */
+;* ------------------------------------------------------------- */
+;* This function is used to prevent checking words declared */
+;* explictitly correct on large regions. */
+;*---------------------------------------------------------------------*/
+(defun flyspell-process-localwords ()
+ "Parse Localwords in the buffer and remove them from the mispellings
+buffer before flyspell attempts to check them."
+ (let (localwords
+ (current-buffer curbuf)
+ (mispellings-buffer buffer)
+ (ispell-casechars (ispell-get-casechars)))
+ ;; Get localwords from the original buffer
+ (save-excursion
+ (set-buffer current-buffer)
+;* (flyspell-delete-all-overlays) */
+ (beginning-of-buffer)
+ ;; Localwords parsing stolen form ispell.el
+ (while (search-forward ispell-words-keyword nil t)
+ (let ((end (save-excursion (end-of-line) (point)))
+ string)
+ ;; buffer-local words separated by a space, and can contain
+ ;; any character other than a space. Not rigorous enough.
+ (while (re-search-forward " *\\([^ ]+\\)" end t)
+ (setq string (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
+ ;; This can fail when string contains a word with illegal chars.
+ ;; Error handling needs to be added between ispell and emacs.
+ (if (and (< 1 (length string))
+ (equal 0 (string-match ispell-casechars string)))
+ (setq localwords (add-to-list 'localwords string)))))))
+ ;; Remove localwords matches
+ (set-buffer mispellings-buffer)
+ (while localwords
+ (beginning-of-buffer)
+ (delete-matching-lines (concat "^" (car localwords) "$"))
+ (setq localwords (cdr localwords)))
+ (end-of-buffer)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-large-region ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-large-region (beg end)
+ (let* ((curbuf (current-buffer))
+ (buffer (get-buffer-create "*flyspell-region*")))
+ (setq flyspell-external-ispell-buffer buffer)
+ (setq flyspell-large-region-buffer curbuf)
+ (setq flyspell-large-region-beg beg)
+ (setq flyspell-large-region-end end)
+ (set-buffer buffer)
+ (erase-buffer)
+ ;; this is done, we can start checking...
+ (if flyspell-issue-message-flag (message "Checking region..."))
+ (set-buffer curbuf)
+ (let ((c (apply 'call-process-region beg
+ end
+ ispell-program-name
+ nil
+ buffer
+ nil
+ (if (boundp 'ispell-list-command)
+ ispell-list-command
+ "-l")
+ (let (args)
+ ;; Local dictionary becomes the global dictionary in use.
+ (if ispell-local-dictionary
+ (setq ispell-dictionary ispell-local-dictionary))
+ (setq args (ispell-get-ispell-args))
+ (if ispell-dictionary ; use specified dictionary
+ (setq args
+ (append (list "-d" ispell-dictionary) args)))
+ (if ispell-personal-dictionary ; use specified pers dict
+ (setq args
+ (append args
+ (list "-p"
+ (expand-file-name
+ ispell-personal-dictionary)))))
+ (setq args (append args ispell-extra-args))
+ args))))
+ (if (= c 0)
+ (progn
+ (flyspell-process-localwords)
+ (with-current-buffer curbuf
+ (flyspell-delete-region-overlays beg end))
+ (flyspell-external-point-words))
+ (error "Can't check region...")))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-region ... */
+;* ------------------------------------------------------------- */
+;* Because `ispell -a' is too slow, it is not possible to use */
+;* it on large region. Then, when ispell is invoked on a large */
+;* text region, a new `ispell -l' process is spawned. The */
+;* pointed out words are then searched in the region a checked with */
+;* regular flyspell means. */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(defun flyspell-region (beg end)
+ "Flyspell text between BEG and END."
+ (interactive "r")
+ (if (= beg end)
+ ()
+ (save-excursion
+ (if (> beg end)
+ (let ((old beg))
+ (setq beg end)
+ (setq end old)))
+ (if (and flyspell-large-region (> (- end beg) flyspell-large-region))
+ (flyspell-large-region beg end)
+ (flyspell-small-region beg end)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-buffer ... */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(defun flyspell-buffer ()
+ "Flyspell whole buffer."
+ (interactive)
+ (flyspell-region (point-min) (point-max)))
+
+;*---------------------------------------------------------------------*/
+;* old next error position ... */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-old-buffer-error nil)
+(defvar flyspell-old-pos-error nil)
+
+;*---------------------------------------------------------------------*/
+;* flyspell-goto-next-error ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-goto-next-error ()
+ "Go to the next previously detected error.
+In general FLYSPELL-GOTO-NEXT-ERROR must be used after
+FLYSPELL-BUFFER."
+ (interactive)
+ (let ((pos (point))
+ (max (point-max)))
+ (if (and (eq (current-buffer) flyspell-old-buffer-error)
+ (eq pos flyspell-old-pos-error))
+ (progn
+ (if (= flyspell-old-pos-error max)
+ ;; goto beginning of buffer
+ (progn
+ (message "Restarting from beginning of buffer")
+ (goto-char (point-min)))
+ (forward-word 1))
+ (setq pos (point))))
+ ;; seek the next error
+ (while (and (< pos max)
+ (let ((ovs (overlays-at pos))
+ (r '()))
+ (while (and (not r) (consp ovs))
+ (if (flyspell-overlay-p (car ovs))
+ (setq r t)
+ (setq ovs (cdr ovs))))
+ (not r)))
+ (setq pos (1+ pos)))
+ ;; save the current location for next invocation
+ (setq flyspell-old-pos-error pos)
+ (setq flyspell-old-buffer-error (current-buffer))
+ (goto-char pos)
+ (if (= pos max)
+ (message "No more miss-spelled word!"))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-overlay-p ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-overlay-p (o)
+ "A predicate that return true iff O is an overlay used by flyspell."
+ (and (overlayp o) (overlay-get o 'flyspell-overlay)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-delete-region-overlays ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-delete-region-overlays (beg end)
+ "Delete overlays used by flyspell in a given region."
+ (let ((l (overlays-in beg end)))
+ (while (consp l)
+ (progn
+ (if (flyspell-overlay-p (car l))
+ (delete-overlay (car l)))
+ (setq l (cdr l))))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-delete-all-overlays ... */
+;* ------------------------------------------------------------- */
+;* Remove all the overlays introduced by flyspell. */
+;*---------------------------------------------------------------------*/
+(defun flyspell-delete-all-overlays ()
+ "Delete all the overlays used by flyspell."
+ (flyspell-delete-region-overlays (point-min) (point-max)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-unhighlight-at ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-unhighlight-at (pos)
+ "Remove the flyspell overlay that are located at POS."
+ (if flyspell-persistent-highlight
+ (let ((overlays (overlays-at pos)))
+ (while (consp overlays)
+ (if (flyspell-overlay-p (car overlays))
+ (delete-overlay (car overlays)))
+ (setq overlays (cdr overlays))))
+ (if (flyspell-overlay-p flyspell-overlay)
+ (delete-overlay flyspell-overlay))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-properties-at-p ... */
+;* ------------------------------------------------------------- */
+;* Is there an highlight properties at position pos? */
+;*---------------------------------------------------------------------*/
+(defun flyspell-properties-at-p (pos)
+ "Return t if there is a text property at POS, not counting `local-map'.
+If variable `flyspell-highlight-properties' is set to nil,
+text with properties are not checked. This function is used to discover
+if the character at POS has any other property."
+ (let ((prop (text-properties-at pos))
+ (keep t))
+ (while (and keep (consp prop))
+ (if (and (eq (car prop) 'local-map) (consp (cdr prop)))
+ (setq prop (cdr (cdr prop)))
+ (setq keep nil)))
+ (consp prop)))
+
+;*---------------------------------------------------------------------*/
+;* make-flyspell-overlay ... */
+;*---------------------------------------------------------------------*/
+(defun make-flyspell-overlay (beg end face mouse-face)
+ "Allocate an overlay to highlight an incorrect word.
+BEG and END specify the range in the buffer of that word.
+FACE and MOUSE-FACE specify the `face' and `mouse-face' properties
+for the overlay."
+ (let ((flyspell-overlay (make-overlay beg end nil t nil)))
+ (overlay-put flyspell-overlay 'face face)
+ (overlay-put flyspell-overlay 'mouse-face mouse-face)
+ (overlay-put flyspell-overlay 'flyspell-overlay t)
+ (overlay-put flyspell-overlay 'evaporate t)
+ (overlay-put flyspell-overlay 'help-echo "mouse-2: correct word at point")
+ (if flyspell-use-local-map
+ (overlay-put flyspell-overlay
+ flyspell-overlay-keymap-property-name
+ flyspell-mouse-map))
+ (when (eq face 'flyspell-incorrect-face)
+ (and (stringp flyspell-before-incorrect-word-string)
+ (overlay-put flyspell-overlay 'before-string
+ flyspell-before-incorrect-word-string))
+ (and (stringp flyspell-after-incorrect-word-string)
+ (overlay-put flyspell-overlay 'after-string
+ flyspell-after-incorrect-word-string)))
+ flyspell-overlay))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-highlight-incorrect-region ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-highlight-incorrect-region (beg end poss)
+ "Set up an overlay on a misspelled word, in the buffer from BEG to END."
+ (unless (run-hook-with-args-until-success
+ 'flyspell-incorrect-hook beg end poss)
+ (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg)))
+ (progn
+ ;; we cleanup all the overlay that are in the region, not
+ ;; beginning at the word start position
+ (if (< (1+ beg) end)
+ (let ((os (overlays-in (1+ beg) end)))
+ (while (consp os)
+ (if (flyspell-overlay-p (car os))
+ (delete-overlay (car os)))
+ (setq os (cdr os)))))
+ ;; we cleanup current overlay at the same position
+ (if (and (not flyspell-persistent-highlight)
+ (overlayp flyspell-overlay))
+ (delete-overlay flyspell-overlay)
+ (let ((os (overlays-at beg)))
+ (while (consp os)
+ (if (flyspell-overlay-p (car os))
+ (delete-overlay (car os)))
+ (setq os (cdr os)))))
+ ;; now we can use a new overlay
+ (setq flyspell-overlay
+ (make-flyspell-overlay beg end
+ 'flyspell-incorrect-face
+ 'highlight))))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-highlight-duplicate-region ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-highlight-duplicate-region (beg end)
+ "Set up an overlay on a duplicated word, in the buffer from BEG to END."
+ (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg)))
+ (progn
+ ;; we cleanup current overlay at the same position
+ (if (and (not flyspell-persistent-highlight)
+ (overlayp flyspell-overlay))
+ (delete-overlay flyspell-overlay)
+ (let ((overlays (overlays-at beg)))
+ (while (consp overlays)
+ (if (flyspell-overlay-p (car overlays))
+ (delete-overlay (car overlays)))
+ (setq overlays (cdr overlays)))))
+ ;; now we can use a new overlay
+ (setq flyspell-overlay
+ (make-flyspell-overlay beg end
+ 'flyspell-duplicate-face
+ 'highlight)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-auto-correct-cache ... */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-auto-correct-pos nil)
+(defvar flyspell-auto-correct-region nil)
+(defvar flyspell-auto-correct-ring nil)
+(defvar flyspell-auto-correct-word nil)
+(make-variable-buffer-local 'flyspell-auto-correct-pos)
+(make-variable-buffer-local 'flyspell-auto-correct-region)
+(make-variable-buffer-local 'flyspell-auto-correct-ring)
+(make-variable-buffer-local 'flyspell-auto-correct-word)
+
+;*---------------------------------------------------------------------*/
+;* flyspell-check-previous-highlighted-word ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-check-previous-highlighted-word (&optional arg)
+ "Correct the closer misspelled word.
+This function scans a mis-spelled word before the cursor. If it finds one
+it proposes replacement for that word. With prefix arg, count that many
+misspelled words backwards."
+ (interactive)
+ (let ((pos1 (point))
+ (pos (point))
+ (arg (if (or (not (numberp arg)) (< arg 1)) 1 arg))
+ ov ovs)
+ (if (catch 'exit
+ (while (and (setq pos (previous-overlay-change pos))
+ (not (= pos pos1)))
+ (setq pos1 pos)
+ (if (> pos (point-min))
+ (progn
+ (setq ovs (overlays-at (1- pos)))
+ (while (consp ovs)
+ (setq ov (car ovs))
+ (setq ovs (cdr ovs))
+ (if (and (overlay-get ov 'flyspell-overlay)
+ (= 0 (setq arg (1- arg))))
+ (throw 'exit t)))))))
+ (save-excursion
+ (goto-char pos)
+ (ispell-word))
+ (error "No word to correct before point"))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-display-next-corrections ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-display-next-corrections (corrections)
+ (let ((string "Corrections:")
+ (l corrections)
+ (pos '()))
+ (while (< (length string) 80)
+ (if (equal (car l) flyspell-auto-correct-word)
+ (setq pos (cons (+ 1 (length string)) pos)))
+ (setq string (concat string " " (car l)))
+ (setq l (cdr l)))
+ (while (consp pos)
+ (let ((num (car pos)))
+ (put-text-property num
+ (+ num (length flyspell-auto-correct-word))
+ 'face
+ 'flyspell-incorrect-face
+ string))
+ (setq pos (cdr pos)))
+ (if (fboundp 'display-message)
+ (display-message 'no-log string)
+ (message string))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-abbrev-table ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-abbrev-table ()
+ (if flyspell-use-global-abbrev-table-p
+ global-abbrev-table
+ local-abbrev-table))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-define-abbrev ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-define-abbrev (name expansion)
+ (let ((table (flyspell-abbrev-table)))
+ (when table
+ (define-abbrev table name expansion))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-auto-correct-word ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-auto-correct-word ()
+ "Correct the current word.
+This command proposes various successive corrections for the current word."
+ (interactive)
+ (let ((pos (point))
+ (old-max (point-max)))
+ ;; use the correct dictionary
+ (flyspell-accept-buffer-local-defs)
+ (if (and (eq flyspell-auto-correct-pos pos)
+ (consp flyspell-auto-correct-region))
+ ;; we have already been using the function at the same location
+ (let* ((start (car flyspell-auto-correct-region))
+ (len (cdr flyspell-auto-correct-region)))
+ (flyspell-unhighlight-at start)
+ (delete-region start (+ start len))
+ (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring))
+ (let* ((word (car flyspell-auto-correct-ring))
+ (len (length word)))
+ (rplacd flyspell-auto-correct-region len)
+ (goto-char start)
+ (if flyspell-abbrev-p
+ (if (flyspell-already-abbrevp (flyspell-abbrev-table)
+ flyspell-auto-correct-word)
+ (flyspell-change-abbrev (flyspell-abbrev-table)
+ flyspell-auto-correct-word
+ word)
+ (flyspell-define-abbrev flyspell-auto-correct-word word)))
+ (funcall flyspell-insert-function word)
+ (flyspell-word)
+ (flyspell-display-next-corrections flyspell-auto-correct-ring))
+ (flyspell-ajust-cursor-point pos (point) old-max)
+ (setq flyspell-auto-correct-pos (point)))
+ ;; fetch the word to be checked
+ (let ((word (flyspell-get-word nil)))
+ (setq flyspell-auto-correct-region nil)
+ (if (consp word)
+ (let ((start (car (cdr word)))
+ (end (car (cdr (cdr word))))
+ (word (car word))
+ poss)
+ (setq flyspell-auto-correct-word word)
+ ;; now check spelling of word.
+ (process-send-string ispell-process "%\n") ;put in verbose mode
+ (process-send-string ispell-process (concat "^" word "\n"))
+ ;; wait until ispell has processed word
+ (while (progn
+ (accept-process-output ispell-process)
+ (not (string= "" (car ispell-filter)))))
+ (setq ispell-filter (cdr ispell-filter))
+ (if (consp ispell-filter)
+ (setq poss (ispell-parse-output (car ispell-filter))))
+ (cond
+ ((or (eq poss t) (stringp poss))
+ ;; don't correct word
+ t)
+ ((null poss)
+ ;; ispell error
+ (error "Ispell: error in Ispell process"))
+ (t
+ ;; the word is incorrect, we have to propose a replacement
+ (let ((replacements (if flyspell-sort-corrections
+ (sort (car (cdr (cdr poss))) 'string<)
+ (car (cdr (cdr poss))))))
+ (if (consp replacements)
+ (progn
+ (let ((replace (car replacements)))
+ (let ((new-word replace))
+ (if (not (equal new-word (car poss)))
+ (progn
+ ;; the save the current replacements
+ (setq flyspell-auto-correct-region
+ (cons start (length new-word)))
+ (let ((l replacements))
+ (while (consp (cdr l))
+ (setq l (cdr l)))
+ (rplacd l (cons (car poss) replacements)))
+ (setq flyspell-auto-correct-ring
+ replacements)
+ (flyspell-unhighlight-at start)
+ (delete-region start end)
+ (funcall flyspell-insert-function new-word)
+ (if flyspell-abbrev-p
+ (if (flyspell-already-abbrevp
+ (flyspell-abbrev-table) word)
+ (flyspell-change-abbrev
+ (flyspell-abbrev-table)
+ word
+ new-word)
+ (flyspell-define-abbrev word
+ new-word)))
+ (flyspell-word)
+ (flyspell-display-next-corrections
+ (cons new-word flyspell-auto-correct-ring))
+ (flyspell-ajust-cursor-point pos
+ (point)
+ old-max))))))))))
+ (ispell-pdict-save t)))
+ (setq flyspell-auto-correct-pos (point))))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-auto-correct-previous-pos ... */
+;*---------------------------------------------------------------------*/
+(defvar flyspell-auto-correct-previous-pos nil
+ "Holds the start of the first incorrect word before point.")
+
+;*---------------------------------------------------------------------*/
+;* flyspell-auto-correct-previous-hook ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-auto-correct-previous-hook ()
+ "Hook to track successive calls to `flyspell-auto-correct-previous-word'.
+Sets flyspell-auto-correct-previous-pos to nil"
+ (interactive)
+ (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t)
+ (unless (eq this-command (function flyspell-auto-correct-previous-word))
+ (setq flyspell-auto-correct-previous-pos nil)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-auto-correct-previous-word ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-auto-correct-previous-word (position)
+ "*Auto correct the first mispelled word that occurs before point."
+ (interactive "d")
+
+ (add-hook 'pre-command-hook
+ (function flyspell-auto-correct-previous-hook) t t)
+
+ (save-excursion
+ (unless flyspell-auto-correct-previous-pos
+ ;; only reset if a new overlay exists
+ (setq flyspell-auto-correct-previous-pos nil)
+
+ (let ((overlay-list (overlays-in (point-min) position))
+ (new-overlay 'dummy-value))
+
+ ;; search for previous (new) flyspell overlay
+ (while (and new-overlay
+ (or (not (flyspell-overlay-p new-overlay))
+ ;; check if its face has changed
+ (not (eq (get-char-property
+ (overlay-start new-overlay) 'face)
+ 'flyspell-incorrect-face))))
+ (setq new-overlay (car-safe overlay-list))
+ (setq overlay-list (cdr-safe overlay-list)))
+
+ ;; if nothing new exits new-overlay should be nil
+ (if new-overlay;; the length of the word may change so go to the start
+ (setq flyspell-auto-correct-previous-pos
+ (overlay-start new-overlay)))))
+
+ (when flyspell-auto-correct-previous-pos
+ (save-excursion
+ (goto-char flyspell-auto-correct-previous-pos)
+ (let ((ispell-following-word t));; point is at start
+ (if (numberp flyspell-auto-correct-previous-pos)
+ (goto-char flyspell-auto-correct-previous-pos))
+ (flyspell-auto-correct-word))
+ ;; the point may have moved so reset this
+ (setq flyspell-auto-correct-previous-pos (point))))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-correct-word ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-correct-word (event)
+ "Pop up a menu of possible corrections for a misspelled word.
+The word checked is the word at the mouse position."
+ (interactive "e")
+ ;; use the correct dictionary
+ (flyspell-accept-buffer-local-defs)
+ ;; retain cursor location (I don't know why but save-excursion here fails).
+ (let ((save (point)))
+ (mouse-set-point event)
+ (let ((cursor-location (point))
+ (word (flyspell-get-word nil))
+ (case-fold-search nil))
+ (if (consp word)
+ (let ((start (car (cdr word)))
+ (end (car (cdr (cdr word))))
+ (word (car word))
+ poss replace)
+ ;; now check spelling of word.
+ (process-send-string ispell-process "%\n") ;put in verbose mode
+ (process-send-string ispell-process (concat "^" word "\n"))
+ ;; wait until ispell has processed word
+ (while (progn
+ (accept-process-output ispell-process)
+ (not (string= "" (car ispell-filter)))))
+ (setq ispell-filter (cdr ispell-filter))
+ (if (consp ispell-filter)
+ (setq poss (ispell-parse-output (car ispell-filter))))
+ (cond
+ ((or (eq poss t) (stringp poss))
+ ;; don't correct word
+ t)
+ ((null poss)
+ ;; ispell error
+ (error "Ispell: error in Ispell process"))
+ ((string-match "GNU" (emacs-version))
+ ;; the word is incorrect, we have to propose a replacement
+ (setq replace (flyspell-emacs-popup event poss word))
+ (cond ((eq replace 'ignore)
+ (goto-char save)
+ nil)
+ ((eq replace 'save)
+ (goto-char save)
+ (process-send-string ispell-process
+ (concat "*" word "\n"))
+ (flyspell-unhighlight-at cursor-location)
+ (setq ispell-pdict-modified-p '(t)))
+ ((or (eq replace 'buffer) (eq replace 'session))
+ (process-send-string ispell-process
+ (concat "@" word "\n"))
+ (if (null ispell-pdict-modified-p)
+ (setq ispell-pdict-modified-p
+ (list ispell-pdict-modified-p)))
+ (flyspell-unhighlight-at cursor-location)
+ (goto-char save)
+ (if (eq replace 'buffer)
+ (ispell-add-per-file-word-list word)))
+ (replace
+ (flyspell-unhighlight-at cursor-location)
+ (let ((new-word (if (atom replace)
+ replace
+ (car replace)))
+ (cursor-location
+ (+ (- (length word) (- end start))
+ cursor-location)))
+ (if (not (equal new-word (car poss)))
+ (let ((old-max (point-max)))
+ (delete-region start end)
+ (funcall flyspell-insert-function new-word)
+ (if flyspell-abbrev-p
+ (flyspell-define-abbrev word new-word))
+ (flyspell-ajust-cursor-point save
+ cursor-location
+ old-max)))))
+ (t
+ (goto-char save)
+ nil)))
+ ((eq flyspell-emacs 'xemacs)
+ (flyspell-xemacs-popup
+ event poss word cursor-location start end save)
+ (goto-char save)))
+ (ispell-pdict-save t))))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-xemacs-correct ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-xemacs-correct (replace poss word cursor-location start end save)
+ "The xemacs popup menu callback."
+ (cond ((eq replace 'ignore)
+ nil)
+ ((eq replace 'save)
+ (process-send-string ispell-process (concat "*" word "\n"))
+ (process-send-string ispell-process "#\n")
+ (flyspell-unhighlight-at cursor-location)
+ (setq ispell-pdict-modified-p '(t)))
+ ((or (eq replace 'buffer) (eq replace 'session))
+ (process-send-string ispell-process (concat "@" word "\n"))
+ (flyspell-unhighlight-at cursor-location)
+ (if (null ispell-pdict-modified-p)
+ (setq ispell-pdict-modified-p
+ (list ispell-pdict-modified-p)))
+ (if (eq replace 'buffer)
+ (ispell-add-per-file-word-list word)))
+ (replace
+ (let ((old-max (point-max))
+ (new-word (if (atom replace)
+ replace
+ (car replace)))
+ (cursor-location (+ (- (length word) (- end start))
+ cursor-location)))
+ (if (not (equal new-word (car poss)))
+ (progn
+ (delete-region start end)
+ (goto-char start)
+ (funcall flyspell-insert-function new-word)
+ (if flyspell-abbrev-p
+ (flyspell-define-abbrev word new-word))))
+ (flyspell-ajust-cursor-point save cursor-location old-max)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-ajust-cursor-point ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-ajust-cursor-point (save cursor-location old-max)
+ (if (>= save cursor-location)
+ (let ((new-pos (+ save (- (point-max) old-max))))
+ (goto-char (cond
+ ((< new-pos (point-min))
+ (point-min))
+ ((> new-pos (point-max))
+ (point-max))
+ (t new-pos))))
+ (goto-char save)))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-emacs-popup ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-emacs-popup (event poss word)
+ "The Emacs popup menu."
+ (if (not event)
+ (let* ((mouse-pos (mouse-position))
+ (mouse-pos (if (nth 1 mouse-pos)
+ mouse-pos
+ (set-mouse-position (car mouse-pos)
+ (/ (frame-width) 2) 2)
+ (unfocus-frame)
+ (mouse-position))))
+ (setq event (list (list (car (cdr mouse-pos))
+ (1+ (cdr (cdr mouse-pos))))
+ (car mouse-pos)))))
+ (let* ((corrects (if flyspell-sort-corrections
+ (sort (car (cdr (cdr poss))) 'string<)
+ (car (cdr (cdr poss)))))
+ (cor-menu (if (consp corrects)
+ (mapcar (lambda (correct)
+ (list correct correct))
+ corrects)
+ '()))
+ (affix (car (cdr (cdr (cdr poss)))))
+ (base-menu (let ((save (if (consp affix)
+ (list
+ (list (concat "Save affix: " (car affix))
+ 'save)
+ '("Accept (session)" session)
+ '("Accept (buffer)" buffer))
+ '(("Save word" save)
+ ("Accept (session)" session)
+ ("Accept (buffer)" buffer)))))
+ (if (consp cor-menu)
+ (append cor-menu (cons "" save))
+ save)))
+ (menu (cons "flyspell correction menu" base-menu)))
+ (car (x-popup-menu event
+ (list (format "%s [%s]" word (or ispell-local-dictionary
+ ispell-dictionary))
+ menu)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-xemacs-popup ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-xemacs-popup (event poss word cursor-location start end save)
+ "The XEmacs popup menu."
+ (let* ((corrects (if flyspell-sort-corrections
+ (sort (car (cdr (cdr poss))) 'string<)
+ (car (cdr (cdr poss)))))
+ (cor-menu (if (consp corrects)
+ (mapcar (lambda (correct)
+ (vector correct
+ (list 'flyspell-xemacs-correct
+ correct
+ (list 'quote poss)
+ word
+ cursor-location
+ start
+ end
+ save)
+ t))
+ corrects)
+ '()))
+ (affix (car (cdr (cdr (cdr poss)))))
+ (menu (let ((save (if (consp affix)
+ (vector
+ (concat "Save affix: " (car affix))
+ (list 'flyspell-xemacs-correct
+ ''save
+ (list 'quote poss)
+ word
+ cursor-location
+ start
+ end
+ save)
+ t)
+ (vector
+ "Save word"
+ (list 'flyspell-xemacs-correct
+ ''save
+ (list 'quote poss)
+ word
+ cursor-location
+ start
+ end
+ save)
+ t)))
+ (session (vector "Accept (session)"
+ (list 'flyspell-xemacs-correct
+ ''session
+ (list 'quote poss)
+ word
+ cursor-location
+ start
+ end
+ save)
+ t))
+ (buffer (vector "Accept (buffer)"
+ (list 'flyspell-xemacs-correct
+ ''buffer
+ (list 'quote poss)
+ word
+ cursor-location
+ start
+ end
+ save)
+ t)))
+ (if (consp cor-menu)
+ (append cor-menu (list "-" save session buffer))
+ (list save session buffer)))))
+ (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary
+ ispell-dictionary))
+ menu))))
+
+;*---------------------------------------------------------------------*/
+;* Some example functions for real autocorrecting */
+;*---------------------------------------------------------------------*/
+(defun flyspell-maybe-correct-transposition (beg end poss)
+ "Check replacements for transposed characters.
+
+If the text between BEG and END is equal to a correction suggested by
+Ispell, after transposing two adjacent characters, correct the text,
+and return t.
+
+The third arg POSS is either the symbol 'doublon' or a list of
+possible corrections as returned by 'ispell-parse-output'.
+
+This function is meant to be added to 'flyspell-incorrect-hook'."
+ (when (consp poss)
+ (catch 'done
+ (save-excursion
+ (goto-char (1+ beg))
+ (while (< (point) end)
+ (transpose-chars 1)
+ (when (member (buffer-substring beg end) (car (cdr (cdr poss))))
+ (throw 'done t))
+ (transpose-chars -1)
+ (forward-char))
+ nil))))
+
+(defun flyspell-maybe-correct-doubling (beg end poss)
+ "Check replacements for doubled characters.
+
+If the text between BEG and END is equal to a correction suggested by
+Ispell, after removing a pair of doubled characters, correct the text,
+and return t.
+
+The third arg POSS is either the symbol 'doublon' or a list of
+possible corrections as returned by 'ispell-parse-output'.
+
+This function is meant to be added to 'flyspell-incorrect-hook'."
+ (when (consp poss)
+ (catch 'done
+ (save-excursion
+ (let ((last (char-after beg))
+ this)
+ (goto-char (1+ beg))
+ (while (< (point) end)
+ (setq this (char-after))
+ (if (not (char-equal this last))
+ (forward-char)
+ (delete-char 1)
+ (when (member (buffer-substring beg (1- end)) (car (cdr (cdr poss))))
+ (throw 'done t))
+ ;; undo
+ (insert-char this 1))
+ (setq last this))
+ nil)))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-already-abbrevp ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-already-abbrevp (table word)
+ (let ((sym (abbrev-symbol word table)))
+ (and sym (symbolp sym))))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-change-abbrev ... */
+;*---------------------------------------------------------------------*/
+(defun flyspell-change-abbrev (table old new)
+ (set (abbrev-symbol old table) new))
+
+;*---------------------------------------------------------------------*/
+;* flyspell-auto-correct-previous-word advice ... */
+;*---------------------------------------------------------------------*/
+(defadvice flyspell-auto-correct-previous-word
+ (around easymacs-flyspell-auto-correct)
+ "Correct current word if misspelled, else previous
+ misspelling. Protect against accidentally changing a word
+ that cannot be seen, because it is somewhere off the screen."
+ (let ((top) (bot))
+ (save-excursion
+ (move-to-window-line 0)
+ (setq top (point))
+ (move-to-window-line -1)
+ (setq bot (point)))
+ (save-restriction
+ (narrow-to-region top bot)
+ (save-excursion
+ (re-search-forward "\\s \\|\\'" nil t)
+ (overlay-recenter (point))
+ ad-do-it))))
+
+(ad-activate 'flyspell-auto-correct-previous-word)
+
+(provide 'flyspell)
+;;; flyspell.el ends here
+;;; </pre>
--- /dev/null
+;;; -*- Mode:Emacs-Lisp -*-
+;;; gambit.el --- Run Gambit in an [X]Emacs buffer
+
+;; Copyright (c) 1997-2004 Marc Feeley & Michael Sperber
+
+;; Authors: Marc Feeley <feeley@iro.umontreal.ca>
+;; Mike Sperber <sperber@informatik.uni-tuebingen.de>
+;; Keywords: processes, lisp
+
+;; To use this package, make sure this file is accessible from your
+;; load-path and that the following lines are in your ".emacs" file:
+;;
+;; (autoload 'gambit-inferior-mode "gambit" "Hook Gambit mode into cmuscheme.")
+;; (autoload 'gambit-mode "gambit" "Hook Gambit mode into scheme.")
+;; (add-hook 'inferior-scheme-mode-hook (function gambit-inferior-mode))
+;; (add-hook 'scheme-mode-hook (function gambit-mode))
+;; (setq scheme-program-name "gsi -:t")
+;;
+;; Alternatively, if you don't mind always loading this package,
+;; you can simply add this line to your ".emacs" file:
+;;
+;; (require 'gambit)
+;;
+;; You can then start Gambit with "M-x run-scheme".
+;;
+;; When Gambit signals an error, Emacs will intercept the location
+;; information in the error message and automatically open a buffer
+;; highlighting the error.
+;;
+;; The continuation of the error can be inspected with the "C-c ["
+;; (crawl towards older frames) and "C-c ]" (crawl towards newer
+;; frames). For each new frame visited, Emacs will highlight the
+;; expression associated with the frame.
+;;
+;; "C-c c", "C-c s" and "C-c l" can be used to send the commands
+;; ",c", ",s" and ",l" respectively to Gambit. This is convenient for
+;; single-stepping a program.
+;;
+;; "C-c _" can be used to delete the last popup window that was
+;; created to highlight a Scheme expression.
+
+;;;----------------------------------------------------------------------------
+
+;; User overridable parameters.
+
+(defvar scheme-program-name "gsi -:d-")
+
+(defvar gambit-repl-command-prefix "\C-c"
+ "Emacs keybinding prefix for Gambit REPL's commands.")
+
+(defvar gambit-highlight-color "gold"
+ "Color of the overlay for highlighting Scheme expressions.")
+
+(defvar gambit-highlight-face
+ (let ((face 'gambit-highlight-face))
+ (condition-case nil
+ (progn
+ (make-face face)
+ (if (x-display-color-p)
+ (set-face-background face gambit-highlight-color)
+ (progn
+ ;(make-face-bold face)
+ (set-face-underline-p face t))))
+ (error (setq face nil)))
+ face)
+ "Face of overlay for highlighting Scheme expressions.")
+
+(defvar gambit-new-window-height 6
+ "Height of a window opened to highlight a Scheme expression.")
+
+(defvar gambit-move-to-highlighted (not gambit-highlight-face)
+ "Flag to move to window opened to highlight a Scheme expression.")
+
+;;;----------------------------------------------------------------------------
+
+;; These must be loaded first because we redefine some of the
+;; functions they contain.
+
+(require 'scheme)
+(require 'cmuscheme)
+
+;;;----------------------------------------------------------------------------
+
+(defun gambit-indent-function (indent-point state)
+ (let ((normal-indent (current-column)))
+ (goto-char (1+ (elt state 1)))
+ (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
+ (if (and (elt state 2)
+ (not (looking-at "\\sw\\|\\s_")))
+ ;; car of form doesn't seem to be a a symbol
+ (progn
+ (if (not (> (save-excursion (forward-line 1) (point))
+ calculate-lisp-indent-last-sexp))
+ (progn (goto-char calculate-lisp-indent-last-sexp)
+ (beginning-of-line)
+ (parse-partial-sexp (point)
+ calculate-lisp-indent-last-sexp 0 t)))
+ ;; Indent under the list or under the first sexp on the same
+ ;; line as calculate-lisp-indent-last-sexp. Note that first
+ ;; thing on that line has to be complete sexp since we are
+ ;; inside the innermost containing sexp.
+ (backward-prefix-chars)
+ (current-column))
+ (let ((function (buffer-substring (point)
+ (progn (forward-sexp 1) (point))))
+ method)
+ (setq method (or (gambit-indent-method function)
+ (get (intern-soft function) 'scheme-indent-function)
+ (get (intern-soft function) 'scheme-indent-hook)))
+ (cond ((or (eq method 'defun)
+ (and (null method)
+ (> (length function) 3)
+ (string-match "\\`def" function)))
+ (lisp-indent-defform state indent-point))
+ ((integerp method)
+ (lisp-indent-specform method state
+ indent-point normal-indent))
+ (method
+ (funcall method state indent-point normal-indent)))))))
+
+(defun gambit-indent-method (function)
+ (let ((method nil)
+ (alist gambit-indent-regexp-alist))
+ (while (and (not method) (not (null alist)))
+ (let* ((regexp (car alist))
+ (x (string-match (car regexp) function)))
+ (if x
+ (setq method (cdr regexp)))
+ (setq alist (cdr alist))))
+ method))
+
+(set lisp-indent-function 'gambit-indent-function)
+
+(defvar gambit-indent-regexp-alist
+ '(
+ ("^declare$" . defun)
+ ("^##declare$" . defun)
+ ("^##define" . defun)
+ ("^macro-check" . defun)
+ ("^macro-force-vars$" . defun)
+ ("^macro-number-dispatch$" . defun)
+ ))
+
+;;;----------------------------------------------------------------------------
+
+;; Portable functions for FSF Emacs and Xemacs.
+
+(defun window-top-edge (window)
+ (if (fboundp 'window-edges)
+ (car (cdr (window-edges window)))
+ (car (cdr (window-pixel-edges window)))))
+
+;; Xemacs calls its overlays "extents", so we have to use them to emulate
+;; overlays on Xemacs. Some versions of Xemacs have the portability package
+;; "overlays.el" for this, so we could simply do:
+;;
+;; (condition-case nil ; load "overlay.el" if we have it
+;; (require 'overlay)
+;; (error nil))
+;;
+;; Unfortunately some versions of Xemacs don't have this package so
+;; we explicitly define an interface to extents.
+
+(if (not (fboundp 'make-overlay))
+ (defun make-overlay (start end)
+ (make-extent start end)))
+
+(if (not (fboundp 'overlay-put))
+ (defun overlay-put (overlay prop val)
+ (set-extent-property overlay prop val)))
+
+(if (not (fboundp 'move-overlay))
+ (defun move-overlay (overlay start end buffer)
+ (set-extent-endpoints overlay start end buffer)))
+
+;;;----------------------------------------------------------------------------
+
+;; Redefine the function scheme-send-region from `cmuscheme' so
+;; that we can keep track of all text sent to Gambit's stdin.
+
+(defun scheme-send-region (start end)
+ "Send the current region to the inferior Scheme process."
+ (interactive "r")
+ (scheme-send-string (buffer-substring start end)))
+
+(defun scheme-send-string (str)
+ "Send a string to the inferior Scheme process."
+ (let* ((clean-str (gambit-string-terminate-with-newline str))
+ (proc (scheme-proc))
+ (pmark (process-mark proc))
+ (buffer (get-buffer scheme-buffer))
+ (old-buffer (current-buffer)))
+ (set-buffer buffer)
+ (goto-char pmark)
+ (set-marker comint-last-input-start (point))
+ (insert clean-str)
+ (set-marker pmark (point))
+ (gambit-input-sender proc clean-str)
+ (set-buffer old-buffer)))
+
+(defun gambit-input-sender (proc str)
+ (let ((clean-str (gambit-string-terminate-with-newline str)))
+ (gambit-register-input clean-str)
+ (gambit-make-read-only (current-buffer) (point-max))
+ (gambit-unhighlight)
+ (comint-send-string proc clean-str)))
+
+(defun gambit-register-input (str)
+ (let ((marker (make-marker)))
+ (set-marker marker comint-last-input-start)
+ (setq gambit-input-line-marker-alist
+ (cons (cons gambit-input-line-count
+ marker)
+ gambit-input-line-marker-alist))
+ (setq gambit-input-line-count
+ (+ gambit-input-line-count
+ (gambit-string-count-lines str)))))
+
+(defun gambit-make-read-only (buffer end)
+ ' ; disable read-only interaction, cause it doesn't work!
+ (progn
+ (put-text-property 1 end 'front-sticky '(read-only) buffer)
+ (put-text-property 1 end 'rear-nonsticky '(read-only) buffer)
+ (put-text-property 1 end 'read-only t buffer)))
+
+;;;----------------------------------------------------------------------------
+
+(defun gambit-load-file (file-name)
+ "Load a Scheme file FILE-NAME into the inferior Scheme process."
+ (interactive (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file
+ scheme-source-modes t)) ; T because LOAD
+ ; needs an exact name
+ (comint-check-source file-name) ; Check to see if buffer needs saved.
+ (setq scheme-prev-l/c-dir/file (cons (file-name-directory file-name)
+ (file-name-nondirectory file-name)))
+ (scheme-send-string (concat "(load \"" file-name "\"\)\n")))
+
+(defun gambit-compile-file (file-name)
+ "Compile a Scheme file FILE-NAME in the inferior Scheme process."
+ (interactive (comint-get-source "Compile Scheme file: "
+ scheme-prev-l/c-dir/file
+ scheme-source-modes
+ nil)) ; NIL because COMPILE doesn't
+ ; need an exact name.
+ (comint-check-source file-name) ; Check to see if buffer needs saved.
+ (setq scheme-prev-l/c-dir/file (cons (file-name-directory file-name)
+ (file-name-nondirectory file-name)))
+ (scheme-send-string (concat "(compile-file \"" file-name "\"\)\n")))
+
+;;;----------------------------------------------------------------------------
+
+;; Buffer local variables of the Gambit inferior process(es).
+
+(defvar gambit-input-line-count nil
+ "Line number as seen by the Gambit process.")
+
+(defvar gambit-input-line-marker-alist nil
+ "Alist of line numbers of input blocks and markers.")
+
+(defvar gambit-last-output-marker nil
+ "Points to the last character output by the Gambit process.")
+
+;;;----------------------------------------------------------------------------
+
+;; Utilities
+
+(defun gambit-string-count-lines (str)
+ "Returns number of complete lines in string."
+ (let ((n 0)
+ (start 0))
+ (while (string-match "\n" str start)
+ (setq n (+ n 1))
+ (setq start (match-end 0)))
+ n))
+
+(defun gambit-string-terminate-with-newline (str)
+ "Adds a newline at end of string if it doesn't already have one."
+ (let ((len (length str)))
+ (if (or (= len 0)
+ (not (equal (aref str (- len 1)) ?\n)))
+ (concat str "\n")
+ str)))
+
+;;;----------------------------------------------------------------------------
+
+;; Define keys for single stepping and continuation crawling.
+
+(defun gambit-step-continuation ()
+ (interactive)
+ (scheme-send-string "#||#,s;"))
+
+(defun gambit-leap-continuation ()
+ (interactive)
+ (scheme-send-string "#||#,l;"))
+
+(defun gambit-continue ()
+ (interactive)
+ (scheme-send-string "#||#,c;"))
+
+(defun gambit-environment ()
+ (interactive)
+ (scheme-send-string "#||#,e;"))
+
+(defun gambit-backtrace ()
+ (interactive)
+ (scheme-send-string "#||#,b;"))
+
+(defun gambit-crawl-backtrace-newer ()
+ (interactive)
+ (scheme-send-string "#||#,-;"))
+
+(defun gambit-crawl-backtrace-older ()
+ (interactive)
+ (scheme-send-string "#||#,+;"))
+
+(defun gambit-kill-last-popup ()
+ (interactive)
+ (let ((windows gambit-popups))
+ (while (not (null windows))
+ (let ((window (car windows)))
+ (setq windows (cdr windows))
+ (if (and window
+ (window-live-p window))
+ (progn
+ (setq gambit-popups windows)
+ (setq windows nil)
+ (delete-window window)))))))
+
+(defun gambit-add-popup (popup)
+ (setq gambit-popups
+ (cons popup (gambit-gc-popups gambit-popups))))
+
+(defun gambit-gc-popups (popups)
+ (cond ((null popups)
+ '())
+ ((window-live-p (car popups))
+ (cons (car popups) (gambit-gc-popups (cdr popups))))
+ (t
+ (gambit-gc-popups (cdr popups)))))
+
+(defvar gambit-popups nil)
+
+;;;----------------------------------------------------------------------------
+
+;; Procedures to intercept and process the location information output
+;; by Gambit.
+
+(defun gambit-output-filter (str)
+ (let* ((buffer
+ (current-buffer))
+ (output-marker
+ (process-mark (get-buffer-process buffer)))
+ (locat
+ (if (string-match "\n" str) ; match only after end of line is seen
+ (let* ((end
+ (save-excursion
+ (goto-char output-marker)
+ (beginning-of-line)
+ (point)))
+ (start
+ (save-excursion
+ (goto-char (+ gambit-last-output-marker 1))
+ (beginning-of-line)
+ (point))))
+ (gambit-extract-location
+ (buffer-substring start end)))
+ nil)))
+ (gambit-make-read-only buffer output-marker)
+ (set-marker gambit-last-output-marker (- output-marker 1))
+ (let* ((windows
+ (gambit-windows-displaying-buffer buffer))
+ (initially-selected-window
+ (selected-window)))
+ (if (not (null windows))
+ (save-excursion
+ (set-buffer buffer)
+ (select-window (car windows))
+ (goto-char output-marker)
+ (if (not (pos-visible-in-window-p))
+ (recenter -1))
+ (select-window initially-selected-window))))
+ (if locat
+ (gambit-highlight-location locat))))
+
+(defun gambit-extract-location (str)
+ (let ((location nil)
+ (alist gambit-location-regexp-alist))
+ (while (and (not location) (not (null alist)))
+ (let* ((regexp (car alist))
+ (x (string-match (car regexp) str)))
+ (if x
+ (let* ((pos1 (nth 1 regexp))
+ (pos2 (nth 2 regexp))
+ (pos3 (nth 3 regexp))
+ (name (substring str
+ (match-beginning pos1)
+ (match-end pos1)))
+ (line (substring str
+ (match-beginning pos2)
+ (match-end pos2)))
+ (column (substring str
+ (match-beginning pos3)
+ (match-end pos3))))
+ (setq location (list (read name) (read line) (read column)))))
+ (setq alist (cdr alist))))
+ location))
+
+(defvar gambit-location-regexp-alist
+ '(("\\(\\\"\\(\\\\\\\\\\|\\\\\"\\|[^\\\"\n]\\)+\\\"\\)@\\([0-9]+\\)\\.\\([0-9]+\\)[^0-9]" 1 3 4)
+ ("\\((console)\\)@\\([0-9]+\\)\\.\\([0-9]+\\)[^0-9]" 1 2 3)
+ ("\\((stdin)\\)@\\([0-9]+\\)\\.\\([0-9]+\\)[^0-9]" 1 2 3)))
+
+(defun gambit-closest-non-following (line alist)
+ (let ((closest nil))
+ (while (not (null alist))
+ (let ((x (car alist)))
+ (if (and (<= (car x) line)
+ (or (not closest)
+ (> (car x) (car closest))))
+ (setq closest x))
+ (setq alist (cdr alist))))
+ closest))
+
+(defun gambit-highlight-location (locat)
+
+ ; invariant: the current buffer is the Scheme buffer
+
+ (let ((name (car locat))
+ (line (car (cdr locat)))
+ (column (car (cdr (cdr locat)))))
+ (cond ((or (equal name '(console))
+ (equal name '(stdin)))
+ (let ((closest
+ (gambit-closest-non-following
+ line
+ gambit-input-line-marker-alist)))
+ (if closest
+ (let ((n (- line (car closest))))
+ (gambit-highlight-expression
+ (current-buffer)
+ (save-excursion
+ (goto-char (cdr closest))
+ (if (> n 0) (forward-line n))
+ (forward-char (- column 1))
+ (point)))))))
+ ((stringp name)
+ (let ((buffer (find-file-noselect name)))
+ (if buffer
+ (gambit-highlight-expression
+ buffer
+ (save-excursion
+ (set-buffer buffer)
+ (goto-line line)
+ (forward-char (- column 1))
+ (point)))))))))
+
+(defun gambit-highlight-expression (location-buffer pos)
+
+"Highlight the expression at a specific location in a buffer.
+
+The location buffer is the one that contains the location to
+highlight and `pos' points to the first character of the
+expression in the buffer. If the location buffer is not visible
+then we must display it in a window. We also have to make sure
+the highlighted expression is visible, which may require the
+window to be scrolled.
+
+Our approach is simple: if the location buffer is not visible or
+it is the Scheme buffer and it is only displayed in the selected
+window, then we split one of the windows in 2 and use the bottom
+window to display the location buffer. The window chosen is
+preferentially the topmost window displaying the Scheme buffer,
+otherwise it is the selected window. Before we do the split, we
+enlarge the window if it is too small."
+
+ (let* ((location-windows
+ (gambit-windows-displaying-buffer location-buffer))
+ (initially-selected-window
+ (selected-window)))
+
+ ; "location-windows" is the list of windows containing
+ ; the location buffer.
+
+ (if (or (null location-windows)
+ (and (eq location-buffer (get-buffer scheme-buffer))
+ (eq initially-selected-window (car location-windows))
+ (null (cdr location-windows))))
+
+ (let* ((scheme-windows
+ (gambit-windows-displaying-buffer (get-buffer scheme-buffer)))
+ (window-to-split
+ (if (null scheme-windows)
+ initially-selected-window
+ (car scheme-windows)))
+ (height
+ (window-height window-to-split)))
+ (select-window window-to-split)
+ (if (< height (* 2 gambit-new-window-height))
+ (enlarge-window
+ (- (* 2 gambit-new-window-height)
+ height)))
+ (let ((bottom-window
+ (split-window
+ window-to-split
+ (- (window-height window-to-split)
+ gambit-new-window-height))))
+ (gambit-add-popup bottom-window)
+ (select-window bottom-window)
+ (switch-to-buffer location-buffer)))
+
+ (select-window (car (reverse location-windows))))
+
+ ; Highlight the expression in the location buffer.
+
+ (save-excursion
+ (set-buffer (window-buffer (selected-window)))
+ (goto-char pos)
+ (if (not (pos-visible-in-window-p))
+ (recenter (- (/ (window-height) 2) 1)))
+ (gambit-highlight-region
+ location-buffer
+ pos
+ (progn
+ (condition-case nil
+ (forward-sexp) ; we assume this uses the same syntax as Gambit
+ (error ; if forward-sexp fails with this condition name
+ (forward-char 1)))
+ (point)))
+ (goto-char pos))
+
+ (if (not (eq initially-selected-window (selected-window)))
+ (progn
+ (goto-char pos)
+ (if (not gambit-move-to-highlighted)
+ (select-window initially-selected-window))))))
+
+(defun gambit-windows-displaying-buffer (buffer)
+ (let ((windows '()))
+ (walk-windows (function
+ (lambda (w)
+ (if (eq buffer (window-buffer w))
+ (setq windows (cons w windows)))))
+ t
+ 'visible)
+ (sort windows
+ (function
+ (lambda (w1 w2)
+ (< (window-top-edge w1)
+ (window-top-edge w2)))))))
+
+(defvar gambit-highlight-overlay
+ (let ((ovl (make-overlay (point-min) (point-min))))
+ (overlay-put ovl 'face gambit-highlight-face)
+ ovl)
+ "Overlay for highlighting Scheme expressions.")
+
+(defun gambit-highlight-region (buffer start end)
+ (if gambit-highlight-overlay
+ (move-overlay gambit-highlight-overlay start end buffer)))
+
+(defun gambit-unhighlight ()
+ (gambit-highlight-region (get-buffer scheme-buffer) 1 1))
+
+;;;----------------------------------------------------------------------------
+
+(defun gambit-install-comment-syntax ()
+ "Configure #| ... |# comments."
+ ;; XEmacs 19 and beyond use 8-bit modify-syntax-entry flags.
+ ;; Emacs 19 uses a 1-bit flag. We will have to set up our
+ ;; syntax tables differently to handle this.
+ ;; Stolen from CC Mode.
+ (let ((table (copy-syntax-table))
+ entry)
+ (modify-syntax-entry ?a ". 12345678" table)
+ (cond
+ ;; XEmacs 19, and beyond Emacs 19.34
+ ((arrayp table)
+ (setq entry (aref table ?a))
+ ;; In Emacs, table entries are cons cells
+ (if (consp entry) (setq entry (car entry))))
+ ;; XEmacs 20
+ ((fboundp 'get-char-table) (setq entry (get-char-table ?a table)))
+ ;; before and including Emacs 19.34
+ ((and (fboundp 'char-table-p)
+ (char-table-p table))
+ (setq entry (car (char-table-range table [?a]))))
+ ;; incompatible
+ (t (error "Gambit mode is incompatible with this version of Emacs")))
+ (if (= (logand (lsh entry -16) 255) 255)
+ (progn
+ ;; XEmacs 19 & 20
+ (modify-syntax-entry ?# "(#58" scheme-mode-syntax-table)
+ (modify-syntax-entry ?| ". 67" scheme-mode-syntax-table))
+ ;; Emacs 19 & 20
+ (modify-syntax-entry ?# "_ 14" scheme-mode-syntax-table)
+ (modify-syntax-entry ?| "\" 23" scheme-mode-syntax-table))))
+
+(defun gambit-extend-mode-map (map)
+ (define-key map [(f8)] 'gambit-continue)
+ (define-key map [(f9)] 'gambit-crawl-backtrace-newer)
+ (define-key map [(f10)] 'gambit-crawl-backtrace-older)
+ (define-key map [(f11)] 'gambit-step-continuation)
+ (define-key map [(f12)] 'gambit-leap-continuation)
+
+ (define-key map "\C-c\C-l" 'gambit-load-file)
+ (define-key map "\C-c\C-k" 'gambit-compile-file)
+
+ (let ((prefix gambit-repl-command-prefix))
+ (define-key map (concat prefix "c") 'gambit-continue)
+ (define-key map (concat prefix "]") 'gambit-crawl-backtrace-newer)
+ (define-key map (concat prefix "[") 'gambit-crawl-backtrace-older)
+ (define-key map (concat prefix "s") 'gambit-step-continuation)
+ (define-key map (concat prefix "l") 'gambit-leap-continuation)
+ (define-key map (concat prefix "_") 'gambit-kill-last-popup)))
+
+(defun gambit-inferior-mode ()
+
+ (gambit-install-comment-syntax)
+ (gambit-extend-mode-map inferior-scheme-mode-map)
+
+ (make-local-variable 'gambit-input-line-count)
+ (setq gambit-input-line-count 1)
+
+ (make-local-variable 'gambit-input-line-marker-alist)
+ (setq gambit-input-line-marker-alist '())
+
+ (make-local-variable 'gambit-last-output-marker)
+ (setq gambit-last-output-marker (make-marker))
+ (set-marker gambit-last-output-marker 0)
+
+ (setq comint-input-sender (function gambit-input-sender))
+
+ (add-hook 'comint-output-filter-functions
+ (function gambit-output-filter)
+ t
+ t)) ; hook is buffer-local
+
+(defun gambit-mode ()
+ (gambit-install-comment-syntax)
+ (gambit-extend-mode-map scheme-mode-map))
+
+;;(autoload 'gambit-inferior-mode "gambit" "Hook Gambit mode into cmuscheme.")
+;;(autoload 'gambit-mode "gambit" "Hook Gambit mode into scheme.")
+(add-hook 'inferior-scheme-mode-hook (function gambit-inferior-mode))
+(add-hook 'scheme-mode-hook (function gambit-mode))
+
+(provide 'gambit)
+
+;;;----------------------------------------------------------------------------
--- /dev/null
+;; gist.el --- Emacs integration for gist.github.com
+
+;; Author: Christian Neukirchen <purl.org/net/chneukirchen>
+;; Maintainer: Chris Wanstrath <chris@ozmm.org>
+;; Contributors:
+;; Will Farrington <wcfarrington@gmail.com>
+;; Michael Ivey
+;; Phil Hagelberg
+;; Dan McKinley
+;; Version: 0.4
+;; Created: 21 Jul 2008
+;; Keywords: gist git github paste pastie pastebin
+
+;; This file is NOT part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Uses your local GitHub config if it can find it.
+;; See http://github.com/blog/180-local-github-config
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'xml)
+
+(defvar github-user nil
+ "If non-nil, will be used as your GitHub username without checking
+git-config(1).")
+(defvar github-token nil
+ "If non-nil, will be used as your GitHub token without checking
+git-config(1).")
+
+(defvar gist-view-gist nil
+ "If non-nil, automatically use `browse-url' to view gists after they're
+posted.")
+
+(defvar gist-supported-modes-alist '((action-script-mode . "as")
+ (c-mode . "c")
+ (c++-mode . "cpp")
+ (clojure-mode . "clj")
+ (common-lisp-mode . "lisp")
+ (css-mode . "css")
+ (diff-mode . "diff")
+ (emacs-lisp-mode . "el")
+ (erlang-mode . "erl")
+ (haskell-mode . "hs")
+ (html-mode . "html")
+ (io-mode . "io")
+ (java-mode . "java")
+ (javascript-mode . "js")
+ (jde-mode . "java")
+ (js2-mode . "js")
+ (lua-mode . "lua")
+ (ocaml-mode . "ml")
+ (objective-c-mode . "m")
+ (perl-mode . "pl")
+ (php-mode . "php")
+ (python-mode . "py")
+ (ruby-mode . "rb")
+ (text-mode . "txt")
+ (scala-mode . "scala")
+ (sql-mode . "sql")
+ (scheme-mode . "scm")
+ (smalltalk-mode . "st")
+ (sh-mode . "sh")
+ (tcl-mode . "tcl")
+ (tex-mode . "tex")
+ (xml-mode . "xml")))
+
+
+
+(defun* gist-request (url callback &optional params)
+ "Makes a request to `url' asynchronously, notifying `callback' when
+complete. The github parameters are included in the request. Optionally
+accepts additional POST `params' as a list of (key . value) conses."
+ (github-with-auth-info login token
+ (let ((url-request-data (gist-make-query-string
+ `(("login" . ,login)
+ ("token" . ,token) ,@params)))
+ (url-max-redirecton 5)
+ (url-request-method "POST"))
+ (url-retrieve url callback))))
+
+;;;###autoload
+(defun gist-region (begin end &optional private &optional callback)
+ "Post the current region as a new paste at gist.github.com
+Copies the URL into the kill ring.
+
+With a prefix argument, makes a private paste."
+ (interactive "r\nP")
+ (let* ((file (or (buffer-file-name) (buffer-name)))
+ (name (file-name-nondirectory file))
+ (ext (or (cdr (assoc major-mode gist-supported-modes-alist))
+ (file-name-extension file)
+ "txt")))
+ (gist-request
+ "http://gist.github.com/gists"
+ (or callback 'gist-created-callback)
+ `(,@(if private '(("action_button" . "private")))
+ ("file_ext[gistfile1]" . ,(concat "." ext))
+ ("file_name[gistfile1]" . ,name)
+ ("file_contents[gistfile1]" . ,(buffer-substring begin end))))))
+
+(defun gist-created-callback (status)
+ (let ((location (cadr status)))
+ (message "Paste created: %s" location)
+ (when gist-view-gist
+ (browse-url location))
+ (kill-new location)
+ (kill-buffer (current-buffer))))
+
+(defun gist-make-query-string (params)
+ "Returns a query string constructed from PARAMS, which should be
+a list with elements of the form (KEY . VALUE). KEY and VALUE
+should both be strings."
+ (mapconcat
+ (lambda (param)
+ (concat (url-hexify-string (car param)) "="
+ (url-hexify-string (cdr param))))
+ params "&"))
+
+;;;###autoload
+(defun gist-region-private (begin end)
+ "Post the current region as a new private paste at gist.github.com
+Copies the URL into the kill ring."
+ (interactive "r")
+ (gist-region begin end t))
+
+(defun github-config (key)
+ "Returns a GitHub specific value from the global Git config."
+ (let ((strip (lambda (string)
+ (if (> (length string) 0)
+ (substring string 0 (- (length string) 1)))))
+ (git (executable-find "git")))
+ (funcall strip (shell-command-to-string
+ (concat git " config --global github." key)))))
+
+(defun github-set-config (key value)
+ "Sets a GitHub specific value to the global Git config."
+ (let ((git (executable-find "git")))
+ (shell-command-to-string
+ (format git " config --global github.%s %s" key value))))
+
+(defun github-auth-info ()
+ "Returns the user's GitHub authorization information.
+Searches for a GitHub username and token in the global git config,
+and returns (USERNAME . TOKEN). If nothing is found, prompts
+for the info then sets it to the git config."
+ (interactive)
+
+ ;; If we've been called within a scope that already has this
+ ;; defined, don't take the time to get it again.
+ (if (boundp '*github-auth-info*)
+ *github-auth-info*
+
+ (let* ((user (or github-user (github-config "user")))
+ (token (or github-token (github-config "token"))))
+
+ (when (not user)
+ (setq user (read-string "GitHub username: "))
+ (github-set-config "user" user))
+
+ (when (not token)
+ (setq token (read-string "GitHub API token: "))
+ (github-set-config "token" token))
+
+ (cons user token))))
+
+(defmacro github-with-auth-info (login token &rest body)
+ "Binds the github authentication credentials to `login' and `token'.
+The credentials are retrieved at most once within the body of this macro."
+ (declare (indent 2))
+ `(let ((*github-auth-info* (github-auth-info)))
+ (destructuring-bind (,login . ,token) *github-auth-info*
+ ,@body)))
+
+;;;###autoload
+(defun gist-buffer (&optional private)
+ "Post the current buffer as a new paste at gist.github.com.
+Copies the URL into the kill ring.
+
+With a prefix argument, makes a private paste."
+ (interactive "P")
+ (gist-region (point-min) (point-max) private))
+
+;;;###autoload
+(defun gist-buffer-private ()
+ "Post the current buffer as a new private paste at gist.github.com.
+Copies the URL into the kill ring."
+ (interactive)
+ (gist-region-private (point-min) (point-max)))
+
+;;;###autoload
+(defun gist-region-or-buffer (&optional private)
+ "Post either the current region, or if mark is not set, the current buffer as a new paste at gist.github.com
+Copies the URL into the kill ring.
+
+With a prefix argument, makes a private paste."
+ (interactive "P")
+ (condition-case nil
+ (gist-region (point) (mark) private)
+ (mark-inactive (gist-buffer private))))
+
+;;;###autoload
+(defun gist-region-or-buffer-private ()
+ "Post either the current region, or if mark is not set, the current buffer as a new private paste at gist.github.com
+Copies the URL into the kill ring."
+ (interactive)
+ (condition-case nil
+ (gist-region-private (point) (mark))
+ (mark-inactive (gist-buffer-private))))
+
+(defvar gist-fetch-url "http://gist.github.com/%d.txt"
+ "Raw Gist content URL format")
+
+;;;###autoload
+(defun gist-list ()
+ "Displays a list of all of the current user's gists in a new buffer."
+ (interactive)
+ (message "Retrieving list of your gists...")
+ (github-with-auth-info login token
+ (gist-request
+ (format "http://gist.github.com/api/v1/xml/gists/%s" login)
+ 'gist-lists-retrieved-callback)))
+
+(defun gist-lists-retrieved-callback (status)
+ "Called when the list of gists has been retrieved. Parses the result
+and displays the list."
+ (goto-char (point-min))
+ (search-forward "<?xml")
+ (let ((gists (gist-xml-cleanup
+ (xml-parse-region (match-beginning 0) (point-max)))))
+ (kill-buffer (current-buffer))
+ (with-current-buffer (get-buffer-create "*gists*")
+ (goto-char (point-min))
+ (save-excursion
+ (kill-region (point-min) (point-max))
+ (gist-insert-list-header)
+ (mapc 'gist-insert-gist-link (xml-node-children (car gists)))
+
+ ;; remove the extra newline at the end
+ (delete-backward-char 1))
+
+ ;; skip header
+ (forward-line)
+ (toggle-read-only t)
+ (set-window-buffer nil (current-buffer)))))
+
+(defun gist-insert-list-header ()
+ "Creates the header line in the gist list buffer."
+ (save-excursion
+ (insert " ID Created "
+ "Visibility Description \n"))
+ (let ((ov (make-overlay (line-beginning-position) (line-end-position))))
+ (overlay-put ov 'face 'header-line))
+ (forward-line))
+
+(defun gist-insert-gist-link (gist)
+ "Inserts a button that will open the given gist when pressed."
+ (let* ((data (gist-parse-gist gist))
+ (repo (string-to-number (car data))))
+ (mapc '(lambda (x) (insert (format " %s " x))) data)
+ (make-text-button (line-beginning-position) (line-end-position)
+ 'repo repo
+ 'action 'gist-fetch-button
+ 'face 'default))
+ (insert "\n"))
+
+(defun gist-fetch-button (button)
+ "Called when a gist button has been pressed. Fetches and displays the gist."
+ (gist-fetch (button-get button 'repo)))
+
+(defun gist-parse-gist (gist)
+ "Returns a list of the gist's attributes for display, given the xml list
+for the gist."
+ (let ((repo (gist-child-text 'repo gist))
+ (created-at (gist-child-text 'created-at gist))
+ (description (gist-child-text 'description gist))
+ (public (if (string= (gist-child-text 'public gist) "true")
+ "public"
+ "private")))
+ (list repo created-at public description)))
+
+(defun gist-child-text (sym node)
+ "Retrieves the text content of a child of a <gist> element."
+ (let* ((children (xml-node-children node)))
+ (car (xml-node-children (assq sym children)))))
+
+(defun gist-xml-cleanup (xml-list)
+ "Removes empty strings or whitespace nodes from the `xml-list'.
+Borrowed from rss.el."
+ (mapcar 'gist-xml-cleanup-node xml-list))
+
+(defun gist-xml-cleanup-node (node)
+ "Recursively removes whitespace and empty strings from the given xml `node'.
+Borrowed from rss.el."
+ (apply 'list
+ (xml-node-name node)
+ (xml-node-attributes node)
+ (let (new)
+ (dolist (child (xml-node-children node))
+ (if (stringp child)
+ (or (string-match "\\`[ \t\n]+\\'" child)
+ (push child new))
+ (push (gist-xml-cleanup-node child) new)))
+ (nreverse new))))
+
+;;;###autoload
+(defun gist-fetch (id)
+ "Fetches a Gist and inserts it into a new buffer
+If the Gist already exists in a buffer, switches to it"
+ (interactive "nGist ID: ")
+
+ (let* ((gist-buffer-name (format "*gist %d*" id))
+ (gist-buffer (get-buffer gist-buffer-name)))
+ (if (bufferp gist-buffer)
+ (switch-to-buffer-other-window gist-buffer)
+ (progn
+ (message "Fetching Gist %d..." id)
+ (setq gist-buffer
+ (url-retrieve-synchronously (format gist-fetch-url id)))
+ (with-current-buffer gist-buffer
+ (rename-buffer gist-buffer-name t)
+ (goto-char (point-min))
+ (search-forward-regexp "\n\n")
+ (delete-region (point-min) (point))
+ (set-buffer-modified-p nil))
+ (switch-to-buffer-other-window gist-buffer)))))
+
+(provide 'gist)
+;;; gist.el ends here.
\ No newline at end of file
--- /dev/null
+;;; graphviz-dot-mode.el --- Mode for the dot-language used by graphviz (att).
+
+;; Copyright (C) 2002 - 2005 Pieter Pareit <pieter.pareit@scarlet.be>
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be
+;; useful, but WITHOUT ANY WARRANTY; without even the implied
+;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public
+;; License along with this program; if not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+;; MA 02111-1307 USA
+
+;; Authors: Pieter Pareit <pieter.pareit@scarlet.be>
+;; Rubens Ramos <rubensr AT users.sourceforge.net>
+;; Maintainer: Pieter Pareit <pieter.pareit@planetinternet.be>
+;; Homepage: http://users.skynet.be/ppareit/projects/graphviz-dot-mode/graphviz-dot-mode.html
+;; Created: 28 Oct 2002
+;; Last modified: 24 Feb 2005
+;; Version: 0.3.4
+;; Keywords: mode dot dot-language dotlanguage graphviz graphs att
+
+;;; Commentary:
+;; Use this mode for editing files in the dot-language (www.graphviz.org and
+;; http://www.research.att.com/sw/tools/graphviz/).
+;;
+;; To use graphviz-dot-mode, add
+;; (load-file "PATH_TO_FILE/graphviz-dot-mode.el")
+;; to your ~/.emacs(.el) or ~/.xemacs/init.el
+;;
+;; The graphviz-dot-mode will do font locking, indentation, preview of graphs
+;; and eases compilation/error location. There is support for both GNU Emacs
+;; and XEmacs.
+;;
+;; Font locking is automatic, indentation uses the same commands as
+;; other modes, tab, M-j and C-M-q. Insertion of comments uses the
+;; same commands as other modes, M-; . You can compile a file using
+;; M-x compile or C-c c, after that M-x next-error will also work.
+;; There is support for viewing an generated image with C-c p.
+
+;;; Todo:
+;; * cleanup the mess of graphviz-dot-compilation-parse-errors
+;; * electric indentation is fundamentally broken, because
+;; {...} are also used for record nodes. You could argue, I suppose, that
+;; many diagrams don't need those, but it would be worth having a note (and
+;; it makes sense that the default is now for electric indentation to be
+;; off).
+
+;;; History:
+
+;; Version 0.3.4 bug fixes
+;; 24/02/2005: * fixed a bug in graphviz-dot-preview
+;; Version 0.3.3 bug fixes
+;; 13/02/2005: Reuben Thomas <rrt AT sc3d.org>
+;; * add graphviz-dot-indent-width
+;; Version 0.3.2 bug fixes
+;; 25/03/2004: Rubens Ramos <rubensr AT users.sourceforge.net>
+;; * semi-colons and brackets are added when electric
+;; behaviour is disabled.
+;; * electric characters do not behave electrically inside
+;; comments or strings.
+;; * default for electric-braces is disabled now (makes more
+;; sense I guess).
+;; * using read-from-minibuffer instead of read-shell-command
+;; for emacs.
+;; * Fixed test for easymenu, so that it works on older
+;; versions of XEmacs.
+;; * Fixed indentation error when trying to indent last brace
+;; of an empty graph.
+;; * region-active-p does not exist in emacs (21.2 at least),
+;; so removed from code
+;; * Added uncomment menu option
+;; Version 0.3.1 bug fixes
+;; 03/03/2004: * backward-word needs argument for older emacs
+;; Version 0.3 added features and fixed bugs
+;; 10/01/2004: fixed a bug in graphviz-dot-indent-graph
+;; 08/01/2004: Rubens Ramos <rubensr AT users.sourceforge.net>
+;; * added customization support
+;; * Now it works on XEmacs and Emacs
+;; * Added support to use an external Viewer
+;; * Now things do not break when dot mode is entered
+;; when there is no buffer name, but the side effect is
+;; that in this case, the compilation command is not
+;; correct.
+;; * Preview works on XEmacs and emacs.
+;; * Electric indentation on newline
+;; * Minor changes to indentation
+;; * Added keyword completion (but could be A LOT better)
+;; * There are still a couple of ugly hacks. Look for 'RR'.
+;; Version 0.2 added features
+;; 11/11/2002: added preview support.
+;; 10/11/2002: indent a graph or subgraph at once with C-M-q.
+;; 08/11/2002: relaxed rules for indentation, the may now be extra chars
+;; after beginning of graph (comment's for example).
+;; Version 0.1.2 bug fixes and naming issues
+;; 06/11/2002: renamed dot-font-lock-defaults to dot-font-lock-keywords.
+;; added some documentation to dot-colors.
+;; provided a much better way to handle my max-specpdl-size
+;; problem.
+;; added an extra autoload cookie (hope this helps, as I don't
+;; yet use autoload myself)
+;; Version 0.1.1 bug fixes
+;; 06/11/2002: added an missing attribute, for font-locking to work.
+;; fixed the regex generating, so that it only recognizes
+;; whole words
+;; 05/11/2002: there can now be extra white space chars after an '{'.
+;; 04/11/2002: Why I use max-specpdl-size is now documented, and old value
+;; gets restored.
+;; Version 0.1 initial release
+;; 02/11/2002: implemented parser for *compilation* of a .dot file.
+;; 01/11/2002: implemented compilation of an .dot file.
+;; 31/10/2002: added syntax-table to the mode.
+;; 30/10/2002: implemented indentation code.
+;; 29/10/2002: implemented all of font-lock.
+;; 28/10/2002: derived graphviz-dot-mode from fundamental-mode, started
+;; implementing font-lock.
+
+;;; Code:
+
+(defconst graphviz-dot-mode-version "0.3.3"
+ "Version of `graphviz-dot-mode.el'.")
+
+(defgroup graphviz nil
+ "Major mode for editing Graphviz Dot files"
+ :group 'tools)
+
+(defun graphviz-dot-customize ()
+ "Run \\[customize-group] for the `graphviz' group."
+ (interactive)
+ (customize-group 'graphviz))
+
+(defvar graphviz-dot-mode-abbrev-table nil
+ "Abbrev table in use in Graphviz Dot mode buffers.")
+(define-abbrev-table 'graphviz-dot-mode-abbrev-table ())
+
+(defcustom graphviz-dot-dot-program "dot"
+ "*Location of the dot program. This is used by `compile'."
+ :type 'string
+ :group 'graphviz)
+
+(defcustom graphviz-dot-view-command "doted %s"
+ "*External program to run on the buffer. You can use `%s' in this string,
+and it will be substituted by the buffer name."
+ :type 'string
+ :group 'graphviz)
+
+(defcustom graphviz-dot-view-edit-command nil
+ "*Whether to allow the user to edit the command to run an external
+viewer."
+ :type 'boolean
+ :group 'graphviz)
+
+(defcustom graphviz-dot-save-before-view t
+ "*If not nil, M-x graphviz-dot-view saves the current buffer before running
+the command."
+ :type 'boolean
+ :group 'graphviz)
+
+(defcustom graphviz-dot-auto-indent-on-newline t
+ "*If not nil, `electric-graphviz-dot-terminate-line' is executed in a line is terminated."
+ :type 'boolean
+ :group 'graphviz)
+
+(defcustom graphviz-dot-indent-width default-tab-width
+ "*Indentation width in Graphviz Dot mode buffers."
+ :type 'integer
+ :group 'graphviz)
+
+(defcustom graphviz-dot-auto-indent-on-braces nil
+ "*If not nil, `electric-graphviz-dot-open-brace' and `electric-graphviz-dot-close-brace' are executed when { or } are typed"
+ :type 'boolean
+ :group 'graphviz)
+
+(defcustom graphviz-dot-auto-indent-on-semi t
+ "*If not nil, `electric-graphviz-dot-semi' is executed when semicolon is typed"
+ :type 'boolean
+ :group 'graphviz)
+
+(defcustom graphviz-dot-preview-extension "png"
+ "*The extension to use for the compilation and preview commands. The format
+for the compilation command is
+`dot -T<extension> file.dot > file.<extension>'."
+ :type 'string
+ :group 'graphviz)
+
+(defcustom graphviz-dot-toggle-completions nil
+ "*Non-nil means that repeated use of \
+\\<graphviz-dot-mode-map>\\[graphviz-dot-complete-word] will toggle the possible
+completions in the minibuffer. Normally, when there is more than one possible
+completion, a buffer will display all completions."
+ :type 'boolean
+ :group 'graphviz)
+
+(defcustom graphviz-dot-delete-completions nil
+ "*Non-nil means that the completion buffer is automatically deleted when a
+key is pressed."
+ :type 'boolean
+ :group 'graphviz)
+
+(defcustom graphviz-dot-attr-keywords
+ '("graph" "digraph" "subgraph" "node" "edge" "strict" "rankdir"
+ "size" "page" "Damping" "Epsilon" "URL" "arrowhead" "arrowsize"
+ "arrowtail" "bb" "bgcolor" "bottomlabel" "center" "clusterrank"
+ "color" "comment" "compound" "concentrate" "constraint" "decorate"
+ "dim" "dir" "distortion" "fillcolor" "fixedsize" "fontcolor"
+ "fontname" "fontpath" "fontsize" "group" "headURL" "headlabel"
+ "headport" "height" "label" "labelangle" "labeldistance" "labelfloat"
+ "labelfontcolor" "labelfontname" "labelfontsize" "labeljust"
+ "labelloc" "layer" "layers" "len" "lhead" "lp" "ltail" "margin"
+ "maxiter" "mclimit" "minlen" "model" "nodesep" "normalize" "nslimit"
+ "nslimit1" "ordering" "orientation" "overlap" "pack" "pagedir"
+ "pencolor" "peripheries" "pin" "pos" "quantum" "rank" "ranksep"
+ "ratio" "rects" "regular" "remincross" "rotate" "samehead" "sametail"
+ "samplepoint" "searchsize" "sep" "shape" "shapefile" "showboxes"
+ "sides" "skew" "splines" "start" "style" "stylesheet" "tailURL"
+ "taillabel" "tailport" "toplabel" "vertices" "voro_margin" "weight"
+ "z")
+ "*Keywords for attribute names in a graph. This is used by the auto
+completion code. The actual completion tables are built when the mode
+is loaded, so changes to this are not immediately visible."
+ :type '(repeat (string :tag "Keyword"))
+ :group 'graphviz)
+
+(defcustom graphviz-dot-value-keywords
+ '("true" "false" "normal" "inv" "dot" "invdot" "odot" "invodot"
+ "none" "tee" "empty" "invempty" "diamond" "odiamond" "box" "obox"
+ "open" "crow" "halfopen" "local" "global" "none" "forward" "back"
+ "both" "none" "BL" "BR" "TL" "TR" "RB" "RT" "LB" "LT" ":n" ":ne" ":e"
+ ":se" ":s" ":sw" ":w" ":nw" "same" "min" "source" "max" "sink" "LR"
+ "box" "polygon" "ellipse" "circle" "point" "egg" "triangle"
+ "plaintext" "diamond" "trapezium" "parallelogram" "house" "hexagon"
+ "octagon" "doublecircle" "doubleoctagon" "tripleoctagon" "invtriangle"
+ "invtrapezium" "invhouse" "Mdiamond" "Msquare" "Mcircle" "record"
+ "Mrecord" "dashed" "dotted" "solid" "invis" "bold" "filled"
+ "diagonals" "rounded" )
+ "*Keywords for attribute values. This is used by the auto completion
+code. The actual completion tables are built when the mode is loaded,
+so changes to this are not immediately visible."
+ :type '(repeat (string :tag "Keyword"))
+ :group 'graphviz)
+
+;;; Font-locking:
+(defvar graphviz-dot-colors-list
+ '(aliceblue antiquewhite antiquewhite1 antiquewhite2
+ antiquewhite3 antiquewhite4 aquamarine aquamarine1
+ aquamarine2 aquamarine3 aquamarine4 azure azure1
+ azure2 azure3 azure4 beige bisque bisque1 bisque2
+ bisque3 bisque4 black blanchedalmond blue blue1
+ blue2 blue3 blue4 blueviolet brown brown1 brown2
+ brown3 brown4 burlywood burlywood1 burlywood2
+ burlywood3 burlywood4 cadetblue cadetblue1
+ cadetblue2 cadetblue3 cadetblue4 chartreuse
+ chartreuse1 chartreuse2 chartreuse3 chartreuse4
+ chocolate chocolate1 chocolate2 chocolate3 chocolate4
+ coral coral1 coral2 coral3 coral4 cornflowerblue
+ cornsilk cornsilk1 cornsilk2 cornsilk3 cornsilk4
+ crimson cyan cyan1 cyan2 cyan3 cyan4 darkgoldenrod
+ darkgoldenrod1 darkgoldenrod2 darkgoldenrod3
+ darkgoldenrod4 darkgreen darkkhaki darkolivegreen
+ darkolivegreen1 darkolivegreen2 darkolivegreen3
+ darkolivegreen4 darkorange darkorange1 darkorange2
+ darkorange3 darkorange4 darkorchid darkorchid1
+ darkorchid2 darkorchid3 darkorchid4 darksalmon
+ darkseagreen darkseagreen1 darkseagreen2
+ darkseagreen3 darkseagreen4 darkslateblue
+ darkslategray darkslategray1 darkslategray2
+ darkslategray3 darkslategray4 darkslategrey
+ darkturquoise darkviolet deeppink deeppink1
+ deeppink2 deeppink3 deeppink4 deepskyblue
+ deepskyblue1 deepskyblue2 deepskyblue3 deepskyblue4
+ dimgray dimgrey dodgerblue dodgerblue1 dodgerblue2
+ dodgerblue3 dodgerblue4 firebrick firebrick1
+ firebrick2 firebrick3 firebrick4 floralwhite
+ forestgreen gainsboro ghostwhite gold gold1 gold2
+ gold3 gold4 goldenrod goldenrod1 goldenrod2
+ goldenrod3 goldenrod4 gray gray0 gray1 gray10 gray100
+ gray11 gray12 gray13 gray14 gray15 gray16 gray17
+ gray18 gray19 gray2 gray20 gray21 gray22 gray23
+ gray24 gray25 gray26 gray27 gray28 gray29 gray3
+ gray30 gray31 gray32 gray33 gray34 gray35 gray36
+ gray37 gray38 gray39 gray4 gray40 gray41 gray42
+ gray43 gray44 gray45 gray46 gray47 gray48 gray49
+ gray5 gray50 gray51 gray52 gray53 gray54 gray55
+ gray56 gray57 gray58 gray59 gray6 gray60 gray61
+ gray62 gray63 gray64 gray65 gray66 gray67 gray68
+ gray69 gray7 gray70 gray71 gray72 gray73 gray74
+ gray75 gray76 gray77 gray78 gray79 gray8 gray80
+ gray81 gray82 gray83 gray84 gray85 gray86 gray87
+ gray88 gray89 gray9 gray90 gray91 gray92 gray93
+ gray94 gray95 gray96 gray97 gray98 gray99 green
+ green1 green2 green3 green4 greenyellow grey grey0
+ grey1 grey10 grey100 grey11 grey12 grey13 grey14
+ grey15 grey16 grey17 grey18 grey19 grey2 grey20
+ grey21 grey22 grey23 grey24 grey25 grey26 grey27
+ grey28 grey29 grey3 grey30 grey31 grey32 grey33
+ grey34 grey35 grey36 grey37 grey38 grey39 grey4
+ grey40 grey41 grey42 grey43 grey44 grey45 grey46
+ grey47 grey48 grey49 grey5 grey50 grey51 grey52
+ grey53 grey54 grey55 grey56 grey57 grey58 grey59
+ grey6 grey60 grey61 grey62 grey63 grey64 grey65
+ grey66 grey67 grey68 grey69 grey7 grey70 grey71
+ grey72 grey73 grey74 grey75 grey76 grey77 grey78
+ grey79 grey8 grey80 grey81 grey82 grey83 grey84
+ grey85 grey86 grey87 grey88 grey89 grey9 grey90
+ grey91 grey92 grey93 grey94 grey95 grey96 grey97
+ grey98 grey99 honeydew honeydew1 honeydew2 honeydew3
+ honeydew4 hotpink hotpink1 hotpink2 hotpink3 hotpink4
+ indianred indianred1 indianred2 indianred3 indianred4
+ indigo ivory ivory1 ivory2 ivory3 ivory4 khaki khaki1
+ khaki2 khaki3 khaki4 lavender lavenderblush
+ lavenderblush1 lavenderblush2 lavenderblush3
+ lavenderblush4 lawngreen lemonchiffon lemonchiffon1
+ lemonchiffon2 lemonchiffon3 lemonchiffon4 lightblue
+ lightblue1 lightblue2 lightblue3 lightblue4
+ lightcoral lightcyan lightcyan1 lightcyan2 lightcyan3
+ lightcyan4 lightgoldenrod lightgoldenrod1
+ lightgoldenrod2 lightgoldenrod3 lightgoldenrod4
+ lightgoldenrodyellow lightgray lightgrey lightpink
+ lightpink1 lightpink2 lightpink3 lightpink4
+ lightsalmon lightsalmon1 lightsalmon2 lightsalmon3
+ lightsalmon4 lightseagreen lightskyblue lightskyblue1
+ lightskyblue2 lightskyblue3 lightskyblue4
+ lightslateblue lightslategray lightslategrey
+ lightsteelblue lightsteelblue1 lightsteelblue2
+ lightsteelblue3 lightsteelblue4 lightyellow
+ lightyellow1 lightyellow2 lightyellow3 lightyellow4
+ limegreen linen magenta magenta1 magenta2 magenta3
+ magenta4 maroon maroon1 maroon2 maroon3 maroon4
+ mediumaquamarine mediumblue mediumorchid
+ mediumorchid1 mediumorchid2 mediumorchid3
+ mediumorchid4 mediumpurple mediumpurple1
+ mediumpurple2 mediumpurple3 mediumpurple4
+ mediumseagreen mediumslateblue mediumspringgreen
+ mediumturquoise mediumvioletred midnightblue
+ mintcream mistyrose mistyrose1 mistyrose2 mistyrose3
+ mistyrose4 moccasin navajowhite navajowhite1
+ navajowhite2 navajowhite3 navajowhite4 navy navyblue
+ oldlace olivedrab olivedrap olivedrab1 olivedrab2
+ olivedrap3 oragne palegoldenrod palegreen palegreen1
+ palegreen2 palegreen3 palegreen4 paleturquoise
+ paleturquoise1 paleturquoise2 paleturquoise3
+ paleturquoise4 palevioletred palevioletred1
+ palevioletred2 palevioletred3 palevioletred4
+ papayawhip peachpuff peachpuff1 peachpuff2
+ peachpuff3 peachpuff4 peru pink pink1 pink2 pink3
+ pink4 plum plum1 plum2 plum3 plum4 powderblue
+ purple purple1 purple2 purple3 purple4 red red1 red2
+ red3 red4 rosybrown rosybrown1 rosybrown2 rosybrown3
+ rosybrown4 royalblue royalblue1 royalblue2 royalblue3
+ royalblue4 saddlebrown salmon salmon1 salmon2 salmon3
+ salmon4 sandybrown seagreen seagreen1 seagreen2
+ seagreen3 seagreen4 seashell seashell1 seashell2
+ seashell3 seashell4 sienna sienna1 sienna2 sienna3
+ sienna4 skyblue skyblue1 skyblue2 skyblue3 skyblue4
+ slateblue slateblue1 slateblue2 slateblue3 slateblue4
+ slategray slategray1 slategray2 slategray3 slategray4
+ slategrey snow snow1 snow2 snow3 snow4 springgreen
+ springgreen1 springgreen2 springgreen3 springgreen4
+ steelblue steelblue1 steelblue2 steelblue3 steelblue4
+ tan tan1 tan2 tan3 tan4 thistle thistle1 thistle2
+ thistle3 thistle4 tomato tomato1 tomato2 tomato3
+ tomato4 transparent turquoise turquoise1 turquoise2
+ turquoise3 turquoise4 violet violetred violetred1
+ violetred2 violetred3 violetred4 wheat wheat1 wheat2
+ wheat3 wheat4 white whitesmoke yellow yellow1 yellow2
+ yellow3 yellow4 yellowgreen)
+ "Possible color constants in the dot language.
+The list of constant is available at http://www.research.att.com/~erg/graphviz\
+/info/colors.html")
+
+
+(defvar graphviz-dot-color-keywords
+ (mapcar 'symbol-name graphviz-dot-colors-list))
+
+(defvar graphviz-attr-keywords
+ (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-attr-keywords))
+
+(defvar graphviz-value-keywords
+ (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-value-keywords))
+
+(defvar graphviz-color-keywords
+ (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-color-keywords))
+
+;;; Key map
+(defvar graphviz-dot-mode-map ()
+ "Keymap used in Graphviz Dot mode.")
+
+(if graphviz-dot-mode-map
+ ()
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'electric-graphviz-dot-terminate-line)
+ (define-key map "{" 'electric-graphviz-dot-open-brace)
+ (define-key map "}" 'electric-graphviz-dot-close-brace)
+ (define-key map ";" 'electric-graphviz-dot-semi)
+ (define-key map "\M-\t" 'graphviz-dot-complete-word)
+ (define-key map "\C-\M-q" 'graphviz-dot-indent-graph)
+ (define-key map "\C-cp" 'graphviz-dot-preview)
+ (define-key map "\C-cc" 'compile)
+ (define-key map "\C-cv" 'graphviz-dot-view)
+ (define-key map "\C-c\C-c" 'comment-region)
+ (define-key map "\C-c\C-u" 'graphviz-dot-uncomment-region)
+ (setq graphviz-dot-mode-map map)
+ ))
+
+;;; Syntax table
+(defvar graphviz-dot-mode-syntax-table nil
+ "Syntax table for `graphviz-dot-mode'.")
+
+(if graphviz-dot-mode-syntax-table
+ ()
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?/ ". 124b" st)
+ (modify-syntax-entry ?* ". 23" st)
+ (modify-syntax-entry ?\n "> b" st)
+ (modify-syntax-entry ?= "." st)
+ (modify-syntax-entry ?_ "_" st)
+ (modify-syntax-entry ?- "_" st)
+ (modify-syntax-entry ?> "." st)
+ (modify-syntax-entry ?[ "(" st)
+ (modify-syntax-entry ?] ")" st)
+ (modify-syntax-entry ?\" "\"" st)
+ (setq graphviz-dot-mode-syntax-table st)
+ ))
+
+(defvar graphviz-dot-font-lock-keywords
+ `(("\\(:?di\\|sub\\)?graph \\(\\sw+\\)"
+ (2 font-lock-function-name-face))
+ (,(regexp-opt graphviz-dot-value-keywords 'words)
+ . font-lock-reference-face)
+ ;; to build the font-locking for the colors,
+ ;; we need more room for max-specpdl-size,
+ ;; after that we take the list of symbols,
+ ;; convert them to a list of strings, and make
+ ;; an optimized regexp from them
+ (,(let ((max-specpdl-size (max max-specpdl-size 1200)))
+ (regexp-opt graphviz-dot-color-keywords))
+ . font-lock-string-face)
+ (,(concat
+ (regexp-opt graphviz-dot-attr-keywords 'words)
+ "[ \\t\\n]*=")
+ ;; RR - ugly, really, but I dont know why xemacs does not work
+ ;; if I change the next car to "1"...
+ (0 font-lock-variable-name-face)))
+ "Keyword highlighting specification for `graphviz-dot-mode'.")
+
+;;;###autoload
+(defun graphviz-dot-mode ()
+ "Major mode for the dot language. \\<graphviz-dot-mode-map>
+TAB indents for graph lines.
+
+\\[graphviz-dot-indent-graph]\t- Indentaion function.
+\\[graphviz-dot-preview]\t- Previews graph in a buffer.
+\\[graphviz-dot-view]\t- Views graph in an external viewer.
+\\[graphviz-dot-indent-line]\t- Indents current line of code.
+\\[graphviz-dot-complete-word]\t- Completes the current word.
+\\[electric-graphviz-dot-terminate-line]\t- Electric newline.
+\\[electric-graphviz-dot-open-brace]\t- Electric open braces.
+\\[electric-graphviz-dot-close-brace]\t- Electric close braces.
+\\[electric-graphviz-dot-semi]\t- Electric semi colons.
+
+Variables specific to this mode:
+
+ graphviz-dot-dot-program (default `dot')
+ Location of the dot program.
+ graphviz-dot-view-command (default `doted %s')
+ Command to run when `graphviz-dot-view' is executed.
+ graphviz-dot-view-edit-command (default nil)
+ If the user should be asked to edit the view command.
+ graphviz-dot-save-before-view (default t)
+ Automatically save current buffer berore `graphviz-dot-view'.
+ graphviz-dot-preview-extension (default `png')
+ File type to use for `graphviz-dot-preview'.
+ graphviz-dot-auto-indent-on-newline (default t)
+ Whether to run `electric-graphviz-dot-terminate-line' when
+ newline is entered.
+ graphviz-dot-auto-indent-on-braces (default t)
+ Whether to run `electric-graphviz-dot-open-brace' and
+ `electric-graphviz-dot-close-brace' when braces are
+ entered.
+ graphviz-dot-auto-indent-on-semi (default t)
+ Whether to run `electric-graphviz-dot-semi' when semi colon
+ is typed.
+ graphviz-dot-toggle-completions (default nil)
+ If completions should be displayed in the buffer instead of a
+ completion buffer when \\[graphviz-dot-complete-word] is
+ pressed repeatedly.
+
+This mode can be customized by running \\[graphviz-dot-customize].
+
+Turning on Graphviz Dot mode calls the value of the variable
+`graphviz-dot-mode-hook' with no args, if that value is non-nil."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map graphviz-dot-mode-map)
+ (setq major-mode 'graphviz-dot-mode)
+ (setq mode-name "dot")
+ (setq local-abbrev-table graphviz-dot-mode-abbrev-table)
+ (set-syntax-table graphviz-dot-mode-syntax-table)
+ (set (make-local-variable 'indent-line-function) 'graphviz-dot-indent-line)
+ (set (make-local-variable 'comment-start) "//")
+ (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *")
+ (set (make-local-variable 'font-lock-defaults)
+ '(graphviz-dot-font-lock-keywords))
+ ;; RR - If user is running this in the scratch buffer, there is no
+ ;; buffer file name...
+ (if (buffer-file-name)
+ (set (make-local-variable 'compile-command)
+ (concat graphviz-dot-dot-program
+ " -T" graphviz-dot-preview-extension " "
+ buffer-file-name
+ " > "
+ (file-name-sans-extension
+ buffer-file-name)
+ "." graphviz-dot-preview-extension)))
+ (set (make-local-variable 'compilation-parse-errors-function)
+ 'graphviz-dot-compilation-parse-errors)
+ (if dot-menu
+ (easy-menu-add dot-menu))
+ (run-hooks 'graphviz-dot-mode-hook)
+ )
+
+;;;; Menu definitions
+
+(defvar dot-menu nil
+ "Menu for Graphviz Dot Mode.
+This menu will get created automatically if you have the `easymenu'
+package. Note that the latest X/Emacs releases contain this package.")
+
+(and (condition-case nil
+ (require 'easymenu)
+ (error nil))
+ (easy-menu-define
+ dot-menu graphviz-dot-mode-map "Graphviz Mode menu"
+ '("Graphviz"
+ ["Indent Graph" graphviz-dot-indent-graph t]
+ ["Comment Out Region" comment-region (mark)]
+ ["Uncomment Region" graphviz-dot-uncomment-region (mark)]
+ "-"
+ ["Compile" compile t]
+ ["Preview" graphviz-dot-preview
+ (and (buffer-file-name)
+ (not (buffer-modified-p)))]
+ ["External Viewer" graphviz-dot-view (buffer-file-name)]
+ "-"
+ ["Customize..." graphviz-dot-customize t]
+ )))
+
+;;;; Compilation
+
+;; note on graphviz-dot-compilation-parse-errors:
+;; It would nicer if we could just use compilation-error-regexp-alist
+;; to do that, 3 options:
+;; - still write dot-compilation-parse-errors, don't build
+;; a return list, but modify the *compilation* buffer
+;; in a way compilation-error-regexp-alist recognizes the
+;; format.
+;; to do that, I should globally change compilation-parse-function
+;; to this function, and call the old value of comp..-parse-fun..
+;; to provide the return value.
+;; two drawbacks are that, every compilation would be run through
+;; this function (performance) and that in autoload there would
+;; be a chance that this function would not yet be known.
+;; - let the compilation run through a filter that would
+;; modify the output of dot or neato:
+;; dot -Tpng input.dot | filter
+;; drawback: ugly, extra work for user, extra decency ...
+;; no-option
+;; - modify dot and neato !!! (PP:15/02/2005 seems to have happend,
+;; so version 0.4.0 should clean this mess up!)
+(defun graphviz-dot-compilation-parse-errors (limit-search find-at-least)
+ "Parse the current buffer for dot errors.
+See variable `compilation-parse-errors-functions' for interface."
+ (interactive)
+ (save-excursion
+ (set-buffer "*compilation*")
+ (goto-char (point-min))
+ (setq compilation-error-list nil)
+ (let (buffer-of-error)
+ (while (not (eobp))
+ (cond
+ ((looking-at "^dot\\( -[^ ]+\\)* \\(.*\\)")
+ (setq buffer-of-error (find-file-noselect
+ (buffer-substring-no-properties
+ (nth 4 (match-data t))
+ (nth 5 (match-data t))))))
+ ((looking-at ".*:.*line \\([0-9]+\\)")
+ (let ((line-of-error
+ (string-to-number (buffer-substring-no-properties
+ (nth 2 (match-data t))
+ (nth 3 (match-data t))))))
+ (setq compilation-error-list
+ (cons
+ (cons
+ (point-marker)
+ (save-excursion
+ (set-buffer buffer-of-error)
+ (goto-line line-of-error)
+ (beginning-of-line)
+ (point-marker)))
+ compilation-error-list))))
+ (t t))
+ (forward-line 1)) )))
+
+;;;;
+;;;; Indentation
+;;;;
+(defun graphviz-dot-uncomment-region (begin end)
+ "Uncomments a region of code."
+ (interactive "r")
+ (comment-region begin end '(4)))
+
+(defun graphviz-dot-indent-line ()
+ "Indent current line of dot code."
+ (interactive)
+ (if (bolp)
+ (graphviz-dot-real-indent-line)
+ (save-excursion
+ (graphviz-dot-real-indent-line))))
+
+(defun graphviz-dot-real-indent-line ()
+ "Indent current line of dot code."
+ (beginning-of-line)
+ (cond
+ ((bobp)
+ ;; simple case, indent to 0
+ (indent-line-to 0))
+ ((looking-at "^[ \t]*}[ \t]*$")
+ ;; block closing, deindent relative to previous line
+ (indent-line-to (save-excursion
+ (forward-line -1)
+ (max 0 (- (current-indentation) graphviz-dot-indent-width)))))
+ ;; other cases need to look at previous lines
+ (t
+ (indent-line-to (save-excursion
+ (forward-line -1)
+ (cond
+ ((looking-at "\\(^.*{[^}]*$\\)")
+ ;; previous line opened a block
+ ;; indent to that line
+ (+ (current-indentation) graphviz-dot-indent-width))
+ ((and (not (looking-at ".*\\[.*\\].*"))
+ (looking-at ".*\\[.*")) ; TODO:PP : can be 1 regex
+ ;; previous line started filling
+ ;; attributes, intend to that start
+ (search-forward "[")
+ (current-column))
+ ((and (not (looking-at ".*\\[.*\\].*"))
+ (looking-at ".*\\].*")) ; TODO:PP : "
+ ;; previous line stopped filling
+ ;; attributes, find the line that started
+ ;; filling them and indent to that line
+ (while (or (looking-at ".*\\[.*\\].*")
+ (not (looking-at ".*\\[.*"))) ; TODO:PP : "
+ (forward-line -1))
+ (current-indentation))
+ (t
+ ;; default case, indent the
+ ;; same as previous line
+ (current-indentation)) ))) )))
+
+(defun graphviz-dot-indent-graph ()
+ "Indent the graph/digraph/subgraph where point is at.
+This will first teach the beginning of the graph were point is at, and
+then indent this and each subgraph in it."
+ (interactive)
+ (save-excursion
+ ;; position point at start of graph
+ (while (not (or (looking-at "\\(^.*{[^}]*$\\)") (bobp)))
+ (forward-line -1))
+ ;; bracket { one +; bracket } one -
+ (let ((bracket-count 0))
+ (while
+ (progn
+ (cond
+ ;; update bracket-count
+ ((looking-at "\\(^.*{[^}]*$\\)")
+ (setq bracket-count (+ bracket-count 1)))
+ ;; update bracket-count
+ ((looking-at "^[ \t]*}[ \t]*$")
+ (setq bracket-count (- bracket-count 1))))
+ ;; indent this line and move on
+ (graphviz-dot-indent-line)
+ (forward-line 1)
+ ;; as long as we are not completed or at end of buffer
+ (and (> bracket-count 0) (not (eobp))))))))
+
+;;;;
+;;;; Electric indentation
+;;;;
+(defun graphviz-dot-comment-or-string-p ()
+ (let ((state (parse-partial-sexp (point-min) (point))))
+ (or (nth 4 state) (nth 3 state))))
+
+(defun graphviz-dot-newline-and-indent ()
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (graphviz-dot-indent-line))
+ (delete-horizontal-space)
+ (newline)
+ (graphviz-dot-indent-line))
+
+(defun electric-graphviz-dot-terminate-line ()
+ "Terminate line and indent next line."
+ (interactive)
+ (if graphviz-dot-auto-indent-on-newline
+ (graphviz-dot-newline-and-indent)
+ (newline)))
+
+(defun electric-graphviz-dot-open-brace ()
+ "Terminate line and indent next line."
+ (interactive)
+ (insert "{")
+ (if (and graphviz-dot-auto-indent-on-braces
+ (not (graphviz-dot-comment-or-string-p)))
+ (graphviz-dot-newline-and-indent)))
+
+(defun electric-graphviz-dot-close-brace ()
+ "Terminate line and indent next line."
+ (interactive)
+ (insert "}")
+ (if (and graphviz-dot-auto-indent-on-braces
+ (not (graphviz-dot-comment-or-string-p)))
+ (progn
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (graphviz-dot-indent-line))
+ (newline)
+ (graphviz-dot-indent-line))))
+
+(defun electric-graphviz-dot-semi ()
+ "Terminate line and indent next line."
+ (interactive)
+ (insert ";")
+ (if (and graphviz-dot-auto-indent-on-semi
+ (not (graphviz-dot-comment-or-string-p)))
+ (graphviz-dot-newline-and-indent)))
+
+;;;;
+;;;; Preview
+;;;;
+(defun graphviz-dot-preview ()
+ "Shows an example of the current dot file in an emacs buffer.
+This assumes that we are running GNU Emacs or XEmacs under a windowing system.
+See `image-file-name-extensions' for customizing the files that can be
+loaded in GNU Emacs, and `image-formats-alist' for XEmacs."
+ (interactive)
+ ;; unsafe to compile ourself, ask it to the user
+ (if (buffer-modified-p)
+ (message "Buffer needs to be compiled.")
+ (if (string-match "XEmacs" emacs-version)
+ ;; things are easier in XEmacs...
+ (find-file-other-window (concat (file-name-sans-extension
+ buffer-file-name)
+ "." graphviz-dot-preview-extension))
+ ;; run through all the extensions for images
+ (let ((l image-file-name-extensions))
+ (while
+ (let ((f (concat (file-name-sans-extension (buffer-file-name))
+ "."
+ (car l))))
+ ;; see if a file matches, might be best also to check
+ ;; if file is up to date TODO:PP
+ (if (file-exists-p f)
+ (progn (auto-image-file-mode 1)
+ ;; OK, this is ugly, I would need to
+ ;; know how I can reload a file in an existing buffer
+ (if (get-buffer "*preview*")
+ (kill-buffer "*preview*"))
+ (set-buffer (find-file-noselect f))
+ (rename-buffer "*preview*")
+ (display-buffer (get-buffer "*preview*"))
+ ;; stop iterating
+ '())
+ ;; will stop iterating when l is nil
+ (setq l (cdr l)))))
+ ;; each extension tested and nothing found, let user know
+ (when (eq l '())
+ (message "No image found."))))))
+
+;;;;
+;;;; View
+;;;;
+(defun graphviz-dot-view ()
+ "Runs an external viewer. This creates an external process every time it
+is executed. If `graphviz-dot-save-before-view' is set, the current
+buffer is saved before the command is executed."
+ (interactive)
+ (let ((cmd (if graphviz-dot-view-edit-command
+ (if (string-match "XEmacs" emacs-version)
+ (read-shell-command "View command: "
+ (format graphviz-dot-view-command
+ (buffer-file-name)))
+ (read-from-minibuffer "View command: "
+ (format graphviz-dot-view-command
+ (buffer-file-name))))
+ (format graphviz-dot-view-command (buffer-file-name)))))
+ (if graphviz-dot-save-before-view
+ (save-buffer))
+ (setq novaproc (start-process-shell-command
+ (downcase mode-name) nil cmd))
+ (message (format "Executing `%s'..." cmd))))
+
+;;;;
+;;;; Completion
+;;;;
+(defvar graphviz-dot-str nil)
+(defvar graphviz-dot-all nil)
+(defvar graphviz-dot-pred nil)
+(defvar graphviz-dot-buffer-to-use nil)
+(defvar graphviz-dot-flag nil)
+
+(defun graphviz-dot-get-state ()
+ "Returns the syntax state of the current point."
+ (let ((state (parse-partial-sexp (point-min) (point))))
+ (cond
+ ((nth 4 state) 'comment)
+ ((nth 3 state) 'string)
+ ((not (nth 1 state)) 'out)
+ (t (save-excursion
+ (skip-chars-backward "^[,=\\[]{};")
+ (backward-char)
+ (cond
+ ((looking-at "[\\[,]{};") 'attribute)
+ ((looking-at "=") (progn
+ (backward-word 1)
+ (if (looking-at "[a-zA-Z]*color")
+ 'color
+ 'value)))
+ (t 'other)))))))
+
+(defun graphviz-dot-get-keywords ()
+ "Return possible completions for a word"
+ (let ((state (graphviz-dot-get-state)))
+ (cond
+ ((equal state 'comment) ())
+ ((equal state 'string) ())
+ ((equal state 'out) graphviz-attr-keywords)
+ ((equal state 'value) graphviz-value-keywords)
+ ((equal state 'color) graphviz-color-keywords)
+ ((equal state 'attribute) graphviz-attr-keywords)
+ (t graphviz-attr-keywords))))
+
+(defvar graphviz-dot-last-word-numb 0)
+(defvar graphviz-dot-last-word-shown nil)
+(defvar graphviz-dot-last-completions nil)
+
+(defun graphviz-dot-complete-word ()
+ "Complete word at current point."
+ (interactive)
+ (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
+ (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
+ (graphviz-dot-str (buffer-substring b e))
+ (allcomp (if (and graphviz-dot-toggle-completions
+ (string= graphviz-dot-last-word-shown
+ graphviz-dot-str))
+ graphviz-dot-last-completions
+ (all-completions graphviz-dot-str
+ (graphviz-dot-get-keywords))))
+ (match (if graphviz-dot-toggle-completions
+ "" (try-completion
+ graphviz-dot-str (mapcar '(lambda (elm)
+ (cons elm 0)) allcomp)))))
+ ;; Delete old string
+ (delete-region b e)
+
+ ;; Toggle-completions inserts whole labels
+ (if graphviz-dot-toggle-completions
+ (progn
+ ;; Update entry number in list
+ (setq graphviz-dot-last-completions allcomp
+ graphviz-dot-last-word-numb
+ (if (>= graphviz-dot-last-word-numb (1- (length allcomp)))
+ 0
+ (1+ graphviz-dot-last-word-numb)))
+ (setq graphviz-dot-last-word-shown
+ (elt allcomp graphviz-dot-last-word-numb))
+ ;; Display next match or same string if no match was found
+ (if (not (null allcomp))
+ (insert "" graphviz-dot-last-word-shown)
+ (insert "" graphviz-dot-str)
+ (message "(No match)")))
+ ;; The other form of completion does not necessarily do that.
+
+ ;; Insert match if found, or the original string if no match
+ (if (or (null match) (equal match 't))
+ (progn (insert "" graphviz-dot-str)
+ (message "(No match)"))
+ (insert "" match))
+ ;; Give message about current status of completion
+ (cond ((equal match 't)
+ (if (not (null (cdr allcomp)))
+ (message "(Complete but not unique)")
+ (message "(Sole completion)")))
+ ;; Display buffer if the current completion didn't help
+ ;; on completing the label.
+ ((and (not (null (cdr allcomp))) (= (length graphviz-dot-str)
+ (length match)))
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list allcomp))
+ ;; Wait for a keypress. Then delete *Completion* window
+ (momentary-string-display "" (point))
+ (if graphviz-dot-delete-completions
+ (delete-window
+ (get-buffer-window (get-buffer "*Completions*"))))
+ )))))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.dot\\'" . graphviz-dot-mode))
+
+;;; graphviz-dot-mode.el ends here
+
--- /dev/null
+;;; highlight-parentheses.el --- highlight surrounding parentheses
+;;
+;; Copyright (C) 2007, 2009 Nikolaj Schumacher
+;;
+;; Author: Nikolaj Schumacher <bugs * nschum de>
+;; Version: 1.0.1
+;; Keywords: faces, matching
+;; URL: http://nschum.de/src/emacs/highlight-parentheses/
+;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 2
+;; of the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;; Add the following to your .emacs file:
+;; (require 'highlight-parentheses)
+;;
+;; Enable `highlight-parentheses-mode'.
+;;
+;;; Change Log:
+;;
+;; 2009-03-19 (1.0.1)
+;; Added setter for color variables.
+;;
+;; 2007-07-30 (1.0)
+;; Added background highlighting and faces.
+;;
+;; 2007-05-15 (0.9.1)
+;; Support for defcustom.
+;;
+;; 2007-04-26 (0.9)
+;; Initial Release.
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defgroup highlight-parentheses nil
+ "Highlight surrounding parentheses"
+ :group 'faces
+ :group 'matching)
+
+(defun hl-paren-set (variable value)
+ (set variable value)
+ (when (fboundp 'hl-paren-color-update)
+ (hl-paren-color-update)))
+
+(defcustom hl-paren-colors
+ '("firebrick1" "IndianRed1" "IndianRed3" "IndianRed4")
+ "*List of colors for the highlighted parentheses.
+The list starts with the the inside parentheses and moves outwards."
+ :type '(repeat color)
+ :set 'hl-paren-set
+ :group 'highlight-parentheses)
+
+(defcustom hl-paren-background-colors nil
+ "*List of colors for the background highlighted parentheses.
+The list starts with the the inside parentheses and moves outwards."
+ :type '(repeat color)
+ :set 'hl-paren-set
+ :group 'highlight-parentheses)
+
+(defface hl-paren-face nil
+ "*Face used for highlighting parentheses.
+Color attributes might be overriden by `hl-paren-colors' and
+`hl-paren-background-colors'."
+ :group 'highlight-parentheses)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar hl-paren-overlays nil
+ "This buffers currently active overlays.")
+(make-variable-buffer-local 'hl-paren-overlays)
+
+(defvar hl-paren-last-point 0
+ "The last point for which parentheses were highlighted.
+This is used to prevent analyzing the same context over and over.")
+(make-variable-buffer-local 'hl-paren-last-point)
+
+(defun hl-paren-highlight ()
+ "Highlight the parentheses around point."
+ (unless (= (point) hl-paren-last-point)
+ (setq hl-paren-last-point (point))
+ (let ((overlays hl-paren-overlays)
+ pos1 pos2
+ (pos (point)))
+ (save-excursion
+ (condition-case err
+ (while (and (setq pos1 (cadr (syntax-ppss pos1)))
+ (cddr overlays))
+ (move-overlay (pop overlays) pos1 (1+ pos1))
+ (when (setq pos2 (scan-sexps pos1 1))
+ (move-overlay (pop overlays) (1- pos2) pos2)
+ ))
+ (error nil))
+ (goto-char pos))
+ (dolist (ov overlays)
+ (move-overlay ov 1 1)))))
+
+;;;###autoload
+(define-minor-mode highlight-parentheses-mode
+ "Minor mode to highlight the surrounding parentheses."
+ nil " hl-p" nil
+ (if highlight-parentheses-mode
+ (progn
+ (hl-paren-create-overlays)
+ (add-hook 'post-command-hook 'hl-paren-highlight nil t))
+ (mapc 'delete-overlay hl-paren-overlays)
+ (kill-local-variable 'hl-paren-overlays)
+ (kill-local-variable 'hl-paren-point)
+ (remove-hook 'post-command-hook 'hl-paren-highlight t)))
+
+;;; overlays ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hl-paren-create-overlays ()
+ (let ((fg hl-paren-colors)
+ (bg hl-paren-background-colors)
+ attributes)
+ (while (or fg bg)
+ (setq attributes (face-attr-construct 'hl-paren-face))
+ (when (car fg)
+ (setq attributes (plist-put attributes :foreground (car fg))))
+ (pop fg)
+ (when (car bg)
+ (setq attributes (plist-put attributes :background (car bg))))
+ (pop bg)
+ (dotimes (i 2) ;; front and back
+ (push (make-overlay 0 0) hl-paren-overlays)
+ (overlay-put (car hl-paren-overlays) 'face attributes)))
+ (setq hl-paren-overlays (nreverse hl-paren-overlays))))
+
+(defun hl-paren-color-update ()
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (when hl-paren-overlays
+ (mapc 'delete-overlay hl-paren-overlays)
+ (setq hl-paren-overlays nil)
+ (hl-paren-create-overlays)
+ (let ((hl-paren-last-point -1)) ;; force update
+ (hl-paren-highlight))))))
+
+(provide 'highlight-parentheses)
+
+;;; highlight-parentheses.el ends here
--- /dev/null
+;;; javascript.el --- Major mode for editing JavaScript source text
+
+;; Copyright (C) 2006 Karl Landström
+
+;; Author: Karl Landström <kland@comhem.se>
+;; Maintainer: Karl Landström <kland@comhem.se>
+;; Version: 2.0 Beta 8
+;; Date: 2006-12-26
+;; Keywords: languages, oop
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; The main features of this JavaScript mode are syntactic
+;; highlighting (enabled with `font-lock-mode' or
+;; `global-font-lock-mode'), automatic indentation and filling of
+;; comments.
+;;
+;; This package has (only) been tested with GNU Emacs 21.4 (the latest
+;; stable release).
+;;
+;; Installation:
+;;
+;; Put this file in a directory where Emacs can find it (`C-h v
+;; load-path' for more info). Then add the following lines to your
+;; Emacs initialization file:
+;;
+;; (add-to-list 'auto-mode-alist '("\\.js\\'" . javascript-mode))
+;; (autoload 'javascript-mode "javascript" nil t)
+;;
+;; General Remarks:
+;;
+;; This mode assumes that block comments are not nested inside block
+;; comments and that strings do not contain line breaks.
+;;
+;; Exported names start with "javascript-" whereas private names start
+;; with "js-".
+;;
+;; Changes:
+;;
+;; See javascript.el.changelog.
+
+;;; Code:
+
+(require 'cc-mode)
+(require 'font-lock)
+(require 'newcomment)
+
+(defgroup javascript nil
+ "Customization variables for `javascript-mode'."
+ :tag "JavaScript"
+ :group 'languages)
+
+(defcustom javascript-indent-level 4
+ "Number of spaces for each indentation step."
+ :type 'integer
+ :group 'javascript)
+
+(defcustom javascript-auto-indent-flag t
+ "Automatic indentation with punctuation characters. If non-nil, the
+current line is indented when certain punctuations are inserted."
+ :type 'boolean
+ :group 'javascript)
+
+
+;; --- Keymap ---
+
+(defvar javascript-mode-map nil
+ "Keymap used in JavaScript mode.")
+
+(unless javascript-mode-map
+ (setq javascript-mode-map (make-sparse-keymap)))
+
+(when javascript-auto-indent-flag
+ (mapc (lambda (key)
+ (define-key javascript-mode-map key 'javascript-insert-and-indent))
+ '("{" "}" "(" ")" ":" ";" ",")))
+
+(defun javascript-insert-and-indent (key)
+ "Run command bound to key and indent current line. Runs the command
+bound to KEY in the global keymap and indents the current line."
+ (interactive (list (this-command-keys)))
+ (call-interactively (lookup-key (current-global-map) key))
+ (indent-according-to-mode))
+
+
+;; --- Syntax Table And Parsing ---
+
+(defvar javascript-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (c-populate-syntax-table table)
+
+ ;; The syntax class of underscore should really be `symbol' ("_")
+ ;; but that makes matching of tokens much more complex as e.g.
+ ;; "\\<xyz\\>" matches part of e.g. "_xyz" and "xyz_abc". Defines
+ ;; it as word constituent for now.
+ (modify-syntax-entry ?_ "w" table)
+
+ table)
+ "Syntax table used in JavaScript mode.")
+
+
+(defun js-re-search-forward-inner (regexp &optional bound count)
+ "Auxiliary function for `js-re-search-forward'."
+ (let ((parse)
+ (saved-point (point-min)))
+ (while (> count 0)
+ (re-search-forward regexp bound)
+ (setq parse (parse-partial-sexp saved-point (point)))
+ (cond ((nth 3 parse)
+ (re-search-forward
+ (concat "\\([^\\]\\|^\\)" (string (nth 3 parse)))
+ (save-excursion (end-of-line) (point)) t))
+ ((nth 7 parse)
+ (forward-line))
+ ((or (nth 4 parse)
+ (and (eq (char-before) ?\/) (eq (char-after) ?\*)))
+ (re-search-forward "\\*/"))
+ (t
+ (setq count (1- count))))
+ (setq saved-point (point))))
+ (point))
+
+
+(defun js-re-search-forward (regexp &optional bound noerror count)
+ "Search forward but ignore strings and comments. Invokes
+`re-search-forward' but treats the buffer as if strings and
+comments have been removed."
+ (let ((saved-point (point))
+ (search-expr
+ (cond ((null count)
+ '(js-re-search-forward-inner regexp bound 1))
+ ((< count 0)
+ '(js-re-search-backward-inner regexp bound (- count)))
+ ((> count 0)
+ '(js-re-search-forward-inner regexp bound count)))))
+ (condition-case err
+ (eval search-expr)
+ (search-failed
+ (goto-char saved-point)
+ (unless noerror
+ (error (error-message-string err)))))))
+
+
+(defun js-re-search-backward-inner (regexp &optional bound count)
+ "Auxiliary function for `js-re-search-backward'."
+ (let ((parse)
+ (saved-point (point-min)))
+ (while (> count 0)
+ (re-search-backward regexp bound)
+ (when (and (> (point) (point-min))
+ (save-excursion (backward-char) (looking-at "/[/*]")))
+ (forward-char))
+ (setq parse (parse-partial-sexp saved-point (point)))
+ (cond ((nth 3 parse)
+ (re-search-backward
+ (concat "\\([^\\]\\|^\\)" (string (nth 3 parse)))
+ (save-excursion (beginning-of-line) (point)) t))
+ ((nth 7 parse)
+ (goto-char (nth 8 parse)))
+ ((or (nth 4 parse)
+ (and (eq (char-before) ?/) (eq (char-after) ?*)))
+ (re-search-backward "/\\*"))
+ (t
+ (setq count (1- count))))))
+ (point))
+
+
+(defun js-re-search-backward (regexp &optional bound noerror count)
+ "Search backward but ignore strings and comments. Invokes
+`re-search-backward' but treats the buffer as if strings and
+comments have been removed."
+ (let ((saved-point (point))
+ (search-expr
+ (cond ((null count)
+ '(js-re-search-backward-inner regexp bound 1))
+ ((< count 0)
+ '(js-re-search-forward-inner regexp bound (- count)))
+ ((> count 0)
+ '(js-re-search-backward-inner regexp bound count)))))
+ (condition-case err
+ (eval search-expr)
+ (search-failed
+ (goto-char saved-point)
+ (unless noerror
+ (error (error-message-string err)))))))
+
+
+(defun js-continued-var-decl-list-p ()
+ "Return non-nil if point is inside a continued variable declaration
+list."
+ (interactive)
+ (let ((start (save-excursion (js-re-search-backward "\\<var\\>" nil t))))
+ (and start
+ (save-excursion (re-search-backward "\n" start t))
+ (not (save-excursion
+ (js-re-search-backward
+ ";\\|[^, \t][ \t]*\\(/[/*]\\|$\\)" start t))))))
+
+
+;; --- Font Lock ---
+
+(defun js-inside-param-list-p ()
+ "Return non-nil if point is inside a function parameter list."
+ (condition-case err
+ (save-excursion
+ (up-list -1)
+ (and (looking-at "(")
+ (progn (backward-word 1)
+ (or (looking-at "function")
+ (progn (backward-word 1) (looking-at "function"))))))
+ (error nil)))
+
+
+(defconst js-function-heading-1-re
+ "^[ \t]*function[ \t]+\\(\\w+\\)"
+ "Regular expression matching the start of a function header.")
+
+(defconst js-function-heading-2-re
+ "^[ \t]*\\(\\w+\\)[ \t]*:[ \t]*function\\>"
+ "Regular expression matching the start of a function entry in
+ an associative array.")
+
+(defconst js-keyword-re
+ (regexp-opt '("abstract" "break" "case" "catch" "class" "const"
+ "continue" "debugger" "default" "delete" "do" "else"
+ "enum" "export" "extends" "final" "finally" "for"
+ "function" "goto" "if" "implements" "import" "in"
+ "instanceof" "interface" "native" "new" "package"
+ "private" "protected" "public" "return" "static"
+ "super" "switch" "synchronized" "this" "throw"
+ "throws" "transient" "try" "typeof" "var" "void"
+ "volatile" "while" "with"
+ "let") 'words)
+ "Regular expression matching any JavaScript keyword.")
+
+(defconst js-basic-type-re
+ (regexp-opt '("boolean" "byte" "char" "double" "float" "int" "long"
+ "short" "void") 'words)
+ "Regular expression matching any predefined type in JavaScript.")
+
+(defconst js-constant-re
+ (regexp-opt '("false" "null" "true") 'words)
+ "Regular expression matching any future reserved words in JavaScript.")
+
+
+(defconst js-font-lock-keywords-1
+ (list
+ "\\<import\\>"
+ (list js-function-heading-1-re 1 font-lock-function-name-face)
+ (list js-function-heading-2-re 1 font-lock-function-name-face)
+ (list "[=(][ \t]*\\(/.*?[^\\]/\\w*\\)" 1 font-lock-string-face))
+ "Level one font lock.")
+
+(defconst js-font-lock-keywords-2
+ (append js-font-lock-keywords-1
+ (list (list js-keyword-re 1 font-lock-keyword-face)
+ (cons js-basic-type-re font-lock-type-face)
+ (cons js-constant-re font-lock-constant-face)))
+ "Level two font lock.")
+
+
+;; Limitations with variable declarations: There seems to be no
+;; sensible way to highlight variables occuring after an initialized
+;; variable in a variable list. For instance, in
+;;
+;; var x, y = f(a, b), z
+;;
+;; z will not be highlighted.
+
+(defconst js-font-lock-keywords-3
+ (append
+ js-font-lock-keywords-2
+ (list
+
+ ;; variable declarations
+ (list
+ (concat "\\<\\(const\\|var\\)\\>\\|" js-basic-type-re)
+ (list "\\(\\w+\\)[ \t]*\\([=;].*\\|,\\|/[/*]\\|$\\)"
+ nil
+ nil
+ '(1 font-lock-variable-name-face)))
+
+ ;; continued variable declaration list
+ (list
+ (concat "^[ \t]*\\w+[ \t]*\\([,;=]\\|/[/*]\\|$\\)")
+ (list "\\(\\w+\\)[ \t]*\\([=;].*\\|,\\|/[/*]\\|$\\)"
+ '(if (save-excursion (backward-char) (js-continued-var-decl-list-p))
+ (backward-word 1)
+ (end-of-line))
+ '(end-of-line)
+ '(1 font-lock-variable-name-face)))
+
+ ;; formal parameters
+ (list
+ (concat "\\<function\\>\\([ \t]+\\w+\\)?[ \t]*([ \t]*\\w")
+ (list "\\(\\w+\\)\\([ \t]*).*\\)?"
+ '(backward-char)
+ '(end-of-line)
+ '(1 font-lock-variable-name-face)))
+
+ ;; continued formal parameter list
+ (list
+ (concat "^[ \t]*\\w+[ \t]*[,)]")
+ (list "\\w+"
+ '(if (save-excursion (backward-char) (js-inside-param-list-p))
+ (backward-word 1)
+ (end-of-line))
+ '(end-of-line)
+ '(0 font-lock-variable-name-face)))))
+ "Level three font lock.")
+
+(defconst js-font-lock-keywords
+ '(js-font-lock-keywords-3 js-font-lock-keywords-1 js-font-lock-keywords-2
+ js-font-lock-keywords-3)
+ "See `font-lock-keywords'.")
+
+
+;; --- Indentation ---
+
+(defconst js-possibly-braceless-keyword-re
+ (regexp-opt
+ '("catch" "do" "else" "finally" "for" "if" "try" "while" "with" "let")
+ 'words)
+ "Regular expression matching keywords that are optionally
+ followed by an opening brace.")
+
+(defconst js-indent-operator-re
+ (concat "[-+*/%<>=&^|?:.]\\([^-+*/]\\|$\\)\\|"
+ (regexp-opt '("in" "instanceof") 'words))
+ "Regular expression matching operators that affect indentation
+ of continued expressions.")
+
+
+(defun js-looking-at-operator-p ()
+ "Return non-nil if text after point is an operator (that is not
+a comma)."
+ (save-match-data
+ (and (looking-at js-indent-operator-re)
+ (or (not (looking-at ":"))
+ (save-excursion
+ (and (js-re-search-backward "[?:{]\\|\\<case\\>" nil t)
+ (looking-at "?")))))))
+
+
+(defun js-continued-expression-p ()
+ "Returns non-nil if the current line continues an expression."
+ (save-excursion
+ (back-to-indentation)
+ (or (js-looking-at-operator-p)
+ (and (js-re-search-backward "\n" nil t)
+ (progn
+ (skip-chars-backward " \t")
+ (backward-char)
+ (and (> (point) (point-min))
+ (save-excursion (backward-char) (not (looking-at "[/*]/")))
+ (js-looking-at-operator-p)
+ (and (progn (backward-char)
+ (not (looking-at "++\\|--\\|/[/*]"))))))))))
+
+
+(defun js-end-of-do-while-loop-p ()
+ "Returns non-nil if word after point is `while' of a do-while
+statement, else returns nil. A braceless do-while statement
+spanning several lines requires that the start of the loop is
+indented to the same column as the current line."
+ (interactive)
+ (save-excursion
+ (save-match-data
+ (when (looking-at "\\s-*\\<while\\>")
+ (if (save-excursion
+ (skip-chars-backward "[ \t\n]*}")
+ (looking-at "[ \t\n]*}"))
+ (save-excursion
+ (backward-list) (backward-word 1) (looking-at "\\<do\\>"))
+ (js-re-search-backward "\\<do\\>" (point-at-bol) t)
+ (or (looking-at "\\<do\\>")
+ (let ((saved-indent (current-indentation)))
+ (while (and (js-re-search-backward "^[ \t]*\\<" nil t)
+ (/= (current-indentation) saved-indent)))
+ (and (looking-at "[ \t]*\\<do\\>")
+ (not (js-re-search-forward
+ "\\<while\\>" (point-at-eol) t))
+ (= (current-indentation) saved-indent)))))))))
+
+
+(defun js-ctrl-statement-indentation ()
+ "Returns the proper indentation of the current line if it
+starts the body of a control statement without braces, else
+returns nil."
+ (save-excursion
+ (back-to-indentation)
+ (when (save-excursion
+ (and (not (looking-at "[{]"))
+ (progn
+ (js-re-search-backward "[[:graph:]]" nil t)
+ (forward-char)
+ (when (= (char-before) ?\)) (backward-list))
+ (skip-syntax-backward " ")
+ (skip-syntax-backward "w")
+ (looking-at js-possibly-braceless-keyword-re))
+ (not (js-end-of-do-while-loop-p))))
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (+ (current-indentation) javascript-indent-level)))))
+
+
+(defun js-proper-indentation (parse-status)
+ "Return the proper indentation for the current line."
+ (save-excursion
+ (back-to-indentation)
+ (let ((ctrl-stmt-indent (js-ctrl-statement-indentation))
+ (same-indent-p (looking-at "[]})]\\|\\<case\\>\\|\\<default\\>"))
+ (continued-expr-p (js-continued-expression-p)))
+ (cond (ctrl-stmt-indent)
+ ((js-continued-var-decl-list-p)
+ (js-re-search-backward "\\<var\\>" nil t)
+ (+ (current-indentation) javascript-indent-level))
+ ((nth 1 parse-status)
+ (goto-char (nth 1 parse-status))
+ (if (looking-at "[({[][ \t]*\\(/[/*]\\|$\\)")
+ (progn
+ (skip-syntax-backward " ")
+ (when (= (char-before) ?\)) (backward-list))
+ (back-to-indentation)
+ (cond (same-indent-p
+ (current-column))
+ (continued-expr-p
+ (+ (current-column) (* 2 javascript-indent-level)))
+ (t
+ (+ (current-column) javascript-indent-level))))
+ (unless same-indent-p
+ (forward-char)
+ (skip-chars-forward " \t"))
+ (current-column)))
+ (continued-expr-p javascript-indent-level)
+ (t 0)))))
+
+
+(defun javascript-indent-line ()
+ "Indent the current line as JavaScript source text."
+ (interactive)
+ (let ((parse-status
+ (save-excursion (parse-partial-sexp (point-min) (point-at-bol))))
+ (offset (- (current-column) (current-indentation))))
+ (when (not (nth 8 parse-status))
+ (indent-line-to (js-proper-indentation parse-status))
+ (when (> offset 0) (forward-char offset)))))
+
+
+;; --- Filling ---
+
+;; FIXME: It should be possible to use the more sofisticated function
+;; `c-fill-paragraph' in `cc-cmds.el' instead. However, just setting
+;; `fill-paragraph-function' to `c-fill-paragraph' does not work;
+;; inside `c-fill-paragraph', `fill-paragraph-function' evaluates to
+;; nil!?
+
+(defun js-backward-paragraph ()
+ "Move backward to start of paragraph. Postcondition: Point is at
+beginning of buffer or the previous line contains only whitespace."
+ (forward-line -1)
+ (while (not (or (bobp) (looking-at "^[ \t]*$")))
+ (forward-line -1))
+ (when (not (bobp)) (forward-line 1)))
+
+
+(defun js-forward-paragraph ()
+ "Move forward to end of paragraph. Postcondition: Point is at
+end of buffer or the next line contains only whitespace."
+ (forward-line 1)
+ (while (not (or (eobp) (looking-at "^[ \t]*$")))
+ (forward-line 1))
+ (when (not (eobp)) (backward-char 1)))
+
+
+(defun js-fill-block-comment-paragraph (parse-status justify)
+ "Fill current paragraph as a block comment. PARSE-STATUS is the
+result of `parse-partial-regexp' from beginning of buffer to
+point. JUSTIFY has the same meaning as in `fill-paragraph'."
+ (let ((offset (save-excursion
+ (goto-char (nth 8 parse-status)) (current-indentation))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (save-excursion
+ (goto-char (nth 8 parse-status)) (point-at-bol))
+ (save-excursion
+ (goto-char (nth 8 parse-status))
+ (re-search-forward "*/")))
+ (narrow-to-region (save-excursion
+ (js-backward-paragraph)
+ (when (looking-at "^[ \t]*$") (forward-line 1))
+ (point))
+ (save-excursion
+ (js-forward-paragraph)
+ (when (looking-at "^[ \t]*$") (backward-char))
+ (point)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (delete-horizontal-space)
+ (forward-line 1))
+ (let ((fill-column (- fill-column offset))
+ (fill-paragraph-function nil))
+ (fill-paragraph justify))
+
+ ;; In Emacs 21.4 as opposed to CVS Emacs 22,
+ ;; `fill-paragraph' seems toadd a newline at the end of the
+ ;; paragraph. Remove it!
+ (goto-char (point-max))
+ (when (looking-at "^$") (backward-delete-char 1))
+
+ (goto-char (point-min))
+ (while (not (eobp))
+ (indent-to offset)
+ (forward-line 1))))))
+
+
+(defun js-sline-comment-par-start ()
+ "Return point at the beginning of the line where the current
+single-line comment paragraph starts."
+ (save-excursion
+ (beginning-of-line)
+ (while (and (not (bobp))
+ (looking-at "^[ \t]*//[ \t]*[[:graph:]]"))
+ (forward-line -1))
+ (unless (bobp) (forward-line 1))
+ (point)))
+
+
+(defun js-sline-comment-par-end ()
+ "Return point at end of current single-line comment paragraph."
+ (save-excursion
+ (beginning-of-line)
+ (while (and (not (eobp))
+ (looking-at "^[ \t]*//[ \t]*[[:graph:]]"))
+ (forward-line 1))
+ (unless (bobp) (backward-char))
+ (point)))
+
+
+(defun js-sline-comment-offset (line)
+ "Return the column at the start of the current single-line
+comment paragraph."
+ (save-excursion
+ (goto-line line)
+ (re-search-forward "//" (point-at-eol))
+ (goto-char (match-beginning 0))
+ (current-column)))
+
+
+(defun js-sline-comment-text-offset (line)
+ "Return the column at the start of the text of the current
+single-line comment paragraph."
+ (save-excursion
+ (goto-line line)
+ (re-search-forward "//[ \t]*" (point-at-eol))
+ (current-column)))
+
+
+(defun js-at-empty-sline-comment-p ()
+ "Return non-nil if inside an empty single-line comment."
+ (and (save-excursion
+ (beginning-of-line)
+ (not (looking-at "^.*//.*[[:graph:]]")))
+ (save-excursion
+ (re-search-backward "//" (point-at-bol) t))))
+
+
+(defun js-fill-sline-comments (parse-status justify)
+ "Fill current paragraph as a sequence of single-line comments.
+PARSE-STATUS is the result of `parse-partial-regexp' from
+beginning of buffer to point. JUSTIFY has the same meaning as in
+`fill-paragraph'."
+ (when (not (js-at-empty-sline-comment-p))
+ (let* ((start (js-sline-comment-par-start))
+ (start-line (1+ (count-lines (point-min) start)))
+ (end (js-sline-comment-par-end))
+ (offset (js-sline-comment-offset start-line))
+ (text-offset (js-sline-comment-text-offset start-line)))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*//[ \t]*" nil t)
+ (replace-match "")
+ (forward-line 1))
+ (let ((fill-paragraph-function nil)
+ (fill-column (- fill-column text-offset)))
+ (fill-paragraph justify))
+
+ ;; In Emacs 21.4 as opposed to CVS Emacs 22,
+ ;; `fill-paragraph' seems toadd a newline at the end of the
+ ;; paragraph. Remove it!
+ (goto-char (point-max))
+ (when (looking-at "^$") (backward-delete-char 1))
+
+ (goto-char (point-min))
+ (while (not (eobp))
+ (indent-to offset)
+ (insert "//")
+ (indent-to text-offset)
+ (forward-line 1)))))))
+
+
+(defun js-trailing-comment-p (parse-status)
+ "Return non-nil if inside a trailing comment. PARSE-STATUS is
+the result of `parse-partial-regexp' from beginning of buffer to
+point."
+ (save-excursion
+ (when (nth 4 parse-status)
+ (goto-char (nth 8 parse-status))
+ (skip-chars-backward " \t")
+ (not (bolp)))))
+
+
+(defun js-block-comment-p (parse-status)
+ "Return non-nil if inside a block comment. PARSE-STATUS is the
+result of `parse-partial-regexp' from beginning of buffer to
+point."
+ (save-excursion
+ (save-match-data
+ (when (nth 4 parse-status)
+ (goto-char (nth 8 parse-status))
+ (looking-at "/\\*")))))
+
+
+(defun javascript-fill-paragraph (&optional justify)
+ "If inside a comment, fill the current comment paragraph.
+Trailing comments are ignored."
+ (interactive)
+ (let ((parse-status (parse-partial-sexp (point-min) (point))))
+ (when (and (nth 4 parse-status)
+ (not (js-trailing-comment-p parse-status)))
+ (if (js-block-comment-p parse-status)
+ (js-fill-block-comment-paragraph parse-status justify)
+ (js-fill-sline-comments parse-status justify))))
+ t)
+
+
+;; --- Imenu ---
+
+(defconst js-imenu-generic-expression
+ (list
+ (list
+ nil
+ "function\\s-+\\(\\w+\\)\\s-*("
+ 1))
+ "Regular expression matching top level procedures. Used by imenu.")
+
+
+;; --- Main Function ---
+
+;;;###autoload
+(defun javascript-mode ()
+ "Major mode for editing JavaScript source text.
+
+Key bindings:
+
+\\{javascript-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+
+ (use-local-map javascript-mode-map)
+ (set-syntax-table javascript-mode-syntax-table)
+ (set (make-local-variable 'indent-line-function) 'javascript-indent-line)
+ (set (make-local-variable 'font-lock-defaults) (list js-font-lock-keywords))
+
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+
+ ;; Comments
+ (setq comment-start "// ")
+ (setq comment-end "")
+ (set (make-local-variable 'fill-paragraph-function)
+ 'javascript-fill-paragraph)
+
+ ;; Make c-mark-function work
+ (setq c-nonsymbol-token-regexp "!=\\|%=\\|&[&=]\\|\\*[/=]\\|\\+[+=]\\|-[=-]\\|/[*/=]\\|<\\(?:<=\\|[<=]\\)\\|==\\|>\\(?:>\\(?:>=\\|[=>]\\)\\|[=>]\\)\\|\\^=\\||[=|]\\|[]!%&(-,./:-?[{-~^-]"
+ c-stmt-delim-chars "^;{}?:"
+ c-syntactic-ws-end "[ \n \r\v\f/]"
+ c-syntactic-eol "\\(\\s \\|/\\*\\([^*\n\r]\\|\\*[^/\n\r]\\)*\\*/\\)*\\(\\(/\\*\\([^*\n\r]\\|\\*[^/\n\r]\\)*\\|\\\\\\)?$\\|//\\)")
+
+ ;; Imenu
+ (setq imenu-case-fold-search nil)
+ (set (make-local-variable 'imenu-generic-expression)
+ js-imenu-generic-expression)
+
+ (setq major-mode 'javascript-mode)
+ (setq mode-name "JavaScript")
+ (run-hooks 'javascript-mode-hook))
+
+
+(provide 'javascript-mode)
+;;; javascript.el ends here
--- /dev/null
+;;; lacarte.el --- Execute menu items as commands, with completion.
+;;
+;; Filename: lacarte.el
+;; Description: Execute menu items as commands, with completion.
+;; Author: Drew Adams
+;; Maintainer: Drew Adams
+;; Copyright (C) 2005-2010, Drew Adams, all rights reserved.
+;; Created: Fri Aug 12 17:18:02 2005
+;; Version: 22.0
+;; Last-Updated: Fri Jun 25 21:05:15 2010 (-0700)
+;; By: dradams
+;; Update #: 632
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/lacarte.el
+;; Keywords: menu-bar, menu, command, help, abbrev, minibuffer, keys,
+;; completion, matching, local, internal, extensions,
+;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Q. When is a menu not a menu? A. When it's a la carte.
+;;
+;; Library La Carte lets you execute menu items as commands, with
+;; completion. You can use it as an alternative to standard library
+;; `tmm.el'.
+;;
+;; Type a menu item. Completion is available. Completion candidates
+;; are of the form menu > submenu > subsubmenu > ... > menu item.
+;; For example:
+;;
+;; File > Open Recent > Cleanup list
+;; File > Open Recent > Edit list...
+;;
+;; When you choose a menu-item candidate, the corresponding command
+;; is executed.
+;;
+;; Put this in your init file (~/.emacs):
+;;
+;; (require 'lacarte)
+;;
+;; Suggested key bindings:
+;;
+;; (global-set-key [?\e ?\M-x] 'lacarte-execute-command)
+;; (global-set-key [?\M-`] 'lacarte-execute-menu-command)
+;; (global-set-key [f10] 'lacarte-execute-menu-command)
+;;
+;; (The latter two replace standard bindings for `tmm-menubar'. On
+;; MS Windows, `f10' is normally bound to `menu-bar-open', which uses
+;; the Windows native keyboard access to menus.)
+;;
+;; To really take advantage of La Carte, use it together with
+;; Icicles. Icicles is not required to be able to use La Carte, but
+;; it enhances the functionality of `lacarte.el' considerably.
+;; (Note: `lacarte.el' was originally called `icicles-menu.el'.)
+;;
+;; If you use MS Windows keyboard accelerators, consider using
+;; `lacarte-remove-w32-keybd-accelerators' as the value of
+;; `lacarte-convert-menu-item-function'. It removes any unescaped
+;; `&' characters (indicating an accelerator) from the menu items.
+;; One library that adds keyboard accelerators to your menu items is
+;; `menuacc.el', by Lennart Borgman (< l e n n a r t . b o r g m a n
+;; @ g m a i l . c o m >).
+;;
+;;
+;; Commands defined here:
+;;
+;; `lacarte-execute-command', `lacarte-execute-menu-command'.
+;;
+;; Options defined here: `lacarte-convert-menu-item-function'.
+;;
+;; Non-interactive functions defined here:
+;;
+;; `lacarte-escape-w32-accel', `lacarte-get-a-menu-item-alist',
+;; `lacarte-get-a-menu-item-alist-1',
+;; `lacarte-get-overall-menu-item-alist', `lacarte-menu-first-p',
+;; `lacarte-remove-w32-keybd-accelerators'.
+;;
+;; Internal variables defined here:
+;;
+;; `lacarte-history', `lacarte-menu-items-alist'.
+;;
+;;
+;; Getting Started
+;; ---------------
+;;
+;; In your init file (`~/.emacs'), bind `ESC M-x' as suggested above:
+;;
+;; (global-set-key [?\e ?\M-x] 'lacarte-execute-command)
+;;
+;; Type `ESC M-x' (or `ESC ESC x', which is the same thing). You are
+;; prompted for a command or menu command to execute. Just start
+;; typing its name. Each menu item's full name, for completion, has
+;; its parent menu names as prefixes.
+;;
+;; ESC M-x
+;; Command:
+;; Command: t [TAB]
+;; Command: Tools >
+;; Command: Tools > Compa [TAB]
+;; Command: Tools > Compare (Ediff) > Two F [TAB]
+;; Command: Tools > Compare (Ediff) > Two Files... [RET]
+;;
+;;
+;; Not Just for Wimps and Noobs Anymore
+;; ------------------------------------
+;;
+;; *You* don't use menus. Nah, they're too slow! Only newbies and
+;; wimps use menus. Well not any more. Use the keyboard to access
+;; any menu item, without knowing where it is or what its full name
+;; is. Type just part of its name and use completion to get the
+;; rest: the complete path and item name.
+;;
+;;
+;; Commands and Menu Commands
+;; --------------------------
+;;
+;; You can bind either `lacarte-execute-menu-command' or
+;; `lacarte-execute-command' to a key such as `ESC M-x'.
+;;
+;; `lacarte-execute-menu-command' uses only menu commands.
+;; `lacarte-execute-command' lets you choose among ordinary Emacs
+;; commands, in addition to menu commands. You can use a prefix arg
+;; with `lacarte-execute-command' to get the same effect as
+;; `lacarte-execute-menu-command'.
+;;
+;; Use `lacarte-execute-command' if you don't care whether a command
+;; is on a menu. Then, if you want a command that affects a buffer,
+;; just type `buf'. This is especially useful if you use Icicles -
+;; see below.
+;;
+;; By default, in Icicle mode, `ESC M-x' is bound to
+;; `lacarte-execute-command', and `M-`' is bound to
+;; `lacarte-execute-menu-command'.
+;;
+;;
+;; Icicles Enhances Dining A La Carte
+;; ----------------------------------
+;;
+;; Use Icicles with La Carte to get more power and convenience.
+;;
+;; It is Icicles that lets you choose menu items a la carte, in fact.
+;; That is, you can access them directly, wherever they might be in
+;; the menu hierachy. Without Icicles, you are limited to choosing
+;; items by their menu-hierarchy prefixes, and you must complete the
+;; entire menu prefix to the item, from the top of the menu on down.
+;; With Icicles, you can directly match any parts of a menu item and
+;; its hierarchy path. Icicles is here:
+;; http://www.emacswiki.org/cgi-bin/wiki/Icicles.
+;;
+;; Type any part of a menu-item, then use the Page Up and Page Down
+;; keys (`prior' and `next') to cycle through all menu commands that
+;; contain the text you typed somewhere in their name. You can match
+;; within any menu or within all menus; that is, you can match any
+;; part(s) of the menu-hierachy prefix.
+;;
+;; You can use `S-TAB' to show and choose from all such "apropos
+;; completions", just as you normally use `TAB' to show all prefix
+;; completions (that is, ordinary completions). Vanilla, prefix
+;; completion is still available using `TAB', and you can cycle
+;; through the prefix completions using the arrow keys.
+;;
+;; You can use Icicles "progressive completion" to match multiple
+;; parts of a menu item separately, in any order. For example, if
+;; you want a menu command that has to do with buffers and
+;; highlighting, type `buf M-SPC hig S-TAB'.
+;;
+;; Icicles apropos completion also lets you type a regular expression
+;; (regexp) - it is matched against all of the possible menu items.
+;; So, for instance, you could type `^e.+buff [next] [next]...' to
+;; quickly cycle to menu command `Edit > Go To > Goto End of Buffer'.
+;; Or type `.*print.*buf S-TAB' to choose from the list of all menu
+;; commands that match `print' followed somewhere by `buf'.
+;;
+;; If you know how to use regexps, you can easily and quickly get to
+;; a menu command you want, or at least narrow the list of candidates
+;; for completion and cycling.
+;;
+;; Additional benefits of using Icicles with La Carte:
+;;
+;; * When you cycle to a candidate menu item, or you complete to one
+;; (entirely), the Emacs command associated with the menu item is
+;; shown in the mode line of buffer `*Completions*'.
+;;
+;; * You can use `M-h' to complete your minibuffer input against
+;; commands, including menu-item commands, that you have entered
+;; previously. You can also use the standard history keys
+;; (e.g. `M-p', `M-r') to access these commands.
+;;
+;;
+;; Menu Organization Helps You Find a Command
+;; ------------------------------------------
+;;
+;; Unlike commands listed in a flat `*Apropos*' page, menu items are
+;; organized, grouped logically by common area of application
+;; (`File', `Edit',...). This grouping is also available when
+;; cycling completion candidates using Icicles, and you can take
+;; advantage of it to hasten your search for the right command.
+;;
+;; You want to execute a command that puts the cursor at the end of a
+;; buffer, but you don't remember its name, what menu it might be a
+;; part of, or where it might appear in that (possibly complex) menu.
+;; With Icicles and La Carte, you type `ESC M-x' and then type
+;; `buffer' at the prompt. You use the Page Up and Page Down keys to
+;; cycle through all menu items that contain the word `buffer'.
+;;
+;; There are lots of such menu items. But all items from the same
+;; menu (e.g. `File') are grouped together. You cycle quickly (not
+;; reading) to the `Edit' menu, because you guess that moving the
+;; cursor has more to do with editing than with file operations, tool
+;; use, buffer choice, help, etc. Then you cycle more slowly among
+;; the `buffer' menu items in the `Edit' menu. You quickly find
+;; `Edit > Go To > Goto End of Buffer'. QED.
+;;
+;;
+;; Learn About Menu Items By Exploring Them
+;; ----------------------------------------
+;;
+;; With Icicles, you can display the complete documentation (doc
+;; string) for the command corresponding to each menu item, as the
+;; item appears in the minibuffer. To do this, just cycle menu-item
+;; candidates using `C-down' or `C-next', instead of `[down]' or
+;; `[next]'. The documentation appears in buffer `*Help*'.
+;;
+;; In sum, if you use La Carte, you will want to use it with Icicles
+;; - enjoy!
+;;
+;;
+;; To Do?
+;; ------
+;;
+;; 1. Provide sorting by menu-bar order, instead of alphabetically.
+;; 2. Echo key bindings for each completed menu item.
+;;
+;; 3. Maybe use tmm-get-bind?
+
+;;(@> "Index")
+;;
+;; If you have library `linkd.el' and Emacs 22 or later, load
+;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
+;; navigate around the sections of this doc. Linkd mode will
+;; highlight this Index, as well as the cross-references and section
+;; headings throughout this file. You can get `linkd.el' here:
+;; http://dto.freeshell.org/notebook/Linkd.html.
+;;
+;; (@> "Change log")
+;; (@> "User Options")
+;; (@> "Internal Variables")
+;; (@> "Functions")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;(@* "Change log")
+;;
+;; 2010/06/26 dadams
+;; lacarte-execute-command: Protected Icicles vars with boundp. Thx to Alexey Romanov.
+;; 2010/05/11 dadams
+;; lacarte-get-a-menu-item-alist-1: Add keyboard shortcuts to item names.
+;; Applied Icicles renamings (belatedly):
+;; icicle-sort-functions-alist to icicle-sort-orders-alist,
+;; icicle-sort-function to icicle-sort-comparer.
+;; 2009/12/25 dadams
+;; Added: lacarte-execute-command, lacarte-menu-first-p.
+;; lacarte-get-a-menu-item-alist-1: Handle :filter (e.g. File > Open Recent submenus).
+;; lacarte-execute-menu-command:
+;; Just let-bind lacarte-menu-items-alist - don't use unwind-protect.
+;; lacarte-get-overall-menu-item-alist: Reset lacarte-menu-items-alist to nil.
+;; lacarte-get-a-menu-item-alist: Set to the return value.
+;; 2009/07/29 dadams
+;; Added: lacarte-history.
+;; lacarte-execute-menu-command:
+;; Use lacarte-history as the history list. Use strict completion.
+;; 2009/07/26 dadams
+;; lacarte-execute-menu-command: Use icicle-interactive-history as the history list.
+;; 2008/08/28 dadams
+;; Renamed from alacarte to lacarte. Confusion with alacarte Ubuntu source package.
+;; 2008/05/21 dadams
+;; Renamed library icicles-menu.el to alacarte.el.
+;; alacarte-execute-menu-command: Case-insensitive completion, by default.
+;; 2008/05/20 dadams
+;; icicle-get-a-menu-item-alist-1: Don't add non-selectable item to alist.
+;; 2006/12/22 dadams
+;; icicle-convert-menu-item-function: Use choice as :type, allowing nil.
+;; :group 'icicles -> :group 'Icicles.
+;; 2006/10/16 dadams
+;; icicle-get-overall-menu-item-alist: Include minor-mode keymaps.
+;; 2006/03/16 dadams
+;; Added to Commentary.
+;; 2006/02/18 dadams
+;; icicle-execute-menu-command: \s -> \\s. (Thx to dslcustomer-211-74.vivodi.gr.)
+;; 2006/01/07 dadams
+;; Added :link for sending bug reports.
+;; 2006/01/06 dadams
+;; Changed defgroup to icicles-menu from icicles.
+;; Added :link.
+;; 2005/11/08 dadams
+;; icicle-execute-menu-command:
+;; Reset icicle-menu-items-alist in unwind-protect.
+;; Fix for dynamic menus Select and Paste, Buffers, and Frames:
+;; Treat special cases of last-command-event.
+;; icicle-get-overall-menu-item-alist: setq result of sort.
+;; 2005/11/05 dadams
+;; Replaced icicle-menu-items with icicle-menu-items-alist (no need for both).
+;; icicle-execute-menu-command: Set, don't bind icicle-menu-items-alist.
+;; 2005/08/23 dadams
+;; icicle-execute-menu-command: renamed alist to icicle-menu-items-alist, so can
+;; refer to it unambiguously in icicle-help-on-candidate (in icicles.el).
+;; 2005/08/19 dadams
+;; Added: icicle-convert-menu-item-function, icicle-remove-w32-keybd-accelerators,
+;; icicle-escape-w32-accel.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(unless (fboundp 'replace-regexp-in-string) (require 'subr-21 nil t))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;(@* "User Options")
+
+;;; User Options -------------------------------------------
+
+(defgroup lacarte nil
+ "Execute menu items as commands, with completion."
+ :prefix "lacarte-" :group 'menu
+ :link `(url-link :tag "Send Bug Report"
+ ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=
+lacarte.el bug: \
+&body=Describe bug here, starting with `emacs -q'. \
+Don't forget to mention your Emacs and library versions."))
+ :link '(url-link :tag "Other Libraries by Drew"
+ "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
+ :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/lacarte.el")
+ :link '(url-link :tag "Description" "http://www.emacswiki.org/cgi-bin/wiki/LaCarte")
+ :link '(emacs-commentary-link :tag "Commentary" "lacarte.el")
+ )
+
+(defcustom lacarte-convert-menu-item-function nil
+ "*Function to call to convert a menu item.
+Used by `lacarte-execute-menu-command'. A typical use would be to
+remove the `&' characters used in MS Windows menus to define keyboard
+accelerators. See `lacarte-remove-w32-keybd-accelerators'."
+ :type '(choice (const :tag "None" nil) function) :group 'lacarte)
+
+;; $$$ NOT YET IMPLEMENTED
+;; (defcustom lacarte-sort-menu-bar-order-flag nil
+;; "*Non-nil means that `lacarte-execute-menu-command' uses menu-bar order.
+;; Nil means use alphabetic order.
+;; The order is what is used for completion.
+;; Note: Using a non-nil value imposes an extra sorting operation, which
+;; slows down the creation of the completion-candidates list."
+;; :type 'boolean :group 'lacarte)
+
+;;; Internal Variables -------------------------------------
+
+(defvar lacarte-history nil "History for menu items read using La Carte completion.")
+
+;; This is used also in `icicle-help-on-candidate', which is defined in Icicles
+;; (library `icicles-mcmd.el').
+(defvar lacarte-menu-items-alist nil
+ "Alist of pairs (MENU-ITEM . COMMAND).
+The pairs are defined by the current local and global keymaps.
+MENU-ITEM is a menu item, with ancestor-menu prefixes.
+ Example: `(\"Files > Insert File...\" . insert-file)'.
+COMMAND is the command bound to the menu item.")
+
+;;; Functions -------------------------------
+
+(defun lacarte-execute-command (&optional no-commands-p)
+ "Execute a menu-bar menu command or an ordinary command.
+Type a menu item or a command name. Completion is available.
+With a prefix arg, only menu items are available.
+Completion is not case-sensitive. However, if you use Icicles, then
+you can use `C-A' in the minibuffer to toggle case-sensitivity.
+
+If you use Icicles, then you can also sort the completion candidates
+in different ways, using `C-,'. With Icicles, by default menu items
+are sorted before non-menu commands, and menu items are highlighted
+using face `icicle-special-candidate'."
+ (interactive "P")
+ (let ((lacarte-menu-items-alist (lacarte-get-overall-menu-item-alist))
+ (completion-ignore-case t) ; Not case-sensitive, by default.
+ (icicle-special-candidate-regexp (and (not no-commands-p) ".* > \\(.\\|\n\\)*"))
+ (icicle-sort-orders-alist (and (boundp 'icicle-sort-orders-alist)
+ (if no-commands-p
+ icicle-sort-orders-alist
+ (cons '("menu items first"
+ . lacarte-menu-first-p)
+ icicle-sort-orders-alist))))
+ (icicle-sort-comparer (and (boundp 'icicle-sort-comparer)
+ (if no-commands-p
+ icicle-sort-comparer
+ 'lacarte-menu-first-p)))
+ choice cmd)
+ (unless no-commands-p
+ (mapatoms (lambda (symb)
+ (when (commandp symb)
+ (push (cons (symbol-name symb) symb) lacarte-menu-items-alist)))))
+ (setq choice (completing-read (if no-commands-p "Menu command: " "Command: ")
+ lacarte-menu-items-alist nil t nil 'lacarte-history)
+ cmd (cdr (assoc choice lacarte-menu-items-alist)))
+ (unless cmd (error "No such menu command"))
+ ;; Treat special cases of `last-command-event', reconstructing it for
+ ;; menu items that get their meaning from the click itself.
+ (cond ((eq cmd 'menu-bar-select-buffer)
+ (string-match " >\\s-+\\(.+\\)\\s-+\\*?%?\\s-+\\S-*\\s-*$" choice)
+ (setq choice (substring choice (match-beginning 1) (match-end 1)))
+ (when (string-match " \\*?%?" choice)
+ (setq choice (substring choice 0 (match-beginning 0))))
+ (setq last-command-event choice))
+ ((eq cmd 'menu-bar-select-yank)
+ (string-match "Edit > Select and Paste > \\(.*\\)$" choice)
+ (setq last-command-event
+ (substring choice (match-beginning 1) (match-end 1))))
+ ((eq cmd 'menu-bar-select-frame)
+ (string-match " >\\s-[^>]+>\\s-+\\(.+\\)$" choice)
+ (setq choice (substring choice (match-beginning 1) (match-end 1)))
+ (setq last-command-event choice)))
+ (call-interactively cmd)))
+
+(defun lacarte-menu-first-p (s1 s2)
+ "Return non-nil if S1 is a menu item and S2 is not."
+ (save-match-data
+ (and (string-match " > " s1) (not (string-match " > " s2)))))
+
+(defun lacarte-execute-menu-command ()
+ "Execute a menu-bar menu command.
+Type a menu item. Completion is available.
+Completion is not case-sensitive. However, if you use Icicles, then
+you can use `C-A' in the minibuffer to toggle case-sensitivity.
+If you use Icicles, then you can also sort the completion candidates
+in different ways, using `C-,'."
+ (interactive)
+ (let* ((lacarte-menu-items-alist (lacarte-get-overall-menu-item-alist))
+ (completion-ignore-case t) ; Not case-sensitive, by default.
+ (menu-item (completing-read "Menu command: "
+ lacarte-menu-items-alist
+ nil t nil 'lacarte-history))
+ (cmd (cdr (assoc menu-item lacarte-menu-items-alist))))
+ (unless cmd (error "No such menu command"))
+ ;; Treat special cases of `last-command-event', reconstructing it for
+ ;; menu items that get their meaning from the click itself.
+ (cond ((eq cmd 'menu-bar-select-buffer)
+ (string-match " >\\s-+\\(.+\\)\\s-+\\*?%?\\s-+\\S-*\\s-*$"
+ menu-item)
+ (setq menu-item (substring menu-item (match-beginning 1) (match-end 1)))
+ (when (string-match " \\*?%?" menu-item)
+ (setq menu-item (substring menu-item 0 (match-beginning 0))))
+ (setq last-command-event menu-item))
+ ((eq cmd 'menu-bar-select-yank)
+ (string-match "Edit > Select and Paste > \\(.*\\)$" menu-item)
+ (setq last-command-event
+ (substring menu-item (match-beginning 1) (match-end 1))))
+ ((eq cmd 'menu-bar-select-frame)
+ (string-match " >\\s-[^>]+>\\s-+\\(.+\\)$" menu-item)
+ (setq menu-item (substring menu-item (match-beginning 1) (match-end 1)))
+ (setq last-command-event menu-item)))
+ (call-interactively cmd)))
+
+(defun lacarte-get-overall-menu-item-alist ()
+ "Alist formed from menu items in current active keymaps.
+See `lacarte-get-a-menu-item-alist' for the structure.
+As a side effect, this modifies `lacarte-get-a-menu-item-alist' and
+then resets it to ()"
+ (let ((alist
+ (apply #'nconc
+ (lacarte-get-a-menu-item-alist (assq 'menu-bar (current-local-map)))
+ (lacarte-get-a-menu-item-alist (assq 'menu-bar (current-global-map)))
+ (mapcar (lambda (map) (lacarte-get-a-menu-item-alist (assq 'menu-bar map)))
+ (current-minor-mode-maps)))))
+ (setq lacarte-menu-items-alist ())
+ (if nil;; `lacarte-sort-menu-bar-order-flag' ; Not yet implemented.
+ (setq alist (sort alist SOME-PREDICATE))
+ alist)))
+
+(defun lacarte-get-a-menu-item-alist (keymap)
+ "Alist of pairs (MENU-ITEM . COMMAND) defined by KEYMAP.
+KEYMAP is any keymap that has menu items.
+MENU-ITEM is a menu item, with ancestor-menu prefixes.
+ Example: `(\"Files > Insert File...\" . insert-file)'.
+COMMAND is the command bound to the menu item.
+Returns `lacarte-menu-items-alist' which it modifies."
+ (setq lacarte-menu-items-alist ())
+ (lacarte-get-a-menu-item-alist-1 keymap)
+ (setq lacarte-menu-items-alist (nreverse lacarte-menu-items-alist)))
+
+(defun lacarte-get-a-menu-item-alist-1 (keymap &optional root)
+ "Helper function for `lacarte-get-a-menu-item-alist'.
+This calls itself recursively, to process submenus.
+Returns `lacarte-menu-items-alist', which it modifies."
+ (let ((scan keymap))
+ (setq root (or root)) ; nil, for top level.
+ (while (consp scan)
+ (if (atom (car scan))
+ (setq scan (cdr scan))
+ (let ((defn (cdr (car scan)))
+ composite-name)
+ ;; Get REAL-BINDING for the menu item.
+ (cond
+ ;; (menu-item ITEM-STRING): non-selectable item - skip it.
+ ((and (eq 'menu-item (car-safe defn))
+ (null (cdr-safe (cdr-safe defn))))
+ (setq defn nil)) ; So `keymapp' test, below, fails.
+
+ ;; (ITEM-STRING): non-selectable item - skip it.
+ ((and (stringp (car-safe defn)) (null (cdr-safe defn)))
+ (setq defn nil)) ; So `keymapp' test, below, fails.
+
+ ;; (menu-item ITEM-STRING REAL-BINDING . PROPERTIES), with `:filter'
+ ((and (eq 'menu-item (car-safe defn))
+ (member :filter (cdr (cddr defn))))
+ (let ((filt (cadr (member :filter (cdr (cddr defn))))))
+ (setq composite-name
+ (concat root (and root " > ") (eval (cadr defn))
+ (let ((keys (car-safe (cdr-safe (cdr-safe (cdr-safe defn))))))
+ (and (consp keys) (stringp (cdr keys)) (cdr keys)))))
+ (setq defn (if (functionp filt) ; Apply the filter to REAL-BINDING.
+ (funcall filt (car (cddr defn)))
+ (car (cddr defn))))))
+
+ ;; (menu-item ITEM-STRING REAL-BINDING . PROPERTIES)
+ ((eq 'menu-item (car-safe defn))
+ (setq composite-name
+ (concat root (and root " > ") (eval (cadr defn))
+ (let ((keys (car-safe (cdr-safe (cdr-safe (cdr-safe defn))))))
+ (and (consp keys) (stringp (cdr keys)) (cdr keys)))))
+ (setq defn (car (cddr defn))))
+
+ ;; (ITEM-STRING . REAL-BINDING) or
+ ;; (ITEM-STRING [HELP-STRING] (KEYBD-SHORTCUTS) . REAL-BINDING)
+ ((stringp (car-safe defn))
+ (setq composite-name (concat root (and root " > ") (eval (car defn))))
+ (setq defn (cdr defn))
+ ;; Skip HELP-STRING
+ (when (stringp (car-safe defn)) (setq defn (cdr defn)))
+ ;; Skip (KEYBD-SHORTCUTS): cached key-equivalence data for menu items.
+ ;; But first add shortcuts to composite name.
+ (when (and (consp defn) (consp (car defn)))
+ (when (stringp (cdar defn)) ; Add shortcuts to name.
+ (setq composite-name (concat composite-name (cdar defn))))
+ (setq defn (cdr defn)))))
+
+ ;; If REAL-BINDING is a keymap, then recurse on it.
+ (when (keymapp defn)
+ ;; Follow indirections to ultimate symbol naming a command.
+ (while (and (symbolp defn) (fboundp defn) (keymapp (symbol-function defn)))
+ (setq defn (symbol-function defn)))
+ (if (eq 'keymap (car-safe defn))
+ (lacarte-get-a-menu-item-alist-1 (cdr defn) composite-name)
+ (lacarte-get-a-menu-item-alist-1 (symbol-function defn) composite-name)))
+
+ ;; Add menu item + command pair to `lacarte-menu-items-alist' alist.
+ ;; Don't add it if `composite-name' is nil - that's a non-selectable item.
+ (when (and root composite-name (not (keymapp defn)))
+ (setq lacarte-menu-items-alist
+ (cons
+ (cons (if (and (functionp lacarte-convert-menu-item-function)
+ (stringp composite-name)) ; Could be nil
+ (funcall lacarte-convert-menu-item-function composite-name)
+ composite-name)
+ defn)
+ lacarte-menu-items-alist))))
+ (when (consp scan) (setq scan (cdr scan)))))
+ lacarte-menu-items-alist))
+
+(defun lacarte-remove-w32-keybd-accelerators (menu-item)
+ "Remove `&' characters that define keyboard accelerators in MS Windows.
+\"&&\" is an escaped `&' - it is replaced by a single `&'.
+This is a candidate value for `lacarte-convert-menu-item-function'."
+ (replace-regexp-in-string "&&?" 'lacarte-escape-w32-accel menu-item))
+
+(defun lacarte-escape-w32-accel (match-string)
+ "If STRING is \"&&\", then return \"&\". Else return \"\"."
+ (if (> (length match-string) 1) "&" ""))
+
+;;;;;;;;;;;;;;;;;;;;;;;
+
+(provide 'lacarte)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; lacarte.el ends here
--- /dev/null
+;; -*- Emacs-Lisp -*-
+
+;;; ll-debug.el --- low level debug tools
+
+;; Copyright (C) 2002-2005 Claus Brunzema <mail@cbrunzema.de>
+
+;; http://www.cbrunzema.de/software.html#ll-debug
+
+;; Version: 2.0.0
+;; $Id: ll-debug.el,v 1.22 2004/12/28 22:23:16 chb Exp $
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; It is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; -----------------------------------------------------------------------
+
+
+;;; Commentary:
+
+;; ll-debug.el provides commands to support a low level debug style.
+;; It features quick insertion of various debug output statements and
+;; improved functions for commenting and uncommenting chunks of code.
+;;
+;; I don't use debuggers very much. I know they can be a big help in
+;; some situations and I tried some of them, but I find it almost
+;; always more direct/convenient/enlightening to put a quick 'printf'
+;; into a critical area to see what is happening than to fire up a big
+;; clumsy extra program where it takes me ages just to step through to
+;; the interesting point. In order to avoid repeated typing of
+;; 'printf("I AM HERE\n");' and similar stuff, I created
+;; `ll-debug-insert'. It inserts a statement into your
+;; sourcecode that will display a debug message. It generates
+;; unique messages on each invocation (the message consists of a big
+;; fat DEBUG together with a counter and the current filename).
+;;
+;; See variable `ll-debug-statement-alist' if you want to know which
+;; modes are currently supported by ll-debug. You can add new modes
+;; with `ll-debug-register-mode'.
+;;
+;; When I have found the buggy spot, I like to keep a version of the
+;; old code in place, just in case I mess things up.
+;; `ll-debug-copy-and-comment-region-or-line' helps here, it makes a
+;; copy of the current line (or the current region, if active) and
+;; comments out the original version.
+;;
+;; I always missed a keystroke that toggles the 'comment state' of a
+;; line (or region) of sourcecode. I need to turn a line or a block of
+;; code on and off quickly. `ll-debug-toggle-comment-region-or-line'
+;; does just that.
+;;
+;; Finally, if you want to spit out the values of a lot of variables
+;; you can use `ll-debug-insert' with a C-u prefix arg. It calls
+;; mode-specific skeletons that keep asking for variable names (and
+;; sometimes format specifiers) in the minibuffer. If you just press
+;; return here the skeleton interaction ends and a statement to print
+;; the names and the values of the variables is inserted in the
+;; buffer.
+;;
+;; If you want to get rid of the debug messages, use
+;; `ll-debug-revert'. It finds and removes the lines with the debug
+;; output statements, asking for confirmation before it removes
+;; anything.
+
+
+;; Prerequisites:
+;;
+;; I made the latest version of ll-debug with the following emacs:
+;; GNU Emacs 21.3.1
+;; Please let me know if other versions work.
+
+
+;; Installation:
+;;
+;; Get the newest version of ll-debug.el via
+;;
+;; http://www.cbrunzema.de/software.html#ll-debug
+;;
+;; and put it in your load-path. Add the following form to your init
+;; file (~/.emacs or ~/.xemacs/init.el):
+;;
+;; (require 'll-debug)
+;;
+;; Now you can bind ll-debug commands to keystrokes yourself or just
+;; call `ll-debug-install-suggested-keybindings'. It clobbers C-v,
+;; which may not be completely emacs-political-correct, but it happens
+;; to be the stuff I use daily, it is only a suggestion, blah, if you
+;; don't like it, don't use it blah blah, do it your own way blah bla
+;; blah and don't flame me....
+;; `ll-debug-install-suggested-keybindings' installs the following
+;; keybindings:
+;;
+;; C-v C-v ll-debug-toggle-comment-region-or-line
+;; C-v v ll-debug-uncomment-region-or-line
+;; C-v C-y ll-debug-copy-and-comment-region-or-line
+;; C-v C-d ll-debug-insert
+
+
+;; Usage example 1:
+;;
+;; If you use `ll-debug-install-suggested-keybindings', hitting C-v C-d
+;; in a c-mode buffer called 'main.c' produces:
+;;
+;; printf("DEBUG-1-main.c\n");
+;;
+;; a second C-v C-d prints
+;;
+;; printf("DEBUG-2-main.c\n");
+;;
+;; and so on. The following conversation uses the variable output (the
+;; part in '[' and ']' takes place in the minibuffer):
+;;
+;; C-u C-v C-d [ foo <RET> s <RET> bar <RET> d <RET> baz <RET> f <RET> <RET> ]
+;;
+;; This gives:
+;;
+;; printf("DEBUG-3-main.c foo:%s bar:%d baz:%f\n", foo, bar, baz);
+;;
+;;
+;; Usage example 2:
+;;
+;; In a lisp-mode buffer called 'tree.lisp' this:
+;;
+;; C-v C-d
+;; C-v C-d
+;; C-u C-v C-d [ foo <RET> bar <RET> baz <RET> <RET> ]
+;;
+;; produces the following lines:
+;;
+;; (CL:format t "DEBUG-1-tree.lisp~%")
+;; (CL:format t "DEBUG-2-tree.lisp~%")
+;; (CL:format t "DEBUG-3-tree.lisp foo:~S bar:~S baz:~S~%" foo bar baz)
+;;
+;;
+;; Usage example 3:
+;;
+;; The keybindings installed via
+;; `ll-debug-install-suggested-keybindings' will call an alternative
+;; versions for variable output if one ore more C-u prefix args are
+;; given. An alternative version is currently available in (c)perl-mode
+;; only. So, in a (c)perl-mode buffer called 'answer.pl' these keys
+;;
+;; C-u C-u C-v C-d [ @quux <RET> %thud <RET> $grunt <RET> <RET> ]
+;;
+;; produce:
+;;
+;; print "DEBUG-1-answer.pl ", Data::Dumper->Dump([\@quux, \%thud, $grunt], [qw/*quux *thud grunt/]), "\n";
+
+
+;; Customisation:
+;;
+;; You can use a different string for the debug messages by setting the
+;; variable `ll-debug-output-prefix'. If you set it e.g. to "# DEBUG-"
+;; your debug output won't disturb gnuplot datafiles anymore.
+;;
+;; If you don't like c++'s streams, you can request the printf style
+;; output by putting the following in your init file:
+;;
+;; (setcdr (assq 'c++-mode ll-debug-statement-alist)
+;; (cdr (assq 'c-mode ll-debug-statement-alist)))
+;;
+;;
+;; If you want to have dynamic output not only according to the major
+;; mode, you can substitute functions in `ll-debug-statement-alist'.
+;; For example, the following snippet uses prefix 'printk' instead of
+;; 'printf' if you are editing c-sources in a file on a path
+;; containing a 'linux' component:
+;;
+;; (setf (ll-debug-struct-prefix (cdr (assq 'c-mode
+;; ll-debug-statement-alist)))
+;; #'(lambda ()
+;; (if (string-match "linux" (buffer-file-name))
+;; "printk("
+;; "printf(")))
+;;
+;;
+;;
+;; Please read the documentation for `ll-debug-insert' and
+;; `ll-debug-expand' to see what is possible.
+;;
+;;
+;; If you want to teach ll-debug new modes, see
+;; `ll-debug-register-mode' and consider sending a patch to
+;; <mail@cbrunzema.de>.
+
+
+;; History:
+;; 2004-12-28 Claus Brunzema
+;; * Major rewrite using defstruct.
+;; * New ll-debug-insert instead of
+;; ll-debug-insert-debug-output and
+;; ll-debug-insert-variable-output.
+;; * New ll-debug-register-mode.
+;; * Version 2.0.0
+;; 2003-05-21 Claus Brunzema
+;; * Added java support.
+;; * Moved prefix calculation stuff into new
+;; ll-debug-insert-debug-output-statement.
+;; * Some cleanup.
+;; * Version 1.3.0
+;; 2003-05-15 Claus Brunzema
+;; * Added ll-debug-install-suggested-keybindings.
+;; 2003-03-10 Claus Brunzema
+;; * Added package/namespace identifiers to common lisp/c++ code
+;; * Version 1.2.6
+;; 2003-03-10 Claus Brunzema
+;; * Put in ll-debug-output-prefix instead of the hardcoded
+;; default (thanks to Stefan Kamphausen for the idea with
+;; gnuplot).
+;; * More documentation.
+;; * Version 1.2.5
+;; 2003-01-30 Claus Brunzema
+;; * added ll-debug-insert-emacs-lisp-variable-output.
+;; * ll-debug-insert-perl-variable-output doesn't insert
+;; the '$' automatically anymore. That always confused me.
+;; * various cleanup and documentation changes.
+;; * Version 1.2.3
+;; 2003-01-29 Claus Brunzema
+;; * added ll-debug-insert-perl-variable-dumper-output.
+;; 2003-01-28 Claus Brunzema
+;; * after (un)commenting a single line the point is moved
+;; to the next line.
+;; 2002-11-20 Claus Brunzema
+;; * added ll-debug-insert-scheme-variable-output.
+;; * Version 1.2.0
+;; 2002-11-11 Claus Brunzema
+;; * added ll-debug-create-next-debug-string (thanks to Scott Frazer).
+;; * updated skeletons to use ll-debug-create-next-debug-string.
+;; * Version 1.1.0
+;; 2002-11-09 Claus Brunzema
+;; * added DEBUG to skeletons.
+;; * added ll-debug-revert (thanks to Scott Frazer for the idea).
+;; * removed automatic linebreaks from skeletons, so ll-debug-revert
+;; doesn't leave half statemets behind.
+;; 2002-10-15 Claus Brunzema
+;; * fixed ll-debug-region-or-line-comment-start to look
+;; for comment-chars starting a line only (thanks to Stefan
+;; Kamphausen for the bug report).
+;; * Code cleanup.
+;; * Version 1.0.0
+;; 2002-09-04 Claus Brunzema
+;; * fixed point position after
+;; ll-debug-copy-and-comment-region-or-line
+;; * Version 0.2.2
+;; 2002-08-17 Claus Brunzema
+;; * use (search-forward comment-start ...) instead of
+;; (re-search-forward comment-start-skip ...).
+;; * use ll-debug-region-or-line-comment-start instead of
+;; the optional ignore-current-column argument for
+;; ll-debug-region-or-line-start.
+;; * ll-debug-copy-and-comment-region-or-line works correctly
+;; now if point is in the middle of the line.
+;; * Version 0.2.1
+;; 2002-08-11 Claus Brunzema
+;; * Variable output support for Common Lisp, perl and c.
+;; * Various cleanup.
+;; * Version 0.2.0
+;; 2002-08-08 Claus Brunzema
+;; * Uncommenting doesn't check the current column anymore
+;; (thanks to Stefan Kamphausen).
+;; * More blurb.
+;; * Version 0.1.1
+;; 2002-08-07 Claus Brunzema
+;; * First public version 0.1.0
+
+
+;; ToDo:
+;; * Check if the strange log calculation in ll-debug-insert is really
+;; necessary. I want the number of C-u keypresses to dispatch
+;; alternatives on the content slot value of a ll-debug-struct, but
+;; every C-u multiplies prefix-numeric-value by 4. Is there a better
+;; way to do this?
+;; * Make preferred output stream customizable.
+
+
+;;; Code:
+
+(require 'skeleton)
+(require 'cl)
+
+;; Struct------------------------------------------------------------------
+(defstruct ll-debug-struct
+ "Strings/functions/skeletons to create debug messages for a single mode.
+See `ll-debug-statement-alist' and `ll-debug-expand', too."
+ (prefix "")
+ (postfix "")
+ (content '() :type list))
+
+
+;; Variables --------------------------------------------------------------
+(defvar ll-debug-output-prefix "DEBUG-"
+ "*Prefix string for debug output messages.")
+
+(defvar ll-debug-statement-alist ()
+ "Stores mode-specific ll-debug-structs.")
+
+
+;;; gnuemacs / xemacs compatibility ---------------------------------------
+(defun ll-debug-region-exists-p ()
+ (if (fboundp 'region-exists-p)
+ (region-exists-p) ;XEmacs
+ (and transient-mark-mode mark-active))) ;GNUEmacs
+
+(defun ll-debug-uncomment-region (beg end)
+ (if (fboundp 'uncomment-region)
+ (uncomment-region beg end) ;GNUEmacs
+ (comment-region beg end -1))) ;XEmacs
+
+
+;;; misc. Functions -------------------------------------------------------
+(defun ll-debug-region-or-line-start ()
+ (save-excursion
+ (if (ll-debug-region-exists-p)
+ (progn
+ (goto-char (region-beginning))
+ (point-at-bol))
+ (if (= (current-column) (current-indentation))
+ (point)
+ (point-at-bol)))))
+
+(defun ll-debug-region-or-line-end ()
+ (save-excursion
+ (if (ll-debug-region-exists-p)
+ (progn
+ (goto-char (region-end))
+ (unless (bolp)
+ (forward-line))
+ (point))
+ (progn
+ (forward-line)
+ (point)))))
+
+(defun ll-debug-install-suggested-keybindings ()
+ "Install suggested keybindings for ll-debug.
+This installs the following keybindings (clobbering C-v):
+
+C-v C-v ll-debug-toggle-comment-region-or-line
+C-v v ll-debug-uncomment-region-or-line
+C-v C-y ll-debug-copy-and-comment-region-or-line
+C-v C-d ll-debug-insert"
+ (interactive)
+ (unless (keymapp (global-key-binding '[(control v)]))
+ (global-unset-key '[(control v)]))
+
+ (define-key global-map '[(control v) (control v)]
+ #'ll-debug-toggle-comment-region-or-line)
+ (define-key global-map '[(control v) v]
+ #'ll-debug-uncomment-region-or-line)
+ (define-key global-map '[(control v) (control y)]
+ #'ll-debug-copy-and-comment-region-or-line)
+ (define-key global-map '[(control v) (control d)]
+ #'ll-debug-insert))
+
+
+(defun ll-debug-expand (thing)
+ "Expands THING into the current buffer.
+If THING is a string, it is inserted.
+If THING is a list, it is treated as a skeleton (see `skeleton-insert')
+If THING is a function, it is funcalled and `ll-debug-expand' is
+invoked recursively on the returned value."
+ (when thing
+ (etypecase thing
+ (string
+ (insert thing))
+ (list
+ (skeleton-insert thing))
+ (function
+ (ll-debug-expand
+ (funcall thing))))))
+
+
+;; comment in and out -----------------------------------------------------
+(defun ll-debug-region-or-line-comment-start ()
+ "Find the comment marker at the beginning of the line or region."
+ (save-excursion
+ (when (ll-debug-region-exists-p) (goto-char (region-beginning)))
+ (beginning-of-line)
+ (skip-chars-forward " \t" (point-at-eol))
+ (if (looking-at (regexp-quote comment-start))
+ (point)
+ nil)))
+
+(defun ll-debug-copy-and-comment-region-or-line ()
+ "Copy the current line/region and comment out the original."
+ (interactive)
+ (let* ((start (ll-debug-region-or-line-start))
+ (end (ll-debug-region-or-line-end))
+ (src-code (buffer-substring start end)))
+ (goto-char end)
+ (comment-region start end)
+ (save-excursion
+ (insert-string src-code))))
+
+(defun ll-debug-comment-region-or-line ()
+ "Comment out the current line or all lines of the region."
+ (interactive)
+ (comment-region (ll-debug-region-or-line-start)
+ (ll-debug-region-or-line-end))
+ (unless (ll-debug-region-exists-p)
+ (forward-line)))
+
+(defun ll-debug-uncomment-region-or-line ()
+ "Uncomment the current line or all lines of the region."
+ (interactive)
+ (ll-debug-uncomment-region (ll-debug-region-or-line-comment-start)
+ (ll-debug-region-or-line-end))
+ (unless (ll-debug-region-exists-p)
+ (forward-line)))
+
+(defun ll-debug-toggle-comment-region-or-line ()
+ "Toggle the current line/region between uncommented and commented state."
+ (interactive)
+ (if (ll-debug-region-or-line-comment-start)
+ (ll-debug-uncomment-region-or-line)
+ (ll-debug-comment-region-or-line)))
+
+
+;; debug output statements ------------------------------------------------
+(defun ll-debug-before-text-p ()
+ "Return t iff point is at bol or in leading whitespace."
+ (save-excursion
+ (skip-chars-backward " \t" (point-at-bol))
+ (bolp)))
+
+(defun ll-debug-after-text-p ()
+ "Return t iff point is at eol or in trailing whitespace."
+ (save-excursion
+ (skip-chars-forward " \t" (point-at-eol))
+ (eolp)))
+
+(defun ll-debug-open-fresh-line ()
+ "Make room for a debug output statement."
+ (cond
+ ((ll-debug-before-text-p)
+ (open-line 1))
+ ((ll-debug-after-text-p)
+ (open-line 1)
+ (forward-line))
+ (t
+ (open-line 2)
+ (forward-line)))
+ (indent-according-to-mode))
+
+(defun ll-debug-register-mode (modes prefix postfix skel1 &rest skels)
+ "Register mode info in `ll-debug-statement-alist'.
+MODES can be a single symbol denoting a mode or a list of mode
+symbols. If it is a list, the following info is registered in every
+listed mode. PREFIX is the prefix thing for debug statements, POSTFIX
+is the postfix thing. SKEL1 and all following SKELS are the content
+things. For more information about these, see the documentation of
+`ll-debug-insert'. If an entry for a given mode already exists in
+`ll-debug-statement-alist', it will be overwritten."
+ (unless (listp modes)
+ (setq modes (list modes)))
+ (push skel1 skels)
+ (dolist (mode modes)
+ (setq ll-debug-statement-alist
+ (cons (cons mode (make-ll-debug-struct :prefix prefix
+ :postfix postfix
+ :content skels))
+ (assq-delete-all mode ll-debug-statement-alist)))))
+
+(defun ll-debug-create-next-debug-string ()
+ "Create the next unique debug string."
+ (let ((max-used 0))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat (regexp-quote ll-debug-output-prefix)
+ "\\([0-9]+\\)-")
+ nil t)
+ (setq max-used (max max-used
+ (string-to-number (match-string 1))))))
+ (format "%s%d-%s"
+ ll-debug-output-prefix
+ (+ 1 max-used)
+ (if (buffer-file-name)
+ (file-name-nondirectory (buffer-file-name))
+ "nofile"))))
+
+(defun ll-debug-insert (arg)
+ "Insert a line of debug output at point according to mode.
+Looks up the current mode in `ll-debug-statement-alist'. The prefix
+thing of the coressponding ll-debug-struct gets inserted by
+`ll-debug-insert'. The number of times C-u was pressed (prefix arg)
+determines the entry from the content list of the ll-debug-struct that
+gets inserted next. Finally the postfix thing from the ll-debug-struct
+is inserted into the current buffer.
+"
+ (interactive "P")
+ (when (listp arg)
+ (if (null arg)
+ (setq arg 0)
+ (setq arg (floor (/ (log (car arg))
+ (log 4))))))
+ (let ((mode-data (cdr (assoc major-mode ll-debug-statement-alist))))
+ (cond
+ ((null mode-data)
+ (message "%s not supported by ll-debug-insert yet." major-mode))
+ ((>= arg (length (ll-debug-struct-content mode-data)))
+ (message "Only %d flavours of debug output defined for %s."
+ (length (ll-debug-struct-content mode-data))
+ major-mode))
+ (t
+ (ll-debug-open-fresh-line)
+ (ll-debug-expand (ll-debug-struct-prefix mode-data))
+ (ll-debug-expand (elt (ll-debug-struct-content mode-data) arg))
+ (ll-debug-expand (ll-debug-struct-postfix mode-data))
+ (indent-according-to-mode)
+ (forward-line)
+ (indent-according-to-mode)))))
+
+(defun ll-debug-revert ()
+ "Deletes (with confirmation) lines containing the regexp 'DEBUG-[0-9]+-'.
+Uses `query-replace-regexp' internally."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (query-replace-regexp (concat "^.*"
+ (regexp-quote ll-debug-output-prefix)
+ "[0-9]+-.*\n")
+ "")))
+
+
+;; register modes ---------------------------------------------------------
+(ll-debug-register-mode 'scheme-mode
+ "(begin " "(newline))"
+ '(nil "(display \""
+ (ll-debug-create-next-debug-string) "\")")
+ '(nil "(display \""
+ (ll-debug-create-next-debug-string) "\")"
+ ("Variable name: "
+ "(display \" " str ":\")(display " str ")")))
+
+(ll-debug-register-mode 'lisp-mode
+ "(CL:format t " ")"
+ '(nil "\"" (ll-debug-create-next-debug-string) "~%\"")
+ '(nil "\"" (ll-debug-create-next-debug-string)
+ ("Variable name: "
+ " " str ":~S"
+ '(progn (setq v1 (concat v1 " " str)) nil)
+ )
+ "~%\" " v1))
+
+
+(ll-debug-register-mode '(emacs-lisp-mode lisp-interaction-mode)
+ "(message " ")"
+ '(nil "\"" (ll-debug-create-next-debug-string) "\"")
+ '(nil "\"" (ll-debug-create-next-debug-string)
+ ("Variable name: "
+ " " str ":%S"
+ '(progn (setq v1 (concat v1 " " str)) nil))
+ "\" " v1))
+
+(ll-debug-register-mode '(perl-mode cperl-mode)
+ "print " ";"
+ '(nil "\"" (ll-debug-create-next-debug-string) "\\n\"")
+ '(nil "\"" (ll-debug-create-next-debug-string)
+ ("Variable: "
+ " \\" str ":" str)
+ "\\n\"")
+ '(nil "\"" (ll-debug-create-next-debug-string)
+ " \", Data::Dumper->Dump(["
+ ("Variable: "
+ str
+ '(progn
+ (if (string= "$" (substring str 0 1))
+ (setq v1 (concat v1 " "
+ (substring str 1)))
+ (progn
+ (backward-word 1)
+ (backward-char 1)
+ (insert "\\")
+ (forward-char 1)
+ (forward-word 1)
+ (setq v1 (concat v1
+ " *"
+ (substring str 1)))))
+ nil)
+ ", ")
+ "], [qw/" v1 "/]), \"\\n\""))
+
+(ll-debug-register-mode 'c++-mode
+ "std::cout << " " << std::endl;"
+ '(nil "\"" (ll-debug-create-next-debug-string) "\"")
+ '(nil "\"" (ll-debug-create-next-debug-string) "\""
+ ("Variable name: "
+ " << \" " str ":\" << " str)))
+
+(ll-debug-register-mode 'c-mode
+ "printf(" ");"
+ '(nil "\"" (ll-debug-create-next-debug-string) "\\n\"")
+ '(nil "\"" (ll-debug-create-next-debug-string)
+ ("Variable name: "
+ " " str ":%"
+ '(progn
+ (if v1
+ (setq v1 (concat v1 ", " str))
+ (setq v1 str))
+ nil)
+ (read-string "Format: "))
+ "\\n\", " v1))
+
+(ll-debug-register-mode '(java-mode jde-mode)
+ "System.out.println(" ");"
+ '(nil "\"" (ll-debug-create-next-debug-string) "\"")
+ '(nil "\"" (ll-debug-create-next-debug-string) "\""
+ ("Variable name: "
+ "+\" " str ":\"+" str)))
+
+(ll-debug-register-mode 'ruby-mode
+ "puts " ""
+ '(nil "\"" (ll-debug-create-next-debug-string) "\""))
+
+(ll-debug-register-mode 'sh-mode
+ "echo " ""
+ '(nil (ll-debug-create-next-debug-string)))
+
+(ll-debug-register-mode '(octave-mode matlab-mode)
+ "disp(" ");"
+ '(nil "'" (ll-debug-create-next-debug-string) "'"))
+
+(provide 'll-debug)
+
+;;; ll-debug.el ends here
--- /dev/null
+; malyon.el --- mode to execute z code files version 3, 5, 8
+
+;; Copyright (C) 1999-2009 Peter Ilberg
+
+;; Maintainer: Peter Ilberg <peter.ilberg@gmail.com>
+
+;; Credits:
+;; The author would like to thank the following people for reporting
+;; bugs, testing, suggesting and/or contributing improvements:
+;; Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko
+
+;;; Commentary:
+
+;; This package provides a basic interpreter for version 3, 5, 8 z code
+;; story files as generated by Inform (C) Graham Nelson and Infocom.
+
+;; If you encounter a bug please send a report to Peter Ilberg at
+;; peter.ilberg@gmail.com. Thank you!
+
+;; To play a story file simple type M-x malyon and enter the path to the
+;; story file. If anything goes wrong and you want to manually clean
+;; up type M-x malyon-quit. In addition, you can switch back to a game in
+;; progress by typing M-x malyon-restore.
+
+;; A note on the format of saved game states:
+
+;; As of version 1.0, Malyon supports the quetzal file format for saved
+;; games. Support for this format required changes to several internal
+;; data structures (stack frames and catch-throw) that are incompatible
+;; with the old implementation. Unfortunately, the old file format for
+;; saved games cannot be converted into quetzal.
+
+;; For backwards compatibility, however, Malyon still supports the old
+;; file format. And you can continue to play your old game states.
+
+;; Because of the incompatibility of the two file formats, Malyon now
+;; runs, as follows, in either of two modes: quetzal and compatibility.
+
+;; - in quetzal mode, game states are saved in quetzal format
+;; - in compatibility mode, games states are saved in the old format
+;; - loading a game state in quetzal format switches to quetzal mode
+;; - loading an old game state switches to compatibility mode
+;; - quetzal mode is the default setting
+
+;; In other words, Malyon will only use the old file format if you've
+;; restored a game state saved in the old file format.
+
+;; Enjoy!
+
+;;; Code:
+
+;; global variables - moved here to appease the byte-code compiler
+
+;; story file information
+
+(defvar malyon-story-file-name nil
+ "The name of the story file being executed.")
+
+(defvar malyon-story-file nil
+ "The story file which is currently being run.")
+
+(defvar malyon-story-version nil
+ "The story file version.")
+
+(defvar malyon-supported-versions '(3 5 8)
+ "A list of supported story file versions.")
+
+;; status and transcript buffers
+
+(defvar malyon-transcript-buffer nil
+ "The main transcript buffer of the story file execution.")
+
+(defvar malyon-transcript-buffer-buffered nil
+ "Is output in the transcript buffer buffered?")
+
+(defvar malyon-status-buffer nil
+ "The status bar buffer of the story file execution.")
+
+(defvar malyon-status-buffer-lines nil
+ "The number of lines in the status bar buffer.")
+
+(defvar malyon-status-buffer-delayed-split nil
+ "If the number of lines in the status buffer is reduced,
+the window configuration is not changed immediately. It
+is changed after the next turn (read or read_char).")
+
+(defvar malyon-status-buffer-point nil
+ "The point location in the status bar buffer.")
+
+(defvar malyon-max-column 72
+ "Maximum column for text display.")
+
+;; window management
+
+(defvar malyon-window-configuration nil
+ "The current window configuration of the malyon interpreter.")
+
+(defvar malyon-current-window nil
+ "The currently active window for text output.")
+
+;; z machine registers
+
+(defvar malyon-stack nil
+ "The stack of the z machine.")
+
+(defvar malyon-stack-pointer nil
+ "The stack pointer of the z machine.")
+
+(defvar malyon-frame-pointer nil
+ "The frame pointer of the z machine.")
+
+(defvar malyon-instruction-pointer nil
+ "The instruction pointer of the z machine.")
+
+;; game file related global variables
+
+(defvar malyon-score-game nil
+ "A flag indicating whether this story uses score or time.")
+
+(defvar malyon-packed-multiplier nil
+ "The amount by which packed addresses are multiplied to get byte
+addresses.")
+
+(defvar malyon-global-variables nil
+ "A pointer to the global variable section in the story file.")
+
+(defvar malyon-abbreviations nil
+ "A pointer to the abbreviations in the story file.")
+
+(defvar malyon-alphabet nil
+ "The z machine's text alphabet.")
+
+(defvar malyon-whitespace nil
+ "A string of whitespace characters recognized by the interpreter.")
+
+;; object tables
+
+(defvar malyon-object-table nil
+ "A pointer to the object table in the story file.")
+
+(defvar malyon-object-table-entry-size nil
+ "The size of one entry in the object table.")
+
+(defvar malyon-object-properties nil
+ "The number of properties per object minus one.")
+
+(defvar malyon-object-property-offset nil
+ "The byte offset of the properties table in the object.")
+
+;; dictionaries
+
+(defvar malyon-dictionary nil
+ "A pointer to the dictionary of the story file.")
+
+(defvar malyon-dictionary-entry-length nil
+ "The length of a dictionary entry.")
+
+(defvar malyon-dictionary-num-entries nil
+ "The number of dictionary entries.")
+
+(defvar malyon-dictionary-entries nil
+ "A pointer to the first dictionary entry.")
+
+(defvar malyon-dictionary-word-length nil
+ "The length of a dictionary word.")
+
+;; game state information
+
+(defvar malyon-game-state-restart nil
+ "The machine state for implementing restart.")
+
+(defvar malyon-game-state-undo nil
+ "The machine state for implementing undo.")
+
+(defvar malyon-game-state-quetzal t
+ "Store game state information for quetzal.")
+
+;; various
+
+(defvar malyon-current-face nil
+ "The current face in which to display text.")
+
+(defvar malyon-last-cursor-position-after-input nil
+ "The last cursor position after reading input from the keyboard.")
+
+;; interactive functions
+
+(defun malyon (file-name)
+ "Major mode for playing z3/5/8 story files.
+This mode allows execution of version 3, 5, 8 z code story files."
+ (interactive "fStory file name: ")
+ (if malyon-story-file
+ (message "You are already playing a game.")
+ (if (not (string-match ".*\.z[358]$" file-name))
+ (message "%s is not a version 3, 5, or 8 story file." file-name)
+ (condition-case nil
+ (malyon-load-story-file file-name)
+ (error
+ (malyon-fatal-error "loading of story file failed.")))
+ (setq malyon-story-version (aref malyon-story-file 0))
+ (cond ((memq malyon-story-version malyon-supported-versions)
+ (condition-case nil
+ (malyon-initialize)
+ (error
+ (malyon-fatal-error "initialization of interpreter failed.")))
+ (malyon-interpreter))
+ (t
+ (message "%s is not a version 3, 5, or 8 story file." file-name)
+ (malyon-cleanup))))))
+
+(defun malyon-restore ()
+ "Restore the save window configuration for the interpreter."
+ (interactive)
+ (condition-case nil
+ (progn
+ (malyon-restore-window-configuration)
+ (malyon-adjust-transcript))
+ (error
+ (malyon-fatal-error "restoring window configuration failed."))))
+
+(defun malyon-quit ()
+ "Exit the malyon interpreter."
+ (interactive)
+ (if malyon-story-file
+ (progn
+ (malyon-restore)
+ (if (malyon-yes-or-no-p-minibuf "Do you really want to quit? ")
+ (malyon-cleanup)))))
+
+(defun malyon-mode ()
+ "This mode provides a basic interpreter for version 3, 5, 8 z code
+story files as generated by Inform (C) Graham Nelson and Infocom.
+
+Note that this package is by no means complete and bug free.
+If you encounter a bug please send a report to Peter Ilberg at
+peter.ilberg@natinst.com. Thank you!
+
+To play a story file simple type M-x malyon and enter the path to the
+story file. If anything goes wrong and you want to manually clean
+up type M-x malyon-quit. In addition, you can switch back to a game in
+progress by typing M-x malyon-restore.
+
+The author would like to thank the following people for reporting
+bugs, testing, suggesting and/or contributing improvements:
+ Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko"
+ (message "Use M-x malyon if you want to play a zcode game."))
+
+;; compatibility functions for GNU emacs
+
+(if (fboundp 'cadr)
+ (defalias 'malyon-cadr 'cadr)
+ (defun malyon-cadr (list)
+ "Take the cadr of the list."
+ (car (cdr list))))
+
+(if (fboundp 'caddr)
+ (defalias 'malyon-caddr 'caddr)
+ (defun malyon-caddr (list)
+ "Take the caddr of the list."
+ (car (cdr (cdr list)))))
+
+(if (fboundp 'cdddr)
+ (defalias 'malyon-cdddr 'cdddr)
+ (defun malyon-cdddr (list)
+ "Take the cdddr of the list."
+ (cdr (cdr (cdr list)))))
+
+(if (fboundp 'char-before)
+ (defalias 'malyon-char-before 'char-before)
+ (defun malyon-char-before ()
+ "Return the character before the point."
+ (char-after (- (point) 1))))
+
+(if (fboundp 'char-to-int)
+ (defalias 'malyon-char-to-int 'char-to-int)
+ (defun malyon-char-to-int (c)
+ "Convert a character into an integer."
+ c))
+
+(if (fboundp 'characterp)
+ (defalias 'malyon-characterp 'characterp)
+ (defun malyon-characterp (x)
+ "Test for a character."
+ (and (numberp x) (<= 0 x) (< x 256))))
+
+(defun malyon-disable-multibyte ()
+ "Disable multibyte support in the current buffer."
+ (condition-case nil (set-buffer-multibyte nil) (error)))
+
+(defun malyon-erase-buffer (&optional buffer)
+ "Erase the given buffer."
+ (save-excursion
+ (if buffer (set-buffer buffer))
+ (if (and buffer (eq buffer malyon-transcript-buffer))
+ (malyon-begin-section)
+ (erase-buffer))))
+
+(if (fboundp 'int-to-char)
+ (defalias 'malyon-int-to-char 'int-to-char)
+ (defun malyon-int-to-char (i)
+ "Convert an integer into a character."
+ i))
+
+(if (fboundp 'mapc)
+ (defalias 'malyon-mapc 'mapc)
+ (defun malyon-mapc (function list)
+ "Apply fun to every element of args ignoring the results."
+ (if (null list)
+ '()
+ (funcall function (car list))
+ (malyon-mapc function (cdr list)))))
+
+(if (fboundp 'mapcan)
+ (defalias 'malyon-mapcan 'mapcan)
+ (defun malyon-mapcan (function list)
+ "Apply fun to every element of args nconc'ing the result."
+ (if (null list)
+ '()
+ (nconc (funcall function (car list))
+ (malyon-mapcan function (cdr list))))))
+
+; Do not use the built-in conversion via 'multibyte-char-to-unibyte.
+(defun malyon-multibyte-char-to-unibyte (char)
+ "Convert a multibyte character to unibyte."
+ char)
+
+(defun malyon-point-max (&optional buffer)
+ "Get the point-max of the given buffer."
+ (save-excursion
+ (if buffer (set-buffer buffer))
+ (point-max)))
+
+(if (fboundp 'redisplay-frame)
+ (defalias 'malyon-redisplay-frame 'redisplay-frame)
+ (defun malyon-redisplay-frame (frame &rest ignore)
+ "Redisplay the given frame."))
+
+(if (fboundp 'remove)
+ (defalias 'malyon-remove 'remove)
+ (defun malyon-remove (element list)
+ "Remove the element from the list."
+ (cond ((null list)
+ '())
+ ((eq element (car list))
+ (malyon-remove element (cdr list)))
+ ((equal element (car list))
+ (malyon-remove element (cdr list)))
+ (t
+ (cons (car list)
+ (malyon-remove element (cdr list)))))))
+
+(if (fboundp 'set-keymap-name)
+ (defalias 'malyon-set-keymap-name 'set-keymap-name)
+ (defun malyon-set-keymap-name (keymap name)
+ "Set the name of the keymap."))
+
+(if (fboundp 'string-to-list)
+ (defalias 'malyon-string-to-list 'string-to-list)
+ (defun malyon-string-to-list (s)
+ "Convert a string into a list of characters."
+ (let ((i (- (length s) 1)) (l '()))
+ (while (<= 0 i)
+ (setq l (cons (aref s i) l)
+ i (- i 1)))
+ l)))
+
+(if (fboundp 'string-to-vector)
+ (defalias 'malyon-string-to-vector 'string-to-vector)
+ (defun malyon-string-to-vector (s)
+ "Convert a string into a vector of characters."
+ (let* ((i 0) (l (length s)) (v (make-vector l 0)))
+ (while (< i l)
+ (aset v i (aref s i))
+ (setq i (+ 1 i)))
+ v)))
+
+; Do not use the built-in conversion via 'unibyte-char-to-multibyte.
+(defun malyon-unibyte-char-to-multibyte (char)
+ "Convert a unibyte character to multibyte."
+ char)
+
+(defun malyon-vector-to-list (v begin end)
+ "Return a list of elements in v in the range [begin, end)."
+ (let ((result '()))
+ (while (< begin end)
+ (setq result (cons (aref v begin) result))
+ (setq begin (+ 1 begin)))
+ (reverse result)))
+
+(if (fboundp 'window-displayed-height)
+ (defalias 'malyon-window-displayed-height 'window-displayed-height)
+ (defun malyon-window-displayed-height (&optional window)
+ "Get the height of the window's displayed region."
+ (- (window-height) 1)))
+
+(if (fboundp 'yes-or-no-p-minibuf)
+ (defalias 'malyon-yes-or-no-p-minibuf 'yes-or-no-p-minibuf)
+ (defun malyon-yes-or-no-p-minibuf (prompt)
+ "Ask a yes or no question."
+ (yes-or-no-p prompt)))
+
+;; global variables for the malyon mode
+
+(defvar malyon-syntax-table nil
+ "Syntax table used while in malyon mode (same as in text-mode).")
+
+(if malyon-syntax-table
+ '()
+ (setq malyon-syntax-table (make-syntax-table))
+ (modify-syntax-entry ?\" ". " malyon-syntax-table)
+ (modify-syntax-entry ?\\ ". " malyon-syntax-table)
+ (modify-syntax-entry ?' "w " malyon-syntax-table))
+
+(defvar malyon-keymap-read nil
+ "Keymap for malyon mode for reading input into a buffer.")
+
+(defvar malyon-history-saved-up nil
+ "The saved binding for the up arrow key.")
+
+(defvar malyon-history-saved-down nil
+ "The saved binding for the down arrow key.")
+
+(if malyon-keymap-read
+ '()
+ (setq malyon-keymap-read (make-sparse-keymap))
+ (malyon-set-keymap-name malyon-keymap-read 'malyon-keymap-read)
+ (setq malyon-history-saved-up (global-key-binding [up]))
+ (setq malyon-history-saved-down (global-key-binding [down]))
+ (define-key malyon-keymap-read "\r" 'malyon-end-input)
+ (define-key malyon-keymap-read [up] 'malyon-history-previous-char)
+ (define-key malyon-keymap-read [down] 'malyon-history-next-char)
+ (define-key malyon-keymap-read "\M-p" 'malyon-history-previous-char)
+ (define-key malyon-keymap-read "\M-n" 'malyon-history-next-char)
+ (define-key malyon-keymap-read "\C-a" 'malyon-beginning-of-line)
+ (define-key malyon-keymap-read "\C-w" 'malyon-kill-region)
+ (define-key malyon-keymap-read "\C-k" 'malyon-kill-line)
+ (define-key malyon-keymap-read "\M-d" 'malyon-kill-word)
+ (define-key malyon-keymap-read "\C-y" 'malyon-yank)
+ (define-key malyon-keymap-read "\M-y" 'malyon-yank-pop)
+ (define-key malyon-keymap-read "\C-d" 'malyon-delete-char)
+ (define-key malyon-keymap-read "\d" 'malyon-backward-delete-char)
+ (define-key malyon-keymap-read [del] 'malyon-delete-char)
+ (define-key malyon-keymap-read [backspace] 'malyon-backward-delete-char)
+ (substitute-key-definition (lookup-key (current-global-map) "a")
+ 'malyon-self-insert-command
+ malyon-keymap-read (current-global-map)))
+
+(defvar malyon-keymap-readchar nil
+ "Keymap for malyon mode for waiting for input.")
+
+(if malyon-keymap-readchar
+ '()
+ (setq malyon-keymap-readchar (make-sparse-keymap))
+ (malyon-set-keymap-name malyon-keymap-readchar 'malyon-keymap-readchar)
+ (define-key malyon-keymap-readchar "\r" 'malyon-wait-char)
+ (substitute-key-definition (lookup-key (current-global-map) "a")
+ 'malyon-wait-char
+ malyon-keymap-readchar (current-global-map)))
+
+(defvar malyon-keymap-more nil
+ "Keymap for malyon mode for browsing through text.")
+
+(if malyon-keymap-more
+ '()
+ (setq malyon-keymap-more (make-sparse-keymap))
+ (malyon-set-keymap-name malyon-keymap-more 'malyon-keymap-more)
+ (define-key malyon-keymap-more "\r" 'malyon-more-char)
+ (substitute-key-definition (lookup-key (current-global-map) "a")
+ 'malyon-more-char
+ malyon-keymap-more (current-global-map)))
+
+(defvar malyon-keymap-more-status nil
+ "Keymap for malyon mode for browsing through the status buffer.")
+
+(if malyon-keymap-more-status
+ '()
+ (setq malyon-keymap-more-status (make-sparse-keymap))
+ (malyon-set-keymap-name malyon-keymap-more-status 'malyon-keymap-more-status)
+ (define-key malyon-keymap-more-status "\r" 'malyon-more-char-status)
+ (substitute-key-definition (lookup-key (current-global-map) "a")
+ 'malyon-more-char-status
+ malyon-keymap-more-status (current-global-map)))
+
+(defvar malyon-faces nil
+ "An association list of text faces used by the malyon mode.")
+
+(defun malyon-initialize-faces ()
+ (copy-face 'default 'malyon-face-plain)
+ (copy-face 'bold 'malyon-face-reverse)
+ (copy-face 'bold 'malyon-face-bold)
+ (copy-face 'italic 'malyon-face-italic)
+ (copy-face 'default 'malyon-face-error)
+ (set-face-foreground 'malyon-face-error "red")
+ (setq malyon-faces '((0 . malyon-face-plain)
+ (1 . malyon-face-reverse)
+ (2 . malyon-face-bold)
+ (4 . malyon-face-italic)
+ (8 . malyon-face-plain))))
+
+(defvar malyon-print-separator nil
+ "A flag indicating whether to print the * * * separator.")
+
+(defun malyon-begin-section ()
+ "Print a section divider and begin a new section."
+ (if malyon-print-separator
+ (progn
+ (malyon-mapc 'malyon-putchar-transcript '(?\n ?\n ?* ? ?* ? ?*))
+ (center-line)
+ (malyon-mapc 'malyon-putchar-transcript '(?\n ?\n))
+ (setq malyon-print-separator nil)))
+ (narrow-to-region (point-max) (point-max)))
+
+(if malyon-whitespace
+ '()
+ (setq malyon-whitespace (list (malyon-char-to-int ? )
+ (malyon-char-to-int ?\t)
+ (malyon-char-to-int ?\n)
+ (malyon-char-to-int ?\r))))
+
+;; memory utilities
+
+(defsubst malyon-read-byte (address)
+ "Read a byte at address in the story file."
+ (if (<= 0 address)
+ (aref malyon-story-file address)
+ (aref malyon-story-file (+ 65536 address))))
+
+(defsubst malyon-store-byte (address value)
+ "Store a byte at address in the story file."
+ (if (<= 0 address)
+ (aset malyon-story-file address (logand 255 value))
+ (aset malyon-story-file (+ 65536 address) (logand 255 value))))
+
+(defsubst malyon-read-word (address)
+ "Read a word at address in the story file."
+ (if (<= 0 address)
+ (logior (lsh (aref malyon-story-file address) 8)
+ (aref malyon-story-file (+ 1 address)))
+ (logior (lsh (aref malyon-story-file (+ 65536 address)) 8)
+ (aref malyon-story-file (+ 65537 address)))))
+
+(defsubst malyon-store-word (address value)
+ "Store a word at address in the story file."
+ (if (<= 0 address)
+ (progn
+ (aset malyon-story-file address (logand 255 (lsh value -8)))
+ (aset malyon-story-file (+ 1 address) (logand 255 value)))
+ (aset malyon-story-file (+ 65536 address) (logand 255 (lsh value -8)))
+ (aset malyon-story-file (+ 65537 address) (logand 255 value))))
+
+(defsubst malyon-read-code-byte ()
+ "Read the next byte at the program counter location."
+ (setq malyon-instruction-pointer (+ malyon-instruction-pointer 1))
+ (malyon-read-byte (- malyon-instruction-pointer 1)))
+
+(defsubst malyon-read-code-word ()
+ "Read the next word at the program counter location."
+ (setq malyon-instruction-pointer (+ malyon-instruction-pointer 2))
+ (malyon-read-word (- malyon-instruction-pointer 2)))
+
+(defsubst malyon-pop-stack ()
+ "Pop a value off the stack."
+ (if (> 0 malyon-stack-pointer)
+ (malyon-fatal-error "stack underflow."))
+ (setq malyon-stack-pointer (- malyon-stack-pointer 1))
+ (aref malyon-stack (+ malyon-stack-pointer 1)))
+
+(defsubst malyon-read-local-variable (variable)
+ "Read a local variable."
+ (aref malyon-stack (+ variable malyon-frame-pointer)))
+
+(defsubst malyon-read-global-variable (variable)
+ "Read a global variable."
+ (malyon-read-word (+ malyon-global-variables (* 2 variable))))
+
+(defsubst malyon-read-variable (variable)
+ "Read a variable."
+ (cond ((= variable 0) (malyon-pop-stack))
+ ((< variable 16) (malyon-read-local-variable variable))
+ (t (malyon-read-global-variable (- variable 16)))))
+
+(defsubst malyon-push-stack (value)
+ "Push a value onto the stack."
+ (setq malyon-stack-pointer (+ malyon-stack-pointer 1))
+ (aset malyon-stack malyon-stack-pointer value))
+
+(defsubst malyon-store-local-variable (variable value)
+ "Store a value in a local variable."
+ (aset malyon-stack (+ variable malyon-frame-pointer) value))
+
+(defsubst malyon-store-global-variable (variable value)
+ "Store a value in a global variable."
+ (malyon-store-word (+ malyon-global-variables (* 2 variable)) value))
+
+(defsubst malyon-store-variable (var value)
+ "Store the value in a variable."
+ (setq value (logand 65535 value))
+ (cond ((= var 0) (malyon-push-stack value))
+ ((< var 16) (malyon-store-local-variable var value))
+ (t (malyon-store-global-variable (- var 16) value))))
+
+;; list of opcodes
+
+(defvar malyon-opcodes
+ [malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-jz
+ malyon-opcode-get-sibling malyon-opcode-get-child
+ malyon-opcode-get-parent malyon-opcode-get-prop-len
+ malyon-opcode-inc malyon-opcode-dec
+ malyon-opcode-print-addr malyon-opcode-calls
+ malyon-opcode-remove-obj malyon-opcode-print-obj
+ malyon-opcode-ret malyon-opcode-jump
+ malyon-opcode-print-paddr malyon-opcode-load
+ malyon-opcode-calln malyon-opcode-jz
+ malyon-opcode-get-sibling malyon-opcode-get-child
+ malyon-opcode-get-parent malyon-opcode-get-prop-len
+ malyon-opcode-inc malyon-opcode-dec
+ malyon-opcode-print-addr malyon-opcode-calls
+ malyon-opcode-remove-obj malyon-opcode-print-obj
+ malyon-opcode-ret malyon-opcode-jump
+ malyon-opcode-print-paddr malyon-opcode-load
+ malyon-opcode-calln malyon-opcode-jz
+ malyon-opcode-get-sibling malyon-opcode-get-child
+ malyon-opcode-get-parent malyon-opcode-get-prop-len
+ malyon-opcode-inc malyon-opcode-dec
+ malyon-opcode-print-addr malyon-opcode-calls
+ malyon-opcode-remove-obj malyon-opcode-print-obj
+ malyon-opcode-ret malyon-opcode-jump
+ malyon-opcode-print-paddr malyon-opcode-load
+ malyon-opcode-calln malyon-opcode-rtrue
+ malyon-opcode-rfalse malyon-opcode-print
+ malyon-opcode-print-ret malyon-opcode-nop
+ malyon-opcode-illegal malyon-opcode-illegal
+ malyon-opcode-restart malyon-opcode-ret-popped
+ malyon-opcode-catch malyon-opcode-quit
+ malyon-opcode-new-line malyon-opcode-illegal
+ malyon-opcode-verify malyon-opcode-illegal
+ malyon-opcode-piracy malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-calls
+ malyon-opcode-storew malyon-opcode-storeb
+ malyon-opcode-put-prop malyon-opcode-aread
+ malyon-opcode-print-char malyon-opcode-print-num
+ malyon-opcode-random malyon-opcode-push
+ malyon-opcode-pull malyon-opcode-split-window
+ malyon-opcode-set-window malyon-opcode-calls
+ malyon-opcode-erase-window malyon-opcode-erase-line
+ malyon-opcode-set-cursor malyon-opcode-get-cursor
+ malyon-opcode-set-text-style malyon-opcode-buffer-mode
+ malyon-opcode-output-stream malyon-opcode-input-stream
+ malyon-opcode-nop malyon-opcode-read-char
+ malyon-opcode-scan-table malyon-opcode-not
+ malyon-opcode-calln malyon-opcode-calln
+ malyon-opcode-tokenise malyon-opcode-encode-text
+ malyon-opcode-copy-table malyon-opcode-print-table
+ malyon-opcode-check-arg-count malyon-opcode-save
+ malyon-opcode-restore malyon-opcode-log-shift
+ malyon-opcode-art-shift malyon-opcode-set-font
+ malyon-opcode-illegal malyon-opcode-illegal
+ malyon-opcode-illegal malyon-opcode-illegal
+ malyon-opcode-save-undo malyon-opcode-restore-undo
+ malyon-opcode-print-unicode malyon-opcode-check-unicode
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop]
+ "A vector of all known legal z code opcodes.")
+
+;; initialization
+
+(defun malyon-load-story-file (file-name)
+ "Load a z code story file into an internal vector."
+ (save-excursion
+ (set-buffer (create-file-buffer file-name))
+ (malyon-disable-multibyte)
+ (malyon-erase-buffer)
+ (let ((coding-system-for-read 'binary))
+ (insert-file-contents file-name))
+ (setq malyon-story-file-name file-name)
+ (setq malyon-story-file (buffer-substring-no-properties (point-min)
+ (point-max)))
+ (setq malyon-story-file (malyon-string-to-vector malyon-story-file))
+ (if (not (eq ?\^A 1))
+ (let ((i 0))
+ (while (< i (length malyon-story-file))
+ (aset malyon-story-file
+ i
+ (malyon-char-to-int (aref malyon-story-file i)))
+ (setq i (+ 1 i)))))
+ (kill-buffer nil)))
+
+(defun malyon-initialize ()
+ "Initialize the z code interpreter."
+; (malyon-trace-file)
+ (setq malyon-game-state-quetzal t)
+ (malyon-initialize-faces)
+ (malyon-initialize-status)
+ (malyon-initialize-transcript)
+ (malyon-initialize-windows)
+ (malyon-initialize-story-header)
+ (malyon-initialize-registers)
+ (malyon-initialize-opcodes)
+ (malyon-history-clear)
+ (setq malyon-game-state-restart (malyon-current-game-state))
+ (malyon-print-header))
+
+(defun malyon-initialize-status ()
+ "Initialize the status buffer."
+ (setq malyon-status-buffer (get-buffer-create "Malyon Status"))
+ (switch-to-buffer malyon-status-buffer)
+ (malyon-erase-buffer)
+ (kill-all-local-variables)
+ (setq malyon-status-buffer-point (point))
+ (setq malyon-status-buffer-lines 0)
+ (setq malyon-status-buffer-delayed-split nil)
+ (use-local-map malyon-keymap-read)
+ (set-syntax-table malyon-syntax-table)
+ (setq mode-name "Malyon")
+ (setq major-mode 'malyon-mode)
+ (run-hooks 'malyon-mode-hook))
+
+(defun malyon-initialize-transcript ()
+ "Initialize the transcript buffer."
+ (setq malyon-transcript-buffer (get-buffer-create "Malyon Transcript"))
+ (switch-to-buffer malyon-transcript-buffer)
+ (malyon-erase-buffer)
+ (kill-all-local-variables)
+ (setq malyon-last-cursor-position-after-input
+ (malyon-point-max malyon-transcript-buffer))
+ (use-local-map malyon-keymap-read)
+ (set-syntax-table malyon-syntax-table)
+ (setq fill-column malyon-max-column)
+ (auto-fill-mode 1)
+ (setq mode-name "Malyon")
+ (setq major-mode 'malyon-mode)
+ (run-hooks 'malyon-mode-hook))
+
+(defun malyon-initialize-windows ()
+ "Initialize the window configuration for the z machine."
+ (setq window-min-height 3)
+ (setq malyon-transcript-buffer-buffered t)
+ (malyon-set-window-configuration 0)
+ (malyon-opcode-set-window 0))
+
+(defun malyon-initialize-story-header ()
+ "Initializes the header section of the story file."
+ (malyon-store-byte 1
+ (if (>= malyon-story-version 5)
+ 28
+ (logior 48 (malyon-read-byte 1))))
+ (malyon-store-byte 16 (logand 440 (malyon-read-byte 16)))
+ (malyon-store-byte 30 1)
+ (malyon-store-byte 31 65)
+ (malyon-store-byte 32 255)
+ (malyon-store-byte 33 (- malyon-max-column 1))
+ (malyon-store-word 34 (- malyon-max-column 1))
+ (malyon-store-word 36 255)
+ (malyon-store-word 38 1)
+ (malyon-store-word 39 1)
+ (malyon-store-byte 44 0)
+ (malyon-store-byte 45 0)
+ (malyon-store-byte 50 1)
+ (malyon-store-byte 51 0))
+
+(defun malyon-initialize-registers ()
+ "Initialize the interpreter's internal registers."
+ (setq malyon-stack (make-vector 1024 0))
+ (setq malyon-stack-pointer -1)
+ (malyon-push-initial-frame)
+ (setq malyon-frame-pointer malyon-stack-pointer)
+ (setq malyon-instruction-pointer (malyon-read-word 6))
+ (setq malyon-global-variables (malyon-read-word 12))
+ (setq malyon-object-table (malyon-read-word 10))
+ (cond ((< malyon-story-version 5)
+ (setq malyon-object-table-entry-size 9)
+ (setq malyon-object-properties 31)
+ (setq malyon-object-property-offset 7))
+ (t
+ (setq malyon-object-table-entry-size 14)
+ (setq malyon-object-properties 63)
+ (setq malyon-object-property-offset 12)))
+ (setq malyon-abbreviations (malyon-read-word 24))
+ (if (< malyon-story-version 5)
+ (setq malyon-score-game (zerop (logand 2 (malyon-read-byte 1)))))
+ (setq malyon-packed-multiplier
+ (malyon-cadr (assq malyon-story-version '((3 2) (5 4) (8 8)))))
+ (if (or (< malyon-story-version 5) (zerop (malyon-read-word 52)))
+ (setq malyon-alphabet (concat "abcdefghijklmnopqrstuvwxyz"
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ " \n0123456789.,!?_#'\"/\\-:()"))
+ (setq malyon-alphabet (make-string 78 ? ))
+ (let ((i 0))
+ (while (< i 78)
+ (aset malyon-alphabet i
+ (malyon-read-byte (+ i (malyon-read-word 52))))
+ (setq i (+ 1 i)))))
+ (malyon-initialize-unicode-table)
+ (setq malyon-dictionary (malyon-read-word 8))
+ (setq malyon-dictionary-entry-length
+ (malyon-read-byte
+ (+ 1 malyon-dictionary (malyon-read-byte malyon-dictionary))))
+ (setq malyon-dictionary-num-entries
+ (malyon-read-word
+ (+ 2 malyon-dictionary (malyon-read-byte malyon-dictionary))))
+ (setq malyon-dictionary-entries
+ (+ 4 malyon-dictionary (malyon-read-byte malyon-dictionary)))
+ (setq malyon-dictionary-word-length (if (< malyon-story-version 5) 3 5))
+ (setq malyon-current-face 'malyon-face-plain)
+ (setq malyon-print-separator nil)
+ (malyon-initialize-output-streams))
+
+(defun malyon-initialize-opcodes ()
+ "Initialize the opcode table used by the story file."
+ (cond ((< malyon-story-version 5)
+ (aset malyon-opcodes 143 'malyon-opcode-not)
+ (aset malyon-opcodes 181 'malyon-opcode-save)
+ (aset malyon-opcodes 182 'malyon-opcode-restore)
+ (aset malyon-opcodes 185 'malyon-opcode-pop)
+ (aset malyon-opcodes 188 'malyon-opcode-show-status))
+ (t
+ (aset malyon-opcodes 143 'malyon-opcode-calln)
+ (aset malyon-opcodes 181 'malyon-opcode-illegal)
+ (aset malyon-opcodes 182 'malyon-opcode-illegal)
+ (aset malyon-opcodes 185 'malyon-opcode-catch)
+ (aset malyon-opcodes 188 'malyon-opcode-illegal))))
+
+(defun malyon-print-header ()
+ "Print malyon mode header information."
+ (malyon-opcode-set-text-style 2)
+ (malyon-print "Malyon V 1.0.2")
+ (malyon-opcode-set-text-style 0)
+ (malyon-newline)
+ (malyon-print "A z-code interpreter for version 3, 5, and 8 games.")
+ (malyon-newline)
+ (malyon-print "(c) 1999-2009 by Peter Ilberg <peter.ilberg@gmail.com>")
+ (malyon-newline)
+ (malyon-newline))
+
+;; cleanup
+
+(defun malyon-cleanup ()
+ "Clean up the z code interpreter."
+ (condition-case nil
+ (progn
+ (setq malyon-story-file nil)
+ (setq malyon-window-configuration nil)
+ (setq malyon-game-state-restart nil)
+ (setq malyon-game-state-undo nil)
+ (if (get-buffer "Malyon Status")
+ (kill-buffer (get-buffer "Malyon Status")))
+ (if (get-buffer "Malyon Transcript")
+ (progn
+ (switch-to-buffer (get-buffer "Malyon Transcript"))
+ (malyon-redisplay-frame (selected-frame) t)
+ (delete-other-windows (get-buffer-window (current-buffer)))
+ (widen)
+ (text-mode)))
+ (setq malyon-status-buffer nil)
+ (setq malyon-transcript-buffer nil))
+ (error
+ (malyon-fatal-error "cleanup failed."))))
+
+;; error handling
+
+(defun malyon-fatal-error (message)
+ "Print error message and abort."
+ (setq message (concat "Malyon fatal error: " message))
+ (unwind-protect
+ (save-excursion
+ (set-buffer malyon-transcript-buffer)
+ (goto-char (point-max))
+ (newline)
+ (newline)
+ (put-text-property 0
+ (length message)
+ 'face
+ 'malyon-face-error
+ message)
+ (insert message)
+ (newline))
+ (malyon-cleanup)
+ (malyon-redisplay-frame (selected-frame) t)
+ (error message)))
+
+;; conversion of zscii to ascii
+
+(defvar malyon-unicode-table nil
+ "An array mapping zscii characters to latin-1 ones.")
+
+(defvar malyon-default-unicode-table nil
+ "The default array mapping zscii characters to latin-1 ones.")
+
+(if malyon-default-unicode-table
+ '()
+ (setq malyon-default-unicode-table
+ [32
+ 0 0 0 0 0 0 0 ; 1 - 7
+ 8 0 0 0 0 10 0 0 ; 8 - 15
+ 0 0 0 0 0 0 0 0 ; 16 - 23
+ 0 0 0 39 0 0 0 0 ; 24 - 31
+ 32 33 34 35 36 37 38 39 ; 32 - 39
+ 40 41 42 43 44 45 46 47 ; 40 - 47
+ 48 49 50 51 52 53 54 55 ; 48 - 55
+ 56 57 58 59 60 61 62 63 ; 56 - 63
+ 64 65 66 67 68 69 70 71 ; 64 - 71
+ 72 73 74 75 76 77 78 79 ; 72 - 79
+ 80 81 82 83 84 85 86 87 ; 80 - 87
+ 88 89 90 91 92 93 94 95 ; 88 - 95
+ 96 97 98 99 100 101 102 103 ; 96 - 103
+ 104 105 106 107 108 109 110 111 ; 104 - 111
+ 112 113 114 115 116 117 118 119 ; 112 - 119
+ 120 121 122 123 124 125 126 0 ; 120 - 127
+ 0 0 0 0 0 0 0 0 ; 128 - 135
+ 0 0 0 0 0 0 0 0 ; 136 - 143
+ 0 48 49 50 51 52 53 54 ; 144 - 151
+ 55 56 57 228 246 252 196 214 ; 152 - 159
+ 220 223 187 171 235 239 255 203 ; 160 - 167
+ 207 225 233 237 243 250 253 193 ; 168 - 175
+ 201 205 211 218 221 224 232 236 ; 176 - 183
+ 242 249 192 200 204 210 217 226 ; 184 - 191
+ 234 238 244 251 194 202 206 212 ; 192 - 199
+ 219 229 197 248 216 227 241 245 ; 200 - 207
+ 195 209 213 230 198 231 199 254 ; 208 - 215
+ 240 222 208 163 63 63 161 191 ; 216 - 223
+ 0 0 0 0 0 0 0 0 ; 224 - 231
+ 0 0 0 0 0 0 0 0 ; 232 - 239
+ 0 0 0 0 0 0 0 0 ; 240 - 247
+ 0 0 0 0 0 0 0 0 ; 248 - 255
+ ]))
+
+(defun malyon-initialize-unicode-table ()
+ "Initializes the zscii-to-unicode conversion table."
+ (setq malyon-unicode-table
+ (copy-sequence malyon-default-unicode-table))
+ (let* ((ext (malyon-read-word 54))
+ (len (if (zerop ext) 0 (malyon-read-word ext)))
+ (table (if (< len 3) 0 (malyon-read-word (+ ext 6)))))
+ (if (or (< malyon-story-version 5) (zerop table))
+ '()
+ (let ((i 0))
+ (while (< i 96)
+ (aset malyon-unicode-table (+ 155 i) (malyon-char-to-int ??))
+ (setq i (+ 1 i))))
+ (setq len (malyon-read-byte table))
+ (let ((i 0))
+ (while (< i len)
+ (aset malyon-unicode-table (+ 155 i)
+ (malyon-read-word (+ table 1 i)))
+ (setq i (+ 1 i)))))))
+
+(defsubst malyon-zscii-to-unicode (char)
+ "Converts a zscii character to unicode."
+ (if (or (< char 0) (> char 255))
+ ??
+ (let ((uni (aref malyon-unicode-table char)))
+ (if (zerop uni)
+ ??
+ (malyon-unibyte-char-to-multibyte (malyon-int-to-char uni))))))
+
+(defsubst malyon-unicode-to-zscii (char)
+ "Converts a unicode character to zscii."
+ (setq char (malyon-multibyte-char-to-unibyte char))
+ (setq char (if (malyon-characterp char) (malyon-char-to-int char) char))
+ (if (= 13 char)
+ ?\r
+ (let ((i 1) (found 0))
+ (while (and (< i 255) (zerop found))
+ (if (= char (aref malyon-unicode-table i))
+ (setq found i))
+ (setq i (+ i 1)))
+ (malyon-int-to-char found))))
+
+;; output streams
+
+(defvar malyon-output-streams nil
+ "Valid output streams for the interpreter.")
+
+(defvar malyon-output-streams-tables nil
+ "A list of active tables for stream 3.")
+
+(defun malyon-initialize-output-streams ()
+ "Initializes the output streams."
+ (setq malyon-output-streams '())
+ (setq malyon-output-streams-tables '())
+ (malyon-add-output-stream 1 0))
+
+(defun malyon-output-stream-function (stream)
+ "Returns the output function representing the given stream."
+ (cond ((= 1 stream) (if (zerop malyon-current-window)
+ 'malyon-putchar-transcript
+ 'malyon-putchar-status))
+ ((= 2 stream) 'malyon-putchar-printer)))
+
+(defun malyon-add-output-stream (stream table)
+ "Add a new output stream."
+ (if (= stream 3)
+ (progn
+ (setq malyon-output-streams-tables
+ (cons table malyon-output-streams-tables))
+ (malyon-store-word table 0))
+ (let ((function (malyon-output-stream-function stream)))
+ (setq malyon-output-streams
+ (if (member function malyon-output-streams)
+ malyon-output-streams
+ (cons function malyon-output-streams))))))
+
+(defun malyon-remove-output-stream (stream)
+ "Remove an output stream."
+ (if (= stream 3)
+ (setq malyon-output-streams-tables (cdr malyon-output-streams-tables))
+ (setq malyon-output-streams
+ (malyon-remove (malyon-output-stream-function stream)
+ malyon-output-streams))))
+
+(defun malyon-update-output-streams ()
+ "Update output streams when the output window has changed."
+ (let ((one (or (member 'malyon-putchar-transcript malyon-output-streams)
+ (member 'malyon-putchar-status malyon-output-streams))))
+ (setq malyon-output-streams
+ (malyon-remove 'malyon-putchar-transcript
+ (malyon-remove 'malyon-putchar-status
+ malyon-output-streams)))
+ (if one
+ (malyon-add-output-stream 1 0))))
+
+(defsubst malyon-output-character (char)
+ "Output a single character on all active streams."
+ (setq char (malyon-zscii-to-unicode char))
+ (if malyon-output-streams-tables
+ (malyon-putchar-table char (car malyon-output-streams-tables))
+ (malyon-mapc (lambda (s) (funcall s char)) malyon-output-streams)))
+
+;; printing text
+
+(defsubst malyon-abbrev (abbrev x)
+ "Print an abbreviation."
+ (malyon-print-ztext
+ (* 2 (malyon-read-word (+ malyon-abbreviations
+ (* 2 (+ x (* 32 (1- abbrev)))))))))
+
+(defun malyon-newline ()
+ "Print a newline."
+ (if (eq malyon-status-buffer (current-buffer))
+ (goto-char malyon-status-buffer-point)
+ (goto-char (point-max)))
+ (malyon-output-character ?\r)
+ (if (eq malyon-status-buffer (current-buffer))
+ (setq malyon-status-buffer-point (point))
+ (goto-char malyon-last-cursor-position-after-input))
+ (malyon-redisplay-frame (selected-frame) nil))
+
+(defun malyon-print (object)
+ "Print text."
+ (let ((text (if (malyon-characterp object) (char-to-string object) object))
+ (start))
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (goto-char (point-max))
+ (goto-char malyon-status-buffer-point))
+ (setq start (point))
+ (malyon-print-characters (malyon-string-to-list text))
+ (put-text-property start (point) 'face malyon-current-face)
+ (if (eq malyon-status-buffer (current-buffer))
+ (setq malyon-status-buffer-point (point))
+ (goto-char malyon-last-cursor-position-after-input))))
+
+(defun malyon-print-characters (text)
+ "Print a list of characters."
+ (malyon-mapc 'malyon-output-character text))
+
+(defsubst malyon-print-state-new (char shift abbr zscii zcode)
+ "Generate a new print state."
+ (list char shift abbr zscii zcode))
+
+(defsubst malyon-print-state-initial ()
+ "Returns an initial state for the ztext decoder."
+ (malyon-print-state-new nil -6 0 0 0))
+
+(defsubst malyon-print-state-next (x ignore shift abbr zscii z)
+ "Print state transition function."
+ (cond ((= zscii 2)
+ (malyon-print-state-new (+ z x) -6 0 0 0))
+ ((= zscii 1)
+ (malyon-print-state-new nil -6 0 2 (* 32 x)))
+ ((> abbr 0)
+ (malyon-abbrev abbr x)
+ (malyon-print-state-initial))
+ ((= x 0)
+ (malyon-print-state-new ? -6 0 0 0))
+ ((< x 4)
+ (malyon-print-state-new nil -6 x 0 0))
+ ((= x 4)
+ (malyon-print-state-new nil 20 0 0 0))
+ ((= x 5)
+ (malyon-print-state-new nil 46 0 0 0))
+ ((and (= shift 46) (= x 6))
+ (malyon-print-state-new nil -6 0 1 0))
+ ((and (= shift 46) (= x 7))
+ (malyon-print-state-new ?\r -6 0 0 0))
+ (t
+ (malyon-print-state-new
+ (aref malyon-alphabet (+ shift x)) -6 0 0 0))))
+
+(defun malyon-print-text (address)
+ "Print text at address and return the address of the following byte."
+ (let ((start))
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (goto-char (point-max))
+ (goto-char malyon-status-buffer-point))
+ (setq start (point))
+ (setq address (malyon-print-ztext address))
+ (put-text-property start (point) 'face malyon-current-face)
+ (if (eq malyon-status-buffer (current-buffer))
+ (setq malyon-status-buffer-point (point))
+ (goto-char malyon-last-cursor-position-after-input))
+ (malyon-redisplay-frame (selected-frame) nil)
+ address))
+
+(defun malyon-print-ztext (address)
+ "Print the ztext stored at the given address."
+ (let ((high 0) (low) (a) (b) (c) (state (malyon-print-state-initial)))
+ (while (zerop (logand 128 high))
+ (setq high (malyon-read-byte address))
+ (setq low (malyon-read-byte (+ 1 address)))
+ (setq a (logand 31 (lsh high -2)))
+ (setq b (logand 31 (logior (lsh high 3) (lsh low -5))))
+ (setq c (logand 31 low))
+ (setq state (apply 'malyon-print-state-next a state))
+ (if (car state) (malyon-output-character (car state)))
+ (setq state (apply 'malyon-print-state-next b state))
+ (if (car state) (malyon-output-character (car state)))
+ (setq state (apply 'malyon-print-state-next c state))
+ (if (car state) (malyon-output-character (car state)))
+ (setq address (+ 2 address)))
+ address))
+
+(defun malyon-putchar-transcript (char)
+ "Print a single character in the transcript window."
+ (if (char-equal char ?\n)
+ (newline 1)
+ (insert char)
+ (setq malyon-print-separator (null (member char malyon-whitespace))))
+ (if (and malyon-transcript-buffer-buffered
+ (> (current-column) (current-fill-column)))
+ (progn
+ (end-of-line)
+ (forward-word -1)
+ (if (< 0 (current-column))
+ (newline 1))
+ (end-of-line))))
+
+(defun malyon-putchar-status (char)
+ "Print a single character in the status window."
+ (if malyon-status-buffer-delayed-split
+ (progn
+ (malyon-split-buffer-windows malyon-status-buffer-delayed-split)
+ (other-window 1)))
+ (if (char-equal char ?\n)
+ (progn
+ (beginning-of-line)
+ (forward-line 1)
+ (if (= (point) (point-max))
+ (forward-line -1)))
+ (if (> (current-column) (current-fill-column))
+ '()
+ (insert char)
+ (delete-char 1))))
+
+(defun malyon-putchar-table (char table)
+ "Print a single character into a table."
+ (setq char (malyon-unicode-to-zscii char))
+ (malyon-store-byte (+ 2 table (malyon-read-word table)) char)
+ (malyon-store-word table (+ 1 (malyon-read-word table))))
+
+(defun malyon-putchar-printer (char)
+ "Print a single character onto a printer."); not yet implemented
+
+;; more
+
+(defvar malyon-more-continue-keymap nil
+ "The keymap with which to continue after More has finished.")
+
+(defun malyon-more (keymap)
+ "Enter More mode."
+ (if (eq malyon-status-buffer (current-buffer))
+ (use-local-map keymap)
+ (if (< malyon-story-version 5) (malyon-opcode-show-status))
+ (if (< (count-lines malyon-last-cursor-position-after-input (point-max))
+ (malyon-window-displayed-height))
+ (progn
+ (malyon-adjust-transcript)
+ (use-local-map keymap))
+ (goto-char malyon-last-cursor-position-after-input)
+ (beginning-of-line)
+ (recenter 1)
+ (setq malyon-more-continue-keymap keymap)
+ (use-local-map malyon-keymap-more)
+ (message "[More]"))))
+
+(defun malyon-more-status-buffer ()
+ "Enter More mode for the status buffer."
+ (setq malyon-more-continue-keymap (current-local-map))
+ (use-local-map malyon-keymap-more-status)
+ (message "[More]")
+ (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))
+
+;; input history
+
+(defvar malyon-history nil
+ "The input history.")
+
+(defun malyon-history-previous ()
+ "Move one entry up in the input history."
+ (let ((prev (aref malyon-history 0))
+ (curr (aref malyon-history 1))
+ (next (aref malyon-history 2)))
+ (if (null prev)
+ curr
+ (aset malyon-history 2 (if curr (cons curr next) next))
+ (aset malyon-history 0 (cdr prev))
+ (aset malyon-history 1 (car prev)))))
+
+(defun malyon-history-next ()
+ "Move one entry down in the input history."
+ (let ((prev (aref malyon-history 0))
+ (curr (aref malyon-history 1))
+ (next (aref malyon-history 2)))
+ (if (null next)
+ curr
+ (aset malyon-history 0 (if curr (cons curr prev) prev))
+ (aset malyon-history 2 (cdr next))
+ (aset malyon-history 1 (car next)))))
+
+(defun malyon-history-clear ()
+ "Clear the input history."
+ (setq malyon-history (vector '() nil '())))
+
+(defun malyon-history-insert (entry)
+ "Insert an entry into the input history."
+ (let* ((prev (aref malyon-history 0))
+ (curr (aref malyon-history 1))
+ (next (aref malyon-history 2))
+ (l (malyon-remove entry
+ (append (nreverse prev)
+ (if curr (cons curr next) next))))
+ (cut (- (length l) 19)))
+ (while (> cut 0)
+ (setq l (cdr l)
+ cut (- cut 1)))
+ (aset malyon-history 0
+ (malyon-remove nil (malyon-remove "" (cons entry (nreverse l)))))
+ (aset malyon-history 1 nil)
+ (aset malyon-history 2 '())))
+
+;; dictionary lookup
+
+(defun malyon-dictionary-word (chars)
+ "Convert a list of characters into a dictionary word."
+ (list (car (car chars))
+ (length chars)
+ (malyon-encode-dictionary-word (append (malyon-mapcan 'cdr chars)
+ '(5 5 5 5 5 5 5 5)))))
+
+(defsubst malyon-join-characters (stop list)
+ "Joins three ztext characters into two bytes."
+ (let ((a (car list))
+ (b (malyon-cadr list))
+ (c (malyon-caddr list))
+ (x (if (zerop stop) 0 128)))
+ (list (logior x (logand 255 (logior (lsh a 2) (lsh b -3))))
+ (logand 255 (logior (lsh b 5) c)))))
+
+(defun malyon-encode-dictionary-word (l)
+ "Converts a list of ztext characters into a dictionary word."
+ (let* ((first l)
+ (second (malyon-cdddr first))
+ (third (malyon-cdddr second)))
+ (apply 'vector
+ (if (< malyon-story-version 5)
+ (append (malyon-join-characters 0 first)
+ (malyon-join-characters 1 second))
+ (append (malyon-join-characters 0 first)
+ (malyon-join-characters 0 second)
+ (malyon-join-characters 1 third))))))
+
+(defun malyon-lookup (dict code)
+ "Look for the given code in the dictionary and return its address."
+ (cond ((not code) 0)
+ ((not dict) (malyon-binary-search code))
+ ((= dict malyon-dictionary) (malyon-binary-search code))
+ (t (malyon-linear-search dict code))))
+
+(defsubst malyon-compare-words (word address)
+ "Compares the given word to the word stored at address."
+ (let* ((i 0)
+ (j address)
+ (x (aref word i))
+ (y (malyon-read-byte j)))
+ (while (not (or (/= x y) (= i malyon-dictionary-word-length)))
+ (setq i (+ 1 i)
+ j (+ 1 j)
+ x (aref word i)
+ y (malyon-read-byte j)))
+ (- x y)))
+
+;; search functions
+
+(defun malyon-binary-search (code)
+ "Binary search through the main dictionary."
+ (let* ((lower 0)
+ (upper (- malyon-dictionary-num-entries 1))
+ (median (/ (+ lower upper) 2))
+ (entry (+ malyon-dictionary-entries
+ (* malyon-dictionary-entry-length median)))
+ (looking (malyon-compare-words code entry)))
+ (while (not (or (> lower upper) (zerop looking)))
+ (setq lower (if (< 0 looking) (+ median 1) lower)
+ upper (if (> 0 looking) (- median 1) upper)
+ median (/ (+ lower upper) 2)
+ entry (+ malyon-dictionary-entries
+ (* malyon-dictionary-entry-length median))
+ looking (malyon-compare-words code entry)))
+ (if (zerop looking) entry 0)))
+
+(defun malyon-linear-search (dictionary code)
+ "Linear search through the given dictionary."
+ (let* ((length (malyon-read-byte (+ dictionary 1
+ (malyon-read-byte dictionary))))
+ (number (malyon-read-word (+ dictionary 2
+ (malyon-read-byte dictionary))))
+ (entries (+ dictionary 4 (malyon-read-byte dictionary)))
+ (i 0)
+ (entry (+ entries (* length i)))
+ (looking (malyon-compare-words code entry)))
+ (while (not (or (>= i number) (zerop looking)))
+ (setq i (+ 1 i)
+ entry (+ entries (* length i))
+ looking (malyon-compare-words code entry)))
+ (if (zerop looking) entry 0)))
+
+;; encoding text and lexical analysis
+
+(defun malyon-split-list (sep list &optional x)
+ "Split a list into sublists as indicated by the separators."
+ (cond ((null list)
+ (list (nreverse x)))
+ ((eq sep (car list))
+ (cons (nreverse x) (malyon-split-list sep (cdr list) '())))
+ (t
+ (malyon-split-list sep (cdr list) (cons (car list) x)))))
+
+(defun malyon-characters-to-words (list)
+ "Turn the list of characters into a list of words."
+ (mapcar 'malyon-dictionary-word
+ (delete '() (malyon-split-list 'malyon-word-separator list))))
+
+(defsubst malyon-char-in-string (c s)
+ "Returns the index of c in s if found, or length of s."
+ (let ((i 0))
+ (while (not (or (= i (length s)) (= c (aref s i))))
+ (setq i (+ 1 i)))
+ i))
+
+(defsubst malyon-encode-into-ztext (c)
+ "Convert a character into ztext."
+ (let* ((index (malyon-char-in-string c malyon-alphabet))
+ (shift (floor index 26))
+ (char (+ 6 (mod index 26))))
+ (cond ((> shift 2) (list 5 6 (logand 31 (lsh c -5)) (logand 31 c)))
+ ((= shift 2) (list 5 char))
+ ((= shift 1) (list 4 char))
+ (t (list char)))))
+
+(defun malyon-encode-single-character (terminating-characters char)
+ "Encode a character into ztext."
+ (let ((pos (car char))
+ (c (cdr char)))
+ (cond ((member c malyon-whitespace)
+ (list 'malyon-word-separator))
+ ((member c terminating-characters)
+ (list 'malyon-word-separator
+ (cons pos (malyon-encode-into-ztext c))
+ 'malyon-word-separator))
+ (t (list (cons pos (malyon-encode-into-ztext c)))))))
+
+(defun malyon-encode-character-list (dict list)
+ "Encode the list of characters into ztext."
+ (let ((l '())
+ (i 0))
+ (while (< i (malyon-read-byte dict))
+ (setq l (cons (malyon-read-byte (+ dict 1 i)) l)
+ i (+ 1 i)))
+ (malyon-mapcan (lambda (x) (malyon-encode-single-character l x)) list)))
+
+(defun malyon-text-length (address)
+ "Return the length of the input text."
+ (if (>= malyon-story-version 5)
+ (malyon-read-byte (+ 1 address))
+ (let ((i 0))
+ (while (not (zerop (malyon-read-byte (+ i 1 address))))
+ (setq i (+ i 1)))
+ i)))
+
+(defun malyon-text-to-character-list (address)
+ "Convert the input text into a list of characters."
+ (let ((i (malyon-text-length address))
+ (text '()))
+ (while (< 0 i)
+ (setq text (cons
+ (cons (if (< malyon-story-version 5) i (+ 1 i))
+ (malyon-read-byte
+ (+ i address (if (< malyon-story-version 5) 0 1))))
+ text)
+ i (- i 1)))
+ text))
+
+(defun malyon-text-to-words (address dictionary)
+ "Turn ztext into a list of dictionary words."
+ (malyon-characters-to-words
+ (malyon-encode-character-list (if dictionary dictionary malyon-dictionary)
+ (malyon-text-to-character-list address))))
+
+;; window management
+
+(defvar malyon-status-buffer-grew-this-turn nil
+ "A flag signalling if the status buffer grew this turn.")
+
+(defun malyon-adjust-transcript ()
+ "Adjust the position of the transcript text."
+ (save-excursion
+ (setq malyon-status-buffer-grew-this-turn nil)
+ (set-buffer malyon-transcript-buffer)
+ (goto-char (point-max))
+ (recenter (- (malyon-window-displayed-height) 2))))
+
+(defun malyon-prepare-status-buffer (status)
+ "Fill the status buffer with empty lines."
+ (save-excursion
+ (set-buffer malyon-status-buffer)
+ (let ((lines (count-lines (point-min) (point-max)))
+ (new status))
+ (if (zerop lines)
+ (newline 1))
+ (goto-char (point-max))
+ (setq status (- status lines -1))
+ (while (> status 0)
+ (insert (make-string (+ 3 malyon-max-column) ? ))
+ (newline 1)
+ (setq status (- status 1)))
+ (goto-char (point-min))
+ (forward-line (+ 1 new))
+ (kill-region (point) (point-max))
+ (insert (make-string (+ 3 malyon-max-column) ? ))
+ (newline 1))))
+
+(defun malyon-restore-window-configuration ()
+ "Restore the saved window configuration."
+ (let ((buffer (window-buffer (selected-window))))
+ (if malyon-window-configuration
+ (set-window-configuration malyon-window-configuration))
+ (cond ((eq malyon-status-buffer buffer) (other-window 1))
+ ((eq malyon-transcript-buffer buffer) (goto-char (point-max))))))
+
+(defun malyon-set-window-configuration (status)
+ "Set up the new window configuration."
+ (cond ((< status malyon-status-buffer-lines)
+ (setq malyon-status-buffer-delayed-split status)
+ (if malyon-status-buffer-grew-this-turn
+ (malyon-more-status-buffer)))
+ ((> status malyon-status-buffer-lines)
+ (malyon-split-buffer-windows status)
+ (setq malyon-status-buffer-grew-this-turn t))
+ ((not malyon-window-configuration)
+ (malyon-split-buffer-windows status))))
+
+(defun malyon-split-buffer-windows (status)
+ "Split the buffer windows.
+The status buffer gets 'status' lines while the transcript buffer
+gets the remaining lines."
+ (delete-other-windows (get-buffer-window (current-buffer)))
+ (setq malyon-status-buffer-lines status)
+ (setq malyon-status-buffer-delayed-split nil)
+ (if (zerop status)
+ '()
+ (split-window (get-buffer-window (current-buffer)) (+ status 3))
+ (switch-to-buffer malyon-status-buffer)
+ (malyon-prepare-status-buffer status)
+ (malyon-opcode-set-cursor 1 1)
+ (other-window 1))
+ (switch-to-buffer malyon-transcript-buffer)
+ (setq malyon-window-configuration (current-window-configuration)))
+
+;; getting and setting the machine state
+
+(defun malyon-current-game-state ()
+ "Return the current state of the interpreter."
+ (vector malyon-instruction-pointer
+ malyon-stack-pointer
+ malyon-frame-pointer
+ (copy-sequence malyon-stack)
+ (copy-sequence malyon-story-file)
+ malyon-game-state-quetzal))
+
+(defun malyon-set-game-state (state)
+ "Installs the given state as the new state of the interpreter."
+ (setq malyon-instruction-pointer (aref state 0))
+ (setq malyon-stack-pointer (aref state 1))
+ (setq malyon-frame-pointer (aref state 2))
+ (setq malyon-stack (copy-sequence (aref state 3)))
+ (setq malyon-story-file (copy-sequence (aref state 4)))
+ (setq malyon-game-state-quetzal (aref state 5))
+ (save-excursion
+ (malyon-erase-buffer malyon-status-buffer)
+ (malyon-split-buffer-windows 0)
+ (setq malyon-last-cursor-position-after-input
+ (malyon-point-max malyon-transcript-buffer))))
+
+;; file utilities
+
+(defsubst malyon-write-byte-to-file (byte)
+ "Write a byte to a file."
+ (insert-char (logand 255 byte) 1))
+
+(defsubst malyon-write-word-to-file (word)
+ "Write a word to the last opened file."
+ (insert-char (logand 255 (lsh word -8)) 1)
+ (insert-char (logand 255 word) 1))
+
+(defsubst malyon-write-dword-to-file (dword)
+ "Write a dword to the last opened file."
+ (insert-char (logand 255 (lsh dword -24)) 1)
+ (insert-char (logand 255 (lsh dword -16)) 1)
+ (insert-char (logand 255 (lsh dword -8)) 1)
+ (insert-char (logand 255 dword) 1))
+
+(defsubst malyon-write-chunk-id-to-file (id)
+ "Write a quetzal chunk id to the last opened file."
+ (insert id))
+
+(defsubst malyon-read-byte-from-file ()
+ "Read the next byte from a file."
+ (if (= (point) (point-max))
+ 0
+ (forward-char 1)
+ (malyon-char-to-int (malyon-char-before))))
+
+(defsubst malyon-read-word-from-file ()
+ "Read the next word from the last opened file."
+ (logior (lsh (malyon-read-byte-from-file) 8) (malyon-read-byte-from-file)))
+
+(defsubst malyon-read-dword-from-file ()
+ "Read the next dword from the last opened file."
+ (logior (lsh (malyon-read-byte-from-file) 24)
+ (lsh (malyon-read-byte-from-file) 16)
+ (lsh (malyon-read-byte-from-file) 8)
+ (malyon-read-byte-from-file)))
+
+(defsubst malyon-read-chunk-id-from-file ()
+ "Read a quetzal chunk id from the last opened file."
+ (string (malyon-int-to-char (malyon-read-byte-from-file))
+ (malyon-int-to-char (malyon-read-byte-from-file))
+ (malyon-int-to-char (malyon-read-byte-from-file))
+ (malyon-int-to-char (malyon-read-byte-from-file))))
+
+(defun malyon-get-file-name (address)
+ "Retrieves the file name stored at address."
+ (let ((name (make-string (malyon-read-byte address) ? ))
+ (i 0))
+ (while (< i (length name))
+ (aset name i (malyon-read-byte (+ address 1 i)))
+ (setq i (+ 1 i)))
+ name))
+
+;; saving data to disk
+
+(defun malyon-save-file (file &optional table length)
+ "Save the current game state or a memory section to disk."
+ (interactive "FSave file: ")
+ (condition-case nil
+ (save-excursion
+ (set-buffer (create-file-buffer file))
+ (malyon-disable-multibyte)
+ (malyon-erase-buffer)
+ (cond (table (malyon-save-table table length))
+ (malyon-game-state-quetzal
+ (malyon-save-quetzal-state (malyon-current-game-state)))
+ (t
+ (malyon-save-game-state (malyon-current-game-state))))
+ (let ((coding-system-for-write 'binary))
+ (write-file file))
+ (kill-buffer nil)
+ 1)
+ (error 0)))
+
+(defun malyon-save-table (table length)
+ "Save the given section of memory to the file."
+ (let ((i 0)
+ (j table))
+ (while (< i length)
+ (malyon-write-byte-to-file (malyon-read-byte j))
+ (setq i (+ 1 i)
+ j (+ 1 j)))))
+
+(defun malyon-save-game-state (state)
+ "Saves the game state to disk."
+ (let ((ip (aref state 0))
+ (sp (aref state 1))
+ (fp (aref state 2))
+ (stack (aref state 3))
+ (mem (aref state 4))
+ (dyn (malyon-read-word 14))
+ (i 0))
+ (malyon-write-word-to-file (length malyon-story-file-name))
+ (while (< i (length malyon-story-file-name))
+ (malyon-write-byte-to-file (aref malyon-story-file-name i))
+ (setq i (+ 1 i)))
+ (malyon-write-dword-to-file ip)
+ (malyon-write-word-to-file sp)
+ (malyon-write-word-to-file fp)
+ (malyon-write-word-to-file dyn)
+ (setq i 0)
+ (while (<= i sp)
+ (malyon-write-dword-to-file (aref stack i))
+ (setq i (+ 1 i)))
+ (setq i 0)
+ (while (< i dyn)
+ (malyon-write-byte-to-file (aref mem i))
+ (setq i (+ 1 i)))))
+
+(defun malyon-save-quetzal-state (state)
+ "Saves the game state to disk in quetzal format."
+ (goto-char (point-min))
+ (malyon-save-quetzal-ifhd state)
+ (malyon-save-quetzal-cmem state)
+ (malyon-save-quetzal-stks state)
+ (goto-char (point-min))
+ (malyon-write-chunk-id-to-file "IFZS")
+ (goto-char (point-min))
+ (malyon-write-dword-to-file (- (point-max) (point-min)))
+ (goto-char (point-min))
+ (malyon-write-chunk-id-to-file "FORM"))
+
+(defun malyon-save-quetzal-ifhd (state)
+ "Saves the IFhd chunk of the quetzal format."
+ (malyon-write-chunk-id-to-file "IFhd")
+ (malyon-write-dword-to-file 13)
+ (malyon-write-word-to-file (malyon-read-word 2))
+ (malyon-write-word-to-file (malyon-read-word 18))
+ (malyon-write-word-to-file (malyon-read-word 20))
+ (malyon-write-word-to-file (malyon-read-word 22))
+ (malyon-write-word-to-file (malyon-read-word 28))
+ (malyon-write-byte-to-file (lsh (aref state 0) -16))
+ (malyon-write-byte-to-file (lsh (aref state 0) -8))
+ (malyon-write-byte-to-file (aref state 0))
+ (malyon-write-byte-to-file 0))
+
+(defun malyon-save-quetzal-cmem (state)
+ "Saves the CMem chunk of the quetzal format."
+ (let ((beginning (point-max))
+ (original (aref malyon-game-state-restart 4))
+ (current (aref state 4))
+ (size (malyon-read-word 14))
+ (byte 0)
+ (count 0)
+ (i 0))
+ (goto-char (point-max))
+ (while (< i size)
+ (setq byte (logxor (aref current i) (aref original i)))
+ (if (zerop byte)
+ (setq count (+ 1 count))
+ (while (> count 0)
+ (malyon-write-byte-to-file 0)
+ (setq count (- count 1))
+ (malyon-write-byte-to-file (min 255 count))
+ (setq count (- count (min 255 count))))
+ (malyon-write-byte-to-file byte))
+ (setq i (+ 1 i)))
+ (setq size (- (point-max) beginning))
+ (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
+ (goto-char beginning)
+ (malyon-write-chunk-id-to-file "CMem")
+ (malyon-write-dword-to-file size)))
+
+(defun malyon-save-quetzal-stks (state)
+ "Saves the Stks chunk of the quetzal format."
+ (let ((beginning (point-max))
+ (size 0))
+ (goto-char (point-max))
+ (malyon-save-quetzal-stack-frame (- (aref state 2) 4)
+ (aref state 1)
+ (aref state 3))
+ (setq size (- (point-max) beginning))
+ (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
+ (goto-char beginning)
+ (malyon-write-chunk-id-to-file "Stks")
+ (malyon-write-dword-to-file size)))
+
+(defun malyon-save-quetzal-stack-frame (fp sp stack)
+ "Saves the stack frames for the Stks chunk."
+ (let* ((frame (malyon-get-stack-frame fp sp stack))
+ (frame-id (aref frame 0))
+ (previous-fp (aref frame 1))
+ (previous-sp (aref frame 2))
+ (return-addr (aref frame 3))
+ (result-addr (aref frame 4))
+ (local-vars (aref frame 5))
+ (num-args (aref frame 6))
+ (eval-stack (aref frame 7)))
+ (if (> frame-id 0)
+ (malyon-save-quetzal-stack-frame previous-fp previous-sp stack))
+ (malyon-write-byte-to-file (lsh return-addr -16))
+ (malyon-write-byte-to-file (lsh return-addr -8))
+ (malyon-write-byte-to-file return-addr)
+ (if (zerop frame-id)
+ (malyon-write-byte-to-file 0)
+ (malyon-write-byte-to-file (logior (if result-addr 0 16)
+ (length local-vars))))
+ (malyon-write-byte-to-file (if result-addr result-addr 0))
+ (malyon-write-byte-to-file (- (lsh 1 num-args) 1))
+ (malyon-write-word-to-file (length eval-stack))
+ (while (not (null local-vars))
+ (malyon-write-word-to-file (car local-vars))
+ (setq local-vars (cdr local-vars)))
+ (while (not (null eval-stack))
+ (malyon-write-word-to-file (car eval-stack))
+ (setq eval-stack (cdr eval-stack)))))
+
+;; restoring data from disk
+
+(defvar malyon-restore-data-error nil
+ "An error message if restoring data from a file failed.")
+
+(defvar malyon-restore-quetzal-stack nil
+ "A temporary stack for restoring quetzal game states.")
+
+(defvar malyon-restore-quetzal-stack-pointer nil
+ "A temporary stack pointer for restoring quetzal game states.")
+
+(defvar malyon-restore-quetzal-frame-pointer nil
+ "A temporary frame-pointer for restoring quetzal game states.")
+
+(defun malyon-restore-file (file &optional table length)
+ "Restore a game state or a memory section from disk."
+ (interactive "fLoad file: ")
+ (if (not (and (file-exists-p file) (file-readable-p file)))
+ 0
+ (condition-case nil
+ (save-excursion
+ (setq malyon-restore-data-error nil)
+ (set-buffer (create-file-buffer file))
+ (malyon-disable-multibyte)
+ (malyon-erase-buffer)
+ (let ((coding-system-for-read 'binary))
+ (insert-file-contents file))
+ (goto-char (point-min))
+ (if table
+ (malyon-restore-table table length)
+ (let* ((first (malyon-read-chunk-id-from-file))
+ (second (malyon-read-dword-from-file))
+ (third (malyon-read-chunk-id-from-file)))
+ (if (and (string= "FORM" first) (string= "IFZS" third))
+ (malyon-restore-quetzal-state (+ 8 second))
+ (goto-char (point-min))
+ (malyon-restore-game-state))))
+ (kill-buffer nil)
+ (if (null malyon-restore-data-error)
+ 2
+ (message malyon-restore-data-error)
+ 0))
+ (error 0))))
+
+(defun malyon-restore-table (table length)
+ "Restore the given section of memory from a file."
+ (let ((i 0)
+ (j table))
+ (while (< i length)
+ (malyon-store-byte j (malyon-read-byte-from-file))
+ (setq i (+ 1 i)
+ j (+ 1 j)))))
+
+(defun malyon-restore-game-state ()
+ "Restore a saved game state from disk."
+ (let ((len 0)
+ (name 0)
+ (story 0)
+ (ip 0)
+ (sp 0)
+ (fp 0)
+ (dyn 0)
+ (stack (copy-sequence malyon-stack))
+ (mem (copy-sequence malyon-story-file))
+ (i 0))
+ (setq len (malyon-read-word-from-file))
+ (setq name (make-string len ? ))
+ (while (< i len)
+ (aset name i (malyon-read-byte-from-file))
+ (setq i (+ 1 i)))
+ (setq ip (malyon-read-dword-from-file))
+ (setq sp (malyon-read-word-from-file))
+ (setq fp (malyon-read-word-from-file))
+ (setq dyn (malyon-read-word-from-file))
+ (setq i 0)
+ (while (<= i sp)
+ (aset stack i (malyon-read-dword-from-file))
+ (setq i (+ 1 i)))
+ (setq i 0)
+ (while (< i dyn)
+ (aset mem i (malyon-read-byte-from-file))
+ (setq i (+ 1 i)))
+ (setq name (file-name-nondirectory name))
+ (setq story (file-name-nondirectory malyon-story-file-name))
+ (if (or (string-match name story) (string-match story name))
+ (malyon-set-game-state (vector ip sp fp stack mem nil))
+ (setq malyon-restore-data-error "Invalid save file."))))
+
+(defun malyon-restore-quetzal-state (size)
+ "Restore a saved quetzal game state from disk."
+ (let ((chunk-id nil)
+ (chunk-len 0)
+ (ip 0)
+ (memory nil)
+ (stack nil)
+ (beginning 0))
+ (while (< (point) size)
+ (setq chunk-id (malyon-read-chunk-id-from-file))
+ (setq chunk-len (malyon-read-dword-from-file))
+ (setq beginning (point))
+ (cond ((string= chunk-id "IFhd")
+ (setq ip (malyon-restore-quetzal-ifhd chunk-len)))
+ ((string= chunk-id "CMem")
+ (setq memory (malyon-restore-quetzal-cmem chunk-len)))
+ ((string= chunk-id "UMem")
+ (setq memory (malyon-restore-quetzal-umem chunk-len)))
+ ((string= chunk-id "Stks")
+ (setq stack (malyon-restore-quetzal-stks chunk-len))))
+ (if (zerop (mod chunk-len 2)) '() (setq chunk-len (+ 1 chunk-len)))
+ (goto-char (+ beginning chunk-len)))
+ (cond ((and ip memory stack)
+ (malyon-set-game-state (vector ip
+ (aref stack 0)
+ (aref stack 1)
+ (aref stack 2)
+ memory
+ t)))
+ ((null malyon-restore-data-error)
+ (setq malyon-restore-data-error "invalid quetzal file.")))))
+
+(defun malyon-restore-quetzal-ifhd (size)
+ "Restore an IFhd chunk from disk. Return the instruction pointer."
+ (if (and (= (malyon-read-word-from-file) (malyon-read-word 2))
+ (= (malyon-read-word-from-file) (malyon-read-word 18))
+ (= (malyon-read-word-from-file) (malyon-read-word 20))
+ (= (malyon-read-word-from-file) (malyon-read-word 22))
+ (= (malyon-read-word-from-file) (malyon-read-word 28)))
+ (logior (lsh (malyon-read-byte-from-file) 16)
+ (lsh (malyon-read-byte-from-file) 8)
+ (malyon-read-byte-from-file))
+ (setq malyon-restore-data-error "quetzal file doesn't belong to game.")
+ nil))
+
+(defun malyon-restore-quetzal-cmem (size)
+ "Restore a CMem chunk from disk. Return the entire memory layout."
+ (let ((memory (copy-sequence (aref malyon-game-state-restart 4)))
+ (max-size (+ (point) size))
+ (byte 0)
+ (i 0))
+ (while (< (point) max-size)
+ (setq byte (malyon-read-byte-from-file))
+ (if (zerop byte)
+ (setq i (+ 1 i (malyon-read-byte-from-file)))
+ (aset memory i (logxor byte (aref memory i)))
+ (setq i (+ 1 i))))
+ memory))
+
+(defun malyon-restore-quetzal-umem (size)
+ "Restore a UMem chunk from disk. Return the entire memory layout."
+ (let ((memory (copy-sequence (aref malyon-game-state-restart 4)))
+ (i 0))
+ (while (< i size)
+ (aset memory i (malyon-read-byte-from-file))
+ (setq i (+ 1 i)))
+ memory))
+
+(defun malyon-restore-quetzal-stks (size)
+ "Restore a Stks chunk from disk. Return a vector containing the
+stack pointer, the frame pointer, and the stack itself."
+ (let ((i 0) (frame-id 0))
+ (setq malyon-restore-quetzal-stack
+ (copy-sequence (aref malyon-game-state-restart 3)))
+ (setq malyon-restore-quetzal-stack-pointer -1)
+ (setq malyon-restore-quetzal-frame-pointer 2)
+ (while (< i size)
+ (let* ((beginning (point))
+ (return3 (malyon-read-byte-from-file))
+ (return2 (malyon-read-byte-from-file))
+ (return1 (malyon-read-byte-from-file))
+ (return-addr (logior (lsh return3 16) (lsh return2 8) return1))
+ (result-locals (malyon-read-byte-from-file))
+ (has-result (zerop (logand 16 result-locals)))
+ (num-locals (logand 15 result-locals))
+ (result-addr (malyon-read-byte-from-file))
+ (arg-flags (+ 1 (malyon-read-byte-from-file)))
+ (num-args 0)
+ (eval-size (malyon-read-word-from-file))
+ (local-vars '())
+ (eval-stack '()))
+ (while (> num-locals 0)
+ (setq local-vars (cons (malyon-read-word-from-file) local-vars))
+ (setq num-locals (- num-locals 1)))
+ (while (> eval-size 0)
+ (setq eval-stack (cons (malyon-read-word-from-file) eval-stack))
+ (setq eval-size (- eval-size 1)))
+ (while (> arg-flags 1)
+ (setq arg-flags (lsh arg-flags -1))
+ (setq num-args (+ num-args 1)))
+ (malyon-push-stack-frame frame-id
+ return-addr
+ (if (zerop frame-id)
+ nil
+ (if has-result result-addr nil))
+ (reverse local-vars)
+ num-args
+ (reverse eval-stack))
+ (setq frame-id (+ 1 frame-id))
+ (setq i (+ i (- (point) beginning)))))
+ (vector malyon-restore-quetzal-stack-pointer
+ malyon-restore-quetzal-frame-pointer
+ malyon-restore-quetzal-stack)))
+
+;; object table management
+
+(defsubst malyon-object-address (object)
+ "Compute the address at which the object is stored."
+ (+ malyon-object-table
+ (* 2 malyon-object-properties)
+ (* malyon-object-table-entry-size (- object 1))))
+
+(defsubst malyon-object-read-parent (address)
+ "Return the parent."
+ (if (< malyon-story-version 5)
+ (malyon-read-byte (+ 4 address))
+ (malyon-read-word (+ 6 address))))
+
+(defsubst malyon-object-read-sibling (address)
+ "Return the next sibling."
+ (if (< malyon-story-version 5)
+ (malyon-read-byte (+ 5 address))
+ (malyon-read-word (+ 8 address))))
+
+(defsubst malyon-object-read-child (address)
+ "Return the first child."
+ (if (< malyon-story-version 5)
+ (malyon-read-byte (+ 6 address))
+ (malyon-read-word (+ 10 address))))
+
+(defsubst malyon-object-store-parent (address value)
+ "Set the parent."
+ (if (< malyon-story-version 5)
+ (malyon-store-byte (+ 4 address) value)
+ (malyon-store-word (+ 6 address) value)))
+
+(defsubst malyon-object-store-sibling (address value)
+ "Set the next sibling."
+ (if (< malyon-story-version 5)
+ (malyon-store-byte (+ 5 address) value)
+ (malyon-store-word (+ 8 address) value)))
+
+(defsubst malyon-object-store-child (address value)
+ "Set the first child."
+ (if (< malyon-story-version 5)
+ (malyon-store-byte (+ 6 address) value)
+ (malyon-store-word (+ 10 address) value)))
+
+(defun malyon-find-property (object property)
+ "Return the address of the object's property, or 0 if it doesn't exist."
+ (let ((next (malyon-first-property object))
+ (number 0))
+ (setq number (logand (malyon-read-byte next) malyon-object-properties))
+ (while (> number property)
+ (setq next (malyon-next-property next))
+ (setq number (logand (malyon-read-byte next) malyon-object-properties)))
+ (if (= number property) next 0)))
+
+(defun malyon-first-property (object)
+ "Get the address of the object's first property."
+ (let ((header (malyon-read-word (+ malyon-object-property-offset
+ (malyon-object-address object)))))
+ (+ header 1 (* 2 (malyon-read-byte header)))))
+
+(defun malyon-next-property (property)
+ "Get the address of the following property."
+ (let ((size (malyon-read-byte property))
+ (addr (+ property 1)))
+ (+ 1 addr (cond ((< malyon-story-version 5) (lsh size -5))
+ ((zerop (logand 128 size)) (lsh size -6))
+ (t
+ (let ((second (logand 63 (malyon-read-byte addr))))
+ (if (= 0 second) 64 second)))))))
+
+(defun malyon-remove-object (object)
+ "Remove the object from the children list of its parent."
+ (let* ((address (malyon-object-address object))
+ (parent (malyon-object-read-parent address))
+ (sibling (malyon-object-read-sibling address)))
+ (malyon-object-store-parent address 0)
+ (malyon-object-store-sibling address 0)
+ (if (/= parent 0)
+ (let ((parent-addr (malyon-object-address parent)))
+ (let ((children (malyon-object-read-child parent-addr)))
+ (if (or (= children 0) (= children object))
+ (malyon-object-store-child parent-addr sibling)
+ (let ((this (malyon-object-address children)))
+ (let ((next (malyon-object-read-sibling this)))
+ (while (/= next object)
+ (setq this (malyon-object-address next))
+ (setq next (malyon-object-read-sibling this)))
+ (malyon-object-store-sibling this sibling)))))))))
+
+;; function calls and code branches
+
+(defun malyon-call-routine (routine arguments &optional result)
+ "Call a routine with the given arguments and return its result."
+ (if (= routine 0)
+ (if result (malyon-store-variable result 0) 0)
+ (malyon-push-stack (if result 0 1))
+ (malyon-push-stack (if result result 0))
+ (malyon-push-stack malyon-instruction-pointer)
+ (malyon-push-stack
+ (logior (lsh (- malyon-stack-pointer malyon-frame-pointer) 8)
+ (length arguments)))
+ (setq malyon-instruction-pointer (* malyon-packed-multiplier routine))
+ (let ((args (malyon-read-code-byte)) (value nil))
+ (if malyon-game-state-quetzal
+ (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
+ (malyon-push-stack (logior (lsh (+ 1 id) 8) args))))
+ (setq malyon-frame-pointer malyon-stack-pointer)
+ (while (> args 0)
+ (setq value (if (< malyon-story-version 5) (malyon-read-code-word) 0))
+ (malyon-push-stack (if (null arguments) value (car arguments)))
+ (setq arguments (cdr arguments))
+ (setq args (- args 1))))))
+
+(defun malyon-jump-if (condition)
+ "Jump depending on the condition and the following jump data."
+ (let ((byte (malyon-read-code-byte))
+ (offset nil)
+ (iftrue nil))
+ (setq iftrue (/= 0 (logand byte 128)))
+ (setq offset (logand byte 63))
+ (if (= 0 (logand byte 64))
+ (progn
+ (setq offset (logior (lsh offset 8) (malyon-read-code-byte)))
+ (if (>= offset 8192) (setq offset (- offset 16384)))))
+ (if (or (and iftrue condition) (and (not iftrue) (not condition)))
+ (progn
+ (cond ((= offset 0) (malyon-opcode-rfalse))
+ ((= offset 1) (malyon-opcode-rtrue))
+ (t (setq
+ malyon-instruction-pointer
+ (+ malyon-instruction-pointer offset -2))))))))
+
+(defun malyon-return (value)
+ "Return from a routine."
+ (setq malyon-stack-pointer malyon-frame-pointer)
+ (if malyon-game-state-quetzal (malyon-pop-stack))
+ (setq malyon-frame-pointer
+ (- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
+ (setq malyon-instruction-pointer (malyon-pop-stack))
+ (let ((result (malyon-pop-stack))
+ (store (malyon-pop-stack)))
+ (if (zerop store)
+ (malyon-return-store result value)
+ (malyon-return-ignore result value))))
+
+(defun malyon-return-ignore (where value)
+ "Return from a routine ignoring the result.")
+
+(defun malyon-return-store (where value)
+ "Return from a routine storing the result."
+ (malyon-store-variable where value))
+
+(defun malyon-push-initial-frame ()
+ "Push the initial stack frame required in quetzal mode."
+ (if malyon-game-state-quetzal
+ (progn
+ (malyon-push-stack 1)
+ (malyon-push-stack 0)
+ (malyon-push-stack 0)
+ (malyon-push-stack 0)
+ (malyon-push-stack 0))))
+
+(defun malyon-get-stack-frame (fp sp stack)
+ "Return a decoded stack frame in quetzal mode.
+The result is a vector containing the frame id, the fp of the
+previous frame, the sp of the previous frame, the return address,
+the result variable if any, a list of local variables, the number
+of arguments, and a list of the evaluation stack elements."
+ (let* ((has-result (zerop (aref stack fp)))
+ (result-addr (if has-result (aref stack (+ 1 fp)) nil))
+ (return-addr (aref stack (+ 2 fp)))
+ (offset (lsh (aref stack (+ 3 fp)) -8))
+ (num-args (logand 255 (aref stack (+ 3 fp))))
+ (frame-id (lsh (aref stack (+ 4 fp)) -8))
+ (num-locals (logand 255 (aref stack (+ 4 fp))))
+ (start-locals (+ 5 fp))
+ (start-eval (+ 5 fp num-locals))
+ (local-vars '())
+ (eval-stack '()))
+ (if (not (zerop num-locals))
+ (setq local-vars
+ (malyon-vector-to-list stack start-locals start-eval)))
+ (if (> sp start-eval)
+ (setq eval-stack
+ (malyon-vector-to-list stack start-eval (+ 1 sp))))
+ (vector frame-id
+ (- fp offset 2)
+ (- fp 1)
+ return-addr
+ result-addr
+ local-vars
+ num-args
+ eval-stack)))
+
+(defsubst malyon-restore-quetzal-push-stack (value)
+ "Push a value onto the restore quetzal stack."
+ (setq malyon-restore-quetzal-stack-pointer
+ (+ malyon-restore-quetzal-stack-pointer 1))
+ (aset malyon-restore-quetzal-stack
+ malyon-restore-quetzal-stack-pointer
+ value))
+
+(defun malyon-push-stack-frame
+ (frame-id return-addr result local-vars num-args eval-stack)
+ "Pushes a new stack frame in quetzal mode."
+ (malyon-restore-quetzal-push-stack (if result 0 1))
+ (malyon-restore-quetzal-push-stack (if result result 0))
+ (malyon-restore-quetzal-push-stack return-addr)
+ (malyon-restore-quetzal-push-stack
+ (logior (lsh (- malyon-restore-quetzal-stack-pointer
+ malyon-restore-quetzal-frame-pointer) 8)
+ num-args))
+ (malyon-restore-quetzal-push-stack
+ (logior (lsh frame-id 8) (length local-vars)))
+ (setq malyon-restore-quetzal-frame-pointer
+ malyon-restore-quetzal-stack-pointer)
+ (while (not (null local-vars))
+ (malyon-restore-quetzal-push-stack (car local-vars))
+ (setq local-vars (cdr local-vars)))
+ (while (not (null eval-stack))
+ (malyon-restore-quetzal-push-stack (car eval-stack))
+ (setq eval-stack (cdr eval-stack))))
+
+;; other stuff
+
+(defvar malyon-aread-text nil
+ "Text buffer for user input.")
+
+(defvar malyon-aread-parse nil
+ "Parse buffer for user input.")
+
+(defvar malyon-aread-beginning-of-line nil
+ "The beginning of the input line.")
+
+;; execution
+
+(defun malyon-interpreter ()
+ "Run the z code interpreter on the given story file."
+; (condition-case nil
+ (progn
+ (malyon-restore-window-configuration)
+ (if malyon-story-file
+ (catch 'malyon-end-of-interpreter-loop
+ (setq malyon-last-cursor-position-after-input
+ (malyon-point-max malyon-transcript-buffer))
+ (malyon-execute))))
+; (error
+; (malyon-fatal-error "unspecified internal runtime error."))))
+)
+(defsubst malyon-fetch-variable-operands (specifier)
+ "Fetch a variable number of operands based on the specifier argument."
+ (let ((var (logand specifier 49152))
+ (op '()))
+ (setq specifier (logand 65535 specifier))
+ (while (/= 0 specifier)
+ (cond ((= var 0) (setq op (cons (malyon-read-code-word) op)))
+ ((= var 16384) (setq op (cons (malyon-read-code-byte) op)))
+ ((= var 32768) (setq op (cons (malyon-read-variable
+ (malyon-read-code-byte)) op)))
+ (t (setq specifier 0)))
+ (setq specifier (logand 65535 (lsh specifier 2)))
+ (setq var (logand specifier 49152)))
+ (nreverse op)))
+
+(defsubst malyon-fetch-extended (opcode)
+ "Fetch operands for an extended instruction."
+ (malyon-fetch-variable-operands
+ (logior (lsh (malyon-read-code-byte) 8) 255)))
+
+(defsubst malyon-fetch-variable (opcode)
+ "Fetch operands for a variable instruction."
+ (malyon-fetch-variable-operands
+ (if (or (= opcode 236) (= opcode 250))
+ (malyon-read-code-word)
+ (logior (lsh (malyon-read-code-byte) 8) 255))))
+
+(defsubst malyon-fetch-short (opcode)
+ "Fetch operands for a short instruction."
+ (let ((op (logand opcode 48)))
+ (cond ((= op 0) (list (malyon-read-code-word)))
+ ((= op 16) (list (malyon-read-code-byte)))
+ ((= op 32) (list (malyon-read-variable (malyon-read-code-byte)))))))
+
+(defsubst malyon-fetch-long (instr)
+ "Fetch operands for a long instruction."
+ (let ((byte1 (malyon-read-code-byte))
+ (byte2 (malyon-read-code-byte)))
+ (list (if (= (logand instr 64) 0) byte1 (malyon-read-variable byte1))
+ (if (= (logand instr 32) 0) byte2 (malyon-read-variable byte2)))))
+
+(defun malyon-execute ()
+ "Execute z code instructions.
+Load the next instruction opcode and its operands and execute it.
+Repeat ad infinitum."
+ (let ((opcode) (operands)); (pc))
+ (while t
+; (setq pc malyon-instruction-pointer)
+ (setq opcode (malyon-read-code-byte))
+ (setq operands (cond ((= opcode 190)
+ (setq opcode (+ 256 (malyon-read-code-byte)))
+ (malyon-fetch-extended opcode))
+ ((>= opcode 192)
+ (malyon-fetch-variable opcode))
+ ((>= opcode 128)
+ (malyon-fetch-short opcode))
+ (t
+ (malyon-fetch-long opcode))))
+; (malyon-trace-opcode pc opcode operands)
+ (apply (aref malyon-opcodes opcode) operands))))
+
+;; opcodes
+
+(defsubst malyon-number (n)
+ "Convert an unsigned number into a signed one."
+ (if (< n 32768) n (- n 65536)))
+
+(defun malyon-opcode-add (a b)
+ "Addition."
+ (malyon-store-variable (malyon-read-code-byte)
+ (+ (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-and (a b)
+ "Bitwise and."
+ (malyon-store-variable (malyon-read-code-byte) (logand a b)))
+
+(defun malyon-opcode-aread (text parse &optional time routine)
+ "Read input text."
+ (setq malyon-aread-text text)
+ (setq malyon-aread-parse parse)
+ (goto-char (point-max))
+ (setq malyon-aread-beginning-of-line (point))
+; Some games violate these assumptions for the "Quit" question.
+; (if (> 3 (malyon-read-byte text))
+; (malyon-fatal-error "text buffer less than 3 bytes."))
+; (if (and (not (zerop parse)) (> 2 (malyon-read-byte parse)))
+; (malyon-fatal-error "parse buffer less than 2 bytes."))
+ (malyon-more malyon-keymap-read)
+ (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))
+
+(defun malyon-opcode-art-shift (value places)
+ "Arithmetic shift."
+ (malyon-store-variable (malyon-read-code-byte) (ash value places)))
+
+(defun malyon-opcode-buffer-mode (mode)
+ "Toggles buffering of text in the transcript window."
+ (setq malyon-transcript-buffer-buffered (/= 0 mode)))
+
+(defun malyon-opcode-calln (routine &rest arguments)
+ "Call a routine and ignore the result."
+ (malyon-call-routine routine arguments))
+
+(defun malyon-opcode-calls (routine &rest arguments)
+ "Call a routine and store the result."
+ (malyon-call-routine routine arguments (malyon-read-code-byte)))
+
+(defun malyon-opcode-catch ()
+ "Return the current stack frame."
+ (malyon-store-variable
+ (malyon-read-code-byte)
+ (if malyon-game-state-quetzal
+ (lsh (aref malyon-stack malyon-frame-pointer) -8)
+ malyon-frame-pointer)))
+
+(defun malyon-opcode-check-arg-count (count)
+ "Tests the number of arguments passed to routine."
+ (malyon-jump-if
+ (<= count (logand 255 (aref malyon-stack
+ (if malyon-game-state-quetzal
+ (- malyon-frame-pointer 1)
+ malyon-frame-pointer))))))
+
+(defun malyon-opcode-check-unicode (char)
+ "Check whether the given character is valid for input/output."
+ (malyon-store-variable (malyon-read-code-byte) 0))
+
+(defun malyon-opcode-clear-attr (object attribute)
+ "Clear the given attribute in the given object."
+ (let ((attributes (malyon-object-address object))
+ (byte (lsh attribute -3)))
+ (malyon-store-byte (+ attributes byte)
+ (logand (malyon-read-byte (+ attributes byte))
+ (logxor (lsh 128 (- (logand attribute 7)))
+ 255)))))
+
+(defun malyon-opcode-copy-table (first second size)
+ "Copies first table onto second one."
+ (let* ((length (abs (malyon-number size)))
+ (zero (zerop second))
+ (forward (or (< (malyon-number size) 0) (> first second)))
+ (i 0)
+ (a (if forward first (+ first length -1)))
+ (b (if forward (if zero first second) (+ second length -1))))
+ (while (< i length)
+ (malyon-store-byte b (if zero 0 (malyon-read-byte a)))
+ (setq i (+ i 1)
+ a (if forward (+ a 1) (- a 1))
+ b (if forward (+ b 1) (- b 1))))))
+
+(defun malyon-opcode-dec (var)
+ "Decrement variable."
+ (malyon-store-variable var
+ (- (malyon-number (malyon-read-variable var)) 1)))
+
+(defun malyon-opcode-dec-chk (variable threshold)
+ "Decrement variable and jump if it's less than the given value."
+ (let ((value (malyon-number (malyon-read-variable variable))))
+ (malyon-store-variable variable (- value 1))
+ (malyon-jump-if (< (- value 1) (malyon-number threshold)))))
+
+(defun malyon-opcode-div (a b)
+ "Division."
+ (if (zerop b) (malyon-fatal-error "division by 0."))
+ (malyon-store-variable (malyon-read-code-byte)
+ (/ (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-encode-text (text length from encoded)
+ "Encode the zscii text starting at from with the given length.
+The result is stored at encoded."
+ (let* ((i length)
+ (j encoded)
+ (l '())
+ (word '()))
+ (while (< 0 i)
+ (setq l (cons (malyon-read-byte (+ text from i -1)) l)
+ i (- i 1)))
+ (setq word (malyon-encode-dictionary-word
+ (append (malyon-mapcan 'malyon-encode-into-ztext l)
+ '(5 5 5 5 5 5 5 5))))
+ (while (< i 6)
+ (malyon-store-byte j (car l))
+ (setq i (+ 1 i)
+ j (+ 1 j)
+ l (cdr word)))))
+
+(defun malyon-opcode-erase-line (value)
+ "Erases the rest of the line."
+ (if (= value 1)
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (kill-line nil)
+ (save-excursion
+ (let ((i (current-column)))
+ (while (<= i malyon-max-column)
+ (insert ? )
+ (delete-char 1)
+ (setq i (+ 1 i))))))))
+
+(defun malyon-opcode-erase-window (window)
+ "Erase the contents of the given window."
+ (save-excursion
+ (let ((w (malyon-number window)))
+ (if (or (= w 0) (= w -1) (= w -2))
+ (malyon-erase-buffer malyon-transcript-buffer))
+ (if (or (= w 1) (= w -1) (= w -2))
+ (malyon-erase-buffer malyon-status-buffer))
+ (if (= w -1)
+ (malyon-split-buffer-windows 0)))
+ (setq malyon-last-cursor-position-after-input
+ (malyon-point-max malyon-transcript-buffer))))
+
+(defun malyon-opcode-get-child (object)
+ "Get the first child of the given object and jump."
+ (let ((child (malyon-object-read-child (malyon-object-address object))))
+ (malyon-store-variable (malyon-read-code-byte) child)
+ (malyon-jump-if (/= 0 child))))
+
+(defun malyon-opcode-get-cursor (array)
+ "Retrieves the current cursor position."
+ (save-excursion
+ (set-buffer malyon-status-buffer)
+ (malyon-store-word array (- (count-lines (point-min) (point)) 1))
+ (malyon-store-word (+ 2 array) (+ 1 (current-column)))))
+
+(defun malyon-opcode-get-next-prop (object property)
+ "Retrieve the first or next property id of object."
+ (let ((next (malyon-first-property object))
+ (number 0))
+ (if (zerop property)
+ '()
+ (setq number (logand (malyon-read-byte next)
+ malyon-object-properties))
+ (setq next (malyon-next-property next))
+ (while (> number property)
+ (setq number (logand (malyon-read-byte next)
+ malyon-object-properties))
+ (setq next (malyon-next-property next)))
+ (if (/= number property)
+ (malyon-fatal-error "property does not exist.")))
+ (setq number (logand (malyon-read-byte next) malyon-object-properties))
+ (malyon-store-variable (malyon-read-code-byte) number)))
+
+(defun malyon-opcode-get-parent (object)
+ "Get the parent of the given object."
+ (malyon-store-variable (malyon-read-code-byte)
+ (malyon-object-read-parent
+ (malyon-object-address object))))
+
+(defun malyon-opcode-get-prop (object property)
+ "Get the value of the object's property."
+ (let* ((address (malyon-find-property object property))
+ (size (malyon-read-byte address)))
+ (malyon-store-variable
+ (malyon-read-code-byte)
+ (cond ((zerop address)
+ (malyon-read-word (+ malyon-object-table (* 2 (- property 1)))))
+ ((and (< malyon-story-version 5) (zerop (lsh size -5)))
+ (malyon-read-byte (+ address 1)))
+ ((and (>= malyon-story-version 5) (zerop (logand 192 size)))
+ (malyon-read-byte (+ address 1)))
+ (t
+ (malyon-read-word (+ address 1)))))))
+
+(defun malyon-opcode-get-prop-addr (object property)
+ "Get the address of the object's property."
+ (let* ((address (malyon-find-property object property))
+ (size (malyon-read-byte address))
+ (offset (if (< malyon-story-version 5)
+ 1
+ (if (zerop (logand 128 size)) 1 2))))
+ (malyon-store-variable (malyon-read-code-byte)
+ (if (zerop address) 0 (+ address offset)))))
+
+(defun malyon-opcode-get-prop-len (property)
+ "Get the length of the object's property."
+ (let ((size (malyon-read-byte (- property 1))))
+ (malyon-store-variable
+ (malyon-read-code-byte)
+ (cond ((< malyon-story-version 5) (+ 1 (lsh size -5)))
+ ((zerop (logand 128 size)) (+ 1 (lsh size -6)))
+ ((zerop (logand 63 size)) 64)
+ (t (logand 63 size))))))
+
+(defun malyon-opcode-get-sibling (object)
+ "Get the next object in the tree and jump."
+ (let ((sibling (malyon-object-read-sibling (malyon-object-address object))))
+ (malyon-store-variable (malyon-read-code-byte) sibling)
+ (malyon-jump-if (/= 0 sibling))))
+
+(defun malyon-opcode-illegal (&rest ignore)
+ "Print an error message and exit the interpreter."
+ (malyon-fatal-error "illegal opcode."))
+
+(defun malyon-opcode-inc (var)
+ "Increment variable."
+ (malyon-store-variable var
+ (+ (malyon-number (malyon-read-variable var)) 1)))
+
+(defun malyon-opcode-inc-chk (variable threshold)
+ "Increment variable and jump if it's greater than the given value."
+ (let ((value (malyon-number (malyon-read-variable variable))))
+ (malyon-store-variable variable (+ value 1))
+ (malyon-jump-if (> (+ value 1) (malyon-number threshold)))))
+
+(defun malyon-opcode-input-stream (number)
+ "Select the given input stream. Only the keyboard is supported."
+ (if (zerop (malyon-number number))
+ '()
+ (message "Only the keyboard is supported as an input stream.")))
+
+(defun malyon-opcode-insert-obj (object destination)
+ "Insert an object into the children list of another."
+ (let ((child (malyon-object-address object))
+ (parent (malyon-object-address destination)))
+ (malyon-remove-object object)
+ (malyon-object-store-parent child destination)
+ (malyon-object-store-sibling child (malyon-object-read-child parent))
+ (malyon-object-store-child parent object)))
+
+(defun malyon-opcode-je (a &rest rest)
+ "Jump if first operand equals any of the following."
+ (malyon-jump-if (member (malyon-number a) (mapcar 'malyon-number rest))))
+
+(defun malyon-opcode-jg (a b)
+ "Jump if first operand > second operand."
+ (malyon-jump-if (> (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-jin (child parent)
+ "Jump if second object is parent of the first one."
+ (malyon-jump-if
+ (= parent (malyon-object-read-parent (malyon-object-address child)))))
+
+(defun malyon-opcode-jl (a b)
+ "Jump if first operand < second operand."
+ (malyon-jump-if (< (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-jump (offset)
+ "Jump unconditionally."
+ (setq malyon-instruction-pointer (+ malyon-instruction-pointer
+ (malyon-number offset) -2)))
+
+(defun malyon-opcode-jz (a)
+ "Jump if operand = 0."
+ (malyon-jump-if (zerop a)))
+
+(defun malyon-opcode-load (variable)
+ "Load a variable."
+ (malyon-store-variable (malyon-read-code-byte)
+ (malyon-read-variable variable)))
+
+(defun malyon-opcode-loadb (array index)
+ "Load an array element into a variable."
+ (malyon-store-variable (malyon-read-code-byte)
+ (malyon-read-byte (+ array index))))
+
+(defun malyon-opcode-loadw (array index)
+ "Load an array element into a variable."
+ (malyon-store-variable (malyon-read-code-byte)
+ (malyon-read-word (+ array (* 2 index)))))
+
+(defun malyon-opcode-log-shift (value places)
+ "Logical shift."
+ (malyon-store-variable (malyon-read-code-byte) (lsh value places)))
+
+(defun malyon-opcode-mod (a b)
+ "Modulo."
+ (malyon-store-variable (malyon-read-code-byte)
+ (mod (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-mul (a b)
+ "Multiplication."
+ (malyon-store-variable (malyon-read-code-byte)
+ (* (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-new-line ()
+ "Print a newline."
+ (malyon-newline))
+
+(defun malyon-opcode-nop (&rest ignore)
+ "Do nothing.")
+
+(defun malyon-opcode-not (a)
+ "Bitwise not."
+ (malyon-store-variable (malyon-read-code-byte) (logand 65535 (lognot a))))
+
+(defun malyon-opcode-or (a b)
+ "Bitwise or."
+ (malyon-store-variable (malyon-read-code-byte) (logior a b)))
+
+(defun malyon-opcode-output-stream (stream &optional table)
+ "Select an output stream."
+ (let ((stream (malyon-number stream)))
+ (cond ((< 0 stream) (malyon-add-output-stream stream table))
+ ((> 0 stream) (malyon-remove-output-stream (- stream))))))
+
+(defun malyon-opcode-piracy ()
+ "Piracy check, effectively an unconditional jump."
+ (malyon-jump-if 1))
+
+(defun malyon-opcode-print ()
+ "Print a string."
+ (setq malyon-instruction-pointer
+ (malyon-print-text malyon-instruction-pointer)))
+
+(defun malyon-opcode-print-addr (address)
+ "Print a string."
+ (malyon-print-text address))
+
+(defun malyon-opcode-print-char (c)
+ "Print a character."
+ (malyon-print (char-to-string c)))
+
+(defun malyon-opcode-print-num (n)
+ "Print a number."
+ (malyon-print (number-to-string (malyon-number n))))
+
+(defun malyon-opcode-print-obj (obj)
+ "Print the short name of the object."
+ (malyon-print-text
+ (+ 1 (malyon-read-word (+ malyon-object-property-offset
+ (malyon-object-address obj))))))
+
+(defun malyon-opcode-print-paddr (address)
+ "Print a string."
+ (malyon-print-text (* malyon-packed-multiplier address)))
+
+(defun malyon-opcode-print-ret ()
+ "Print a string, print a newline, return true/1."
+ (setq malyon-instruction-pointer
+ (malyon-print-text malyon-instruction-pointer))
+ (malyon-newline)
+ (malyon-return 1))
+
+(defun malyon-opcode-print-table (text width &optional height skip)
+ "Print the given table."
+ (if (not height) (setq height 1))
+ (if (not skip) (setq skip 0))
+ (let ((column (current-column))
+ (address text)
+ (y 0)
+ (x 0))
+ (while (< y height)
+ (if (zerop y)
+ '()
+ (malyon-newline)
+ (malyon-print-characters (make-string column ? )))
+ (setq x 0)
+ (while (< x width)
+ (malyon-output-character (malyon-read-byte address))
+ (setq address (+ 1 address))
+ (setq x (+ 1 x)))
+ (setq address (+ skip address))
+ (setq y (+ 1 y)))))
+
+(defun malyon-opcode-print-unicode (char)
+ "Prints a unicode character.")
+
+(defun malyon-opcode-pull (variable)
+ "Pull value off stack."
+ (malyon-store-variable variable (malyon-pop-stack)))
+
+(defun malyon-opcode-push (value)
+ "Push value onto stack."
+ (malyon-push-stack value))
+
+(defun malyon-opcode-put-prop (object property value)
+ "Set the object's property to the given value."
+ (let* ((address (malyon-find-property object property))
+ (size (malyon-read-byte address)))
+ (cond ((= address 0)
+ (malyon-fatal-error "property does not exist."))
+ ((and (< malyon-story-version 5) (zerop (lsh size -5)))
+ (malyon-store-byte (+ 1 address) (logand 255 value)))
+ ((and (>= malyon-story-version 5) (zerop (logand size 192)))
+ (malyon-store-byte (+ 1 address) (logand 255 value)))
+ (t
+ (malyon-store-word (+ 1 address) value)))))
+
+(defun malyon-opcode-quit ()
+ "End the game immediately."
+ (malyon-adjust-transcript)
+ (malyon-cleanup)
+ (throw 'malyon-end-of-interpreter-loop 'malyon-opcode-quit))
+
+(defun malyon-opcode-random (limit)
+ "Generate a random number or set the seed value."
+ (malyon-store-variable (malyon-read-code-byte)
+ (if (>= 0 (malyon-number limit))
+ 0
+ (+ 1 (random (malyon-number limit))))))
+
+(defun malyon-opcode-read-char (&optional device &rest ignore)
+ "Read a character."
+ (if (and device (/= 1 device))
+ (malyon-fatal-error "illegal device specified in read_char."))
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (goto-char (point-max)))
+ (message "[Press a key.]")
+ (malyon-more malyon-keymap-readchar)
+ (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-character))
+
+(defun malyon-opcode-remove-obj (object)
+ "Remove an object from its parent's children list."
+ (malyon-remove-object object))
+
+(defun malyon-opcode-restart ()
+ "Restart the game."
+ (malyon-set-game-state malyon-game-state-restart))
+
+(defun malyon-opcode-restore (&optional table bytes name)
+ "Restore a saved game state or a section of memory from a file."
+ (let ((result (if name
+ (malyon-restore-file
+ (malyon-get-file-name name) table bytes)
+ (call-interactively 'malyon-restore-file))))
+ (if (< malyon-story-version 5)
+ (malyon-jump-if (not (zerop result)))
+ (malyon-store-variable (malyon-read-code-byte) result))))
+
+(defun malyon-opcode-restore-undo ()
+ "Restore game state for undo."
+ (if malyon-game-state-undo
+ (malyon-set-game-state malyon-game-state-undo))
+ (malyon-store-variable (malyon-read-code-byte) 2))
+
+(defun malyon-opcode-ret (value)
+ "Return a value."
+ (malyon-return value))
+
+(defun malyon-opcode-ret-popped ()
+ "Return top of stack."
+ (malyon-return (malyon-pop-stack)))
+
+(defun malyon-opcode-rfalse ()
+ "Return false/0."
+ (malyon-return 0))
+
+(defun malyon-opcode-rtrue ()
+ "Return true/1."
+ (malyon-return 1))
+
+(defun malyon-opcode-save (&optional table bytes name)
+ "Save the current game state or a section of memory to a file."
+ (let ((result (if name
+ (malyon-save-file (malyon-get-file-name name) table bytes)
+ (call-interactively 'malyon-save-file))))
+ (if (< malyon-story-version 5)
+ (malyon-jump-if (not (zerop result)))
+ (malyon-store-variable (malyon-read-code-byte) result))))
+
+(defun malyon-opcode-save-undo ()
+ "Save game state for undo."
+ (setq malyon-game-state-undo (malyon-current-game-state))
+ (malyon-store-byte (malyon-read-code-byte) 1))
+
+(defun malyon-opcode-scan-table (x table len &optional form)
+ "Scan the given table for the first occurrence of x."
+ (if (not form) (setq form 130))
+ (let ((inc (logand 127 form))
+ (byte (zerop (logand 128 form)))
+ (addr table)
+ (found 0)
+ (index 0))
+ (while (and (zerop found) (< index len))
+ (setq found
+ (if byte
+ (if (= x (malyon-read-byte addr)) addr 0)
+ (if (= x (malyon-read-word addr)) addr 0)))
+ (setq addr (+ addr inc))
+ (setq index (+ index 1)))
+ (malyon-store-variable (malyon-read-code-byte) found)
+ (malyon-jump-if (not (zerop found)))))
+
+(defun malyon-opcode-set-attr (object attribute)
+ "Set the given attribute in the given object."
+ (let ((attributes (malyon-object-address object))
+ (byte (lsh attribute -3)))
+ (malyon-store-byte (+ attributes byte)
+ (logior (malyon-read-byte (+ attributes byte))
+ (lsh 128 (- (logand attribute 7)))))))
+
+(defun malyon-opcode-set-color (foreground background)
+ "Sets the fore- and background colors ie. does nothing.")
+
+(defun malyon-opcode-set-cursor (&optional line column)
+ "Set the cursor."
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (goto-char (point-max))
+ (if malyon-status-buffer-delayed-split
+ (progn
+ (malyon-split-buffer-windows malyon-status-buffer-delayed-split)
+ (other-window 1)))
+ (if line '() (setq line (count-lines (point-min) (point))))
+ (if column '() (setq column (current-column)))
+ (if (> line malyon-status-buffer-lines)
+ (progn
+ (malyon-split-buffer-windows line)
+ (other-window 1)))
+ (goto-char (point-min))
+ (if (and (<= 1 line) (<= line malyon-status-buffer-lines))
+ (forward-line line)
+ (beginning-of-line))
+ (if (and (<= 1 column) (<= column malyon-max-column))
+ (forward-char (- column 1))
+ (beginning-of-line))
+ (setq malyon-status-buffer-point (point))))
+
+(defun malyon-opcode-set-font (font)
+ "Sets the font if available or 0 otherwise."
+ (malyon-store-variable (malyon-read-code-byte) 0))
+
+(defun malyon-opcode-set-text-style (style)
+ "Set the text style/face."
+ (let ((face (assq style malyon-faces)))
+ (setq malyon-current-face (if face (cdr face) 'malyon-face-plain))))
+
+(defun malyon-opcode-set-window (window)
+ "Set the current window."
+ (malyon-restore-window-configuration)
+ (setq malyon-current-window window)
+ (malyon-update-output-streams)
+ (if (zerop window)
+ (if (not (eq malyon-transcript-buffer (current-buffer)))
+ (other-window 1))
+ (if (not (eq malyon-status-buffer (current-buffer)))
+ (other-window 1))
+ (malyon-opcode-set-cursor 1 1)))
+
+(defun malyon-opcode-show-status ()
+ "Display the status line."
+ (save-excursion
+ (malyon-opcode-split-window 1)
+ (malyon-restore-window-configuration)
+ (malyon-opcode-set-window 1)
+ (malyon-prepare-status-buffer 1)
+ (malyon-opcode-set-cursor 1 1)
+ (malyon-opcode-print-obj (malyon-read-global-variable 0))
+ (if (<= (current-column) (- (current-fill-column) 10))
+ (let* ((x (malyon-read-global-variable 1))
+ (y (malyon-read-global-variable 2))
+ (hours (if (> x 12) (- x 12) x))
+ (ampm (if (> x 12) "PM" "AM"))
+ (score (format "%4d/%4d" x y))
+ (time (format "%02d:%02d%s" hours y ampm)))
+ (malyon-opcode-set-cursor 1 (- (current-fill-column) 10))
+ (malyon-print (if malyon-score-game score time))))
+ (malyon-opcode-set-window 0)
+ (malyon-adjust-transcript)))
+
+(defun malyon-opcode-split-window (size)
+ "Split upper and lower window."
+ (malyon-set-window-configuration size))
+
+(defun malyon-opcode-store (variable value)
+ "Store a value in a variable."
+ (malyon-store-variable variable value))
+
+(defun malyon-opcode-storeb (array index value)
+ "Store a value in an array at the given index."
+ (malyon-store-byte (+ array index) value))
+
+(defun malyon-opcode-storew (array index value)
+ "Store a value in an array at the given index."
+ (malyon-store-word (+ array (* 2 index)) value))
+
+(defun malyon-opcode-sub (a b)
+ "Subtraction."
+ (malyon-store-variable (malyon-read-code-byte)
+ (- (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-test (bitmap flags)
+ "Test if all of the flags are set in the bitmap."
+ (malyon-jump-if (= flags (logand bitmap flags))))
+
+(defun malyon-opcode-test-attr (object attribute)
+ "Jump depending on the given attribute in the given object."
+ (malyon-jump-if
+ (/= 0 (logand (malyon-read-byte (+ (malyon-object-address object)
+ (lsh attribute -3)))
+ (lsh 128 (- (logand attribute 7)))))))
+
+(defun malyon-opcode-throw (value frame)
+ "Return from the given stack frame."
+ (if malyon-game-state-quetzal
+ (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
+ (while (/= frame id)
+ (setq malyon-stack-pointer malyon-frame-pointer)
+ (malyon-pop-stack)
+ (setq malyon-frame-pointer
+ (- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
+ (malyon-pop-stack)
+ (malyon-pop-stack)
+ (setq id (lsh (aref malyon-stack malyon-frame-pointer) -8))))
+ (setq malyon-frame-pointer frame))
+ (malyon-return value))
+
+(defun malyon-opcode-tokenise (text parse &optional dict flag)
+ "Perform lexical analysis on the text buffer."
+ (let* ((words (malyon-text-to-words text dict))
+ (word (car words))
+ (start (car word))
+ (len (malyon-cadr word))
+ (code (malyon-caddr word))
+ (entry (malyon-lookup dict code))
+ (i 0))
+ (while (not (or (null words) (= i (malyon-read-byte parse))))
+ (if (and (zerop entry) flag (/= 0 flag))
+ '()
+ (malyon-store-word (+ 2 parse (* 4 i)) entry)
+ (malyon-store-byte (+ 4 parse (* 4 i)) len)
+ (malyon-store-byte (+ 5 parse (* 4 i)) start))
+ (setq words (cdr words)
+ word (car words)
+ start (car word)
+ len (malyon-cadr word)
+ code (malyon-caddr word)
+ entry (malyon-lookup dict code)
+ i (+ 1 i)))
+ (malyon-store-byte (+ 1 parse) i)))
+
+(defun malyon-opcode-verify ()
+ "Verify the correctness of the story file."
+ (let ((length (+ 1 (* malyon-packed-multiplier (malyon-read-word 26))))
+ (sum 0)
+ (i 64))
+ (while (< i length)
+ (setq sum (mod (+ sum (malyon-read-byte i)) 65536)
+ i (+ 1 i)))
+ (malyon-jump-if (= (malyon-read-word 28) sum))))
+
+;; keymap utilities
+
+(defun malyon-end-input ()
+ "Store the input line in a text buffer and perform lexical analysis."
+ (interactive)
+ (condition-case nil
+ (progn
+ (malyon-adjust-transcript)
+ (switch-to-buffer malyon-transcript-buffer)
+ (goto-char (point-max))
+ (let* ((input (downcase
+ (buffer-substring-no-properties
+ (if (< malyon-aread-beginning-of-line (point))
+ malyon-aread-beginning-of-line
+ (point))
+ (point))))
+ (vec (malyon-string-to-vector input))
+ (text (apply 'vector (mapcar 'malyon-unicode-to-zscii vec)))
+ (len (min (malyon-read-byte malyon-aread-text) (length text)))
+ (i 0))
+ (malyon-history-insert input)
+ (if (>= malyon-story-version 5)
+ (malyon-store-byte (+ malyon-aread-text 1) len))
+ (while (< i len)
+ (malyon-store-byte
+ (+ malyon-aread-text (if (< malyon-story-version 5) 1 2) i)
+ (malyon-char-to-int (aref text i)))
+ (setq i (+ 1 i)))
+ (if (< malyon-story-version 5)
+ (malyon-store-byte (+ malyon-aread-text 1 len) 0)))
+ (if (/= 0 malyon-aread-parse)
+ (malyon-opcode-tokenise malyon-aread-text malyon-aread-parse))
+ (newline)
+ (if (>= malyon-story-version 5)
+ (malyon-store-variable (malyon-read-code-byte) 10))
+ (malyon-interpreter))
+ (error
+ (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defun malyon-more-char ()
+ "Page down in More mode."
+ (interactive)
+ (condition-case nil
+ (scroll-up)
+ (error))
+ (if (>= (count-lines (point) (point-max))
+ (malyon-window-displayed-height))
+ (message "[More]")
+ (goto-char (point-max))
+ (malyon-adjust-transcript)
+ (use-local-map malyon-more-continue-keymap)))
+
+(defun malyon-more-char-status ()
+ "Wait for a key then continue."
+ (interactive)
+ (condition-case nil
+ (progn
+ (malyon-adjust-transcript)
+ (use-local-map malyon-more-continue-keymap)
+ (malyon-interpreter))
+ (error
+ (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defun malyon-wait-char ()
+ "Store the input character in a variable and resume execution."
+ (interactive)
+ (condition-case nil
+ (progn
+ (malyon-store-variable
+ (malyon-read-code-byte)
+ (malyon-char-to-int (malyon-unicode-to-zscii last-command-char)))
+ (use-local-map malyon-keymap-read)
+ (malyon-interpreter))
+ (error
+ (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defun malyon-history-previous-char (arg)
+ "Display the previous item in the input history."
+ (interactive "p")
+ (let ((input (malyon-history-previous)))
+ (cond ((> malyon-aread-beginning-of-line (point))
+ (funcall malyon-history-saved-up arg))
+ (input
+ (save-excursion
+ (set-buffer malyon-transcript-buffer)
+ (delete-region malyon-aread-beginning-of-line (point-max)))
+ (goto-char (point-max))
+ (insert input)
+ (malyon-adjust-transcript)))))
+
+(defun malyon-history-next-char (arg)
+ "Display the next item in the input history."
+ (interactive "p")
+ (let ((input (malyon-history-next)))
+ (cond ((> malyon-aread-beginning-of-line (point))
+ (funcall malyon-history-saved-down arg))
+ (input
+ (save-excursion
+ (set-buffer malyon-transcript-buffer)
+ (delete-region malyon-aread-beginning-of-line (point-max)))
+ (goto-char (point-max))
+ (insert input)
+ (malyon-adjust-transcript)))))
+
+(defun malyon-beginning-of-line (arg)
+ "Go to the beginning of the line."
+ (interactive "p")
+ (if (> malyon-aread-beginning-of-line (point))
+ (beginning-of-line)
+ (goto-char malyon-aread-beginning-of-line)))
+
+(defun malyon-kill-region (arg)
+ "Kill region."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (kill-region (point) (mark))
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-kill-line (arg)
+ "Kill rest of the current line."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (kill-line)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-kill-word (arg)
+ "Kill the current word."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (kill-word 1)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-yank (arg)
+ "Yank."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (yank)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-yank-pop (arg)
+ "Yank pop."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (yank-pop 1)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-delete-char (arg)
+ "Delete a character."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (delete-char 1)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-backward-delete-char (arg)
+ "Delete a character backwards."
+ (interactive "p")
+ (if (< malyon-aread-beginning-of-line (point))
+ (backward-delete-char-untabify 1)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-self-insert-command (arg)
+ "Insert a character."
+ (interactive "p")
+ (if (> malyon-aread-beginning-of-line (point))
+ (goto-char (point-max)))
+ (self-insert-command 1))
+
+;; tracing utility
+
+(defun malyon-trace-file ()
+ "Turn tracing on for a particular file."
+ (let ((trace
+ (get-buffer-create
+ (concat "Malyon Trace " malyon-story-file-name))))
+ (if trace
+ (save-excursion
+ (set-buffer trace)
+ (malyon-erase-buffer)
+ (insert (concat "Tracing " malyon-story-file-name "..."))
+ (newline)))))
+
+(defun malyon-trace-newline ()
+ "Output tracing newline."
+ (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
+ (if trace
+ (save-excursion
+ (set-buffer trace)
+ (goto-char (point-max))
+ (newline)))))
+
+(defun malyon-trace-opcode (pc opcode operands)
+ "Output a z code instruction."
+ (malyon-trace-string
+ (format "%8d %-3d %-25s %s\n"
+ pc
+ opcode
+ (symbol-name (aref malyon-opcodes opcode))
+ (apply 'concat (malyon-mapcan
+ (lambda (x)
+ (list " "
+ (number-to-string
+ (if (malyon-characterp x)
+ (malyon-char-to-int x)
+ x))))
+ operands)))))
+
+(defun malyon-trace-string (s)
+ "Output tracing string."
+ (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
+ (if (and trace s)
+ (save-excursion
+ (set-buffer trace)
+ (goto-char (point-max))
+ (insert s)))))
+
+(defun malyon-trace-object (o)
+ "Output tracing object."
+ (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
+ (if (and trace o)
+ (save-excursion
+ (set-buffer trace)
+ (goto-char (point-max))
+ (prin1 o trace)))))
+
+;;; announce malyon-mode
+
+(provide 'malyon-mode)
+(provide 'malyon)
+
+;;; malyon-mode.el ends here
--- /dev/null
+;;; $Id: maxframe.el 331 2007-02-20 16:58:21Z ryan $
+;; maximize the emacs frame based on display size
+
+;; Copyright (C) 2007 Ryan McGeary
+;; Author: Ryan McGeary
+;; Keywords: display frame window maximize
+
+;; This code is free; you can redistribute it and/or modify it under the
+;; terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+
+;;; Commentary:
+;;
+;; Purpose
+;; -------
+;; maxframe provides the ability to maximize the emacs frame and stay within
+;; the display resolution.
+;;
+;; Usage
+;; -----
+;; Example of lines to be added to your .emacs:
+;;
+;; (require 'maxframe)
+;; (add-hook 'window-setup-hook 'maximize-frame t)
+;;
+;; How it works
+;; ------------
+;; puts the emacs frame in the top left corner of the display and calculates
+;; the maximum number of columns and rows that can fit in the display
+;;
+;; Limitations
+;; -----------
+;; Requires Emacs 22 (for fringe support), but maximize-frame still works
+;; under Emacs 21 on Windows.
+;;
+;; Emacs does not recognize when the display's resolution is changed. This is
+;; a problem because I would like to be able to re-maximize the frame after
+;; connecting to a display with different resolution. Unfortunately,
+;; display-pixel-width and display-pixel-height yield the display resolution
+;; values from when emacs was started instead of the current display
+;; values. Perhaps there's a way to have emacs re-sniff these values, but I'm
+;; not yet sure how.
+
+
+(defgroup maxframe nil "Handle maximizing frames.")
+
+(defcustom mf-display-padding-width 0
+ "*Any extra display padding that you want to account for while
+determining the maximize number of columns to fit on a display"
+ :type 'integer
+ :group 'maxframe)
+
+;; The default accounts for a Mac OS X display with a menubar
+;; height of 22 pixels, a titlebar of 23 pixels, and no dock.
+(defcustom mf-display-padding-height (+ 22 23)
+ "*Any extra display padding that you want to account for while
+determining the maximize number of rows to fit on a display"
+ :type 'integer
+ :group 'maxframe)
+
+(defun w32-maximize-frame ()
+ "Maximize the current frame (windows only)"
+ (interactive)
+ (w32-send-sys-command 61488))
+
+(defun w32-restore-frame ()
+ "Restore a minimized/maximized frame (windows only)"
+ (interactive)
+ (w32-send-sys-command 61728))
+
+(defun mf-max-columns (width)
+ "Calculates the maximum number of columns that can fit in
+pixels specified by WIDTH."
+ (let ((scroll-bar (or (frame-parameter nil 'scroll-bar-width) 0))
+ (left-fringe (or left-fringe-width (nth 0 (window-fringes)) 0))
+ (right-fringe (or right-fringe-width (nth 1 (window-fringes)) 0)))
+ (/ (- width scroll-bar left-fringe right-fringe
+ mf-display-padding-width)
+ (frame-char-width))))
+
+(defun mf-max-rows (height)
+ "Calculates the maximum number of rows that can fit in pixels
+specified by HEIGHT."
+ (/ (- height
+ mf-display-padding-height)
+ (frame-char-height)))
+
+(defun mf-set-frame-pixel-size (frame width height)
+ "Sets size of FRAME to WIDTH by HEIGHT, measured in pixels."
+ (set-frame-size frame (mf-max-columns width) (mf-max-rows height)))
+
+(defun x-maximize-frame ()
+ "Maximize the current frame (x or mac only)"
+ (interactive)
+ (mf-set-frame-pixel-size (selected-frame)
+ (display-pixel-width)
+ (display-pixel-height))
+ (set-frame-position (selected-frame) 0 0))
+
+(defun maximize-frame ()
+ "Maximizes the frame to fit the display if under a windowing
+system."
+ (interactive)
+ (cond ((eq window-system 'w32) (w32-maximize-frame))
+ ((memq window-system '(x mac)) (x-maximize-frame))))
+
+(defalias 'mf 'maximize-frame)
+
+(provide 'maxframe)
--- /dev/null
+;;; moz.el --- Lets current buffer interact with inferior mozilla.
+
+;; URL: http://github.com/bard/mozrepl/raw/master/chrome/content/moz.el
+
+;; Copyright (C) 2006 by Massimiliano Mirra
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+;;
+;; Author: Massimiliano Mirra, <bard [at] hyperstruct [dot] net>
+;; Contributors:
+;; - Lennart Borgman
+
+;;; Commentary:
+;;
+;; This file implements communication with Firefox via MozRepl
+;; (http://hyperstruct.net/projects/mozrepl). It is a slightly
+;; modified version of the file moz.el that comes with MozLab. To use
+;; it you have to install the MozRepl addon in Firefox.
+;;
+;; This file contains
+;;
+;; * a major mode for direct interaction in a buffer (as with
+;; telnet) with MozRepl, `inferior-moz-mode'.
+;; * a minor mode for sending code portions or whole files from
+;; other buffers to MozRepl, `moz-minor-mode'.
+;;
+;; Assuming you want to use javascript-mode to edit Javascript files,
+;; enter the following in your .emacs initialization file (from Emacs
+;; integration in the help text):
+;;
+;; (add-to-list 'auto-mode-alist '("\\.js$" . javascript-mode))
+;; (autoload 'inferior-moz-mode "moz" "MozRepl Inferior Mode" t)
+;; (autoload 'moz-minor-mode "moz" "MozRepl Minor Mode" t)
+;; (add-hook 'javascript-mode-hook 'javascript-moz-setup)
+;; (defun javascript-moz-setup () (moz-minor-mode 1))
+;;
+;; Replace javascript-mode above with the name of your favorite
+;; javascript mode.
+;;
+;; If you got this with nXhtml the setup above is already done for
+;; you.
+;;
+;; *Note 1* You have to start the MozRepl server in Firefox (or
+;; whatever Mozilla browser you use). From the menus do
+;;
+;; Tools - MozRepl - Start
+;;
+;; *Note 2* For clearness and brevity the documentation says Firefox
+;; where the correct term should rather be "your Mozilla web
+;; browser".
+
+;;; Change log:
+;;
+;; 2008-07-20: Lennart Borgman
+;; - Add `moz-minor-mode-map'.
+;; - Add `inferior-moz-insert-moz-repl'.
+;; - Add `inferior-moz-mode-map'.
+;; - Add doc strings to interactive functions.
+;; - Make minor enhancements to documentation etc.
+;; - Change Mozilla to Firefox/MozRepl for clarity and brevity.
+;; - Add error handling when starting MozRepl.
+
+;;; Code:
+
+(require 'comint)
+
+;; Maybe fix-me: C-c control-char are reserved for major modes. But
+;; this minor mode is used in only one major mode (or one family of
+;; major modes) so it complies I think ...
+(defvar moz-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-s" 'run-mozilla)
+ (define-key map "\C-\M-x" 'moz-send-defun)
+ (define-key map "\C-c\C-c" 'moz-send-defun-and-go)
+ (define-key map "\C-c\C-r" 'moz-send-region)
+ (define-key map "\C-c\C-l" 'moz-save-buffer-and-send)
+ map))
+
+;;;###autoload
+(define-minor-mode moz-minor-mode
+ "MozRepl minor mode for interaction with Firefox.
+With no argument, this command toggles the mode.
+Non-null prefix argument turns on the mode.
+Null prefix argument turns off the mode.
+
+When this minor mode is enabled, some commands become available
+to send current code area \(as understood by c-mark-function) or
+region or buffer to an inferior MozRepl process (which will be
+started as needed).
+
+The following keys are bound in this minor mode:
+
+\\{moz-minor-mode-map}"
+ nil
+ " Moz"
+ :keymap moz-minor-mode-map
+ :group 'moz)
+
+(defalias 'run-mozilla 'inferior-moz-switch-to-mozilla)
+
+(defvar moz-repl-name "repl"
+ "The current name of the repl.")
+
+(defvar moz-input-separator "\n--end-remote-input\n")
+
+(defvar moz-repl-host "localhost")
+
+(defvar moz-repl-port 4242)
+
+(defun moz-temporary-file ()
+ (if (and moz-temporary-file
+ (file-readable-p moz-temporary-file))
+ moz-temporary-file
+ (setq moz-temporary-file (make-temp-file "emacs-mozrepl"))))
+
+(defun moz-send-region (start end)
+ "Send the region to Firefox via MozRepl."
+ (interactive "r")
+ (comint-send-string (inferior-moz-process)
+ (concat moz-repl-name ".pushenv('printPrompt', 'inputMode'); "
+ moz-repl-name ".setenv('printPrompt', false); "
+ moz-repl-name ".setenv('inputMode', 'multiline'); "
+ "undefined; \n"))
+ ;; Give the previous line a chance to be evaluated on its own. If
+ ;; it gets concatenated to the following ones, we are doomed.
+ (sleep-for 0 1)
+ (comint-send-region (inferior-moz-process)
+ start end)
+ (comint-send-string (inferior-moz-process)
+ "\n--end-remote-input\n")
+ (comint-send-string (inferior-moz-process)
+ (concat moz-repl-name ".popenv('inputMode', 'printPrompt'); "
+ "undefined; \n"))
+ (comint-send-string (inferior-moz-process)
+ "\n--end-remote-input\n")
+ (display-buffer (process-buffer (inferior-moz-process))))
+
+(defun moz-send-defun ()
+ "Send the current function to Firefox via MozRepl.
+Curent function is the one recognized by c-mark-function."
+ (interactive)
+ (save-excursion
+ (mark-defun)
+ (moz-send-region (point) (mark))))
+
+(defun moz-send-defun-and-go ()
+ "Send the current function to Firefox via MozRepl.
+Also switch to the interaction buffer."
+ (interactive)
+ (moz-send-defun)
+ (inferior-moz-switch-to-mozilla nil))
+
+(defun moz-save-buffer-and-send ()
+ "Save the current buffer and load it in Firefox via MozRepl."
+ (interactive)
+ (save-buffer)
+ (comint-send-string (inferior-moz-process)
+ (concat moz-repl-name ".pushenv('printPrompt', 'inputMode'); "
+ moz-repl-name ".setenv('inputMode', 'line'); "
+ moz-repl-name ".setenv('printPrompt', false); undefined; "))
+ (comint-send-string (inferior-moz-process)
+ (concat moz-repl-name ".load('file://localhost/" (buffer-file-name) "');\n"
+ moz-repl-name ".popenv('inputMode', 'printPrompt'); undefined;\n"))
+ (display-buffer (process-buffer (inferior-moz-process))))
+
+;;; Inferior Mode
+
+(defvar inferior-moz-buffer nil
+ "The buffer in which the inferior process is running.")
+
+(defun inferior-moz-insert-moz-repl ()
+ "Insert value of `moz-repl-name' and a dot (.)."
+ (interactive) (insert moz-repl-name "."))
+
+(defvar inferior-moz-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-cc" 'inferior-moz-insert-moz-repl)
+ map))
+
+;;;###autoload
+(define-derived-mode inferior-moz-mode comint-mode "Inf-MozRepl"
+ "Major mode for interacting with Firefox via MozRepl."
+ (setq comint-input-sender 'inferior-moz-input-sender)
+ (add-hook 'comint-output-filter-functions 'inferior-moz-track-repl-name nil t))
+
+(defun inferior-moz-track-repl-name (comint-output)
+ (when (string-match "\\(\\w+\\)> $" comint-output)
+ (setq moz-repl-name (match-string 1 comint-output))))
+
+(defun inferior-moz-self-insert-or-repl-name ()
+ (interactive)
+ (if (looking-back "\\(\\w+\\)> $")
+ (insert moz-repl-name ".")
+ (insert last-command-char)))
+
+(defun inferior-moz-input-sender (proc string)
+ "Custom function to send input with comint-send-input.
+Instead of sending input and newline separately like in
+comint-simple-send, here we *first* concatenate input and
+newline, then send it all together. This prevents newline to be
+interpreted on its own."
+ (comint-send-string proc (concat string "\n")))
+
+(defun inferior-moz-switch-to-mozilla (arg)
+ "Switch to the inferior MozRepl buffer.
+Create the buffer and start the MozRepl process and connect to
+Firefox if needed.
+
+See also `inferior-moz-start-process'."
+ (interactive "P")
+ (when arg
+ (setq moz-repl-host (read-string "Host: " "localhost"))
+ (setq moz-repl-port (read-number "Port: " 4242)))
+ (pop-to-buffer (process-buffer (inferior-moz-process)))
+ (goto-char (process-mark (inferior-moz-process))))
+
+(defun inferior-moz-process ()
+ "Return inferior MozRepl process. Start it if necessary.
+See also `inferior-moz-start-process'."
+ (or (if (buffer-live-p inferior-moz-buffer)
+ (get-buffer-process inferior-moz-buffer))
+ (progn
+ (inferior-moz-start-process)
+ (inferior-moz-process))))
+
+(defun inferior-moz-start-process ()
+ "Start an inferior Mozrepl process and connect to Firefox.
+It runs the hook `inferior-moz-hook' after starting the process
+and setting up the inferior Firefox buffer.
+
+Note that you have to start the MozRepl server from Firefox."
+ (interactive)
+ (condition-case err
+ (progn
+ (setq inferior-moz-buffer
+ (apply 'make-comint "MozRepl" (cons moz-repl-host moz-repl-port) nil nil))
+ (sleep-for 0 100)
+ (with-current-buffer inferior-moz-buffer
+ (inferior-moz-mode)
+ (run-hooks 'inferior-moz-hook)))
+ (file-error
+ (with-output-to-temp-buffer "*MozRepl Error*"
+ (with-current-buffer (get-buffer "*MozRepl Error*")
+ (insert "Can't start MozRepl, the error message was:\n\n "
+ (error-message-string err)
+ "\n"
+ "\nA possible reason is that you have not installed"
+ "\nthe MozRepl add-on to Firefox or that you have not"
+ "\nstarted it. You start it from the menus in Firefox:"
+ "\n\n Tools / MozRepl / Start"
+ "\n"
+ "\nSee ")
+ (insert-text-button
+ "MozRepl home page"
+ 'action (lambda (button)
+ (browse-url
+ "http://hyperstruct.net/projects/mozrepl")
+ )
+ 'face 'button)
+ (insert
+ " for more information."
+ "\n"
+ "\nMozRepl is also available directly from Firefox add-on"
+ "\npages, but is updated less frequently there.")
+ ))
+ (error "Can't start MozRepl"))))
+
+(provide 'moz)
+
+;;; moz.el ends here
--- /dev/null
+(require 'cc-mode)
+
+(defconst vu3rdd-c-style
+ '((c-basic-offset . 2)
+ (tab-width . 4)
+ (indent-tabs-mode . nil)
+ (c-comment-only-line-offset . 0)
+ (c-hanging-braces-alist . ((substatement-open before after)))
+ (c-offsets-alist . ((topmost-intro . 0)
+ (substatement . +)
+ (substatement-open . 0)
+ (case-label . +)
+ (access-label . -)
+ (inclass . ++)
+ (inline-open . 0)
+ ))))
+
+
+(c-add-style "vu3rddstyle" vu3rdd-c-style nil)
+
+(defun vu3rdd-c-hook ()
+ (c-set-style "vu3rddstyle")
+ ;; parenthesis matching {}[]()
+ (global-set-key "%" 'match-paren))
+
+(add-hook 'c-mode-common-hook 'vu3rdd-c-hook)
+
+(add-hook 'c-mode-common-hook
+ (lambda () (which-function-mode t)))
--- /dev/null
+;;; erc
+(require 'erc)
+
+;; Load authentication info from an external source. Put sensitive
+;; passwords and the like in here.
+(load "~/.emacs.d/emacs/.erc-auth")
+
+(require 'erc-services)
+(require 'erc-match)
+(erc-services-mode 1)
+
+(setq erc-prompt-for-nickserv-password nil)
+
+(setq erc-nickserv-passwords
+ `((freenode (("vu3rdd" . ,freenode-nick-pass)))
+ (debian (("vu3rdd" . ,debian-nick-pass)))))
+
+(setq erc-autojoin-channels-alist
+ '((".*\\.freenode.net" "#racket" "#haskell")
+ (".*\\.oftc.net" "#debian-arm" "#debian" "#debian-devel")))
+
+(global-set-key "\C-cef" (lambda () (interactive)
+ (erc :server "irc.freenode.net" :port "8000"
+ :nick "vu3rdd")))
+(global-set-key "\C-ced" (lambda () (interactive)
+ (erc :server "irc.debian.org" :port "6668"
+ :nick "vu3rdd")))
+
+(setq erc-user-full-name "Ramakrishnan Muthukrishnan")
+(setq erc-email-userid "vu3rdd@gmail.com")
+
+(require 'erc-track)
+(erc-track-mode 1)
+(setq erc-track-switch-direction 'importance)
+
+;; Only track my nick(s)
+(defadvice erc-track-find-face (around erc-track-find-face-promote-query activate)
+ (if (erc-query-buffer-p)
+ (setq ad-return-value (intern "erc-current-nick-face"))
+ ad-do-it))
+
+(setq erc-keywords '("vu3rdd" "rkrishnan"))
+
+(setq erc-track-exclude-types '("JOIN" "NICK" "PART" "QUIT" "MODE"
+ "324" "329" "332" "333" "353" "477"))
+
+(global-set-key (kbd "C-c SPC") 'erc-track-switch-buffer)
+
+;; erc notification via notify
+(defun clean-message (s)
+ (setq s (replace-regexp-in-string "'" "'"
+ (replace-regexp-in-string "\"" """
+ (replace-regexp-in-string "&" "&"
+ (replace-regexp-in-string "<" "<"
+ (replace-regexp-in-string ">" ">" s)))))))
+
+(defun call-libnotify (matched-type nick msg)
+ (let* ((cmsg (split-string (clean-message msg)))
+ (nick (first (split-string nick "!")))
+ (msg (mapconcat 'identity (rest cmsg) " ")))
+ (shell-command-to-string
+ (format "notify-send -t 5000 -u critical '%s says:' '%s'" nick msg))))
+
+(add-hook 'erc-text-matched-hook 'call-libnotify)
+
+;; Enable logging
+(setq erc-log-insert-log-on-open nil)
+(setq erc-log-channels t)
+(setq erc-log-channels-directory "~/.erc/logs/")
+(setq erc-save-buffer-on-part t)
+(setq erc-save-queries-on-quit nil
+ erc-log-write-after-send t
+ erc-log-write-after-insert t)
+(defadvice save-buffers-kill-emacs (before save-logs (arg) activate)
+ (save-some-buffers t (lambda () (when (and (eq major-mode 'erc-mode)
+ (not (null buffer-file-name)))))))
+(add-hook 'erc-insert-post-hook 'erc-save-buffer-in-logs)
--- /dev/null
+;; inhibit splash screen
+(setq inhibit-splash-screen t)
+
+;; prevent backup file creation
+(setq make-backup-files nil)
+
+(transient-mark-mode t)
+
+;; disable startup message
+(setq inhibit-startup-message t)
+
+;; Show column number at bottom of screen
+(column-number-mode 1)
+
+;; alias y to yes and n to no
+(defalias 'yes-or-no-p 'y-or-n-p)
+
+;; Pgup/dn will return exactly to the starting point.
+(setq scroll-preserve-screen-position 1)
+
+;; format the title-bar to always include the buffer name
+(setq frame-title-format "emacs - %b")
+
+;; scroll just one line when hitting the bottom of the window
+(setq scroll-step 1)
+(setq scroll-conservatively 1)
+
+;; scroll bar
+(setq toggle-scroll-bar t)
+
+;; iswitchb
+(setq iswitchb-mode t)
+
+(setq cursor-type 'bar)
+
+;; how long to wait?
+(setq show-paren-delay 0)
+;; turn paren-mode on
+
+;; alternatives are 'parenthesis' and 'mixed'
+;(setq show-paren-style 'expression)
+
+;; font lock
+(global-font-lock-mode t)
--- /dev/null
+(add-to-list 'load-path "~/.emacs.d/vendor/haskell-mode")
+
+;;; haskell mode
+(setq auto-mode-alist
+ (append auto-mode-alist
+ '(("\\.[hg]s$" . haskell-mode)
+ ("\\.hic?$" . haskell-mode)
+ ("\\.hsc$" . haskell-mode)
+ ("\\.chs$" . haskell-mode)
+ ("\\.l[hg]s$" . literate-haskell-mode))))
+(autoload 'haskell-mode "haskell-mode"
+ "Major mode for editing Haskell scripts." t)
+(autoload 'literate-haskell-mode "haskell-mode"
+ "Major mode for editing literate Haskell scripts." t)
+
+;adding the following lines according to which modules you want to use:
+(require 'inf-haskell)
+
+(add-hook 'haskell-mode-hook 'turn-on-font-lock)
+(add-hook 'haskell-mode-hook 'turn-on-haskell-ghci)
+(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode)
+(add-hook 'haskell-mode-hook 'turn-on-haskell-indent)
+(set-variable 'haskell-program-name "ghci")
+
--- /dev/null
+;; org mode
+(require 'org-install)
+(add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
+(define-key global-map "\C-cl" 'org-store-link)
+(define-key global-map "\C-ca" 'org-agenda)
+(define-key global-map "\C-cb" 'org-iswitchb)
+(setq org-log-done 'time)
+(setq org-startup-indented t)
+
+(setq org-agenda-files (list "~/org/work.org"
+ "~/org/remember.org"
+ "~/org/debian.org"
+ "~/org/clojure.org"
+ "~/org/learning.org"
+ "~/org/reading.org"
+ "~/org/investments.org"))
+
+;; adapted from <http://doc.norang.ca/org-mode.html>
+(setq org-todo-keywords '((sequence "TODO(t)"
+ "STARTED(s!)"
+ "|"
+ "DONE(d!/!)")
+ (sequence "WAITING(w@/!)"
+ "SOMEDAY(S!)"
+ "|"
+ "CANCELLED(c@/!)")))
+
+(setq org-todo-keyword-faces (quote (("TODO" :foreground "red" :weight bold)
+ ("STARTED" :foreground "blue" :weight bold)
+ ("DONE" :foreground "forest green" :weight bold)
+ ("WAITING" :foreground "orange" :weight bold)
+ ("SOMEDAY" :foreground "magenta" :weight bold)
+ ("CANCELLED" :foreground "forest green" :weight bold))))
--- /dev/null
+(require 'ac-python)
+
+;;; Use python-mode with files with these extensions
+(add-to-list 'auto-mode-alist '("\\.py\\'" . python-mode))
+(add-to-list 'auto-mode-alist '("\\.pyx\\'" . python-mode))
+
+;;; Turn on auto-complete in python shells
+(add-hook 'inferior-python-mode-hook (lambda () (auto-complete-mode 1)))
+
+;;; Use python major mode if 'python' is in hashbang.
+(add-to-list 'interpreter-mode-alist '("python" . python-mode))
+
+;;; Use python as the python interpreter (can be changed to "ipython" in time
+;;; when it works)
+(setq python-python-command "python")
+
+;;; Check files for pep8 mistakes
+(autoload 'python-pep8 "python-pep8")
+(autoload 'pep8 "python-pep8")
--- /dev/null
+;; highlight matches from searches
+(setq isearch-highlight t)
+(setq search-highlight t)
+(setq-default transient-mark-mode t)
--- /dev/null
+;; slime
+(add-to-list 'load-path "~/.emacs.d/vendor/slime")
+
+(eval-after-load "slime"
+ '(progn
+ (setq slime-use-autodoc-mode nil)
+ (slime-setup '(inferior-slime
+ ;; slime-asdf
+ ;; slime-autodoc
+ slime-banner
+ ;; slime-c-p-c
+ ;; slime-editing-commands
+ slime-fancy-inspector
+ slime-fancy
+ slime-fuzzy
+ ;; slime-highlight-edits
+ ;; slime-parse
+ ;; slime-presentation-streams
+ ;; slime-presentations
+ ;; slime-references
+ slime-repl
+ slime-scratch
+ ;;slime-tramp
+ ;;slime-typeout-frame
+ slime-xref-browser
+ slime-scheme))
+
+ (setq slime-protocol-version 'ignore)
+ (setq slime-complete-symbol*-fancy t)
+ (setq slime-complete-symbol-function 'slime-fuzzy-complete-symbol)))
+
+(require 'slime)
+;(setq inferior-lisp-program "~/src/sbcl/src/runtime/sbcl")
+(add-to-list 'slime-lisp-implementations '(sbcl ("/usr/bin/sbcl")))
+(setq slime-default-lisp 'sbcl)
+
+;; enable cldoc for slime
+(dolist (hook '(lisp-mode-hook
+ slime-repl-mode-hook))
+ (add-hook hook 'turn-on-cldoc-mode))
+
+;; needed for overriding default method for invoking slime
+; (ad-activate 'slime-read-interactive-args)
--- /dev/null
+;; swank-js
+(add-to-list 'load-path "~/.emacs.d/vendor/swank-js")
+(require 'slime-js)
--- /dev/null
+(add-to-list 'load-path "~/.emacs.d/emacs/twittering-mode")
+(require 'twittering-mode)
+
+(add-hook 'twittering-edit-mode-hook (lambda () (ispell-minor-mode) (flyspell-mode)))
--- /dev/null
+;;; naquadah-theme.el --- A color theme
+
+;; Copyright (C) 2011 Julien Danjou
+
+;; Authors: Julien Danjou <julien@danjou.info>
+
+;; This file is NOT part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(deftheme naquadah
+ "Naquadah theme.")
+
+(let ((light-blue "#72A0CF")
+ (pale-yellow "#D4F77F")
+ (violet "#C66CD0")
+ (green "#89E234")
+ (blue "#374EAB")
+ (yellow "#FCCD3A")
+ (pink "#DE336D")
+ (red "#8A0B0B")
+ (violet-blue "#5337AD")
+ (orange "#FFA500")
+ (tomato "#FC683A")
+ (background "#252A2B")
+ (shadow "#888a85"))
+ (custom-theme-set-faces
+ 'naquadah
+ `(default ((((min-colors 4096)) (:background ,background :foreground "#eeeeec"))))
+ `(shadow ((t (:foreground ,shadow))))
+ '(cursor ((t (:background "#aa0000"))))
+ '(hl-line ((t (:background "#191919"))))
+ '(highlight ((t (:background "brown1" :foreground nil))))
+ '(fringe ((t (:background "gray10"))))
+ '(mode-line ((t (:foreground "#fafafa" :background "#000000" :box (:line-width 1 :color "#444444")))))
+ '(mode-line-inactive ((t (:foreground "#888888" :background "#2c2f2f" :box (:line-width 1 :color "black")))))
+ `(mode-line-buffer-id ((t (:bold t :foreground ,orange))))
+ '(header-line ((t (:foreground "#dddddd" :background "#1e2426" :box (:line-width 1 :color "#444444")))))
+ '(region ((t (:background "grey30"))))
+ `(link ((t (:underline t :foreground ,light-blue))))
+ '(custom-link ((t (:inherit 'link))))
+ '(match ((t (:bold t :background "#e9b96e" :foreground "#2e3436"))))
+ '(tooltip ((t (:inherit 'variable-pitch :foreground "LightYellow" :background "black"))))
+ '(bold ((t (:bold t :underline nil :background nil))))
+ '(italic ((t (:italic t :underline nil :background nil))))
+ `(font-lock-builtin-face ((t (:foreground ,light-blue))))
+ '(font-lock-comment-face ((t (:inherit 'shadow :italic t))))
+ '(font-lock-comment-delimiter-face ((t (:inherit 'font-lock-comment-face))))
+ `(font-lock-constant-face ((t (:foreground ,green))))
+ '(font-lock-doc-face ((t (:inherit 'shadow))))
+ '(font-lock-keyword-face ((t (:inherit 'font-lock-builtin-face :bold t))))
+ `(font-lock-string-face ((t (:foreground ,violet))))
+ '(font-lock-type-face ((t (:inherit 'font-lock-constant-face :bold t))))
+ `(font-lock-variable-name-face ((t (:foreground ,tomato))))
+ `(font-lock-warning-face ((t (:bold t :foreground ,orange))))
+ `(font-lock-function-name-face ((t (:foreground ,yellow :bold t))))
+ '(comint-highlight-input ((t (:italic t :bold t))))
+ `(comint-highlight-prompt ((t (:foreground ,green))))
+ `(isearch ((t (:background ,orange :foreground ,background))))
+ `(show-paren-match-face ((t (:background ,green))))
+ `(show-paren-mismatch-face ((t (:background ,violet))))
+ `(minibuffer-prompt ((t (:foreground ,light-blue :bold t))))
+ `(info-xref ((t (:foreground ,light-blue))))
+ `(info-xref-visited ((t (:foreground ,violet))))
+ '(widget-button ((t (:bold t))))
+ `(widget-mouse-face ((t (:bold t :foreground "white" :background ,red))))
+ `(widget-field ((t (:foreground ,orange :background "gray30"))))
+ `(widget-single-line-field ((t (:foreground ,orange :background "gray30"))))
+ `(custom-group-tag ((t (:bold t :foreground ,orange :height 1.3))))
+ '(custom-variable-tag ((t (:bold t :foreground "#edd400" :height 1.1))))
+ '(custom-face-tag ((t (:bold t :foreground "#edd400" :height 1.1))))
+ `(custom-state-face ((t (:foreground ,light-blue))))
+ '(custom-button ((t (:box (:line-width 1 :style released-button) :background "gray50" :foreground "black"))))
+ '(custom-variable-button ((t (:inherit 'custom-button))))
+ '(custom-button-mouse ((t (:inherit 'custom-button :background "gray60"))))
+ '(custom-button-unraised ((t (:background "gray50" :foreground "black"))))
+ '(custom-button-mouse-unraised ((t (:inherit 'custom-button-unraised :background "gray60"))))
+ '(custom-button-pressed ((t (:inherit 'custom-button :box (:style pressed-button)))))
+ '(custom-button-mouse-pressed-unraised ((t (:inherit 'custom-button-unraised :background "gray60"))))
+ '(custom-documentation ((t (:italic t))))
+ '(gnus-cite-face-1 ((t (:foreground "#ad7fa3"))))
+ '(gnus-cite-face-2 ((t (:foreground "sienna3"))))
+ '(gnus-cite-face-3 ((t (:foreground "khaki4"))))
+ '(gnus-cite-face-4 ((t (:foreground "PaleTurquoise4"))))
+ '(gnus-header-name-face ((t (:bold t :foreground "#729fcf"))))
+ '(gnus-header-from ((t (:bold t :foreground "#e0d400"))))
+ '(gnus-header-subject ((t (:foreground "#e0d400"))))
+ '(gnus-header-content ((t (:italic t :foreground "#8ae234"))))
+ '(gnus-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3"))))
+ '(gnus-signature-face ((t (:italic t :foreground "OliveDrab1"))))
+ `(gnus-summary-cancelled-face ((t (:background "black" :foreground ,yellow))))
+ '(gnus-summary-normal-ancient-face ((t (:foreground "medium sea green"))))
+ '(gnus-summary-normal-read-face ((t (:foreground "lime green"))))
+ `(gnus-summary-normal-ticked-face ((t (:foreground ,tomato))))
+ '(gnus-summary-normal-unread-face ((t (:foreground "white"))))
+ '(gnus-summary-high-ancient-face ((t (:inherit 'gnus-summary-normal-ancient-face))))
+ '(gnus-summary-high-read-face ((t (:inherit 'gnus-summary-normal-read-face))))
+ `(gnus-summary-high-ticked-face ((t (:inherit 'gnus-summary-normal-ticked-face)))))
+ '(gnus-summary-high-unread-face ((t (:inherit 'gnus-summary-normal-unread-face))))
+ '(gnus-summary-low-ancient-face ((t (:inherit 'gnus-summary-normal-ancient-face) :italic t)))
+ '(gnus-summary-low-read-face ((t (:inherit 'gnus-summary-normal-read-face :italic t))))
+ '(gnus-summary-low-ticked-face ((t (:inherit 'gnus-summary-normal-ticked-face :italic t))))
+ '(gnus-summary-low-unread-face ((t (:inherit 'gnus-summary-normal-unread-face :italic t))))
+ '(spam-face ((t (:background "black" :foreground "magenta3"))))
+ `(gnus-summary-selected ((t (:background ,light-blue :foreground "white"))))
+ '(message-header-name-face ((t (:foreground "#729cfc"))))
+ '(message-header-newsgroups-face ((t (:italic t :bold t :foreground "LightSkyBlue3"))))
+ '(message-header-other-face ((t (:foreground "LightSkyBlue3"))))
+ '(message-header-xheader-face ((t (:foreground "DodgerBlue3"))))
+ '(message-header-subject ((t (:foreground "white"))))
+ '(message-header-to ((t (:foreground "white"))))
+ '(message-header-cc ((t (:foreground "white"))))
+ '(org-hide ((t (:foreground "#252a2b"))))
+ '(org-level-1 ((t (:bold t :foreground "#4788cc" :height 1.2))))
+ '(org-level-2 ((t (:bold t :foreground "#6ac214" :height 1.1))))
+ '(org-level-3 ((t (:bold t :foreground "#edd400" :height 1.0))))
+ '(org-level-4 ((t (:bold t :foreground "tomato" :height 1.0))))
+ '(org-footnote ((t (:underline t :foreground "magenta3"))))
+ '(org-link ((t (:foreground "SkyBlue2"))))
+ '(org-special-keyword ((t (:foreground "brown1"))))
+ '(org-verbatim ((t (:foreground "#eeeeec" :underline t :slant italic))))
+ '(org-block ((t (:foreground "#bbbbbc"))))
+ '(org-quote ((t (:inherit org-block :slant italic))))
+ '(org-verse ((t (:inherit org-block :slant italic))))
+ '(org-todo ((t (:bold t :foreground "#ff2020"))))
+ '(org-done ((t (:bold t :foreground "forest green"))))
+ '(org-mode-line-clock ((t (:foreground "#cc77ff" :background nil))))
+ '(org-date ((t (:underline nil :foreground "#edd466" :background nil))))
+ '(org-agenda-date ((t (:underline nil :foreground "SkyBlue2" :height 1.2))))
+ '(org-agenda-date-today ((t (:inherit org-agenda-date :foreground "#edd466" :weight bold))))
+ '(org-agenda-date-telecommuting ((t (:inherit org-agenda-date :foreground "#ffbb22" :weight bold))))
+ '(org-agenda-date-weekend ((t (:inherit org-agenda-date :foreground "brown3" :weight bold))))
+ '(anything-header ((t (:bold t :background "gray15" :foreground "#edd400"))))
+ '(egocentric-face ((t (:foreground "#ff4289" :weight bold))))
+ '(erc-direct-msg-face ((t (:foreground "#ee5577"))))
+ '(erc-header-line ((t (:background "black" :foreground "white"))))
+ '(erc-input-face ((t (:foreground "gray70"))))
+ '(erc-my-nick-face ((t (:inherit egocentric-face :weight thin :foreground nil))))
+ '(erc-notice-face ((t (:foreground "light blue" :weight thin))))
+ '(erc-prompt-face ((t (:background "black" :foreground "gray80" :weight bold))))
+ '(erc-timestamp-face ((t (:foreground "gray70" :weight bold))))
+ '(erc-pal-face ((t (:foreground "DarkOliveGreen3" :weight bold))))
+ '(erc-fool-face ((t (:foreground "gray60" :weight thin))))
+ '(erc-current-nick-face ((t (:inherit egocentric-face :weight thin :foreground nil))))
+ '(ido-subdir ((t (:foreground "orange1"))))
+ '(which-func ((t (:foreground "#729cfc"))))
+ '(mm-uu-extract ((t (:background "#404040"))))
+ `(diff-added ((t (:foreground ,green))))
+ `(diff-changed ((t (:foreground ,orange))))
+ `(diff-removed ((t (:foreground ,red))))
+ '(diff-hunk-header ((t (:bold t))))
+ `(diff-function ((t (:foreground ,orange))))
+ '(diff-header ((t (:background "grey10"))))
+ '(diff-file-header ((t (:background nil :foreground "white"))))
+ '(git-commit-summary-face ((t (:bold t))))
+ `(git-commit-branch-face ((t (:foreground ,orange :bold t))))
+ '(git-commit-nonempty-second-line-face ((t (:foreground "red"))))
+ '(git-commit-comment-face ((t (:inherit font-lock-comment-face))))
+ '(git-commit-known-pseudo-header-face ((t (:inherit gnus-header-name-face))))
+ '(git-commit-pseudo-header-face ((t (:inherit gnus-header-content))))
+ '(rst-level-1-face ((t (:inherit org-level-1 :background nil))))
+ '(rst-level-2-face ((t (:inherit org-level-2 :background nil))))
+ '(rst-level-3-face ((t (:inherit org-level-3 :background nil))))
+ '(rst-level-4-face ((t (:inherit org-level-4 :background nil)))))
+
+(provide-theme 'naquadah)
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; naquadah-theme.el ends here
--- /dev/null
+;;; notify.el --- notification frontend
+
+;; Copyright (C) 2008 Mark A. Hershberger
+
+;; Original Author: Mark A. Hershberger <mhersberger@intrahealth.org>
+;; Keywords: extensions, convenience, lisp
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This provides a single function, notify, that will produce a notify
+;; pop-up via DBus.
+
+;;; Code:
+
+(defvar notify-last '(0 0 0))
+
+(defvar notify-defaults
+ (list :app "GNU Emacs"
+ :icon "/usr/share/icons/emacs22/emacs_48.png"
+ :timeout 10000
+ :urgency "low"
+ :category "emacs.message"))
+
+(defvar notify-id 0)
+
+(defvar notify-delay '(0 5 0))
+
+(defvar notify-last-notification '(0 5 0))
+
+;; We could set up other notification methods like notify-via-shell or
+;; notify-via-pointer
+(defvar notify-method 'notify-via-dbus)
+
+(defun notify-next-id ()
+ "Return the next notification id."
+ (setq notify-id (+ notify-id 1)))
+
+(defun notify-via-dbus (title body params)
+ "Send notification via DBus."
+ (when (and (fboundp 'dbus-ping)
+ (dbus-ping :session "org.freedesktop.Notifications"))
+ (dbus-call-method :session "org.freedesktop.Notifications"
+ "/org/freedesktop/Notifications"
+ "org.freedesktop.Notifications" "Notify"
+ (get 'params :app)
+ (notify-next-id)
+ (get 'params :icon)
+ title
+ body
+ '(:array)
+ '(:array :signature "{sv}")
+ ':int32 (get 'params :timeout))))
+
+(defun notify (title body &rest args)
+ "Use pop-up notifications for events."
+ (when (and
+ (time-less-p notify-delay
+ (time-since notify-last-notification))
+ (let ((params))
+ (keywords-to-properties 'params args notify-defaults)
+ (setq notify-last-notification (current-time))
+ (funcall notify-method title body params)))))
+
+(defun keywords-to-properties (symbol args &optional defaults)
+ "Convert a list in the form (:keywordA valueA
+ :keywordB valueB ...)
+to a list of propertys with the given values"
+ (when (car-safe defaults) ; probably need to avoid recursion
+ (keywords-to-properties symbol defaults))
+ (while args
+ (let ((arg (car args)))
+ (setq args (cdr args))
+ (unless (symbolp arg)
+ (error "Junk in args %S" args))
+ (let ((keyword arg)
+ (value (car args)))
+ (unless args
+ (error "Keyword %s is missing an argument" keyword))
+ (setq args (cdr args))
+ (put symbol keyword value)))))
+
+(provide 'notify)
+
+;;; notify.el ends here
--- /dev/null
+To install nXhtml put this in your .emacs:\r
+\r
+ (load "YOUR-PATH-TO/nxhtml/autostart.el")\r
+\r
+where autostart.el is the file in the same directory as this\r
+readme.txt file.\r
+\r
+Note 1: If you are using Emacs+EmacsW32 then nXhtml is already\r
+ installed.\r
+\r
+Note 2: If you are using Emacs 22 then you need to install nXml\r
+ separately. (It is included in Emacs 23.)\r
+\r
+Note 3: You may optionally also byte compile nXhtml from the nXhtml\r
+ menu (recommended).\r
+\r
+\r
+\r
+Files that are now in Emacs' development (CVS/Bazaar) repository\r
+================================================================\r
+\r
+Some files that were previously distributed with nXhtml are now in\r
+Emacs' development repository. Distributing them also with nXhtml is\r
+a bad idea since that can lead to that the wrong file is loaded. They\r
+are therefore not distributed with nXhtml anymore.\r
+\r
+Instead you can (if you do not have the files in your Emacs) in many\r
+cases use the version from the repository. To do that you can\r
+currently start from\r
+\r
+ http://cvs.savannah.gnu.org/viewvc/emacs/emacs/lisp/\r
+\r
+Files you can download and use this way are for example\r
+\r
+ js.el (JavaScript, formerly called espresso.el)\r
+ htmlfontify.el\r
+\r
+If you do that I suggest that you put these files in a special\r
+directory and add that to load-path in your .emacs and make that\r
+adding to load-path depend on your Emacs version so that they will not\r
+be loaded when you have upgraded your Emacs.\r
+\r
+Note that if you want to use nxml-mode (and it is not in your Emacs)\r
+you should not download it from Emacs' development directory. Instead go to\r
+\r
+ http://www.thaiopensource.com/download/\r
--- /dev/null
+;; find-recursive.el -- Find files recursively into a directory
+;;
+;; Copyright (C) 2001 Ovidiu Predescu
+;;
+;; Author: Ovidiu Predescu <ovidiu@cup.hp.com>
+;; Date: March 26, 2001
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 2
+;; of the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;
+;; Setup: put this file in your Lisp path and add the following line in
+;; your .emacs:
+;;
+;; (require 'find-recursive)
+;;
+
+(require 'cl)
+
+(defcustom find-recursive-exclude-files '(".*.class$" ".*~$" ".*.elc$")
+ "List of regular expressions of files to be excluded when recursively searching for files."
+ :type '(repeat (string :tag "File regexp")))
+
+(defun find-file-recursively (file-regexp directory)
+ (interactive "sFile name to search for recursively: \nDIn directory: ")
+ (let ((directory (if (equal (substring directory -1) "/")
+ directory
+ (concat directory "/")))
+ (matches
+ (find-recursive-filter-out
+ find-recursive-exclude-files
+ (find-recursive-directory-relative-files directory "" file-regexp))))
+ (cond ((eq (length matches) 0) (message "No file(s) found!"))
+ ((eq (length matches) 1)
+ (find-file (concat directory (car matches))))
+ (t
+ (run-with-timer 0.001 nil
+ (lambda ()
+ (dispatch-event
+ (make-event 'key-press '(key tab)))))
+ (let ((file (completing-read "Choose file: "
+ (mapcar 'list matches)
+ nil t)))
+ (if (or (eq file nil) (equal file ""))
+ (message "No file selected.")
+ (find-file (concat directory file))))))))
+
+(defun find-recursive-directory-relative-files (directory
+ relative-directory
+ file-regexp)
+ (let* ((full-dir (concat directory "/" relative-directory))
+ (matches
+ (mapcar
+ (function (lambda (x)
+ (concat relative-directory x)))
+ (find-recursive-filter-out '(nil)
+ (directory-files full-dir nil
+ file-regexp nil t))))
+ (inner
+ (mapcar
+ (function
+ (lambda (dir)
+ (find-recursive-directory-relative-files directory
+ (concat relative-directory
+ dir "/")
+ file-regexp)))
+ (find-recursive-filter-out '(nil "\\." "\\.\\.")
+ (directory-files full-dir nil ".*"
+ nil 'directories)))))
+ (mapcar (function (lambda (dir) (setq matches (append matches dir))))
+ inner)
+ matches))
+
+(defun find-recursive-filter-out (remove-list list)
+ "Remove all the elements in *remove-list* from *list*"
+ (if (eq list nil)
+ nil
+ (let ((elem (car list))
+ (rest (cdr list)))
+ (if (some
+ (lambda (regexp)
+ (if (or (eq elem nil) (eq regexp nil))
+ nil
+ (not (eq (string-match regexp elem) nil))))
+ remove-list)
+ (find-recursive-filter-out remove-list rest)
+ (cons elem (find-recursive-filter-out remove-list rest))))))
+
+(defvar find-recursive-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
+
+(if find-recursive-running-xemacs
+ nil
+ (defadvice directory-files (after
+ directory-files-xemacs
+ (dirname &optional full match nosort files-only)
+ activate)
+ "Add an additional argument, FILES-ONLY to the list of arguments
+for GNU Emacs. If the symbol is t, then only the files in the
+directory will be returned. If FILES-ONLY is nil, then both files and
+directories are selected. If FILES-ONLY is not nil and not t, then
+only sundirectories are returned."
+ (setq ad-return-value
+ (cond ((null files-only) ad-return-value)
+ ((eq files-only t)
+ (find-recursive-remove-if (lambda (f)
+ (file-directory-p
+ (concat dirname "/" f)))
+ ad-return-value))
+ (t
+ (find-recursive-remove-if (lambda (f)
+ (not (file-directory-p
+ (concat dirname "/" f))))
+ ad-return-value)))))
+
+ (defun find-recursive-remove-if (func list)
+ "Removes all elements satisfying FUNC from LIST."
+ (let ((result nil))
+ (while list
+ (if (not (funcall func (car list)))
+ (setq result (cons (car list) result)))
+ (setq list (cdr list)))
+ (nreverse result))))
+
+(global-set-key [(control x) (meta f)] 'find-file-recursively)
+
+(provide 'find-recursive)
--- /dev/null
+;;; javascript.el --- Major mode for editing JavaScript source text
+
+;; Copyright (C) 2006 Karl Landström
+
+;; Author: Karl Landström <kland@comhem.se>
+;; Maintainer: Karl Landström <kland@comhem.se>
+;; Version: 2.0 Beta 8
+;; Date: 2006-12-26
+;; Keywords: languages, oop
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; The main features of this JavaScript mode are syntactic
+;; highlighting (enabled with `font-lock-mode' or
+;; `global-font-lock-mode'), automatic indentation and filling of
+;; comments.
+;;
+;; This package has (only) been tested with GNU Emacs 21.4 (the latest
+;; stable release).
+;;
+;; Installation:
+;;
+;; Put this file in a directory where Emacs can find it (`C-h v
+;; load-path' for more info). Then add the following lines to your
+;; Emacs initialization file:
+;;
+;; (add-to-list 'auto-mode-alist '("\\.js\\'" . javascript-mode))
+;; (autoload 'javascript-mode "javascript" nil t)
+;;
+;; General Remarks:
+;;
+;; This mode assumes that block comments are not nested inside block
+;; comments and that strings do not contain line breaks.
+;;
+;; Exported names start with "javascript-" whereas private names start
+;; with "js-".
+;;
+;; Changes:
+;;
+;; See javascript.el.changelog.
+
+;;; Code:
+
+(require 'cc-mode)
+(require 'font-lock)
+(require 'newcomment)
+
+(defgroup javascript nil
+ "Customization variables for `javascript-mode'."
+ :tag "JavaScript"
+ :group 'languages)
+
+(defcustom javascript-indent-level 4
+ "Number of spaces for each indentation step."
+ :type 'integer
+ :group 'javascript)
+
+(defcustom javascript-auto-indent-flag t
+ "Automatic indentation with punctuation characters. If non-nil, the
+current line is indented when certain punctuations are inserted."
+ :type 'boolean
+ :group 'javascript)
+
+
+;; --- Keymap ---
+
+(defvar javascript-mode-map nil
+ "Keymap used in JavaScript mode.")
+
+(unless javascript-mode-map
+ (setq javascript-mode-map (make-sparse-keymap)))
+
+(when javascript-auto-indent-flag
+ (mapc (lambda (key)
+ (define-key javascript-mode-map key 'javascript-insert-and-indent))
+ '("{" "}" "(" ")" ":" ";" ",")))
+
+(defun javascript-insert-and-indent (key)
+ "Run command bound to key and indent current line. Runs the command
+bound to KEY in the global keymap and indents the current line."
+ (interactive (list (this-command-keys)))
+ (call-interactively (lookup-key (current-global-map) key))
+ (indent-according-to-mode))
+
+
+;; --- Syntax Table And Parsing ---
+
+(defvar javascript-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (c-populate-syntax-table table)
+
+ ;; The syntax class of underscore should really be `symbol' ("_")
+ ;; but that makes matching of tokens much more complex as e.g.
+ ;; "\\<xyz\\>" matches part of e.g. "_xyz" and "xyz_abc". Defines
+ ;; it as word constituent for now.
+ (modify-syntax-entry ?_ "w" table)
+
+ table)
+ "Syntax table used in JavaScript mode.")
+
+
+(defun js-re-search-forward-inner (regexp &optional bound count)
+ "Auxiliary function for `js-re-search-forward'."
+ (let ((parse)
+ (saved-point (point-min)))
+ (while (> count 0)
+ (re-search-forward regexp bound)
+ (setq parse (parse-partial-sexp saved-point (point)))
+ (cond ((nth 3 parse)
+ (re-search-forward
+ (concat "\\([^\\]\\|^\\)" (string (nth 3 parse)))
+ (save-excursion (end-of-line) (point)) t))
+ ((nth 7 parse)
+ (forward-line))
+ ((or (nth 4 parse)
+ (and (eq (char-before) ?\/) (eq (char-after) ?\*)))
+ (re-search-forward "\\*/"))
+ (t
+ (setq count (1- count))))
+ (setq saved-point (point))))
+ (point))
+
+
+(defun js-re-search-forward (regexp &optional bound noerror count)
+ "Search forward but ignore strings and comments. Invokes
+`re-search-forward' but treats the buffer as if strings and
+comments have been removed."
+ (let ((saved-point (point))
+ (search-expr
+ (cond ((null count)
+ '(js-re-search-forward-inner regexp bound 1))
+ ((< count 0)
+ '(js-re-search-backward-inner regexp bound (- count)))
+ ((> count 0)
+ '(js-re-search-forward-inner regexp bound count)))))
+ (condition-case err
+ (eval search-expr)
+ (search-failed
+ (goto-char saved-point)
+ (unless noerror
+ (error (error-message-string err)))))))
+
+
+(defun js-re-search-backward-inner (regexp &optional bound count)
+ "Auxiliary function for `js-re-search-backward'."
+ (let ((parse)
+ (saved-point (point-min)))
+ (while (> count 0)
+ (re-search-backward regexp bound)
+ (when (and (> (point) (point-min))
+ (save-excursion (backward-char) (looking-at "/[/*]")))
+ (forward-char))
+ (setq parse (parse-partial-sexp saved-point (point)))
+ (cond ((nth 3 parse)
+ (re-search-backward
+ (concat "\\([^\\]\\|^\\)" (string (nth 3 parse)))
+ (save-excursion (beginning-of-line) (point)) t))
+ ((nth 7 parse)
+ (goto-char (nth 8 parse)))
+ ((or (nth 4 parse)
+ (and (eq (char-before) ?/) (eq (char-after) ?*)))
+ (re-search-backward "/\\*"))
+ (t
+ (setq count (1- count))))))
+ (point))
+
+
+(defun js-re-search-backward (regexp &optional bound noerror count)
+ "Search backward but ignore strings and comments. Invokes
+`re-search-backward' but treats the buffer as if strings and
+comments have been removed."
+ (let ((saved-point (point))
+ (search-expr
+ (cond ((null count)
+ '(js-re-search-backward-inner regexp bound 1))
+ ((< count 0)
+ '(js-re-search-forward-inner regexp bound (- count)))
+ ((> count 0)
+ '(js-re-search-backward-inner regexp bound count)))))
+ (condition-case err
+ (eval search-expr)
+ (search-failed
+ (goto-char saved-point)
+ (unless noerror
+ (error (error-message-string err)))))))
+
+
+(defun js-continued-var-decl-list-p ()
+ "Return non-nil if point is inside a continued variable declaration
+list."
+ (interactive)
+ (let ((start (save-excursion (js-re-search-backward "\\<var\\>" nil t))))
+ (and start
+ (save-excursion (re-search-backward "\n" start t))
+ (not (save-excursion
+ (js-re-search-backward
+ ";\\|[^, \t][ \t]*\\(/[/*]\\|$\\)" start t))))))
+
+
+;; --- Font Lock ---
+
+(defun js-inside-param-list-p ()
+ "Return non-nil if point is inside a function parameter list."
+ (condition-case err
+ (save-excursion
+ (up-list -1)
+ (and (looking-at "(")
+ (progn (backward-word 1)
+ (or (looking-at "function")
+ (progn (backward-word 1) (looking-at "function"))))))
+ (error nil)))
+
+
+(defconst js-function-heading-1-re
+ "^[ \t]*function[ \t]+\\(\\w+\\)"
+ "Regular expression matching the start of a function header.")
+
+(defconst js-function-heading-2-re
+ "^[ \t]*\\(\\w+\\)[ \t]*:[ \t]*function\\>"
+ "Regular expression matching the start of a function entry in
+ an associative array.")
+
+(defconst js-keyword-re
+ (regexp-opt '("abstract" "break" "case" "catch" "class" "const"
+ "continue" "debugger" "default" "delete" "do" "else"
+ "enum" "export" "extends" "final" "finally" "for"
+ "function" "goto" "if" "implements" "import" "in"
+ "instanceof" "interface" "native" "new" "package"
+ "private" "protected" "public" "return" "static"
+ "super" "switch" "synchronized" "this" "throw"
+ "throws" "transient" "try" "typeof" "var" "void"
+ "volatile" "while" "with"
+ "let") 'words)
+ "Regular expression matching any JavaScript keyword.")
+
+(defconst js-basic-type-re
+ (regexp-opt '("boolean" "byte" "char" "double" "float" "int" "long"
+ "short" "void") 'words)
+ "Regular expression matching any predefined type in JavaScript.")
+
+(defconst js-constant-re
+ (regexp-opt '("false" "null" "true") 'words)
+ "Regular expression matching any future reserved words in JavaScript.")
+
+
+(defconst js-font-lock-keywords-1
+ (list
+ "\\<import\\>"
+ (list js-function-heading-1-re 1 font-lock-function-name-face)
+ (list js-function-heading-2-re 1 font-lock-function-name-face)
+ (list "[=(][ \t]*\\(/.*?[^\\]/\\w*\\)" 1 font-lock-string-face))
+ "Level one font lock.")
+
+(defconst js-font-lock-keywords-2
+ (append js-font-lock-keywords-1
+ (list (list js-keyword-re 1 font-lock-keyword-face)
+ (cons js-basic-type-re font-lock-type-face)
+ (cons js-constant-re font-lock-constant-face)))
+ "Level two font lock.")
+
+
+;; Limitations with variable declarations: There seems to be no
+;; sensible way to highlight variables occuring after an initialized
+;; variable in a variable list. For instance, in
+;;
+;; var x, y = f(a, b), z
+;;
+;; z will not be highlighted.
+
+(defconst js-font-lock-keywords-3
+ (append
+ js-font-lock-keywords-2
+ (list
+
+ ;; variable declarations
+ (list
+ (concat "\\<\\(const\\|var\\)\\>\\|" js-basic-type-re)
+ (list "\\(\\w+\\)[ \t]*\\([=;].*\\|,\\|/[/*]\\|$\\)"
+ nil
+ nil
+ '(1 font-lock-variable-name-face)))
+
+ ;; continued variable declaration list
+ (list
+ (concat "^[ \t]*\\w+[ \t]*\\([,;=]\\|/[/*]\\|$\\)")
+ (list "\\(\\w+\\)[ \t]*\\([=;].*\\|,\\|/[/*]\\|$\\)"
+ '(if (save-excursion (backward-char) (js-continued-var-decl-list-p))
+ (backward-word 1)
+ (end-of-line))
+ '(end-of-line)
+ '(1 font-lock-variable-name-face)))
+
+ ;; formal parameters
+ (list
+ (concat "\\<function\\>\\([ \t]+\\w+\\)?[ \t]*([ \t]*\\w")
+ (list "\\(\\w+\\)\\([ \t]*).*\\)?"
+ '(backward-char)
+ '(end-of-line)
+ '(1 font-lock-variable-name-face)))
+
+ ;; continued formal parameter list
+ (list
+ (concat "^[ \t]*\\w+[ \t]*[,)]")
+ (list "\\w+"
+ '(if (save-excursion (backward-char) (js-inside-param-list-p))
+ (backward-word 1)
+ (end-of-line))
+ '(end-of-line)
+ '(0 font-lock-variable-name-face)))))
+ "Level three font lock.")
+
+(defconst js-font-lock-keywords
+ '(js-font-lock-keywords-3 js-font-lock-keywords-1 js-font-lock-keywords-2
+ js-font-lock-keywords-3)
+ "See `font-lock-keywords'.")
+
+
+;; --- Indentation ---
+
+(defconst js-possibly-braceless-keyword-re
+ (regexp-opt
+ '("catch" "do" "else" "finally" "for" "if" "try" "while" "with" "let")
+ 'words)
+ "Regular expression matching keywords that are optionally
+ followed by an opening brace.")
+
+(defconst js-indent-operator-re
+ (concat "[-+*/%<>=&^|?:.]\\([^-+*/]\\|$\\)\\|"
+ (regexp-opt '("in" "instanceof") 'words))
+ "Regular expression matching operators that affect indentation
+ of continued expressions.")
+
+
+(defun js-looking-at-operator-p ()
+ "Return non-nil if text after point is an operator (that is not
+a comma)."
+ (save-match-data
+ (and (looking-at js-indent-operator-re)
+ (or (not (looking-at ":"))
+ (save-excursion
+ (and (js-re-search-backward "[?:{]\\|\\<case\\>" nil t)
+ (looking-at "?")))))))
+
+
+(defun js-continued-expression-p ()
+ "Returns non-nil if the current line continues an expression."
+ (save-excursion
+ (back-to-indentation)
+ (or (js-looking-at-operator-p)
+ (and (js-re-search-backward "\n" nil t)
+ (progn
+ (skip-chars-backward " \t")
+ (backward-char)
+ (and (> (point) (point-min))
+ (save-excursion (backward-char) (not (looking-at "[/*]/")))
+ (js-looking-at-operator-p)
+ (and (progn (backward-char)
+ (not (looking-at "++\\|--\\|/[/*]"))))))))))
+
+
+(defun js-end-of-do-while-loop-p ()
+ "Returns non-nil if word after point is `while' of a do-while
+statement, else returns nil. A braceless do-while statement
+spanning several lines requires that the start of the loop is
+indented to the same column as the current line."
+ (interactive)
+ (save-excursion
+ (save-match-data
+ (when (looking-at "\\s-*\\<while\\>")
+ (if (save-excursion
+ (skip-chars-backward "[ \t\n]*}")
+ (looking-at "[ \t\n]*}"))
+ (save-excursion
+ (backward-list) (backward-word 1) (looking-at "\\<do\\>"))
+ (js-re-search-backward "\\<do\\>" (point-at-bol) t)
+ (or (looking-at "\\<do\\>")
+ (let ((saved-indent (current-indentation)))
+ (while (and (js-re-search-backward "^[ \t]*\\<" nil t)
+ (/= (current-indentation) saved-indent)))
+ (and (looking-at "[ \t]*\\<do\\>")
+ (not (js-re-search-forward
+ "\\<while\\>" (point-at-eol) t))
+ (= (current-indentation) saved-indent)))))))))
+
+
+(defun js-ctrl-statement-indentation ()
+ "Returns the proper indentation of the current line if it
+starts the body of a control statement without braces, else
+returns nil."
+ (save-excursion
+ (back-to-indentation)
+ (when (save-excursion
+ (and (not (looking-at "[{]"))
+ (progn
+ (js-re-search-backward "[[:graph:]]" nil t)
+ (forward-char)
+ (when (= (char-before) ?\)) (backward-list))
+ (skip-syntax-backward " ")
+ (skip-syntax-backward "w")
+ (looking-at js-possibly-braceless-keyword-re))
+ (not (js-end-of-do-while-loop-p))))
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (+ (current-indentation) javascript-indent-level)))))
+
+
+(defun js-proper-indentation (parse-status)
+ "Return the proper indentation for the current line."
+ (save-excursion
+ (back-to-indentation)
+ (let ((ctrl-stmt-indent (js-ctrl-statement-indentation))
+ (same-indent-p (looking-at "[]})]\\|\\<case\\>\\|\\<default\\>"))
+ (continued-expr-p (js-continued-expression-p)))
+ (cond (ctrl-stmt-indent)
+ ((js-continued-var-decl-list-p)
+ (js-re-search-backward "\\<var\\>" nil t)
+ (+ (current-indentation) javascript-indent-level))
+ ((nth 1 parse-status)
+ (goto-char (nth 1 parse-status))
+ (if (looking-at "[({[][ \t]*\\(/[/*]\\|$\\)")
+ (progn
+ (skip-syntax-backward " ")
+ (when (= (char-before) ?\)) (backward-list))
+ (back-to-indentation)
+ (cond (same-indent-p
+ (current-column))
+ (continued-expr-p
+ (+ (current-column) (* 2 javascript-indent-level)))
+ (t
+ (+ (current-column) javascript-indent-level))))
+ (unless same-indent-p
+ (forward-char)
+ (skip-chars-forward " \t"))
+ (current-column)))
+ (continued-expr-p javascript-indent-level)
+ (t 0)))))
+
+
+(defun javascript-indent-line ()
+ "Indent the current line as JavaScript source text."
+ (interactive)
+ (let ((parse-status
+ (save-excursion (parse-partial-sexp (point-min) (point-at-bol))))
+ (offset (- (current-column) (current-indentation))))
+ (when (not (nth 8 parse-status))
+ (indent-line-to (js-proper-indentation parse-status))
+ (when (> offset 0) (forward-char offset)))))
+
+
+;; --- Filling ---
+
+;; FIXME: It should be possible to use the more sofisticated function
+;; `c-fill-paragraph' in `cc-cmds.el' instead. However, just setting
+;; `fill-paragraph-function' to `c-fill-paragraph' does not work;
+;; inside `c-fill-paragraph', `fill-paragraph-function' evaluates to
+;; nil!?
+
+(defun js-backward-paragraph ()
+ "Move backward to start of paragraph. Postcondition: Point is at
+beginning of buffer or the previous line contains only whitespace."
+ (forward-line -1)
+ (while (not (or (bobp) (looking-at "^[ \t]*$")))
+ (forward-line -1))
+ (when (not (bobp)) (forward-line 1)))
+
+
+(defun js-forward-paragraph ()
+ "Move forward to end of paragraph. Postcondition: Point is at
+end of buffer or the next line contains only whitespace."
+ (forward-line 1)
+ (while (not (or (eobp) (looking-at "^[ \t]*$")))
+ (forward-line 1))
+ (when (not (eobp)) (backward-char 1)))
+
+
+(defun js-fill-block-comment-paragraph (parse-status justify)
+ "Fill current paragraph as a block comment. PARSE-STATUS is the
+result of `parse-partial-regexp' from beginning of buffer to
+point. JUSTIFY has the same meaning as in `fill-paragraph'."
+ (let ((offset (save-excursion
+ (goto-char (nth 8 parse-status)) (current-indentation))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (save-excursion
+ (goto-char (nth 8 parse-status)) (point-at-bol))
+ (save-excursion
+ (goto-char (nth 8 parse-status))
+ (re-search-forward "*/")))
+ (narrow-to-region (save-excursion
+ (js-backward-paragraph)
+ (when (looking-at "^[ \t]*$") (forward-line 1))
+ (point))
+ (save-excursion
+ (js-forward-paragraph)
+ (when (looking-at "^[ \t]*$") (backward-char))
+ (point)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (delete-horizontal-space)
+ (forward-line 1))
+ (let ((fill-column (- fill-column offset))
+ (fill-paragraph-function nil))
+ (fill-paragraph justify))
+
+ ;; In Emacs 21.4 as opposed to CVS Emacs 22,
+ ;; `fill-paragraph' seems toadd a newline at the end of the
+ ;; paragraph. Remove it!
+ (goto-char (point-max))
+ (when (looking-at "^$") (backward-delete-char 1))
+
+ (goto-char (point-min))
+ (while (not (eobp))
+ (indent-to offset)
+ (forward-line 1))))))
+
+
+(defun js-sline-comment-par-start ()
+ "Return point at the beginning of the line where the current
+single-line comment paragraph starts."
+ (save-excursion
+ (beginning-of-line)
+ (while (and (not (bobp))
+ (looking-at "^[ \t]*//[ \t]*[[:graph:]]"))
+ (forward-line -1))
+ (unless (bobp) (forward-line 1))
+ (point)))
+
+
+(defun js-sline-comment-par-end ()
+ "Return point at end of current single-line comment paragraph."
+ (save-excursion
+ (beginning-of-line)
+ (while (and (not (eobp))
+ (looking-at "^[ \t]*//[ \t]*[[:graph:]]"))
+ (forward-line 1))
+ (unless (bobp) (backward-char))
+ (point)))
+
+
+(defun js-sline-comment-offset (line)
+ "Return the column at the start of the current single-line
+comment paragraph."
+ (save-excursion
+ (goto-line line)
+ (re-search-forward "//" (point-at-eol))
+ (goto-char (match-beginning 0))
+ (current-column)))
+
+
+(defun js-sline-comment-text-offset (line)
+ "Return the column at the start of the text of the current
+single-line comment paragraph."
+ (save-excursion
+ (goto-line line)
+ (re-search-forward "//[ \t]*" (point-at-eol))
+ (current-column)))
+
+
+(defun js-at-empty-sline-comment-p ()
+ "Return non-nil if inside an empty single-line comment."
+ (and (save-excursion
+ (beginning-of-line)
+ (not (looking-at "^.*//.*[[:graph:]]")))
+ (save-excursion
+ (re-search-backward "//" (point-at-bol) t))))
+
+
+(defun js-fill-sline-comments (parse-status justify)
+ "Fill current paragraph as a sequence of single-line comments.
+PARSE-STATUS is the result of `parse-partial-regexp' from
+beginning of buffer to point. JUSTIFY has the same meaning as in
+`fill-paragraph'."
+ (when (not (js-at-empty-sline-comment-p))
+ (let* ((start (js-sline-comment-par-start))
+ (start-line (1+ (count-lines (point-min) start)))
+ (end (js-sline-comment-par-end))
+ (offset (js-sline-comment-offset start-line))
+ (text-offset (js-sline-comment-text-offset start-line)))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*//[ \t]*" nil t)
+ (replace-match "")
+ (forward-line 1))
+ (let ((fill-paragraph-function nil)
+ (fill-column (- fill-column text-offset)))
+ (fill-paragraph justify))
+
+ ;; In Emacs 21.4 as opposed to CVS Emacs 22,
+ ;; `fill-paragraph' seems toadd a newline at the end of the
+ ;; paragraph. Remove it!
+ (goto-char (point-max))
+ (when (looking-at "^$") (backward-delete-char 1))
+
+ (goto-char (point-min))
+ (while (not (eobp))
+ (indent-to offset)
+ (insert "//")
+ (indent-to text-offset)
+ (forward-line 1)))))))
+
+
+(defun js-trailing-comment-p (parse-status)
+ "Return non-nil if inside a trailing comment. PARSE-STATUS is
+the result of `parse-partial-regexp' from beginning of buffer to
+point."
+ (save-excursion
+ (when (nth 4 parse-status)
+ (goto-char (nth 8 parse-status))
+ (skip-chars-backward " \t")
+ (not (bolp)))))
+
+
+(defun js-block-comment-p (parse-status)
+ "Return non-nil if inside a block comment. PARSE-STATUS is the
+result of `parse-partial-regexp' from beginning of buffer to
+point."
+ (save-excursion
+ (save-match-data
+ (when (nth 4 parse-status)
+ (goto-char (nth 8 parse-status))
+ (looking-at "/\\*")))))
+
+
+(defun javascript-fill-paragraph (&optional justify)
+ "If inside a comment, fill the current comment paragraph.
+Trailing comments are ignored."
+ (interactive)
+ (let ((parse-status (parse-partial-sexp (point-min) (point))))
+ (when (and (nth 4 parse-status)
+ (not (js-trailing-comment-p parse-status)))
+ (if (js-block-comment-p parse-status)
+ (js-fill-block-comment-paragraph parse-status justify)
+ (js-fill-sline-comments parse-status justify))))
+ t)
+
+
+;; --- Imenu ---
+
+(defconst js-imenu-generic-expression
+ (list
+ (list
+ nil
+ "function\\s-+\\(\\w+\\)\\s-*("
+ 1))
+ "Regular expression matching top level procedures. Used by imenu.")
+
+
+;; --- Main Function ---
+
+;;;###autoload
+(defun javascript-mode ()
+ "Major mode for editing JavaScript source text.
+
+Key bindings:
+
+\\{javascript-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+
+ (use-local-map javascript-mode-map)
+ (set-syntax-table javascript-mode-syntax-table)
+ (set (make-local-variable 'indent-line-function) 'javascript-indent-line)
+ (set (make-local-variable 'font-lock-defaults) (list js-font-lock-keywords))
+
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+
+ ;; Comments
+ (setq comment-start "// ")
+ (setq comment-end "")
+ (set (make-local-variable 'fill-paragraph-function)
+ 'javascript-fill-paragraph)
+
+ ;; Make c-mark-function work
+ (setq c-nonsymbol-token-regexp "!=\\|%=\\|&[&=]\\|\\*[/=]\\|\\+[+=]\\|-[=-]\\|/[*/=]\\|<\\(?:<=\\|[<=]\\)\\|==\\|>\\(?:>\\(?:>=\\|[=>]\\)\\|[=>]\\)\\|\\^=\\||[=|]\\|[]!%&(-,./:-?[{-~^-]"
+ c-stmt-delim-chars "^;{}?:"
+ c-syntactic-ws-end "[ \n
+\v\f/]"
+ c-syntactic-eol "\\(\\s \\|/\\*\\([^*\n
+]\\|\\*[^/\n
+]\\)*\\*/\\)*\\(\\(/\\*\\([^*\n
+]\\|\\*[^/\n
+]\\)*\\|\\\\\\)?$\\|//\\)")
+
+ ;; Imenu
+ (setq imenu-case-fold-search nil)
+ (set (make-local-variable 'imenu-generic-expression)
+ js-imenu-generic-expression)
+
+ (setq major-mode 'javascript-mode)
+ (setq mode-name "JavaScript")
+ (run-hooks 'javascript-mode-hook))
+
+
+(provide 'javascript-mode)
+;;; javascript.el ends here
--- /dev/null
+;;; smarty-mode.el --- major mode for editing Smarty templates
+
+;; Author: Vincent DEBOUT <deboutv@free.fr>
+;; Maintainer: Vincent DEBOUT <deboutv@free.fr>
+;; Keywords: languages smarty templates
+;; WWW: http://deboutv.free.fr/lisp/smarty/
+
+;;; License
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 2
+;; of the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+;;; History
+
+;; $Log: smarty-mode.el,v $
+;; Revision 1.6 2006/12/16 19:54:26 vincent
+;; Update release version
+;;
+;; Revision 1.5 2006/12/16 19:53:00 vincent
+;; Fix bug #15
+;;
+;; Revision 1.4 2006/12/16 14:59:46 vincent
+;; Fix bugs for release
+;;
+;; Revision 1.3 2006/11/19 12:29:53 vincent
+;; Fix highlight bug, add templates
+;;
+;; Revision 1.2 2006/11/12 11:44:18 vincent
+;; First release commit
+;;
+
+(defconst smarty-version "0.0.4"
+ "Smarty Mode version number.")
+
+(defconst smarty-time-stamp "2006-12-16"
+ "Smarty Mode time stamp for last update.")
+
+(require 'font-lock)
+(require 'cc-mode)
+(require 'custom)
+(require 'etags)
+(eval-when-compile
+(require 'regexp-opt))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Customization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgroup smarty nil
+ "Customizations for Smarty mode."
+ :prefix "smarty-"
+ :group 'languages)
+
+(defgroup smarty-mode nil
+ "Customizations for Smarty mode."
+ :group 'smarty)
+
+(defcustom smarty-electric-mode t
+ "*Non-nil enables electrification (automatic template generation).
+If nil, template generators can still be invoked through key bindings and
+menu. Is indicated in the modeline by \"/e\" after the mode name and can be
+toggled by `\\[smarty-electric-mode]'."
+ :type 'boolean
+ :group 'smarty-mode)
+
+(defcustom smarty-stutter-mode t
+ "*Non-nil enables stuttering.
+Is indicated in the modeline by \"/s\" after the mode name and can be toggled
+by `\\[smarty-stutter-mode]'."
+ :type 'boolean
+ :group 'smarty-mode)
+
+(defgroup smarty-menu nil
+ "Customizations for menues."
+ :group 'smarty)
+
+(defcustom smarty-source-file-menu t
+ "*Non-nil means add a menu of all source files in current directory."
+ :type 'boolean
+ :group 'smarty-menu)
+
+(defgroup smarty-highlight nil
+ "Customizations for highlight."
+ :group 'smarty)
+
+(defcustom smarty-highlight-plugin-functions t
+ "*Non-nil means highlight the plugin functions in the buffer."
+ :type 'boolean
+ :group 'smarty-highlight)
+
+(defgroup smarty-template nil
+ "Customizations for templates."
+ :group 'smarty)
+
+(defgroup smarty-header nil
+ "Customizations for header template."
+ :group 'smarty-template)
+
+(defcustom smarty-file-header ""
+ "*String or file to insert as file header.
+If the string specifies an existing file name, the contents of the file is
+inserted, otherwise the string itself is inserted as file header.
+Type `C-j' for newlines.
+If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS>
+if the header needs to be version controlled.
+
+The following keywords for template generation are supported:
+ <filename> : replaced by the name of the buffer
+ <author> : replaced by the user name and email address
+ \(`user-full-name',`mail-host-address', `user-mail-address')
+ <login> : replaced by user login name (`user-login-name')
+ <company> : replaced by contents of option `smarty-company-name'
+ <date> : replaced by the current date
+ <year> : replaced by the current year
+ <copyright> : replaced by copyright string (`smarty-copyright-string')
+ <cursor> : final cursor position."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-file-footer ""
+ "*String or file to insert as file footer.
+If the string specifies an existing file name, the contents of the file is
+inserted, otherwise the string itself is inserted as file footer (i.e. at
+the end of the file).
+Type `C-j' for newlines.
+The same keywords as in option `smarty-file-header' can be used."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-company-name ""
+ "*Name of company to insert in file header.
+See option `smarty-file-header'."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-copyright-string ""
+ "*Copyright string to insert in file header.
+Can be multi-line string (type `C-j' for newline) and contain other file
+header keywords (see option `smarty-file-header')."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-date-format "%Y-%m-%d"
+ "*Specifies the date format to use in the header.
+This string is passed as argument to the command `format-time-string'.
+For more information on format strings, see the documentation for the
+`format-time-string' command (C-h f `format-time-string')."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-modify-date-prefix-string ""
+ "*Prefix string of modification date in Smarty file header.
+If actualization of the modification date is called (menu,
+`\\[smarty-template-modify]'), this string is searched and the rest
+of the line replaced by the current date."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-modify-date-on-saving nil
+ "*Non-nil means update the modification date when the buffer is saved.
+Calls function `\\[smarty-template-modify]').
+
+NOTE: Activate the new setting in a Smarty buffer by using the menu entry
+ \"Activate Options\"."
+ :type 'boolean
+ :group 'smarty-header)
+
+(defgroup smarty-misc nil
+ "Miscellaneous customizations."
+ :group 'smarty)
+
+(defcustom smarty-left-delimiter "{"
+ "Left escaping delimiter."
+ :type 'string
+ :group 'smarty-misc)
+
+(defcustom smarty-right-delimiter "}"
+ "Right escaping delimiter."
+ :type 'string
+ :group 'smarty-misc)
+
+(defcustom smarty-intelligent-tab t
+ "*Non-nil means `TAB' does indentation, word completion and tab insertion.
+That is, if preceding character is part of a word then complete word,
+else if not at beginning of line then insert tab,
+else if last command was a `TAB' or `RET' then dedent one step,
+else indent current line (i.e. `TAB' is bound to `smarty-electric-tab').
+If nil, TAB always indents current line (i.e. `TAB' is bound to
+`indent-according-to-mode').
+
+NOTE: Activate the new setting in a Smarty buffer by using the menu entry
+ \"Activate Options\"."
+ :type 'boolean
+ :group 'smarty-misc)
+
+(defcustom smarty-word-completion-in-minibuffer t
+ "*Non-nil enables word completion in minibuffer (for template prompts).
+
+NOTE: Activate the new setting by restarting Emacs."
+ :type 'boolean
+ :group 'smarty-misc)
+
+(defcustom smarty-word-completion-case-sensitive nil
+ "*Non-nil means word completion using `TAB' is case sensitive.
+That is, `TAB' completes words that start with the same letters and case.
+Otherwise, case is ignored."
+ :type 'boolean
+ :group 'smarty-misc)
+
+;; Functions
+
+(defun smarty-customize ()
+ "Call the customize function with `smarty' as argument."
+ (interactive)
+ (customize-browse 'smarty))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-menu-max-size 20
+ "*Specifies the maximum size of a menu before splitting it into submenues.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Menu tools functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-menu-split (list title)
+ "Split menu LIST into several submenues, if number of
+elements > `smarty-menu-max-size'."
+ (if (> (length list) smarty-menu-max-size)
+ (let ((remain list)
+ (result '())
+ (sublist '())
+ (menuno 1)
+ (i 0))
+ (while remain
+ (setq sublist (cons (car remain) sublist))
+ (setq remain (cdr remain))
+ (setq i (+ i 1))
+ (if (= i smarty-menu-max-size)
+ (progn
+ (setq result (cons (cons (format "%s %s" title menuno)
+ (nreverse sublist)) result))
+ (setq i 0)
+ (setq menuno (+ menuno 1))
+ (setq sublist '()))))
+ (and sublist
+ (setq result (cons (cons (format "%s %s" title menuno)
+ (nreverse sublist)) result)))
+ (nreverse result))
+ list))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Source file menu
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-sources-menu nil)
+
+;; Create the source menu
+(defun smarty-add-source-files-menu ()
+ "Scan directory for all Smarty source files and generate menu.
+The directory of the current source file is scanned."
+ (interactive)
+ (message "Scanning directory for source files ...")
+ (let ((newmap (current-local-map))
+ (file-list (smarty-get-source-files))
+ menu-list found)
+ ;; Create list for menu
+ (setq found nil)
+ (while file-list
+ (setq found t)
+ (setq menu-list (cons (vector (car file-list)
+ (list 'find-file (car file-list)) t)
+ menu-list))
+ (setq file-list (cdr file-list)))
+ (setq menu-list (smarty-menu-split menu-list "Sources"))
+ (when found (setq menu-list (cons "--" menu-list)))
+ (setq menu-list (cons ["*Rescan*" smarty-add-source-files-menu t] menu-list))
+ (setq menu-list (cons "Sources" menu-list))
+ ;; Create menu
+ (easy-menu-add menu-list)
+ (easy-menu-define smarty-sources-menu newmap
+ "Smarty source files menu" menu-list))
+ (message ""))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Smarty menu
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-create-mode-menu ()
+ "Create Smarty Mode menu."
+ `("Smarty"
+ ("Templates"
+ ("Built-in Functions"
+ ["capture" smarty-template-capture t]
+ ["config_load" smarty-template-config-load t]
+ ["else" smarty-template-else t]
+ ["elseif" smarty-template-elseif t]
+ ["foreach" smarty-template-foreach t]
+ ["foreachelse" smarty-template-foreachelse t]
+ ["if" smarty-template-if t]
+ ["include" smarty-template-include t]
+ ["include_php" smarty-template-include-php t]
+ ["insert" smarty-template-insert t]
+ ["ldelim" smarty-template-ldelim t]
+ ["literal" smarty-template-literal t]
+ ["php" smarty-template-php t]
+ ["rdelim" smarty-template-rdelim t]
+ ["section" smarty-template-section t]
+ ["sectionelse" smarty-template-sectionelse t]
+ ["strip" smarty-template-strip t])
+ ("Custom Functions"
+ ["assign" smarty-template-assign t]
+ ["counter" smarty-template-counter t]
+ ["cycle" smarty-template-cycle t]
+ ["debug" smarty-template-debug t]
+ ["eval" smarty-template-eval t]
+ ["fetch" smarty-template-fetch t]
+ ["html_checkboxes" smarty-template-html-checkboxes t]
+ ["html_image" smarty-template-html-image t]
+ ["html_options" smarty-template-html-options t]
+ ["html_radios" smarty-template-html-radios t]
+ ["html_select_date" smarty-template-html-select-date t]
+ ["html_select_time" smarty-template-html-select-time t]
+ ["html_table" smarty-template-html-table t]
+ ["mailto" smarty-template-mailto t]
+ ["math" smarty-template-math t]
+ ["popup" smarty-template-popup t]
+ ["popup_init" smarty-template-popup-init t]
+ ["textformat" smarty-template-textformat t])
+ ("Variable Modifiers"
+ ["capitalize" smarty-template-capitalize t]
+ ["cat" smarty-template-cat t]
+ ["count_characters" smarty-template-count-characters t]
+ ["count_paragraphs" smarty-template-count-paragraphs t]
+ ["count_sentences" smarty-template-count-sentences t]
+ ["count_words" smarty-template-count-words t]
+ ["date_format" smarty-template-date-format t]
+ ["default" smarty-template-default t]
+ ["escape" smarty-template-escape t]
+ ["indent" smarty-template-indent t]
+ ["lower" smarty-template-lower t]
+ ["nl2br" smarty-template-nl2br t]
+ ["regex_replace" smarty-template-regex-replace t]
+ ["replace" smarty-template-replace t]
+ ["spacify" smarty-template-spacify t]
+ ["string_format" smarty-template-string-format t]
+ ["strip" smarty-template-vstrip t]
+ ["strip_tags" smarty-template-strip-tags t]
+ ["truncate" smarty-template-truncate t]
+ ["upper" smarty-template-upper t]
+ ["wordwrap" smarty-template-wordwrap t])
+ ("Plugins (Functions)"
+ ("SmartyFormtool"
+ ["formtool_checkall" smarty-template-formtool-checkall t]
+ ["formtool_copy" smarty-template-formtool-copy t]
+ ["formtool_count_chars" smarty-template-formtool-count-chars t]
+ ["formtool_init" smarty-template-formtool-init t]
+ ["formtool_move" smarty-template-formtool-move t]
+ ["formtool_moveall" smarty-template-formtool-moveall t]
+ ["formtool_movedown" smarty-template-formtool-movedown t]
+ ["formtool_moveup" smarty-template-formtool-moveup t]
+ ["formtool_remove" smarty-template-formtool-remove t]
+ ["formtool_rename" smarty-template-formtool-rename t]
+ ["formtool_save" smarty-template-formtool-save t]
+ ["formtool_selectall" smarty-template-formtool-selectall t])
+ ("SmartyPaginate"
+ ["paginate_first" smarty-template-paginate-first t]
+ ["paginate_last" smarty-template-paginate-last t]
+ ["paginate_middle" smarty-template-paginate-middle t]
+ ["paginate_next" smarty-template-paginate-next t]
+ ["paginate_prev" smarty-template-paginate-prev t])
+ ("SmartyValidate"
+ ["validate" smarty-template-validate t]))
+ ("Plugins (Variable Modifiers)"
+ ("AlternativeDateModifierPlugin"
+ ["date_format2" smarty-template-date-formatto t])
+ ("B2Smilies"
+ ["B2Smilies" smarty-template-btosmilies t])
+ ("BBCodePlugin"
+ ["bbcode2html" smarty-template-bbcodetohtml t])
+ )
+ "--"
+ ["Insert Header" smarty-template-header t]
+ ["Insert Footer" smarty-template-footer t]
+ ["Insert Date" smarty-template-insert-date t]
+ ["Modify Date" smarty-template-modify t])
+ "--"
+ ["Show Messages" smarty-show-messages :keys "C-c M-m"]
+ ["Smarty Mode Documentation" smarty-doc-mode :keys "C-c C-h"]
+ ["Version" smarty-version :keys "C-c C-v"]
+ "--"
+ ("Options"
+ ("Mode"
+ ["Electric Mode"
+ (progn (customize-set-variable 'smarty-electric-mode
+ (not smarty-electric-mode))
+ (smarty-mode-line-update))
+ :style toggle :selected smarty-electric-mode :keys "C-c C-m C-e"]
+ ["Stutter Mode"
+ (progn (customize-set-variable 'smarty-stutter-mode
+ (not smarty-stutter-mode))
+ (smarty-mode-line-update))
+ :style toggle :selected smarty-stutter-mode :keys "C-c C-m C-s"]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-mode) t])
+ ("Menu"
+ ["Source Menu"
+ (customize-set-variable 'smarty-source-file-menu
+ (not smarty-source-file-menu))
+ :style toggle :selected smarty-source-file-menu]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-menu) t])
+ ("Highlight"
+ ["Highlight plugin functions"
+ (progn (customize-set-variable 'smarty-highlight-plugin-functions
+ (not smarty-highlight-plugin-functions)))
+ :style toggle :selected smarty-highlight-plugin-functions]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-highlight) t])
+ ("Template"
+ ("Header"
+ ["Header template..."
+ (customize-option 'smarty-file-header) t]
+ ["Footer template..."
+ (customize-option 'smarty-file-footer) t]
+ ["Company..."
+ (customize-option 'smarty-company-name) t]
+ ["Copyright..."
+ (customize-option 'smarty-copyright-string) t]
+ ["Date format..."
+ (customize-option 'smarty-date-format) t]
+ ["Modify date prefix..."
+ (customize-option 'smarty-modify-date-prefix-string) t]
+ ["Modify date on saving"
+ (customize-set-variable 'smarty-modify-date-on-saving
+ (not smarty-modify-date-on-saving))
+ :style toggle :selected smarty-modify-date-on-saving]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-header) t])
+ "--"
+ ["Customize Group..." (customize-group 'smarty-template) t])
+ ("Miscellaneous"
+ ["Left delimiter..."
+ (customize-option 'smarty-left-delimiter) t]
+ ["Right delimiter..."
+ (customize-option 'smarty-right-delimiter) t]
+ ["Use Intelligent Tab"
+ (progn (customize-set-variable 'smarty-intelligent-tab
+ (not smarty-intelligent-tab))
+ (smarty-activate-customizations))
+ :style toggle :selected smarty-intelligent-tab]
+ ["Word Completion in Minibuffer"
+ (progn (customize-set-variable 'smarty-word-completion-in-minibuffer
+ (not smarty-word-completion-in-minibuffer))
+ (message "Activate new setting by saving options and restarting Emacs"))
+ :style toggle :selected smarty-word-completion-in-minibuffer]
+ ["Completion is case sensitive"
+ (customize-set-variable 'smarty-word-completion-case-sensitive
+ (not smarty-word-completion-case-sensitive))
+ :style toggle :selected smarty-word-completion-case-sensitive]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-misc) t])
+ "--"
+ ["Save Options" customize-save-customized t]
+ ["Activate Options" smarty-activate-customizations t]
+ ["Browse Options..." smarty-customize t])))
+
+(defvar smarty-mode-menu-list (smarty-create-mode-menu)
+ "Smarty Mode menu.")
+
+(defvar smarty-mode-map nil
+ "Keymap for Smarty Mode.")
+
+(defun smarty-update-mode-menu ()
+ "Update Smarty Mode menu."
+ (interactive)
+ (easy-menu-remove smarty-mode-menu-list)
+ (setq smarty-mode-menu-list (smarty-create-mode-menu))
+ (easy-menu-add smarty-mode-menu-list)
+ (easy-menu-define smarty-mode-menu smarty-mode-map
+ "Menu keymap for Smarty Mode." smarty-mode-menu-list))
+
+
+
+
+(defvar smarty-mode-hook nil)
+
+(defvar smarty-functions nil
+ "List of Smarty functions.")
+
+(defvar smarty-functions-regexp nil
+ "Regexp for Smarty functions.")
+
+(defconst smarty-01-functions
+ '("capture" "config_load" "foreach" "foreachelse" "include"
+ "include_php" "insert" "if" "elseif" "else" "ldelim" "rdelim"
+ "literal" "php" "section" "sectionelse" "strip" "assign" "counter"
+ "cycle" "debug" "eval" "fetch" "html_checkboxes" "html_image"
+ "html_options" "html_radios" "html_select_date" "html_select_time"
+ "html_table" "math" "mailto" "popup_init" "popup" "textformat")
+ "Smarty built-in & custom functions.")
+
+(defvar smarty-modifiers nil
+ "List of Smarty variable modifiers.")
+
+(defvar smarty-modifiers-regexp nil
+ "Regexp for Smarty variable modifiers.")
+
+(defconst smarty-01-modifiers
+ '("capitalize" "cat" "count_characters" "count_paragraphs"
+ "count_sentences" "count_words" "date_format" "default"
+ "escape" "indent" "lower" "nl2br" "regex_replace" "replace"
+ "spacify" "string_format" "strip" "strip_tags" "truncate"
+ "upper" "wordwrap")
+ "Smarty variable modifiers.")
+
+(defvar smarty-plugins-functions nil
+ "List of Smarty functions.")
+
+(defvar smarty-plugins-functions-regexp nil
+ "Regexp for Smarty functions.")
+
+(defconst smarty-01-plugins-functions
+ '("validate" "formtool_checkall" "formtool_copy" "formtool_count_chars"
+ "formtool_init" "formtool_move" "formtool_moveall"
+ "formtool_movedown" "formtool_moveup" "formtool_remove"
+ "formtool_rename" "formtool_save" "formtool_selectall"
+ "paginate_first" "paginate_last" "paginate_middle"
+ "paginate_next" "paginate_prev")
+ "Smarty plugins functions.")
+
+(defvar smarty-plugins-modifiers nil
+ "List of Smarty variable modifiers.")
+
+(defvar smarty-plugins-modifiers-regexp nil
+ "Regexp for Smarty functions.")
+
+(defconst smarty-01-plugins-modifiers
+ '("B2Smilies" "bbcode2html" "date_format2")
+ "Smarty plugins modifiers.")
+
+(defconst smarty-constants
+ (eval-when-compile
+ (regexp-opt
+ '("TRUE" "FALSE" "NULL") t))
+ "Smarty constants.")
+
+
+;; Syntax table creation
+(defvar smarty-mode-syntax-table nil
+ "Syntax table for smarty-mode.")
+
+(defvar smarty-mode-ext-syntax-table nil
+ "Syntax table extended by `_' used in `smarty-mode' buffers.")
+
+(defun smarty-create-syntax-table ()
+ (if smarty-mode-syntax-table
+ ()
+ (setq smarty-mode-syntax-table (make-syntax-table))
+
+ ;; Make | a punctuation character
+ (modify-syntax-entry ?| "." smarty-mode-syntax-table)
+ ;; Make " a punctuation character so highlighing works withing html strings
+ (modify-syntax-entry ?\" "." smarty-mode-syntax-table)
+ ;; define parentheses to match
+ (modify-syntax-entry ?\( "()" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\) ")(" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\[ "(]" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\] ")[" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\{ "(}" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\} "){" smarty-mode-syntax-table)
+ )
+ (set-syntax-table smarty-mode-syntax-table)
+ ;; extended syntax table including '_' (for simpler search regexps)
+ (setq smarty-mode-ext-syntax-table (copy-syntax-table smarty-mode-syntax-table))
+ (modify-syntax-entry ?_ "w" smarty-mode-ext-syntax-table))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; File/directory manipulation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-directory-files (directory &optional full match)
+ "Call `directory-files' if DIRECTORY exists, otherwise generate error
+message."
+ (if (not (file-directory-p directory))
+ (smarty-warning-when-idle "No such directory: \"%s\"" directory)
+ (let ((dir (directory-files directory full match)))
+ (setq dir (delete "." dir))
+ (setq dir (delete ".." dir))
+ dir)))
+
+(defun smarty-get-source-files (&optional full directory)
+ "Get list of SMARTY source files in DIRECTORY or current directory."
+ (let ((mode-alist auto-mode-alist)
+ filename-regexp)
+ ;; create regular expressions for matching file names
+ (setq filename-regexp "\\`[^.].*\\(")
+ (while mode-alist
+ (when (eq (cdar mode-alist) 'smarty-mode)
+ (setq filename-regexp
+ (concat filename-regexp (caar mode-alist) "\\|")))
+ (setq mode-alist (cdr mode-alist)))
+ (setq filename-regexp
+ (concat (substring filename-regexp 0
+ (string-match "\\\\|$" filename-regexp)) "\\)"))
+ ;; find files
+ (smarty-directory-files
+ (or directory default-directory) full filename-regexp)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Messages reporting
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-warnings nil
+ "Warnings to tell the user during start up.")
+
+(defun smarty-run-when-idle (secs repeat function)
+ "Wait until idle, then run FUNCTION."
+ (if (fboundp 'start-itimer)
+ (start-itimer "smarty-mode" function secs repeat t)
+; (run-with-idle-timer secs repeat function)))
+ ;; explicitely activate timer (necessary when Emacs is already idle)
+ (aset (run-with-idle-timer secs repeat function) 0 nil)))
+
+(defun smarty-warning-when-idle (&rest args)
+ "Wait until idle, then print out warning STRING and beep."
+ (if noninteractive
+ (smarty-warning (apply 'format args) t)
+ (unless smarty-warnings
+ (smarty-run-when-idle .1 nil 'smarty-print-warnings))
+ (setq smarty-warnings (cons (apply 'format args) smarty-warnings))))
+
+(defun smarty-warning (string &optional nobeep)
+ "Print out warning STRING and beep."
+ (message (concat "WARNING: " string))
+ (unless (or nobeep noninteractive) (beep)))
+
+(defun smarty-print-warnings ()
+ "Print out messages in variable `smarty-warnings'."
+ (let ((no-warnings (length smarty-warnings)))
+ (setq smarty-warnings (nreverse smarty-warnings))
+ (while smarty-warnings
+ (message (concat "WARNING: " (car smarty-warnings)))
+ (setq smarty-warnings (cdr smarty-warnings)))
+ (beep)
+ (when (> no-warnings 1)
+ (message "WARNING: See warnings in message buffer (type `C-c M-m')."))))
+
+(defun smarty-show-messages ()
+ "Get *Messages* buffer to show recent messages."
+ (interactive)
+ (display-buffer " *Message-Log*"))
+
+(defun smarty-version ()
+ "Echo the current version of Smarty Mode in the minibuffer."
+ (interactive)
+ (message "Smarty Mode %s (%s)" smarty-version smarty-time-stamp)
+ (smarty-keep-region-active))
+
+;; active regions
+(defun smarty-keep-region-active ()
+ "Do whatever is necessary to keep the region active in XEmacs.
+Ignore byte-compiler warnings you might see."
+ (and (boundp 'zmacs-region-stays)
+ (setq zmacs-region-stays t)))
+
+(defmacro smarty-prepare-search-1 (&rest body)
+ "Enable case insensitive search and switch to syntax table that includes '_',
+then execute BODY, and finally restore the old environment. Used for
+consistent searching."
+ `(let ((case-fold-search t) ; case insensitive search
+ (current-syntax-table (syntax-table))
+ result
+ (restore-prog ; program to restore enviroment
+ '(progn
+ ;; restore syntax table
+ (set-syntax-table current-syntax-table))))
+ ;; use extended syntax table
+ (set-syntax-table smarty-mode-ext-syntax-table)
+ ;; execute BODY safely
+ (setq result
+ (condition-case info
+ (progn ,@body)
+ (error (eval restore-prog) ; restore environment on error
+ (error (cadr info))))) ; pass error up
+ ;; restore environment
+ (eval restore-prog)
+ result))
+
+(defmacro smarty-prepare-search-2 (&rest body)
+ "Enable case insensitive search, switch to syntax table that includes '_',
+and remove `intangible' overlays, then execute BODY, and finally restore the
+old environment. Used for consistent searching."
+ `(let ((case-fold-search t) ; case insensitive search
+ (current-syntax-table (syntax-table))
+ result overlay-all-list overlay-intangible-list overlay
+ (restore-prog ; program to restore enviroment
+ '(progn
+ ;; restore syntax table
+ (set-syntax-table current-syntax-table)
+ ;; restore `intangible' overlays
+ (when (fboundp 'overlay-lists)
+ (while overlay-intangible-list
+ (overlay-put (car overlay-intangible-list) 'intangible t)
+ (setq overlay-intangible-list
+ (cdr overlay-intangible-list)))))))
+ ;; use extended syntax table
+ (set-syntax-table smarty-mode-ext-syntax-table)
+ ;; remove `intangible' overlays
+ (when (fboundp 'overlay-lists)
+ (setq overlay-all-list (overlay-lists))
+ (setq overlay-all-list
+ (append (car overlay-all-list) (cdr overlay-all-list)))
+ (while overlay-all-list
+ (setq overlay (car overlay-all-list))
+ (when (memq 'intangible (overlay-properties overlay))
+ (setq overlay-intangible-list
+ (cons overlay overlay-intangible-list))
+ (overlay-put overlay 'intangible nil))
+ (setq overlay-all-list (cdr overlay-all-list))))
+ ;; execute BODY safely
+ (setq result
+ (condition-case info
+ (progn ,@body)
+ (error (eval restore-prog) ; restore environment on error
+ (error (cadr info))))) ; pass error up
+ ;; restore environment
+ (eval restore-prog)
+ result))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Enabling/disabling
+
+(defun smarty-mode-line-update ()
+ "Update the modeline string for Smarty major mode."
+ (setq mode-name (concat "Smarty"
+ (and (or smarty-electric-mode smarty-stutter-mode) "/")
+ (and smarty-electric-mode "e")
+ (and smarty-stutter-mode "s")))
+ (force-mode-line-update t))
+
+(defun smarty-electric-mode (arg)
+ "Toggle Smarty electric mode.
+Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
+ (interactive "P")
+ (setq smarty-electric-mode
+ (cond ((or (not arg) (zerop arg)) (not smarty-electric-mode))
+ ((> arg 0) t) (t nil)))
+ (smarty-mode-line-update))
+
+(defun smarty-stutter-mode (arg)
+ "Toggle Smarty stuttering mode.
+Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
+ (interactive "P")
+ (setq smarty-stutter-mode
+ (cond ((or (not arg) (zerop arg)) (not smarty-stutter-mode))
+ ((> arg 0) t) (t nil)))
+ (smarty-mode-line-update))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Smarty code delimitation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-in-literal ()
+ "Determine if point is in a Smarty literal."
+ (save-excursion
+ (let ((here (point))
+ start state)
+ (beginning-of-line)
+ (setq start (point))
+ (goto-char here)
+ (setq state (parse-partial-sexp start (point)))
+ (cond
+ ((nth 3 state) 'string)
+ ((nth 4 state) 'comment)
+ (t nil)))))
+
+(defun smarty-in-comment-p ()
+ "Check if point is in a comment."
+ (let ((result nil) (here (point-marker)) found)
+ (save-excursion
+ (setq found (re-search-backward (regexp-quote (concat smarty-left-delimiter "*")) nil t))
+ (when found
+ (setq result (re-search-forward (regexp-quote (concat "*" smarty-right-delimiter)) here t))
+ (setq result (not result))))
+ result))
+
+(defun smarty-after-ldelim ()
+ "Check that the previous character is the left delimiter."
+ (let ((here (point-marker)) ldelim-found ldelim-point)
+ (save-excursion
+ (setq ldelim-found (re-search-backward (regexp-quote smarty-left-delimiter) nil t))
+ (re-search-forward (regexp-quote smarty-left-delimiter) here t)
+ (setq ldelim-point (point-marker))
+ (goto-char here)
+ (if (and (= here ldelim-point) ldelim-found)
+ t
+ nil))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Words to expand
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-words-init ()
+ "Initialize reserved words."
+ (setq smarty-functions smarty-01-functions)
+ (setq smarty-modifiers smarty-01-modifiers)
+ (setq smarty-plugins-functions smarty-01-plugins-functions)
+ (setq smarty-plugins-modifiers smarty-01-plugins-modifiers)
+ (setq smarty-functions-regexp (concat "\\<\\(" (regexp-opt smarty-functions) "\\)\\>"))
+ (setq smarty-modifiers-regexp (concat "\\<\\(" (regexp-opt smarty-modifiers) "\\)\\>"))
+ (setq smarty-plugins-functions-regexp (concat "\\<\\(" (regexp-opt smarty-plugins-functions) "\\)\\>"))
+ (setq smarty-plugins-modifiers-regexp (concat "\\<\\(" (regexp-opt smarty-plugins-modifiers) "\\)\\>"))
+ (smarty-abbrev-list-init))
+
+(defvar smarty-abbrev-list nil
+ "Predefined abbreviations for Smarty.")
+
+(defun smarty-abbrev-list-init ()
+ (setq smarty-abbrev-list
+ (append
+ (list nil) smarty-functions
+ (list nil) smarty-modifiers
+ (list nil) smarty-plugins-functions
+ (list nil) smarty-plugins-modifiers)))
+
+(defvar smarty-expand-upper-case nil)
+
+(defun smarty-try-expand-abbrev (old)
+ "Try expanding abbreviations from `smarty-abbrev-list'."
+ (unless old
+ (he-init-string (he-dabbrev-beg) (point))
+ (setq he-expand-list
+ (let ((abbrev-list smarty-abbrev-list)
+ (sel-abbrev-list '()))
+ (while abbrev-list
+ ; (if (stringp (car abbrev-list))
+ ; (insert (concat " " (car abbrev-list))))
+ (when (or (not (stringp (car abbrev-list)))
+ (string-match
+ (concat "^" he-search-string) (car abbrev-list)))
+ (setq sel-abbrev-list
+ (cons (car abbrev-list) sel-abbrev-list)))
+ (setq abbrev-list (cdr abbrev-list)))
+ (nreverse sel-abbrev-list))))
+ (while (and he-expand-list
+ (or (not (stringp (car he-expand-list)))
+ (he-string-member (car he-expand-list) he-tried-table t)))
+ (unless (stringp (car he-expand-list))
+ (setq smarty-expand-upper-case (car he-expand-list)))
+ (setq he-expand-list (cdr he-expand-list)))
+ (if (null he-expand-list)
+ (progn (when old (he-reset-string))
+ nil)
+ (he-substitute-string
+ (if smarty-expand-upper-case
+ (upcase (car he-expand-list))
+ (car he-expand-list))
+ t)
+ (setq he-expand-list (cdr he-expand-list))
+ t))
+
+;; initialize reserved words for Smarty Mode
+(smarty-words-init)
+
+;; function for expanding abbrevs and dabbrevs
+(defun smarty-expand-abbrev (arg))
+(fset 'smarty-expand-abbrev (make-hippie-expand-function
+ '(try-expand-dabbrev
+ try-expand-dabbrev-all-buffers
+ smarty-try-expand-abbrev)))
+
+;; function for expanding parenthesis
+(defun smarty-expand-paren (arg))
+(fset 'smarty-expand-paren (make-hippie-expand-function
+ '(try-expand-list
+ try-expand-list-all-buffers)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Stuttering
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-electric-tab (&optional prefix-arg)
+ "If preceding character is part of a word or a paren then hippie-expand,
+else if right of non whitespace on line then insert tab,
+else if last command was a tab or return then dedent one step or if a comment
+toggle between normal indent and inline comment indent,
+else indent `correctly'."
+ (interactive "*P")
+ (smarty-prepare-search-2
+ (cond
+ ;; expand word
+ ((= (char-syntax (preceding-char)) ?w)
+ (let ((case-fold-search (not smarty-word-completion-case-sensitive))
+ (case-replace nil)
+ (hippie-expand-only-buffers
+ (or (and (boundp 'hippie-expand-only-buffers)
+ hippie-expand-only-buffers)
+ '(smarty-mode))))
+ (smarty-expand-abbrev prefix-arg)))
+ ;; expand parenthesis
+ ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
+ (let ((case-fold-search (not smarty-word-completion-case-sensitive))
+ (case-replace nil))
+ (smarty-expand-paren prefix-arg))))
+ (setq this-command 'smarty-electric-tab)))
+
+(defun smarty-electric-space (count)
+ "Expand abbreviations and self-insert space(s)."
+ (interactive "p")
+ (let ((here (point-marker)) ldelim-found ldelim-point rdelim-found rdelim-point
+ delete-a)
+ (setq ldelim-found (re-search-backward (regexp-quote smarty-left-delimiter) nil t))
+ (re-search-forward (regexp-quote smarty-left-delimiter) here t)
+ (setq ldelim-point (point-marker))
+ (goto-char here)
+ (setq rdelim-found (re-search-backward (regexp-quote (concat " " smarty-right-delimiter)) nil t))
+ (re-search-forward (regexp-quote (concat " " smarty-right-delimiter)) here t)
+ (setq rdelim-point (point-marker))
+ (goto-char here)
+ (cond ((and (= here ldelim-point) ldelim-found) (insert (concat "ldelim" smarty-right-delimiter)))
+ ((and (= here rdelim-point) rdelim-found)
+ (re-search-backward (regexp-quote (concat " " smarty-right-delimiter)) nil t)
+ (delete-char 1)
+ (insert (concat " " smarty-left-delimiter "rdelim"))
+ (goto-char here))
+ ((smarty-in-comment-p)
+ (self-insert-command count)
+ (cond ((>= (current-column) (+ 2 end-comment-column))
+ (backward-char 1)
+ (skip-chars-backward "^ \t\n")
+ (indent-new-comment-line)
+ (skip-chars-forward "^ \t\n")
+ (forward-char 1))
+ ((>= (current-column) end-comment-column)
+ (indent-new-comment-line))
+ (t nil)))
+ ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
+ (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z))
+ (and (>= (preceding-char) ?0) (<= (preceding-char) ?9)))
+ (progn
+ (setq here (point-marker))
+ (insert " ")
+ (setq delete-a t)
+ (if (re-search-backward "|" nil t)
+ (progn
+ (setq found (re-search-forward (regexp-quote "B2Smilies") here t))
+ (if (and found (= here (point-marker)))
+ (replace-match "btosmilies")
+ (setq found (re-search-forward (regexp-quote "bbcode2html") here t))
+ (if (and found (= here (point-marker)))
+ (replace-match "bbcodetohtml")
+ (setq found (re-search-forward (regexp-quote "date_format2") here t))
+ (if (and found (= here (point-marker)))
+ (replace-match "date_formatto")
+ (goto-char here)
+ (setq delete-a nil)
+ (delete-char 1)))))
+ (goto-char here)
+ (setq delete-a nil)
+ (delete-char 1)))
+ (smarty-prepare-search-1 (expand-abbrev))
+ (self-insert-command count)
+ (if (and delete-a (looking-at " "))
+ (delete-char 1)))
+ (t (self-insert-command count)))))
+
+(defun smarty-electric-open-bracket (count)
+ "'(' --> '(', '((' --> '[', '[(' --> '{'"
+ (interactive "p")
+ (if (and smarty-stutter-mode (= count 1) (not (smarty-in-literal)))
+ (if (= (preceding-char) ?\()
+ (progn (delete-char -1) (insert-char ?\[ 1))
+ (if (= (preceding-char) ?\[)
+ (progn (delete-char -1) (insert-char ?\{ 1))
+ (insert-char ?\( 1)))
+ (self-insert-command count)))
+
+(defun smarty-electric-close-bracket (count)
+ "')' --> ')', '))' --> ']', '])' --> '}'"
+ (interactive "p")
+ (if (and smarty-stutter-mode (= count 1) (not (smarty-in-literal)))
+ (progn
+ (if (= (preceding-char) ?\))
+ (progn (delete-char -1) (insert-char ?\] 1))
+ (if (= (preceding-char) ?\])
+ (progn (delete-char -1) (insert-char ?} 1))
+ (insert-char ?\) 1)))
+ (blink-matching-open))
+ (self-insert-command count)))
+
+(defun smarty-electric-star (count)
+ "After a left delimiter add a right delemiter to close the comment"
+ (interactive "p")
+ (let ((here (point-marker)) found)
+ (if (and smarty-stutter-mode (= count 1) (not (smarty-in-literal)))
+ (progn
+ (setq found (re-search-backward (regexp-quote smarty-left-delimiter) nil t))
+ (re-search-forward (regexp-quote smarty-left-delimiter) here t)
+ (if (not (and (= here (point-marker)) found))
+ (progn (goto-char here)
+ (self-insert-command count))
+ (self-insert-command count)
+ (insert " ")
+ (setq here (point-marker))
+ (insert " *")
+ (insert smarty-right-delimiter)
+ (goto-char here)))
+ (self-insert-command count))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Electrification
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst smarty-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]"
+ "Syntax of prompt inserted by template generators.")
+
+(defvar smarty-template-invoked-by-hook nil
+ "Indicates whether a template has been invoked by a hook or by key or menu.
+Used for undoing after template abortion.")
+
+(defun smarty-minibuffer-tab (&optional prefix-arg)
+ "If preceding character is part of a word or a paren then hippie-expand,
+else insert tab (used for word completion in Smarty minibuffer)."
+ (interactive "P")
+ (cond
+ ;; expand word
+ ((= (char-syntax (preceding-char)) ?w)
+ (let ((case-fold-search (not smarty-word-completion-case-sensitive))
+ (case-replace nil)
+ (hippie-expand-only-buffers
+ (or (and (boundp 'hippie-expand-only-buffers)
+ hippie-expand-only-buffers)
+ '(smarty-mode))))
+ (smarty-expand-abbrev prefix-arg)))
+ ;; expand parenthesis
+ ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
+ (let ((case-fold-search (not smarty-word-completion-case-sensitive))
+ (case-replace nil))
+ (smarty-expand-paren prefix-arg)))
+ ;; insert tab
+ (t (insert-tab))))
+
+;; correct different behavior of function `unread-command-events' in XEmacs
+(defun smarty-character-to-event (arg))
+(defalias 'smarty-character-to-event
+ (if (fboundp 'character-to-event) 'character-to-event 'identity))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Abbrev ook bindings
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-mode-abbrev-table nil
+ "Abbrev table to use in `smarty-mode' buffers.")
+
+(defun smarty-mode-abbrev-table-init ()
+ "Initialize `smarty-mode-abbrev-table'."
+ (when smarty-mode-abbrev-table (clear-abbrev-table smarty-mode-abbrev-table))
+ (define-abbrev-table 'smarty-mode-abbrev-table
+ (append
+ '(
+ ("capture" "" smarty-template-capture-hook 0)
+ ("config_load" "" smarty-template-config-load-hook 0)
+ ("else" "" smarty-template-else-hook 0)
+ ("elseif" "" smarty-template-elseif-hook 0)
+ ("foreach" "" smarty-template-foreach-hook 0)
+ ("foreachelse" "" smarty-template-foreachelse-hook 0)
+ ("if" "" smarty-template-if-hook 0)
+ ("include" "" smarty-template-include-hook 0)
+ ("include_php" "" smarty-template-include-php-hook 0)
+ ("insert" "" smarty-template-insert-hook 0)
+ ("ldelim" "" smarty-template-ldelim-hook 0)
+ ("literal" "" smarty-template-literal-hook 0)
+ ("php" "" smarty-template-php-hook 0)
+ ("rdelim" "" smarty-template-rdelim-hook 0)
+ ("section" "" smarty-template-section-hook 0)
+ ("sectionelse" "" smarty-template-sectionelse-hook 0)
+ ("strip" "" smarty-template-strip-hook 0)
+ ("assign" "" smarty-template-assign-hook 0)
+ ("counter" "" smarty-template-counter-hook 0)
+ ("cycle" "" smarty-template-cycle-hook 0)
+ ("debug" "" smarty-template-debug-hook 0)
+ ("eval" "" smarty-template-eval-hook 0)
+ ("fetch" "" smarty-template-fetch-hook 0)
+ ("html_checkboxes" "" smarty-template-html-checkboxes-hook 0)
+ ("html_image" "" smarty-template-html-image-hook 0)
+ ("html_options" "" smarty-template-html-options-hook 0)
+ ("html_radios" "" smarty-template-html-radios-hook 0)
+ ("html_select_date" "" smarty-template-html-select-date-hook 0)
+ ("html_select_time" "" smarty-template-html-select-time-hook 0)
+ ("html_table" "" smarty-template-html-table-hook 0)
+ ("mailto" "" smarty-template-mailto-hook 0)
+ ("math" "" smarty-template-math-hook 0)
+ ("popup" "" smarty-template-popup-hook 0)
+ ("popup_init" "" smarty-template-popup-init-hook 0)
+ ("textformat" "" smarty-template-textformat-hook 0)
+ ("capitalize" "" smarty-template-capitalize-hook 0)
+ ("cat" "" smarty-template-cat-hook 0)
+ ("count_characters" "" smarty-template-count-characters-hook 0)
+ ("count_paragraphs" "" smarty-template-count-paragraphs-hook 0)
+ ("count_sentences" "" smarty-template-count-sentences-hook 0)
+ ("count_words" "" smarty-template-count-words-hook 0)
+ ("date_format" "" smarty-template-date-format-hook 0)
+ ("default" "" smarty-template-default-hook 0)
+ ("escape" "" smarty-template-escape-hook 0)
+ ("indent" "" smarty-template-indent-hook 0)
+ ("lower" "" smarty-template-lower-hook 0)
+ ("nl2br" "" smarty-template-nl2br-hook 0)
+ ("regex_replace" "" smarty-template-regex-replace-hook 0)
+ ("replace" "" smarty-template-replace-hook 0)
+ ("spacify" "" smarty-template-spacify-hook 0)
+ ("string_format" "" smarty-template-string-format-hook 0)
+ ("strip" "" smarty-template-vstrip-hook 0)
+ ("strip_tags" "" smarty-template-strip-tags-hook 0)
+ ("truncate" "" smarty-template-truncate-hook 0)
+ ("upper" "" smarty-template-upper-hook 0)
+ ("wordwrap" "" smarty-template-wordwrap-hook 0)
+ ("validate" "" smarty-template-validate-hook 0)
+ ("formtool_checkall" "" smarty-template-formtool-checkall-hook 0)
+ ("formtool_copy" "" smarty-template-formtool-copy-hook 0)
+ ("formtool_count_chars" "" smarty-template-formtool-count-chars-hook 0)
+ ("formtool_init" "" smarty-template-formtool-init-hook 0)
+ ("formtool_move" "" smarty-template-formtool-move-hook 0)
+ ("formtool_moveall" "" smarty-template-formtool-moveall-hook 0)
+ ("formtool_movedown" "" smarty-template-formtool-movedown-hook 0)
+ ("formtool_moveup" "" smarty-template-formtool-moveup-hook 0)
+ ("formtool_remove" "" smarty-template-formtool-remove-hook 0)
+ ("formtool_rename" "" smarty-template-formtool-rename-hook 0)
+ ("formtool_save" "" smarty-template-formtool-save-hook 0)
+ ("formtool_selectall" "" smarty-template-formtool-selectall-hook 0)
+ ("paginate_first" "" smarty-template-paginate-first-hook 0)
+ ("paginate_last" "" smarty-template-paginate-last-hook 0)
+ ("paginate_middle" "" smarty-template-paginate-middle-hook 0)
+ ("paginate_next" "" smarty-template-paginate-next-hook 0)
+ ("paginate_prev" "" smarty-template-paginate-prev-hook 0)
+ ("btosmilies" "" smarty-template-btosmilies-hook 0)
+ ("bbcodetohtml" "" smarty-template-bbcodetohtml-hook 0)
+ ("date_formatto" "" smarty-template-date-formatto-hook 0)))))
+
+;; initialize abbrev table for Smarty Mode
+(smarty-mode-abbrev-table-init)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Abbrev hooks
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-hooked-abbrev (func)
+ "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
+but not if inside a comment or quote)."
+ (if (or (smarty-in-literal)
+ (smarty-in-comment-p))
+ (progn
+ (insert " ")
+ (unexpand-abbrev)
+ (delete-char -1))
+ (if (not smarty-electric-mode)
+ (progn
+ (insert " ")
+ (unexpand-abbrev)
+ (backward-word 1)
+ (delete-char 1))
+ (let ((invoke-char last-command-char)
+ (abbrev-mode -1)
+ (smarty-template-invoked-by-hook t))
+ (let ((caught (catch 'abort
+ (funcall func))))
+ (when (stringp caught) (message caught)))
+ (when (= invoke-char ?-) (setq abbrev-start-location (point)))
+ ;; delete CR which is still in event queue
+ (if (fboundp 'enqueue-eval-event)
+ (enqueue-eval-event 'delete-char -1)
+ (setq unread-command-events ; push back a delete char
+ (list (smarty-character-to-event ?\177))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Fontification
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-font-lock-keywords-1
+ (list
+
+ ;; Fontify built-in functions
+ (cons
+ (concat (regexp-quote smarty-left-delimiter) "[/]*" smarty-functions-regexp)
+ '(1 font-lock-keyword-face))
+
+ (cons
+ (concat "\\<\\(" smarty-constants "\\)\\>")
+ 'font-lock-constant-face)
+
+ (cons (concat "\\(" (regexp-quote (concat smarty-left-delimiter "*")) "\\(\\s-\\|\\w\\|\\s.\\|\\s_\\|\\s(\\|\\s)\\|\\s\\\\)*" (regexp-quote (concat "*" smarty-right-delimiter)) "\\)")
+ 'font-lock-comment-face)
+
+ )
+ "Subdued level highlighting for Smarty mode.")
+
+(defconst smarty-font-lock-keywords-2
+ (append
+ smarty-font-lock-keywords-1
+ (list
+
+ ;; Fontify variable names (\\sw\\|\\s_\\) matches any word character +
+ ;; underscore
+ '("\\$\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face)) ; $variable
+ '("->\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face t t)) ; ->variable
+ '("\\.\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face t t)) ; .variable
+ '("->\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(" (1 font-lock-function-name-face t t)) ; ->function_call
+ '("\\<\\(\\(?:\\sw\\|\\s_\\)+\\s-*\\)(" (1 font-lock-function-name-face)) ; word(
+ '("\\<\\(\\(?:\\sw\\|\\s_\\)+\\s-*\\)[[]" (1 font-lock-variable-name-face)) ; word[
+ '("\\<[0-9]+" . default) ; number (also matches word)
+
+ ;; Fontify strings
+ ;;'("\"\\([^\"]*\\)\"[^\"]+" (1 font-lock-string-face t t))
+ ))
+
+ "Medium level highlighting for Smarty mode.")
+
+(defconst smarty-font-lock-keywords-3
+ (append
+ smarty-font-lock-keywords-2
+ (list
+ ;; Fontify modifiers
+ (cons (concat "|\\(" smarty-modifiers-regexp "\\)[:|]+") '(1 font-lock-function-name-face))
+ (cons (concat "|\\(" smarty-modifiers-regexp "\\)" (regexp-quote smarty-right-delimiter)) '(1 font-lock-function-name-face))
+
+ ;; Fontify config vars
+ (cons (concat (regexp-quote smarty-left-delimiter) "\\(#\\(?:\\sw\\|\\s_\\)+#\\)") '(1 font-lock-constant-face))))
+ "Balls-out highlighting for Smarty mode.")
+
+(defconst smarty-font-lock-keywords-4
+ (append
+ smarty-font-lock-keywords-3
+ (list
+ ;; Fontify plugin functions
+ (cons
+ (concat (regexp-quote smarty-left-delimiter) "[/]*" smarty-plugins-functions-regexp)
+ '(1 font-lock-keyword-face))
+
+ (cons (concat "|\\(" smarty-plugins-modifiers-regexp "\\)[:|]+") '(1 font-lock-function-name-face))
+ (cons (concat "|\\(" smarty-plugins-modifiers-regexp "\\)" (regexp-quote smarty-right-delimiter)) '(1 font-lock-function-name-face)))))
+
+(defvar smarty-font-lock-keywords smarty-font-lock-keywords-3
+ "Default highlighting level for Smarty mode")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Mode map
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-template-map nil
+ "Keymap for Smarty templates.")
+
+(defun smarty-template-map-init ()
+ "Initialize `smarty-template-map'."
+ (setq smarty-template-map (make-sparse-keymap))
+ ;; key bindings for Smarty templates
+ (define-key smarty-template-map "\C-ba" 'smarty-template-capture)
+ (define-key smarty-template-map "\C-bc" 'smarty-template-config-load)
+ (define-key smarty-template-map "\C-b\M-e" 'smarty-template-else)
+ (define-key smarty-template-map "\C-b\C-e" 'smarty-template-elseif)
+ (define-key smarty-template-map "\C-b\C-f" 'smarty-template-foreach)
+ (define-key smarty-template-map "\C-b\M-f" 'smarty-template-foreachelse)
+ (define-key smarty-template-map "\C-bf" 'smarty-template-if)
+ (define-key smarty-template-map "\C-b\C-i" 'smarty-template-include)
+ (define-key smarty-template-map "\C-b\M-i" 'smarty-template-include-php)
+ (define-key smarty-template-map "\C-bi" 'smarty-template-insert)
+ (define-key smarty-template-map "\C-bl" 'smarty-template-ldelim)
+ (define-key smarty-template-map "\C-b\C-l" 'smarty-template-literal)
+ (define-key smarty-template-map "\C-bp" 'smarty-template-php)
+ (define-key smarty-template-map "\C-br" 'smarty-template-rdelim)
+ (define-key smarty-template-map "\C-b\C-s" 'smarty-template-section)
+ (define-key smarty-template-map "\C-b\M-s" 'smarty-template-sectionelse)
+ (define-key smarty-template-map "\C-bs" 'smarty-template-strip)
+ (define-key smarty-template-map "\C-ca" 'smarty-template-assign)
+ (define-key smarty-template-map "\C-co" 'smarty-template-counter)
+ (define-key smarty-template-map "\C-cc" 'smarty-template-cycle)
+ (define-key smarty-template-map "\C-cd" 'smarty-template-debug)
+ (define-key smarty-template-map "\C-ce" 'smarty-template-eval)
+ (define-key smarty-template-map "\C-cf" 'smarty-template-fetch)
+ (define-key smarty-template-map "\C-c\C-hc" 'smarty-template-html-checkboxes)
+ (define-key smarty-template-map "\C-c\C-hi" 'smarty-template-html-image)
+ (define-key smarty-template-map "\C-c\C-ho" 'smarty-template-html-options)
+ (define-key smarty-template-map "\C-c\C-hr" 'smarty-template-html-radios)
+ (define-key smarty-template-map "\C-c\C-hd" 'smarty-template-html-select-date)
+ (define-key smarty-template-map "\C-c\C-hm" 'smarty-template-html-select-time)
+ (define-key smarty-template-map "\C-c\C-ht" 'smarty-template-html-table)
+ (define-key smarty-template-map "\C-ci" 'smarty-template-mailto)
+ (define-key smarty-template-map "\C-ch" 'smarty-template-math)
+ (define-key smarty-template-map "\C-c\C-p" 'smarty-template-popup)
+ (define-key smarty-template-map "\C-c\M-p" 'smarty-template-popup-init)
+ (define-key smarty-template-map "\C-ct" 'smarty-template-textformat)
+ (define-key smarty-template-map "\C-vp" 'smarty-template-capitalize)
+ (define-key smarty-template-map "\C-vc" 'smarty-template-cat)
+ (define-key smarty-template-map "\C-v\C-cc" 'smarty-template-count-characters)
+ (define-key smarty-template-map "\C-v\C-cp" 'smarty-template-count-paragraphs)
+ (define-key smarty-template-map "\C-v\C-cs" 'smarty-template-count-sentences)
+ (define-key smarty-template-map "\C-v\C-cw" 'smarty-template-count-words)
+ (define-key smarty-template-map "\C-vf" 'smarty-template-date-format)
+ (define-key smarty-template-map "\C-vd" 'smarty-template-default)
+ (define-key smarty-template-map "\C-ve" 'smarty-template-escape)
+ (define-key smarty-template-map "\C-vi" 'smarty-template-indent)
+ (define-key smarty-template-map "\C-vl" 'smarty-template-lower)
+ (define-key smarty-template-map "\C-vn" 'smarty-template-nl2br)
+ (define-key smarty-template-map "\C-vx" 'smarty-template-regex-replace)
+ (define-key smarty-template-map "\C-v\C-p" 'smarty-template-replace)
+ (define-key smarty-template-map "\C-vy" 'smarty-template-spacify)
+ (define-key smarty-template-map "\C-vs" 'smarty-template-string-format)
+ (define-key smarty-template-map "\C-v\C-s" 'smarty-template-vstrip)
+ (define-key smarty-template-map "\C-v\M-s" 'smarty-template-strip-tags)
+ (define-key smarty-template-map "\C-vt" 'smarty-template-truncate)
+ (define-key smarty-template-map "\C-vu" 'smarty-template-upper)
+ (define-key smarty-template-map "\C-vw" 'smarty-template-wordwrap)
+ (define-key smarty-template-map "\C-h" 'smarty-template-header)
+ (define-key smarty-template-map "\C-f" 'smarty-template-footer)
+ (define-key smarty-template-map "\C-di" 'smarty-template-insert-date)
+ (define-key smarty-template-map "\C-dm" 'smarty-template-modify))
+
+;; initialize template map for Smarty Mode
+(smarty-template-map-init)
+
+(defun smarty-mode-map-init ()
+ "Initialize `smarty-mode-map'."
+ (setq smarty-mode-map (make-sparse-keymap))
+ ;; template key bindings
+ (define-key smarty-mode-map "\C-c\C-t" smarty-template-map)
+ ;; mode specific key bindings
+ (define-key smarty-mode-map "\C-c\C-m\C-e" 'smarty-electric-mode)
+ (define-key smarty-mode-map "\C-c\C-m\C-s" 'smarty-stutter-mode)
+ (define-key smarty-mode-map "\C-c\C-s\C-u" 'smarty-add-source-files-menu)
+ (define-key smarty-mode-map "\C-c\M-m" 'smarty-show-messages)
+ (define-key smarty-mode-map "\C-c\C-h" 'smarty-doc-mode)
+ (define-key smarty-mode-map "\C-c\C-v" 'smarty-version)
+ ;; electric key bindings
+ (when smarty-intelligent-tab
+ (define-key smarty-mode-map "\t" 'smarty-electric-tab))
+ (define-key smarty-mode-map " " 'smarty-electric-space)
+ (define-key smarty-mode-map "(" 'smarty-electric-open-bracket)
+ (define-key smarty-mode-map ")" 'smarty-electric-close-bracket)
+ (define-key smarty-mode-map "*" 'smarty-electric-star))
+
+;; initialize mode map for Smarty Mode
+(smarty-mode-map-init)
+
+(defvar smarty-minibuffer-local-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (when smarty-word-completion-in-minibuffer
+ (define-key map "\t" 'smarty-minibuffer-tab))
+ map)
+ "Keymap for minibuffer used in Smarty Mode.")
+
+(mapcar
+ (function
+ (lambda (sym)
+ (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs)
+ (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs)
+ '(smarty-electric-space
+ smarty-electric-tab
+ smarty-electric-open-bracket
+ smarty-electric-close-bracket
+ smarty-electric-star))
+
+;;;###autoload
+(defun smarty-mode ()
+ "Smarty Mode
+***********
+
+Smarty Mode is a GNU XEmacs major mode for editing Smarty templates.
+
+1 Introduction
+**************
+
+Smarty-Mode is a mode allowing easy edit of Smarty templates:
+highlight, templates, navigation into source files...
+
+
+
+Features (new features in bold) :
+
+ * Completion
+
+ * Customizable
+
+ * Highlight
+
+ * Menu
+
+ * Stuttering
+
+ * Templates
+ - Built-in Functions
+
+ - User Functions
+
+ - Variable Modifiers
+
+ - Plugin (Functions)
+ * Smarty Formtool
+
+ * Smarty Paginate
+
+ * Smarty Validate
+
+ - Plugin (Variable Modifiers)
+ * AlternativeDateModifierPlugin
+
+ * B2Smilies
+
+ * BBCodePlugin
+
+ - Fonctions Non-Smarty
+
+
+
+This manual describes Smarty Mode version 0.0.4.
+
+2 Installation
+**************
+
+2.1 Requirements
+================
+
+Smarty Mode is a XEmacs major mode that needs the following
+software/packages:
+
+ * XEmacs (http://www.xemacs.org/).
+
+ * `font-lock' mode generaly installed with XEmacs.
+
+ * `assoc' mode generaly installed with XEmacs.
+
+ * `easymenu' mode generaly installed with XEmacs.
+
+ * `hippie-exp' mode generaly installed with XEmacs.
+
+Before continuing, you must be sure to have all this packages
+installed.
+
+2.2 Download
+============
+
+Two internet address to download Smarty Mode :
+
+ * Principal: Smarty-Mode 0.0.4
+ (http://deboutv.free.fr/lisp/smarty/download/smarty-0.0.4.tar.gz)
+ (http://deboutv.free.fr/lisp/smarty/)
+
+ * Secondary: Smarty-Mode 0.0.4
+ (http://www.morinie.fr/lisp/smarty/download/smarty-0.0.4.tar.gz)
+ (http://www.morinie.fr/lisp/smarty/)
+
+ * Old releases: Smarty-Mode
+ (http://deboutv.free.fr/lisp/smarty/download.php)
+ (http://deboutv.free.fr/lisp/smarty/)
+
+2.3 Installation
+================
+
+2.3.1 Installation
+------------------
+
+To install Smarty Mode you need to choose an installation directory
+(for example `/usr/local/share/lisp' or `c:\lisp'). The administrator
+must have the write rights on this directory.
+
+With your favorite unzip software, unzip the archive in the
+installation directory.
+
+Example:
+ cd /usr/local/share/lisp
+ tar zxvf smarty-0.0.4.tar.gz
+Now you have a `smarty' directory in the installation directory. This
+directory contains 2 files `smarty-mode.el' and `smarty-mode.elc' and
+another directory `docs' containing the documentation.
+
+You need to configure XEmacs. open you initialization file `init.el'
+(open the file or start XEmacs then choose the Options menu and Edit
+Init File). Add the following lines (the installation directory in
+this example is `/usr/local/share/lisp') :
+
+ (setq load-path
+ (append (list \"/usr/local/share/lisp/\") load-path))
+ (autoload 'smarty-mode \"smarty-mode\" \"Smarty Mode\" t)
+
+2.3.2 Update
+------------
+
+The update is easy. You need to unzip the archive in the installation
+directory to remove the old release.
+
+Example:
+ cd /usr/local/share/lisp
+ rm -rf smarty
+ tar zxvf smarty-0.0.4.tar.gz
+
+2.4 Invoke Smarty-Mode
+======================
+
+You have two possibilities to invoke the Smarty Mode.
+
+ - Manually: At each file opening you need to launch Smarty Mode
+ with the following command:
+
+ `M-x smarty-mode'
+
+ - Automatically: Add the following linesin your initialization
+ file `init.el' :
+
+ (setq auto-mode-alist
+ (append
+ '((\"\\.tpl$\" . smarty-mode))
+ auto-mode-alist))
+
+
+3 Customization
+***************
+
+This chapter describes the differents parameters and functions that
+you can change to customize Smarty Mode. To do that, open a Smarty
+file, click on the Smarty menu and choose Options then Browse
+Options....
+
+3.1 Parameters
+==============
+
+3.1.1 Mode
+----------
+
+Smarty Mode has 2 modes allowing to simplify the writing of Smarty
+templates. You can enable/disable each mode individually.
+
+`smarty-electric-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable automatic generation of template.
+ If `nil'; template generators can still be invoked through key
+ bindings and menu. Is indicated in the modeline by \"/e\" after
+ the mode name and can be toggled by `smarty-electric-mode'.
+
+`smarty-stutter-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable the stuttering. Is indicated in the
+ modeline by \"/s\" after the mode name and can be toggled by
+ `smarty-stutter-mode'.
+
+3.1.2 Menu
+----------
+
+Smarty Mode has also 1 menu that you can enable/disable. The menu
+Sources is specific to each Smarty files opened.
+
+`smarty-source-file-menu'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; the Sources menu is enabled. This menu
+ contains the list of Smarty file located in the current
+ directory. The Sources menu scans the directory when a file is
+ opened.
+
+3.1.3 Menu
+----------
+
+`smarty-highlight-plugin-functions'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; the functions described in the smarty
+ plugins are highlighted.
+
+3.1.4 Templates
+---------------
+
+3.1.4.1 Header
+..............
+
+`smarty-file-header'
+ Type: string
+ Default value: `\"\"'
+ Description: String or file to insert as file header. If the
+ string specifies an existing file name the contents of the file
+ is inserted; otherwise the string itself is inserted as file
+ header.
+ Type `C-j' for newlines.
+ The follonwing keywords are supported:
+ <filename>: replaced by the file name.
+ <author>: replaced by the user name and email address.
+ <login>: replaced by `user-login-name'.
+ <company>: replaced by `smarty-company-name' content.
+ <date>: replaced by the current date.
+ <year>: replaced by the current year.
+ <copyright>: replaced by `smarty-copyright-string' content.
+ <cursor>: final cursor position.
+
+`smarty-file-footer'
+ Type: string
+ Default value: `\"\"'
+ Description: String or file to insert as file footer. See
+ `smarty-file-header'
+
+`smarty-company-name'
+ Type: string
+ Default value: `\"\"'
+ Description: Name of the company to insert in file header.
+
+`smarty-copyright-string'
+ Type: string
+ Default value: `\"\"'
+ Description: Coryright string to insert in file header.
+
+`smarty-date-format'
+ Type: string
+ Default value: `\"%Y-%m-%d\"'
+ Description: Date format.
+
+`smarty-modify-date-prefix-string'
+ Type: string
+ Default value: `\"\"'
+ Description: Prefix string of modification date in Smarty file
+ header.
+
+`smarty-modify-date-on-saving'
+ Type: bool
+ Default value: `nil'
+ Description: If `t'; update the modification date when the
+ buffer is saved.
+
+3.1.5 Miscellaneous
+-------------------
+
+`smarty-left-delimiter'
+ Type: string
+ Default value: `\"\"'
+ Description: Left escaping delimiter for Smarty templates.
+
+`smarty-right-delimiter'
+ Type: string
+ Default value: `\"\"'
+ Description: Right escaping delimiter for Smarty templates.
+
+`smarty-intelligent-tab'
+ Type: bool
+ Default value: `t'
+ Description: If `t'; TAB does indentation; completion and insert
+ tabulations. If `nil'; TAB does only indentation.
+
+`smarty-word-completion-in-minibuffer'
+ Type: bool
+ Default value: `t'
+ Description: If `t'; enable completion in the minibuffer.
+
+`smarty-word-completion-case-sensitive'
+ Type: bool
+ Default value: `nil'
+ Description: If `t'; completion is case sensitive.
+
+3.2 Functions
+=============
+
+3.2.1 Mode
+----------
+
+`smarty-electric-mode'
+ Menu: Smarty -> Options -> Mode -> Electric Mode
+ Keybinding: `C-c C-m C-e'
+ Description: This functions is used to enable/disable the
+ electric mode.
+
+`smarty-stutter-mode'
+ Menu: Smarty -> Options -> Mode -> Stutter Mode
+ Keybinding: `C-c C-m C-s'
+ Description: This function is used to enable/disable the stutter
+ mode.
+
+4 Menus
+*******
+
+There are 2 menus: Smarty and Sources. All theses menus can be
+accessed from the menubar or from the right click. This chapter
+describes each menus.
+
+4.1 Smarty
+==========
+
+This is the main menu of Smarty Mode. It allows an easy access to the
+main features of the Smarty Mode: Templates (see *Note Templates::)
+and Options (see *Note Customization::).
+
+This menu contains also 3 functions that are discussed in the next
+part.
+
+4.1.1 Functions
+---------------
+
+`smarty-show-messages'
+ Menu: Smarty -> Show Messages
+ Keybinding: `C-c M-m'
+ Description: This function opens the *Messages* buffer to
+ display previous error messages.
+
+`smarty-doc-mode'
+ Menu: Smarty -> Smarty Mode Documentation
+ Keybinding: `C-c C-h'
+ Description: This function opens the *Help* buffer and prints in
+ it the Smarty Mode documentation.
+
+`smarty-version'
+ Menu: Smarty -> Version
+ Keybinding: `C-c C-v'
+ Description: This function displays in the minibuffer the
+ current Smarty Mode version with the timestamp.
+
+4.2 Sources
+===========
+
+The Sources menu shows the Smarty files in the current directory. If
+you add or delete a file in the current directory, you need to
+refresh the menu.
+
+4.2.1 Customization
+-------------------
+
+`smarty-source-file-menu'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; the Sources menu is enabled. This menu
+ contains the list of Smarty file located in the current
+ directory. The Sources menu scans the directory when a file is
+ opened.
+
+4.2.2 Functions
+---------------
+
+`smarty-add-source-files-menu'
+ Menu: Sources -> *Rescan*
+ Keybinding: `C-c C-s C-u'
+ Description: This function is used to refresh the Sources menu.
+
+5 Stuttering
+************
+
+The stutter mode is a mode that affects a function to a key. For
+example, when you use the `ENTER' key, the associated function will
+create a new line and indent it.
+
+5.1 Customization
+=================
+
+`smarty-stutter-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable the stuttering. Is indicated in the
+ modeline by \"/s\" after the mode name and can be toggled by
+ `smarty-stutter-mode'.
+
+5.2 Functions
+=============
+
+`SPACE'
+ If in comment, indent the comment and add new line if necessary.
+ In other case, add a space.
+
+`('
+ If the previous character is a `(', the `((' will be replaced by
+ `['.
+ If the previous character is a `[', the `[(' will be replaced by
+ `{'.
+ In other case, insert a `('.
+
+`)'
+ If the previous character is a `)', the `))' will be replaced by
+ `]'.
+ If the previous character is a `]', the `])' will be replaced by
+ `}'.
+ In other case, insert a `)'.
+
+6 Templates
+***********
+
+In the Smarty Mode, the Smarty functions (like if, while, for, fopen,
+fclose) are predefined in functions called \"Templates\".
+
+Each template can be invoked by the function name or by using the
+<SPACE> key after the Smarty function name in the buffer (Note, using
+`M-<SPACE>' disable the template).
+
+A template can be aborted by using the `C-g' or by lefting empty the
+tempate prompt (in the minibuffer).
+
+6.1 Customization
+=================
+
+`smarty-electric-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable automatic generation of template.
+ If `nil'; template generators can still be invoked through key
+ bindings and menu. Is indicated in the modeline by \"/e\" after
+ the mode name and can be toggled by `smarty-electric-mode'.
+
+For a complete description of the template customizable variables,
+see *Note Cu01-Pa01-Template::
+
+6.2 Functions
+=============
+
+6.2.1 Smarty Functions
+----------------------
+
+For Smarty functions, see PDF or HTML documentation.
+
+6.2.2 Non-Smarty Functions
+--------------------------
+
+`smarty-template-header'
+ Menu: Smarty -> Templates -> Insert Header
+ Keybinding: `C-c C-t C-h'
+ Description: This function is used to insert a header in the
+ current buffer.
+
+`smarty-template-footer'
+ Menu: Smarty -> Templates -> Insert Footer
+ Keybinding: `C-c C-t C-f'
+ Description: This function is used to insert a footer in the
+ current buffer.
+
+`smarty-template-insert-date'
+ Menu: Smarty -> Templates -> Insert Date
+ Keybinding: `C-c C-t C-d i'
+ Description: This function is used to insert the date in the
+ current buffer.
+
+`smarty-template-modify'
+ Menu: Smarty -> Templates -> Modify Date
+ Keybinding: `C-c C-t C-d m'
+ Description: This function is used to modify the last
+ modification date in the current buffer.
+
+7 Bugs, Help
+************
+
+ * To report bugs: Bugtracker
+ (http://bugtracker.morinie.fr/lisp/set_project.php?project_id=2)
+
+ * To obtain help you can post on the dedicated forum: Forum
+ (http://forum.morinie.fr/lisp/)
+
+8 Key bindings
+**************
+
+\\{smarty-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'smarty-mode)
+ (setq mode-name "Smarty")
+
+ (smarty-create-syntax-table)
+
+ ;; set maps and tables
+ (use-local-map smarty-mode-map)
+ (set-syntax-table smarty-mode-syntax-table)
+ (setq local-abbrev-table smarty-mode-abbrev-table)
+
+ (set (make-local-variable 'comment-start) (concat smarty-left-delimiter "*"))
+ (set (make-local-variable 'comment-end) (concat "*" smarty-right-delimiter))
+ (set (make-local-variable 'comment-multi-line) t)
+ (set (make-local-variable 'end-comment-column) 80)
+
+ (make-local-variable 'font-lock-defaults)
+ (if smarty-highlight-plugin-functions
+ (setq smarty-font-lock-keywords smarty-font-lock-keywords-4)
+ (setq smarty-font-lock-keywords smarty-font-lock-keywords-3))
+ (setq font-lock-defaults
+ '((smarty-font-lock-keywords)
+ nil ; Keywords only (i.e. no comment or string highlighting
+ t ; case fold
+ nil ; syntax-alist
+ nil ; syntax-begin
+ ))
+
+ (setq font-lock-maximum-decoration t
+ case-fold-search t)
+
+ ;; add source file menu
+ (if smarty-source-file-menu (smarty-add-source-files-menu))
+ ;; add Smarty menu
+ (easy-menu-add smarty-mode-menu-list)
+ (easy-menu-define smarty-mode-menu smarty-mode-map
+ "Menu keymap for Smarty Mode." smarty-mode-menu-list)
+
+ (message "Smarty Mode %s.%s" smarty-version
+ (if noninteractive "" " See menu for documentation and release notes."))
+ (smarty-mode-line-update)
+ (run-hooks 'smarty-mode-hook))
+
+(defun smarty-doc-mode ()
+ "Display Smarty Mode documentation in *Help* buffer."
+ (interactive)
+ (with-output-to-temp-buffer
+ (if (fboundp 'help-buffer) (help-buffer) "*Help*")
+ (princ mode-name)
+ (princ " mode:\n")
+ (princ (documentation 'smarty-mode))
+ (with-current-buffer standard-output
+ (help-mode))
+ (print-help-return-message)))
+
+(defun smarty-activate-customizations ()
+ "Activate all customizations on local variables."
+ (interactive)
+ (smarty-mode-map-init)
+ (use-local-map smarty-mode-map)
+ (set-syntax-table smarty-mode-syntax-table)
+ (smarty-update-mode-menu)
+ (run-hooks 'menu-bar-update-hook)
+ (smarty-mode-line-update))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Templates
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-template-field (prompt &optional follow-string optional
+ begin end is-string string-char default)
+ "Prompt for string and insert it in buffer with optional FOLLOW-STRING.
+If OPTIONAL is nil, the prompt is left if an empty string is inserted. If
+an empty string is inserted, return nil and call `smarty-template-undo' for
+the region between BEGIN and END. IS-STRING indicates whether a string
+with double-quotes is to be inserted. DEFAULT specifies a default string."
+ (let ((position (point))
+ string)
+ (insert "<" prompt ">")
+ (if (not (> (length string-char) 0))
+ (setq string-char "\""))
+ (setq string
+ (condition-case ()
+ (read-from-minibuffer (concat prompt ": ")
+ (or (and is-string (cons (concat string-char string-char) 1)) default)
+ smarty-minibuffer-local-map)
+ (quit (if (and optional begin end)
+ (progn (beep) "")
+ (keyboard-quit)))))
+ (when (or (not (equal string "")) optional)
+ (delete-region position (point)))
+ (when (and (equal string "") optional begin end)
+ (smarty-template-undo begin end)
+ (message "Template aborted"))
+ (unless (equal string "")
+ (insert string))
+ (when (or (not (equal string "")) (not optional))
+ (insert (or follow-string "")))
+ (if (equal string "") nil string)))
+
+(defun smarty-template-undo (begin end)
+ "Undo aborted template by deleting region and unexpanding the keyword."
+ (cond (smarty-template-invoked-by-hook
+ (goto-char end)
+ (insert " ")
+ (delete-region begin end)
+ (unexpand-abbrev))
+ (t (delete-region begin end))))
+
+(defun smarty-template-generic-function (label close-label field mandatory-count &optional infinite special-field)
+ "Generic function template 'label field1= field2=..."
+ (interactive)
+ (let ((start (point)) found here result-value elt continue field-count stop prompt)
+ (if smarty-template-invoked-by-hook
+ (setq found (smarty-after-ldelim))
+ (insert smarty-left-delimiter)
+ (setq found t))
+ (insert label)
+ (setq here (point-marker))
+ (insert " ")
+ (when found
+ (setq elt field)
+ (setq continue t)
+ (setq field-count 0)
+ (setq stop nil)
+ (while (and elt continue)
+ (setq prompt (car elt))
+ (when (not special-field)
+ (insert prompt "="))
+ (setq result-value (smarty-template-field prompt nil t))
+ (if (and (not result-value)
+ (< field-count mandatory-count))
+ (progn (setq continue nil)
+ (delete-region start (point))
+ (insert (concat label " "))
+ (setq stop t))
+ (if (not result-value)
+ (setq continue nil)
+ (setq here (point-marker))
+ (insert " ")))
+ (setq field-count (+ 1 field-count))
+ (setq elt (cdr elt)))
+ (when (and infinite continue)
+ (while continue
+ (setq result-value (smarty-template-field "var_name" "=" t here))
+ (if (not result-value)
+ (setq continue nil)
+ (setq continue (smarty-template-field "var_value" nil t here))
+ (setq here (point-marker))
+ (insert " "))))
+ (when (not stop)
+ (delete-region here (point))
+ (if (> 0 mandatory-count)
+ (delete-char -1))
+ (if special-field
+ (delete-char -1))
+ (insert smarty-right-delimiter)
+ (setq here (point-marker))
+ (if close-label
+ (insert smarty-left-delimiter "/" label smarty-right-delimiter))
+ (goto-char here)))))
+
+(defun smarty-template-generic-modifier (label field mandatory-count)
+ "Generic modifier template '|label:field1:field2..."
+ (interactive)
+ (let ((start (point)) found here result-value elt continue field-count stop prompt)
+ (setq found (re-search-backward (concat (regexp-quote smarty-left-delimiter) "\\$\\(\\w+\\)" (regexp-quote "|")) nil t))
+ (if found
+ (progn
+ (setq found (re-search-forward (regexp-quote smarty-right-delimiter) start t))
+ (if (not found)
+ (progn
+ (goto-char start)
+ (insert label)
+ (setq here (point-marker))
+ (setq elt field)
+ (setq continue t)
+ (setq field-count 0)
+ (setq stop nil)
+ (while (and elt continue)
+ (setq prompt (car elt))
+ (insert ":")
+ (setq result-value (smarty-template-field prompt nil t))
+ (if (and (not result-value)
+ (< field-count mandatory-count))
+ (progn (setq continue nil)
+ (delete-region start (point))
+ (insert (concat label " "))
+ (setq stop t))
+ (if (not result-value)
+ (setq continue nil)
+ (setq here (point-marker))
+ (insert ":")))
+ (setq field-count (+ 1 field-count))
+ (setq elt (cdr elt)))
+ (when (not stop)
+ (delete-region here (point))
+ (if (not (or (looking-at smarty-right-delimiter)
+ (looking-at "|")))
+ (insert smarty-right-delimiter))))
+ (goto-char start)
+ (insert label " ")))
+ (goto-char start)
+ (insert label " "))))
+
+(defun smarty-template-capture-hook ()
+ (smarty-hooked-abbrev 'smarty-template-capture))
+(defun smarty-template-config-load-hook ()
+ (smarty-hooked-abbrev 'smarty-template-config-load))
+(defun smarty-template-else-hook ()
+ (smarty-hooked-abbrev 'smarty-template-else))
+(defun smarty-template-elseif-hook ()
+ (smarty-hooked-abbrev 'smarty-template-elseif))
+(defun smarty-template-foreach-hook ()
+ (smarty-hooked-abbrev 'smarty-template-foreach))
+(defun smarty-template-foreachelse-hook ()
+ (smarty-hooked-abbrev 'smarty-template-foreachelse))
+(defun smarty-template-if-hook ()
+ (smarty-hooked-abbrev 'smarty-template-if))
+(defun smarty-template-include-hook ()
+ (smarty-hooked-abbrev 'smarty-template-include))
+(defun smarty-template-include-php-hook ()
+ (smarty-hooked-abbrev 'smarty-template-include-php))
+(defun smarty-template-insert-hook ()
+ (smarty-hooked-abbrev 'smarty-template-insert))
+(defun smarty-template-ldelim-hook ()
+ (smarty-hooked-abbrev 'smarty-template-ldelim))
+(defun smarty-template-literal-hook ()
+ (smarty-hooked-abbrev 'smarty-template-literal))
+(defun smarty-template-php-hook ()
+ (smarty-hooked-abbrev 'smarty-template-php))
+(defun smarty-template-rdelim-hook ()
+ (smarty-hooked-abbrev 'smarty-template-rdelim))
+(defun smarty-template-section-hook ()
+ (smarty-hooked-abbrev 'smarty-template-section))
+(defun smarty-template-sectionelse-hook ()
+ (smarty-hooked-abbrev 'smarty-template-sectionelse))
+(defun smarty-template-strip-hook ()
+ (smarty-hooked-abbrev 'smarty-template-strip))
+
+(defun smarty-template-assign-hook ()
+ (smarty-hooked-abbrev 'smarty-template-assign))
+(defun smarty-template-counter-hook ()
+ (smarty-hooked-abbrev 'smarty-template-counter))
+(defun smarty-template-cycle-hook ()
+ (smarty-hooked-abbrev 'smarty-template-cycle))
+(defun smarty-template-debug-hook ()
+ (smarty-hooked-abbrev 'smarty-template-debug))
+(defun smarty-template-eval-hook ()
+ (smarty-hooked-abbrev 'smarty-template-eval))
+(defun smarty-template-fetch-hook ()
+ (smarty-hooked-abbrev 'smarty-template-fetch))
+(defun smarty-template-html-checkboxes-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-checkboxes))
+(defun smarty-template-html-image-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-image))
+(defun smarty-template-html-options-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-options))
+(defun smarty-template-html-radios-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-radios))
+(defun smarty-template-html-select-date-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-select-date))
+(defun smarty-template-html-select-time-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-select-time))
+(defun smarty-template-html-table-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-table))
+(defun smarty-template-mailto-hook ()
+ (smarty-hooked-abbrev 'smarty-template-mailto))
+(defun smarty-template-math-hook ()
+ (smarty-hooked-abbrev 'smarty-template-math))
+(defun smarty-template-popup-hook ()
+ (smarty-hooked-abbrev 'smarty-template-popup))
+(defun smarty-template-popup-init-hook ()
+ (smarty-hooked-abbrev 'smarty-template-popup-init))
+(defun smarty-template-textformat-hook ()
+ (smarty-hooked-abbrev 'smarty-template-textformat))
+
+(defun smarty-template-capitalize-hook ()
+ (smarty-hooked-abbrev 'smarty-template-capitalize))
+(defun smarty-template-cat-hook ()
+ (smarty-hooked-abbrev 'smarty-template-cat))
+(defun smarty-template-count-characters-hook ()
+ (smarty-hooked-abbrev 'smarty-template-count-characters))
+(defun smarty-template-count-paragraphs-hook ()
+ (smarty-hooked-abbrev 'smarty-template-count-paragraphs))
+(defun smarty-template-count-sentences-hook ()
+ (smarty-hooked-abbrev 'smarty-template-count-sentences))
+(defun smarty-template-count-words-hook ()
+ (smarty-hooked-abbrev 'smarty-template-count-words))
+(defun smarty-template-date-format-hook ()
+ (smarty-hooked-abbrev 'smarty-template-date-format))
+(defun smarty-template-default-hook ()
+ (smarty-hooked-abbrev 'smarty-template-default))
+(defun smarty-template-escape-hook ()
+ (smarty-hooked-abbrev 'smarty-template-escape))
+(defun smarty-template-indent-hook ()
+ (smarty-hooked-abbrev 'smarty-template-indent))
+(defun smarty-template-lower-hook ()
+ (smarty-hooked-abbrev 'smarty-template-lower))
+(defun smarty-template-nl2br-hook ()
+ (smarty-hooked-abbrev 'smarty-template-nl2br))
+(defun smarty-template-regex-replace-hook ()
+ (smarty-hooked-abbrev 'smarty-template-regex-replace))
+(defun smarty-template-replace-hook ()
+ (smarty-hooked-abbrev 'smarty-template-replace))
+(defun smarty-template-spacify-hook ()
+ (smarty-hooked-abbrev 'smarty-template-spacify))
+(defun smarty-template-string-format-hook ()
+ (smarty-hooked-abbrev 'smarty-template-string-format))
+(defun smarty-template-vstrip-hook ()
+ (smarty-hooked-abbrev 'smarty-template-vstrip))
+(defun smarty-template-strip-tags-hook ()
+ (smarty-hooked-abbrev 'smarty-template-strip-tags))
+(defun smarty-template-truncate-hook ()
+ (smarty-hooked-abbrev 'smarty-template-truncate))
+(defun smarty-template-upper-hook ()
+ (smarty-hooked-abbrev 'smarty-template-upper))
+(defun smarty-template-wordwrap-hook ()
+ (smarty-hooked-abbrev 'smarty-template-wordwrap))
+
+(defun smarty-template-validate-hook ()
+ (smarty-hooked-abbrev 'smarty-template-validate))
+(defun smarty-template-formtool-checkall-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-checkall))
+(defun smarty-template-formtool-copy-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-copy))
+(defun smarty-template-formtool-count-chars-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-count-chars))
+(defun smarty-template-formtool-init-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-init))
+(defun smarty-template-formtool-move-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-move))
+(defun smarty-template-formtool-moveall-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-moveall))
+(defun smarty-template-formtool-movedown-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-movedown))
+(defun smarty-template-formtool-moveup-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-moveup))
+(defun smarty-template-formtool-remove-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-remove))
+(defun smarty-template-formtool-rename-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-rename))
+(defun smarty-template-formtool-save-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-save))
+(defun smarty-template-formtool-selectall-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-selectall))
+(defun smarty-template-paginate-first-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-first))
+(defun smarty-template-paginate-last-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-last))
+(defun smarty-template-paginate-middle-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-middle))
+(defun smarty-template-paginate-next-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-next))
+(defun smarty-template-paginate-prev-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-prev))
+
+(defun smarty-template-btosmilies-hook ()
+ (smarty-hooked-abbrev 'smarty-template-btosmilies))
+(defun smarty-template-bbcodetohtml-hook ()
+ (smarty-hooked-abbrev 'smarty-template-bbcodetohtml))
+(defun smarty-template-date-formatto-hook ()
+ (smarty-hooked-abbrev 'smarty-template-date-formatto))
+
+(defun smarty-template-capture ()
+ "Insert a capture statement."
+ (interactive)
+ (smarty-template-generic-function "capture" t '("name" "assign") 0))
+
+(defun smarty-template-config-load ()
+ "Insert a config_load statement."
+ (interactive)
+ (smarty-template-generic-function "config_load" nil '("file" "section" "scope" "global") 1))
+
+(defun smarty-template-else ()
+ "Insert a else statement."
+ (interactive)
+ (smarty-template-generic-function "else" nil '() 0))
+
+(defun smarty-template-elseif ()
+ "Insert a elseif statement."
+ (interactive)
+ (smarty-template-generic-function "elseif" nil '("condition") 1 nil t))
+
+(defun smarty-template-foreach ()
+ "Insert a foreach statement."
+ (interactive)
+ (smarty-template-generic-function "foreach" t '("from" "item" "key" "name") 2))
+
+(defun smarty-template-foreachelse ()
+ "Insert a foreachelse statement."
+ (interactive)
+ (smarty-template-generic-function "foreachelse" nil '() 0))
+
+(defun smarty-template-if ()
+ "Insert a if statement."
+ (interactive)
+ (smarty-template-generic-function "if" t '("condition") 1 nil t))
+
+(defun smarty-template-include ()
+ "Insert a include statement."
+ (interactive)
+ (smarty-template-generic-function "include" nil '("file" "assign") 1 t))
+
+(defun smarty-template-include-php ()
+ "Insert a include_php statement."
+ (interactive)
+ (smarty-template-generic-function "include_php" nil '("file" "once" "assign") 1))
+
+(defun smarty-template-insert ()
+ "Insert a insert statement."
+ (interactive)
+ (smarty-template-generic-function "insert" nil '("name" "assign" "script") 1 t))
+
+(defun smarty-template-ldelim ()
+ "Insert a ldelim statement."
+ (interactive)
+ (smarty-template-generic-function "ldelim" nil '() 0))
+
+(defun smarty-template-literal ()
+ "Insert a literal statement."
+ (interactive)
+ (smarty-template-generic-function "literal" t '() 0))
+
+(defun smarty-template-php ()
+ "Insert a php statement."
+ (interactive)
+ (smarty-template-generic-function "php" t '() 0))
+
+(defun smarty-template-rdelim ()
+ "Insert a rdelim statement."
+ (interactive)
+ (smarty-template-generic-function "rdelim" nil '() 0))
+
+(defun smarty-template-section ()
+ "Insert a section statement."
+ (interactive)
+ (smarty-template-generic-function "section" t '("name" "loop" "start" "step" "max" "show") 2))
+
+(defun smarty-template-sectionelse ()
+ "Insert a sectionelse statement."
+ (interactive)
+ (smarty-template-generic-function "sectionelse" nil '() 0))
+
+(defun smarty-template-strip ()
+ "Insert a strip statement."
+ (interactive)
+ (smarty-template-generic-function "strip" t '() 0))
+
+
+(defun smarty-template-assign ()
+ "Insert a assign statement."
+ (interactive)
+ (smarty-template-generic-function "assign" nil '("var" "value") 2))
+
+(defun smarty-template-counter ()
+ "Insert a counter statement."
+ (interactive)
+ (smarty-template-generic-function "counter" nil '("name" "start" "skip" "direction" "print" "assign") 0))
+
+(defun smarty-template-cycle ()
+ "Insert a cycle statement."
+ (interactive)
+ (smarty-template-generic-function "cycle" nil '("values" "name" "print" "advance" "delimiter" "assign" "reset") 1))
+
+(defun smarty-template-debug ()
+ "Insert a debug statement."
+ (interactive)
+ (smarty-template-generic-function "debug" nil '("output") 0))
+
+(defun smarty-template-eval ()
+ "Insert a eval statement."
+ (interactive)
+ (smarty-template-generic-function "eval" nil '("var" "assign") 1))
+
+(defun smarty-template-fetch ()
+ "Insert a fetch statement."
+ (interactive)
+ (smarty-template-generic-function "fetch" nil '("file" "assign") 1))
+
+(defun smarty-template-html-checkboxes ()
+ "Insert a html_checkboxes statement."
+ (interactive)
+ (smarty-template-generic-function "html_checkboxes" nil '("name" "values" "output" "selected" "options" "separator" "assign" "labels") 0))
+
+(defun smarty-template-html-image ()
+ "Insert a html_image statement."
+ (interactive)
+ (smarty-template-generic-function "html_image" nil '("file" "height" "width" "basedir" "alt" "href" "path_prefix") 1))
+
+(defun smarty-template-html-options ()
+ "Insert a html_options statement."
+ (interactive)
+ (smarty-template-generic-function "html_options" nil '("name" "values" "output" "selected" "options") 0))
+
+(defun smarty-template-html-radios ()
+ "Insert a html_radios statement."
+ (interactive)
+ (smarty-template-generic-function "html_radios" nil '("name" "values" "output" "selected" "options" "separator" "assign") 0))
+
+(defun smarty-template-html-select-date ()
+ "Insert a html_select_date statement."
+ (interactive)
+ (smarty-template-generic-function "html_select_date" nil '("prefix" "time" "start_year" "end_year" "display_days" "display_months" "display_years" "month_format" "day_format" "day_value_format" "year_as_text" "reverse_years" "field_array" "day_size" "month_size" "year_size" "all_extra" "day_extra" "month_extra" "year_extra" "field_order" "field_separator" "month_value_format" "year_empty" "month_empty" "day_empty") 0))
+
+(defun smarty-template-html-select-time ()
+ "Insert a html_select_time statement."
+ (interactive)
+ (smarty-template-generic-function "html_select_time" nil '("prefix" "time" "display_hours" "display_minutes" "display_seconds" "display_meridian" "use_24_hours" "minute_interval" "second_interval" "field_array" "all_extra" "hour_extra" "minute_extra" "second_extra" "meridian_extra") 0))
+
+(defun smarty-template-html-table ()
+ "Insert a html_table statement."
+ (interactive)
+ (smarty-template-generic-function "html_table" nil '("loop" "cols" "rows" "inner" "caption" "table_attr" "th_attr" "tr_attr" "td_attr" "trailpad" "hdir" "vdir") 1))
+
+(defun smarty-template-mailto ()
+ "Insert a mailto statement."
+ (interactive)
+ (smarty-template-generic-function "mailto" nil '("address" "text" "encode" "cc" "bcc" "subject" "newsgroups" "followupto" "extra") 1))
+
+(defun smarty-template-math ()
+ "Insert a math statement."
+ (interactive)
+ (smarty-template-generic-function "math" nil '("equation" "var" "format" "assign") 2 t))
+
+(defun smarty-template-popup ()
+ "Insert a popup statement."
+ (interactive)
+ (smarty-template-generic-function "popup" nil '("text" "trigger" "sticky" "caption" "fgcolor" "bgcolor" "textcolor" "capcolor" "closecolor" "textfont" "captionfont" "closefont" "textsize" "captionsize" "closesize" "width" "height" "left" "right" "center" "above" "below" "border" "offsetx" "offsety" "fgbackground" "bgbackground" "closetext" "noclose" "status" "autostatus" "autostatuscap" "inarray" "caparray" "capicon" "snapx" "snapy" "fixx" "fixy" "background" "padx" "pady" "fullhtml" "frame" "function" "delay" "hauto" "vauto") 1))
+
+(defun smarty-template-popup-init ()
+ "Insert a popup_init statement."
+ (interactive)
+ (smarty-template-generic-function "popup_init" nil '("src") 1))
+
+(defun smarty-template-textformat ()
+ "Insert a textformat statement."
+ (interactive)
+ (smarty-template-generic-function "textformat" t '("style" "indent" "indent_first" "indent_char" "wrap" "wrap_char" "wrap_cut" "assign") 0))
+
+(defun smarty-template-capitalize ()
+ "Insert a capitalize statement."
+ (interactive)
+ (smarty-template-generic-modifier "capitalize" '("upcase_numeric") 0))
+
+(defun smarty-template-cat ()
+ "Insert a cat statement."
+ (interactive)
+ (smarty-template-generic-modifier "cat" '("value") 0))
+
+(defun smarty-template-count-characters ()
+ "Insert a count_characters statement."
+ (interactive)
+ (smarty-template-generic-modifier "count_characters" '("include_whitespace") 0))
+
+(defun smarty-template-count-paragraphs ()
+ "Insert a count_paragraphs statement."
+ (interactive)
+ (smarty-template-generic-modifier "count_paragraphs" '() 0))
+
+(defun smarty-template-count-sentences ()
+ "Insert a count_sentences statement."
+ (interactive)
+ (smarty-template-generic-modifier "count_sentences" '() 0))
+
+(defun smarty-template-count-words ()
+ "Insert a count_words statement."
+ (interactive)
+ (smarty-template-generic-modifier "count_words" '() 0))
+
+(defun smarty-template-date-format ()
+ "Insert a date_format statement."
+ (interactive)
+ (smarty-template-generic-modifier "date_format" '("format" "default") 0))
+
+(defun smarty-template-default ()
+ "Insert a default statement."
+ (interactive)
+ (smarty-template-generic-modifier "default" '("value") 0))
+
+(defun smarty-template-escape ()
+ "Insert a escape statement."
+ (interactive)
+ (smarty-template-generic-modifier "escape" '("html|htmlall|url|urlpathinfo|quotes|hex|hexentity|javascript|mail" "charset") 0))
+
+(defun smarty-template-indent ()
+ "Insert a indent statement."
+ (interactive)
+ (smarty-template-generic-modifier "indent" '("value" "character") 0))
+
+(defun smarty-template-lower ()
+ "Insert a lower statement."
+ (interactive)
+ (smarty-template-generic-modifier "lower" '() 0))
+
+(defun smarty-template-nl2br ()
+ "Insert a nl2br statement."
+ (interactive)
+ (smarty-template-generic-modifier "nl2br" '() 0))
+
+(defun smarty-template-regex-replace ()
+ "Insert a regex_replace statement."
+ (interactive)
+ (smarty-template-generic-modifier "regex_replace" '("regexp" "string_to_replace") 2))
+
+(defun smarty-template-replace ()
+ "Insert a replace statement."
+ (interactive)
+ (smarty-template-generic-modifier "replace" '("string" "string_to_replace_with") 2))
+
+(defun smarty-template-spacify ()
+ "Insert a spacify statement."
+ (interactive)
+ (smarty-template-generic-modifier "spacify" '("character") 0))
+
+(defun smarty-template-string-format ()
+ "Insert a string_format statement."
+ (interactive)
+ (smarty-template-generic-modifier "string_format" '("format") 1))
+
+(defun smarty-template-vstrip ()
+ "Insert a strip statement."
+ (interactive)
+ (smarty-template-generic-modifier "strip" '() 0))
+
+(defun smarty-template-strip-tags ()
+ "Insert a strip_tags statement."
+ (interactive)
+ (smarty-template-generic-modifier "strip_tags" '("replace_by_space") 0))
+
+(defun smarty-template-truncate ()
+ "Insert a truncate statement."
+ (interactive)
+ (smarty-template-generic-modifier "truncate" '("count" "text_to_replace" "character_boundary" "middle_string") 0))
+
+(defun smarty-template-upper ()
+ "Insert a upper statement."
+ (interactive)
+ (smarty-template-generic-modifier "upper" '() 0))
+
+(defun smarty-template-wordwrap ()
+ "Insert a wordwrap statement."
+ (interactive)
+ (smarty-template-generic-modifier "wordwrap" '("count" "string" "character_boundary") 0))
+
+
+(defun smarty-template-validate ()
+ "Insert a validate statement."
+ (interactive)
+ (smarty-template-generic-function "validate" nil '("field" "criteria" "message" "form" "transform" "trim" "empty" "halt" "assign" "append" "page") 3))
+
+(defun smarty-template-formtool-checkall ()
+ "Insert a formtool_checkall statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_checkall" nil '("name" "class" "style") 1))
+
+(defun smarty-template-formtool-copy ()
+ "Insert a formtool_copy statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_copy" nil '("from" "to" "save" "button_text" "all" "counter" "class" "style") 3))
+
+(defun smarty-template-formtool-count-chars ()
+ "Insert a formtool_count_chars statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_count_chars" nil '("name" "limit" "alert") 3))
+
+(defun smarty-template-formtool-init ()
+ "Insert a formtool_init statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_init" nil '("src") 1))
+
+(defun smarty-template-formtool-move ()
+ "Insert a formtool_move statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_move" nil '("from" "to" "save_from" "save_to" "all" "count_to" "count_from" "class" "style") 4))
+
+(defun smarty-template-formtool-moveall ()
+ "Insert a formtool_moveall statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_moveall" nil '("from" "to" "save_from" "save_to" "all" "count_to" "count_from" "class" "style") 4))
+
+(defun smarty-template-formtool-movedown ()
+ "Insert a formtool_movedown statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_movedown" nil '("save" "name" "class" "style") 2))
+
+(defun smarty-template-formtool-moveup ()
+ "Insert a formtool_moveup statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_moveup" nil '("save" "name" "class" "style") 2))
+
+(defun smarty-template-formtool-remove ()
+ "Insert a formtool_remove statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_remove" nil '("from" "save" "all" "counter" "class" "style") 2))
+
+(defun smarty-template-formtool-rename ()
+ "Insert a formtool_rename statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_rename" nil '("name" "from" "save" "class" "style") 3))
+
+(defun smarty-template-formtool-save ()
+ "Insert a formtool_save statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_save" nil '("from" "name" "save") 3))
+
+(defun smarty-template-formtool-selectall ()
+ "Insert a formtool_selectall statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_selectall" nil '("name" "class" "style") 1))
+
+(defun smarty-template-paginate-first ()
+ "Insert a paginate_first statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_first" nil '("id" "text") 0))
+
+(defun smarty-template-paginate-last ()
+ "Insert a paginate_last statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_last" nil '("id" "text") 0))
+
+(defun smarty-template-paginate-middle ()
+ "Insert a paginate_middle statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_middle" nil '("id" "format" "prefix" "page_limit" "link_prefix" "link_suffix") 0))
+
+(defun smarty-template-paginate-next ()
+ "Insert a paginate_next statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_next" nil '("id" "text") 0))
+
+(defun smarty-template-paginate-prev ()
+ "Insert a paginate_prev statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_prev" nil '("id" "text") 0))
+
+
+(defun smarty-template-btosmilies ()
+ "Insert a B2Smilies statement."
+ (interactive)
+ (smarty-template-generic-modifier "B2Smilies" '() 0))
+
+(defun smarty-template-bbcodetohtml ()
+ "Insert a bbcode2html statement."
+ (interactive)
+ (smarty-template-generic-modifier "bbcode2html" '() 0))
+
+(defun smarty-template-date-formatto ()
+ "Insert a date_format2 statement."
+ (interactive)
+ (smarty-template-generic-modifier "date_format2" '("format" "default") 0))
+
+;;
+
+(defun smarty-resolve-env-variable (string)
+ "Resolve environment variables in STRING."
+ (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string)
+ (setq string (concat (match-string 1 string)
+ (getenv (match-string 2 string))
+ (match-string 4 string))))
+ string)
+
+(defun smarty-insert-string-or-file (string)
+ "Insert STRING or file contents if STRING is an existing file name."
+ (unless (equal string "")
+ (let ((file-name
+ (progn (string-match "^\\([^\n]+\\)" string)
+ (smarty-resolve-env-variable (match-string 1 string)))))
+ (if (file-exists-p file-name)
+ (forward-char (cadr (insert-file-contents file-name)))
+ (insert string)))))
+
+(defun smarty-template-insert-date ()
+ "Insert date in appropriate format."
+ (interactive)
+ (insert
+ (cond
+ ;; 'american, 'european, 'scientific kept for backward compatibility
+ ((eq smarty-date-format 'american) (format-time-string "%m/%d/%Y" nil))
+ ((eq smarty-date-format 'european) (format-time-string "%d.%m.%Y" nil))
+ ((eq smarty-date-format 'scientific) (format-time-string "%Y/%m/%d" nil))
+ (t (format-time-string smarty-date-format nil)))))
+
+(defun smarty-template-header (&optional file-title)
+ "Insert a Smarty file header."
+ (interactive)
+ (unless (equal smarty-file-header "")
+ (let (pos)
+ (save-excursion
+ (smarty-insert-string-or-file smarty-file-header)
+ (setq pos (point-marker)))
+ (smarty-template-replace-header-keywords
+ (point-min-marker) pos file-title))))
+
+(defun smarty-template-footer ()
+ "Insert a Smarty file footer."
+ (interactive)
+ (unless (equal smarty-file-footer "")
+ (let (pos)
+ (save-excursion
+ (setq pos (point-marker))
+ (smarty-insert-string-or-file smarty-file-footer)
+ (unless (= (preceding-char) ?\n)
+ (insert "\n")))
+ (smarty-template-replace-header-keywords pos (point-max-marker)))))
+
+(defun smarty-template-replace-header-keywords (beg end &optional file-title is-model)
+ "Replace keywords in header and footer."
+ (let ()
+ (smarty-prepare-search-2
+ (save-excursion
+ (goto-char beg)
+ (while (search-forward "<filename>" end t)
+ (replace-match (buffer-name) t t))
+ (goto-char beg)
+ (while (search-forward "<copyright>" end t)
+ (replace-match smarty-copyright-string t t))
+ (goto-char beg)
+ (while (search-forward "<author>" end t)
+ (replace-match "" t t)
+ (insert (user-full-name))
+ (when user-mail-address (insert " <" user-mail-address ">")))
+ (goto-char beg)
+ (while (search-forward "<login>" end t)
+ (replace-match (user-login-name) t t))
+ (goto-char beg)
+ (while (search-forward "<company>" end t)
+ (replace-match smarty-company-name t t))
+ (goto-char beg)
+ ;; Replace <RCS> with $, so that RCS for the source is
+ ;; not over-enthusiastic with replacements
+ (while (search-forward "<RCS>" end t)
+ (replace-match "$" nil t))
+ (goto-char beg)
+ (while (search-forward "<date>" end t)
+ (replace-match "" t t)
+ (smarty-template-insert-date))
+ (goto-char beg)
+ (while (search-forward "<year>" end t)
+ (replace-match (format-time-string "%Y" nil) t t))
+ (goto-char beg)
+ (let (string)
+ (while
+ (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
+ (setq string (read-string (concat (match-string 1) ": ")))
+ (replace-match string t t)))
+ (goto-char beg)
+ (when (and (not is-model) (search-forward "<cursor>" end t))
+ (replace-match "" t t))))))
+
+(provide 'smarty-mode)
+;;; smarty-mode.el ends here
\ No newline at end of file
--- /dev/null
+;;; autostart.el --- Load nxhtml
+;;
+;; Author: By: Lennart Borgman
+;; Created: Fri Dec 15 2006
+;; Version:
+;; Last-Updated: 2009-04-30 Thu
+;; Keywords:
+;; Compatibility:
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; Fix-me: Split out the definitions from this file so it can be
+;; loaded during byte compilation.
+
+;;(eval-when-compile (require 'web-vcs nil t))
+;;(eval-when-compile (require 'nxhtml-web-vcs nil t))
+
+(message "Nxml/Nxhtml Autostart.el loading ...")
+
+(defconst nxhtml-autostart-trace nil)
+(defsubst nxhtml-autostart-trace (format-string &rest args)
+ (when nxhtml-autostart-trace
+ (apply 'message format-string args)))
+
+(defconst nxhtml-load-time-start (float-time))
+
+;; Add this dir to load-path
+(add-to-list 'load-path
+ (file-name-directory (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name)))
+
+(require 'nxhtml-base)
+(eval-and-compile (when (fboundp 'nxml-mode)
+ (load (expand-file-name "etc/schema/schema-path-patch"
+ nxhtml-install-dir))))
+
+;; (defun nxhtml-custom-load-and-get-value (symbol)
+;; (custom-load-symbol symbol)
+;; (symbol-value symbol))
+
+(defun nxhtml-list-loaded-features (use-message)
+ (interactive (list t))
+ (let ((buf (when use-message ;(called-interactively-p)
+ (get-buffer-create "*nXhtml loaded features*"))))
+ (if buf
+ (with-current-buffer buf (erase-buffer))
+ (message "")
+ (message "=== Loaded at nxhtml/autostart.el end:"))
+ (dolist (feature '(
+ as-external
+ html-chklnk
+ html-imenu
+ html-move
+ html-pagetoc
+ html-quote
+ html-site
+ html-toc
+ html-upl
+ html-wtoc
+ inlimg
+ mumamo
+ nxhtml-bug
+ nxhtml-menu
+ nxhtml-mode
+ nxhtml-mumamo
+ nxhtml-strval
+ nxhtml
+ nxhtml-js
+ nxml-where
+ outline-magic
+ rngalt
+ tidy-xhtml
+ xhtml-help
+ ))
+ (when (featurep feature)
+ (if buf
+ (with-current-buffer buf
+ (insert (format "(feature '%s)=%s\n" feature (featurep feature))))
+ (message "(feature '%s)=%s" feature (featurep feature)))))
+ (if buf
+ (display-buffer buf)
+ (message ""))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Code that will run on loading this file
+
+(if (< emacs-major-version 23)
+ (unless (featurep 'autostart22)
+ (load (expand-file-name "autostart22" nxhtml-install-dir)))
+ ;; Check that the nxml-mode included with Emacs is used. There
+ ;; has been some problems on Debian with this.
+ (let ((nxml-mode-file (locate-library "nxml-mode"))
+ (help-file (locate-library "help")))
+ (unless (string= (expand-file-name ".." help-file)
+ (expand-file-name "../.." nxml-mode-file))
+ (error "Wrong nxml-mode=%s used, please use the one that comes with Emacs" nxml-mode-file))))
+
+(let* ((util-dir (file-name-as-directory (expand-file-name "util" nxhtml-install-dir)))
+ (related-dir (file-name-as-directory (expand-file-name "related" nxhtml-install-dir)))
+ (nxhtml-dir (file-name-as-directory (expand-file-name "nxhtml" nxhtml-install-dir)))
+ ;;(company-dir (file-name-as-directory (expand-file-name "util/nxhtml-company-mode" nxhtml-install-dir)))
+ (tests-dir (file-name-as-directory (expand-file-name "tests" nxhtml-install-dir))))
+ (add-to-list 'load-path nxhtml-dir)
+ (add-to-list 'load-path related-dir)
+ (add-to-list 'load-path util-dir)
+ (add-to-list 'load-path nxhtml-install-dir)
+ ;;(add-to-list 'load-path company-dir)
+ (add-to-list 'load-path tests-dir)
+
+ (nxhtml-autostart-trace "... nXhtml loading %.1f seconds elapsed ..." (- (float-time) nxhtml-load-time-start))
+
+ ;; Autoloading etc
+ ;; (unless (featurep 'web-vcs)
+ ;; (load (expand-file-name "web-vcs" nxhtml-install-dir) (not nxhtml-autoload-web)))
+
+ ;; (when (catch 'miss
+ ;; (dolist (file nxhtml-basic-files)
+ ;; (let ((dl-file (expand-file-name file nxhtml-install-dir)))
+ ;; (unless (file-exists-p dl-file)
+ ;; (throw 'miss t))))
+ ;; nil)
+ ;; (nxhtml-setup-auto-download nxhtml-install-dir))
+
+ (unless (featurep 'web-autoload)
+ (load (expand-file-name "web-autoload" nxhtml-install-dir) (not nxhtml-autoload-web)))
+
+ (when nxhtml-autoload-web
+ (ad-activate 'require t))
+
+ ;; Fix-me: Why must as-external be loaded? Why doesn't it work in batch?
+ ;;(unless noninteractive (require 'as-external))
+
+ (unless (featurep 'nxhtml-loaddefs)
+ (load (expand-file-name "nxhtml-loaddefs" nxhtml-install-dir) nxhtml-autoload-web))
+ (nxhtml-autostart-trace "... nXhtml loading %.1f seconds elapsed ..." (- (float-time) nxhtml-load-time-start))
+
+ ;; Turn on `nxhtml-menu-mode' unconditionally
+ (nxhtml-autostart-trace "Turn on `nxhtml-menu-mode' unconditionally")
+ (nxhtml-menu-mode 1)
+ (nxhtml-autostart-trace "... nXhtml loading %.1f seconds elapsed ..." (- (float-time) nxhtml-load-time-start))
+
+ ;; Patch the rnc include paths
+ (when (fboundp 'rncpp-patch-xhtml-loader) (rncpp-patch-xhtml-loader))
+ (nxhtml-autostart-trace "... nXhtml loading %.1f seconds elapsed ..." (- (float-time) nxhtml-load-time-start))
+
+ ;; Load nXhtml
+ (unless (featurep 'nxhtml-autoload)
+ (load (expand-file-name "nxhtml/nxhtml-autoload" nxhtml-install-dir))))
+(nxhtml-autostart-trace "... nXhtml loading %.1f seconds elapsed ..." (- (float-time) nxhtml-load-time-start))
+
+
+(unless (featurep 'nxhtml-autostart)
+ ;; Provide the feature here to avoid loading looping on error.
+ (provide 'nxhtml-autostart)
+
+ ;; Tell what have been loaded of nXhtml:
+ (when nxhtml-autostart-trace (nxhtml-list-loaded-features nil))
+
+ ;; How long time did it all take?
+ (message "Nxml/Nxhtml Autostart.el loaded in %.1f seconds" (- (float-time) nxhtml-load-time-start)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; autostart.el ends here
--- /dev/null
+;;; autostart22.el --- Example of autostart file for Emacs22
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-01-01 Thu
+;; Version:
+;; Last-Updated: 2009-01-05 Mon
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; This file is for Emacs 22 only.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Change this file according to the path of your nxml-mode dir. If
+;; you do not use nxml-mode then just use autostart.el.
+;;
+;; NOTICE: You need to enter the path to your nxml-mode installation
+;; below.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(let ((debug-on-error t))
+ (if (/= emacs-major-version 22)
+ (message "This file (autostart22.el) is for Emacs 22 only")
+
+ (defalias 'Custom-mode 'custom-mode)
+
+ (let* ((this-file (or load-file-name buffer-file-name))
+ (this-dir (file-name-directory this-file))
+ ;; FIX-ME: Download nXml (since it is not included in Emacs
+ ;; 22) and place the path to rng-auto.el in your downloaded
+ ;; nXml HERE:
+ (rng-auto-file (or (locate-library "rng-auto.el")
+ "c:/emacs/u/081231/EmacsW32/nxhtml/nxml-mode-20041004/rng-auto.el")))
+ (unless (file-exists-p rng-auto-file)
+ (error "Can't find rng-auto.el, please edit %s" this-file))
+ (load rng-auto-file))))
+
+(provide 'autostart22)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; autostart22.el ends here
--- /dev/null
+c:\emacs\emacs-22.3\bin\emacs.exe -Q --debug-init -l autostart.el
--- /dev/null
+namespace py = "http://genshi.edgewall.org/"\r
+\r
+genshi.expr-type = xsd:string { minLength = "1" }\r
+genshi.with-type = xsd:string { minLength = "1" }\r
+genshi.choose-type = xsd:string\r
+genshi.def-type = xsd:string\r
+genshi.xpath-type = xsd:anyURI\r
+\r
+genshi.attrib = attribute py:if { genshi.expr-type }?,\r
+ attribute py:choose { genshi.choose-type }?,\r
+ attribute py:when { genshi.expr-type }?,\r
+ attribute py:otherwise { genshi.expr-type }?,\r
+ attribute py:for { genshi.expr-type }?,\r
+ attribute py:def { genshi.def-type }?,\r
+ attribute py:match { genshi.xpath-type }?,\r
+ attribute py:with { genshi.with-type }?,\r
+ attribute py:attrs { genshi.expr-type }?,\r
+ attribute py:content { genshi.expr-type }?,\r
+ attribute py:replace { genshi.expr-type }?,\r
+ attribute py:strip { genshi.expr-type }?\r
+\r
+genshi.if.attlist = attribute expr { genshi.expr-type }\r
+genshi.for.attlist = attribute each { genshi.expr-type }\r
+genshi.def.attlist = attribute each { genshi.expr-type }\r
+genshi.with.attlist = attribute vars { genshi.with-type }\r
+\r
+ \r
--- /dev/null
+<locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0">\r
+ <typeId id="XHTML" uri="qtmstr-xhtml.rnc" />\r
+</locatingRules>\r
--- /dev/null
+default namespace = "http://genshi.edgewall.org/"\r
+namespace py = "http://genshi.edgewall.org/"\r
+\r
+include "xinclude.rnc"\r
+\r
+# There's no way to just match the text part against a Genshi Python expression\r
+# See: http://relaxng.org/compact-tutorial-20030326.html#id2814737\r
+python.expression = text\r
+\r
+genshi.expr-type = xsd:string { minLength = "1" }\r
+genshi.xpath-type = xsd:anyURI\r
+\r
+genshi.attrib =\r
+ attribute py:if { genshi.expr-type }?,\r
+ attribute py:choose { text }?,\r
+ attribute py:when { genshi.expr-type }?,\r
+ attribute py:otherwise { text }?,\r
+ attribute py:for { genshi.expr-type }?,\r
+ attribute py:def { genshi.expr-type }?,\r
+ attribute py:match { genshi.xpath-type}?,\r
+ attribute py:with { genshi.expr-type }?,\r
+ attribute py:attrs { genshi.expr-type }?,\r
+ attribute py:content { text }?,\r
+ attribute py:replace { genshi.expr-type }?,\r
+ attribute py:strip { text }?\r
+\r
+genshi.if.attlist = attribute test { genshi.expr-type }\r
+genshi.choose.attlist = attribute test { text }\r
+genshi.when.attlist = attribute test { genshi.expr-type }\r
+genshi.for.attlist = attribute each { genshi.expr-type }\r
+genshi.def.attlist = attribute function { genshi.expr-type }\r
+genshi.with.attlist = attribute vars { genshi.expr-type }\r
+genshi.replace.attlist = attribute value { genshi.expr-type }\r
+genshi.match.attlist =\r
+ attribute path { genshi.xpath-type },\r
+ attribute buffer { "true" | "false" }?,\r
+ attribute once { "true" | "false" }?,\r
+ attribute recursive { "true" | "false" }?\r
+\r
+genshi.choose =\r
+ element py:choose { genshi.choose.attlist,\r
+ genshi.model\r
+ }\r
+genshi.when =\r
+ element py:when { genshi.when.attlist,\r
+ genshi.model\r
+ }\r
+genshi.otherwise =\r
+ element py:otherwise {\r
+ genshi.model\r
+ }\r
+genshi.if =\r
+ element py:if { genshi.if.attlist,\r
+ genshi.model\r
+ }\r
+genshi.for =\r
+ element py:for { genshi.for.attlist,\r
+ genshi.model\r
+ }\r
+genshi.def =\r
+ element py:def { genshi.def.attlist,\r
+ genshi.model\r
+ }\r
+genshi.with =\r
+ element py:with { genshi.with.attlist,\r
+ genshi.model\r
+ }\r
+genshi.match =\r
+ element py:match { genshi.match.attlist,\r
+ genshi.model\r
+ }\r
+genshi.replace =\r
+ element py:replace { genshi.replace.attlist,\r
+ genshi.model\r
+ }\r
+\r
+genshi.allowed.children = text\r
+\r
+genshi.class = genshi.if | genshi.choose | genshi.when | genshi.otherwise\r
+ | genshi.for | genshi.def | genshi.with | genshi.match | genshi.replace\r
+ | python.expression\r
+ | xi.include\r
+\r
+genshi.model = genshi.class* | genshi.allowed.children*
\ No newline at end of file
--- /dev/null
+include "xhtml-loader.rnc"
+
+MjtAll.attrib =
+ attribute mjt.def { Text.datatype }?,
+ attribute mjt.when { Text.datatype }?,
+ attribute mjt.otherwise { Text.datatype }?,
+ attribute mjt.for { Text.datatype }?,
+ attribute mjt.if { Text.datatype }?,
+ attribute mjt.elif { Text.datatype }?,
+ attribute mjt.else { Text.datatype }?,
+ attribute mjt.script { Text.datatype }?,
+ attribute mjt.choose { Text.datatype }?,
+ attribute mjt.replace { Text.datatype }?,
+ attribute mjt.content { Text.datatype }?,
+ attribute mjt.strip { Text.datatype }?,
+ attribute mjt.src { Text.datatype }?,
+ attribute mjt.style { Text.datatype }?,
+ attribute mjt.class { Text.datatype }?,
+ attribute mjt.id { Text.datatype }?,
+ attribute mjt.attrs { Text.datatype }?,
+ attribute mjt.task { Text.datatype }?
+
+
+a.attlist &=
+ attribute mjt.onblur { Script.datatype }?,
+ attribute mjt.onfocus { Script.datatype }?
+area.attlist &=
+ attribute mjt.onblur { Script.datatype }?,
+ attribute mjt.onfocus { Script.datatype }?
+form.attlist &=
+ attribute mjt.onreset { Script.datatype }?,
+ attribute mjt.onsubmit { Script.datatype }?
+body.attlist &=
+ attribute mjt.onload { Script.datatype }?,
+ attribute mjt.onunload { Script.datatype }?
+label.attlist &=
+ attribute mjt.onblur { Script.datatype }?,
+ attribute mjt.onfocus { Script.datatype }?
+input.attlist &=
+ attribute mjt.onblur { Script.datatype }?,
+ attribute mjt.onchange { Script.datatype }?,
+ attribute mjt.onfocus { Script.datatype }?,
+ attribute mjt.onselect { Script.datatype }?
+select.attlist &=
+ attribute mjt.onblur { Script.datatype }?,
+ attribute mjt.onchange { Script.datatype }?,
+ attribute mjt.onfocus { Script.datatype }?
+textarea.attlist &=
+ attribute mjt.onblur { Script.datatype }?,
+ attribute mjt.onchange { Script.datatype }?,
+ attribute mjt.onfocus { Script.datatype }?,
+ attribute mjt.onselect { Script.datatype }?
+button.attlist &=
+ attribute mjt.onblur { Script.datatype }?,
+ attribute mjt.onfocus { Script.datatype }?
+
+MjtEvents.attrib =
+ attribute mjt.onclick { Script.datatype }?,
+ attribute mjt.ondblclick { Script.datatype }?,
+ attribute mjt.onmousedown { Script.datatype }?,
+ attribute mjt.onmouseup { Script.datatype }?,
+ attribute mjt.onmouseover { Script.datatype }?,
+ attribute mjt.onmousemove { Script.datatype }?,
+ attribute mjt.onmouseout { Script.datatype }?,
+ attribute mjt.onkeypress { Script.datatype }?,
+ attribute mjt.onkeydown { Script.datatype }?,
+ attribute mjt.onkeyup { Script.datatype }?
+
+
+Common.attrib &= MjtAll.attrib
+CommonIdRequired.attrib &= MjtAll.attrib
+
+Common.attrib &= MjtEvents.attrib
+CommonIdRequired.attrib &= MjtEvents.attrib
--- /dev/null
+--- nxml-mode-orig/xmltok.el 2005-10-16 15:32:53.000000000 -0400
++++ nxml-mode-erb/xmltok.el 2006-09-01 01:02:55.000000000 -0400
+@@ -496,6 +496,9 @@
+ (xmltok+ (xmltok-g markup-declaration "!")
+ (xmltok-g comment-first-dash "-"
+ (xmltok-g comment-open "-") opt) opt))
++ (erb-section
++ (xmltok+ "%"
++ (xmltok-g erb-section-open "[^%]") opt))
+ (cdata-section
+ (xmltok+ "!"
+ (xmltok-g marked-section-open "\\[")
+@@ -526,6 +529,7 @@
+ ;; by default
+ or cdata-section
+ or comment
++ or erb-section
+ or processing-instruction))
+ (xmltok-defregexp
+ xmltok-attribute
+@@ -693,6 +697,16 @@
+ nil
+ "]]>")
+ 'not-well-formed)))
++ ((xmltok-after-lt start erb-section-open)
++ (setq xmltok-type
++ (if (re-search-forward "[^%]%>" nil t)
++ 'erb-section
++ (xmltok-add-error "No closing %>")
++ (xmltok-add-dependent 'xmltok-unclosed-reparse-p
++ nil
++ nil
++ "%>")
++ 'not-well-formed)))
+ ((xmltok-after-lt start processing-instruction-question)
+ (xmltok-scan-after-processing-instruction-open))
+ ((xmltok-after-lt start comment-open)
--- /dev/null
+namespace py = "http://genshi.edgewall.org/"\r
+\r
+genshi.expr-type = xsd:string { minLength = "1" }\r
+genshi.with-type = xsd:string { minLength = "1" }\r
+genshi.choose-type = xsd:string\r
+genshi.def-type = xsd:string\r
+genshi.xpath-type = xsd:anyURI\r
+\r
+genshi.attrib = attribute py:if { genshi.expr-type }?,\r
+ attribute py:choose { genshi.choose-type }?,\r
+ attribute py:when { genshi.expr-type }?,\r
+ attribute py:otherwise { genshi.expr-type }?,\r
+ attribute py:for { genshi.expr-type }?,\r
+ attribute py:def { genshi.def-type }?,\r
+ attribute py:match { genshi.xpath-type }?,\r
+ attribute py:with { genshi.with-type }?,\r
+ attribute py:attrs { genshi.expr-type }?,\r
+ attribute py:content { genshi.expr-type }?,\r
+ attribute py:replace { genshi.expr-type }?,\r
+ attribute py:strip { genshi.expr-type }?\r
+\r
+genshi.if.attlist = attribute test { genshi.expr-type }\r
+genshi.for.attlist = attribute each { genshi.expr-type }\r
+genshi.def.attlist = attribute function { genshi.expr-type }\r
+genshi.with.attlist = attribute vars { genshi.with-type }\r
+genshi.match.attlist = attribute path { genshi.xpath-type },\r
+ attribute buffer { genshi.expr-type }?,\r
+ attribute once { genshi.expr-type }?,\r
+ attribute recursive { genshi.expr-type }?\r
+\r
+ \r
--- /dev/null
+namespace py = "http://genshi.edgewall.org/"\r
+namespace xi = "http://www.w3.org/2001/XInclude"\r
+\r
+include "genshi.rnc"\r
+include "xinclude.rnc"\r
+include "xhtml-loader.rnc"\r
+\r
+start |= head|body|p|\div|h1|h2|h3|h4|h5|h6|hr|pre|dl|ol|ul|table|form\r
+\r
+Common.attrib &= genshi.attrib\r
+head.attlist &= genshi.attrib\r
+html.attlist &= genshi.attrib\r
+\r
+Head.class = base | isindex | link | meta | script | title | style |\r
+ if-head | for-head | def-head | with-head\r
+\r
+Head.model = Head.class*\r
+\r
+head.content &= Head.model*\r
+\r
+if-inline = element py:if { genshi.if.attlist, Inline.model }\r
+if-block = element py:if { genshi.if.attlist, Block.model }\r
+if-head = element py:if { genshi.if.attlist, Head.model }\r
+for-inline = element py:for { genshi.for.attlist, Inline.model }\r
+for-block = element py:for { genshi.for.attlist, Block.model }\r
+for-head = element py:for { genshi.for.attlist, Head.model }\r
+def-inline = element py:def { genshi.def.attlist, Inline.model }\r
+def-block = element py:def { genshi.def.attlist, Block.model }\r
+def-head = element py:def { genshi.def.attlist, Head.model }\r
+with-inline = element py:with { genshi.with.attlist, Inline.model }\r
+with-block = element py:with { genshi.with.attlist, Block.model }\r
+with-head = element py:with { genshi.with.attlist, Head.model }\r
+match-inline = element py:match { genshi.match.attlist, Inline.model }\r
+match-block = element py:match { genshi.match.attlist, Block.model }\r
+match-head = element py:match { genshi.match.attlist, Head.model }\r
+\r
+Inline.class |= if-inline | for-inline | def-inline | with-inline | match-inline\r
+Block.class |= if-block | for-block | def-block | with-block | match-block\r
+\r
+xi-inline = element xi:include {\r
+ xinclude.include.attlist,\r
+ element xi:fallback { genshi.attrib,\r
+ (xi-inline | Inline.model)*\r
+ }?\r
+ }\r
+\r
+xi-block = element xi:include { xinclude.include.attlist,\r
+ element xi:fallback { genshi.attrib,\r
+ (xi-block | Block.model)*\r
+ }?\r
+ }\r
+\r
+xi-head = element xi:include { xinclude.include.attlist,\r
+ element xi:fallback { genshi.attrib,\r
+ (xi-head | Head.model)*\r
+ }?\r
+ }\r
+\r
+Inline.class |= xi-inline\r
+Block.class |= xi-block\r
+Head.class |= xi-head\r
--- /dev/null
+namespace xi = "http://www.w3.org/2001/XInclude"\r
+namespace local = ""\r
+\r
+xinclude.include.attlist =\r
+ attribute href { xsd:anyURI }?,\r
+ attribute parse { xsd:string }?,\r
+ attribute xpointer { xsd:string }?,\r
+ attribute encoding { xsd:string }?,\r
+ attribute accept { xsd:string }?,\r
+ attribute accept-language { xsd:string }?\r
+\r
--- /dev/null
+namespace py = "http://genshi.edgewall.org/"\r
+namespace xi = "http://www.w3.org/2001/XInclude"\r
+\r
+include "genshi.rnc"\r
+include "xinclude.rnc"\r
+include "xhtml-loader.rnc"\r
+\r
+start |= head|body|p|\div|h1|h2|h3|h4|h5|h6|hr|pre|dl|ol|ul|table|form\r
+\r
+Common.attrib &= genshi.attrib\r
+head.attlist &= genshi.attrib\r
+html.attlist &= genshi.attrib\r
+\r
+Head.class = base | isindex | link | meta | script | title | style |\r
+ if-head | for-head | def-head | with-head\r
+\r
+Head.model = Head.class*\r
+\r
+head.content &= Head.model*\r
+\r
+if-inline = element py:if { genshi.if.attlist, Inline.model }\r
+if-block = element py:if { genshi.if.attlist, Block.model }\r
+if-head = element py:if { genshi.if.attlist, Head.model }\r
+for-inline = element py:for { genshi.for.attlist, Inline.model }\r
+for-block = element py:for { genshi.for.attlist, Block.model }\r
+for-head = element py:for { genshi.for.attlist, Head.model }\r
+def-inline = element py:def { genshi.def.attlist, Inline.model }\r
+def-block = element py:def { genshi.def.attlist, Block.model }\r
+def-head = element py:def { genshi.def.attlist, Head.model }\r
+with-inline = element py:with { genshi.with.attlist, Inline.model }\r
+with-block = element py:with { genshi.with.attlist, Block.model }\r
+with-head = element py:with { genshi.with.attlist, Head.model }\r
+\r
+Inline.class |= if-inline | for-inline | def-inline | with-inline\r
+Block.class |= if-block | for-block | def-block | with-block\r
+\r
+xi-inline = element xi:include {\r
+ xinclude.include.attlist,\r
+ element xi:fallback { genshi.attrib,\r
+ (xi-inline | Inline.model)*\r
+ }?\r
+ }\r
+\r
+xi-block = element xi:include { xinclude.include.attlist,\r
+ element xi:fallback { genshi.attrib,\r
+ (xi-block | Block.model)*\r
+ }?\r
+ }\r
+\r
+xi-head = element xi:include { xinclude.include.attlist,\r
+ element xi:fallback { genshi.attrib,\r
+ (xi-head | Head.model)*\r
+ }?\r
+ }\r
+\r
+Inline.class |= xi-inline\r
+Block.class |= xi-block\r
+Head.class |= xi-head\r
--- /dev/null
+default namespace = "http://www.w3.org/1999/xhtml"\r
+\r
+include "genshi.rnc"\r
+include "xhtml-loader.rnc" {\r
+ start = html | head | head.content | body | frameset | frame | noframes |\r
+ Block.class | Inline.class | Table.class | Form.extra.class | genshi.class\r
+ html = element html { html.attlist, (genshi.model | (head, (body | frameset | genshi.model))) }\r
+ frameset =\r
+ element frameset {\r
+ frameset.attlist,\r
+ (((frameset | frame)+ & noframes?) | genshi.model)\r
+ }\r
+ noframes = element noframes { noframes.attlist, (body | genshi.model) }\r
+ title = element title { title.attlist, (text | genshi.model)* }\r
+ script = element script { script.attlist, (text | genshi.model)* }\r
+ style = element style { style.attlist, (text | genshi.model)* }\r
+ dl = element dl { dl.attlist, ((dt | dd)+ | genshi.model) }\r
+ ol = element ol { ol.attlist, (li+ | genshi.model) }\r
+ ul = element ul { ul.attlist, (li+ | genshi.model) }\r
+ dir = element dir { dir.attlist, (li.noblock+ | genshi.model) }\r
+ menu = element menu { menu.attlist, (li.noblock+ | genshi.model) }\r
+ select = element select { select.attlist, ((option | optgroup)+ | genshi.model) }\r
+ option =\r
+ element option {\r
+ Common.attrib,\r
+ attribute selected { "selected" }?,\r
+ attribute value { text }?,\r
+ (text | genshi.model)*\r
+ }\r
+ textarea = element textarea { textarea.attlist, (text & genshi.model)* }\r
+ optgroup = element optgroup { optgroup.attlist, (option+ | genshi.model) }\r
+ table =\r
+ element table {\r
+ table.attlist,\r
+ (caption? | genshi.model),\r
+ (col* | colgroup* | genshi.model),\r
+ (((thead? | genshi.model),\r
+ (tfoot? | genshi.model),\r
+ (tbody+ | genshi.model)) | (tr+ | genshi.model))\r
+ }\r
+ colgroup = element colgroup { colgroup.attlist, (col* | genshi.model) }\r
+ tr = element tr { tr.attlist, ((th | td)+ | genshi.model) }\r
+ tbody = element tbody { tbody.attlist, (tr+ | genshi.model) }\r
+ thead = element thead { thead.attlist, (tr+ | genshi.model) }\r
+ tfoot = element tfoot { tfoot.attlist, (tr+ | genshi.model) }\r
+}\r
+\r
+Table.class = caption | colgroup | col | tbody | thead | tfoot | th | tr | td\r
+Form.extra.class = option | optgroup | legend\r
+\r
+Block.class |= genshi.class\r
+Inline.class |= genshi.class\r
+head.content &= genshi.class\r
+\r
+Core.attrib &= genshi.attrib\r
+html.attlist &= genshi.attrib\r
+head.attlist &= genshi.attrib\r
+title.attlist &= genshi.attrib\r
+base.attlist &= genshi.attrib\r
+meta.attlist &= genshi.attrib\r
+script.attlist &= genshi.attrib\r
+param.attlist &= genshi.attrib\r
+Edit.attrib &= genshi.attrib\r
+\r
+genshi.allowed.children |= html | head | head.content | body | frameset | frame\r
+ | noframes | Inline.class | Block.class | Table.class | Form.extra.class\r
--- /dev/null
+;;; schema-path-patch.el --- Patch schema paths
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-08-08T20:21:31+0200 Fri
+;; Version: 0.2
+;; Last-Updated: 2008-08-19T00:21:25+0200 Mon
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; Cannot open load file: schema-path-patch.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Schemas here may include parts from nxml and need to know the path.
+;; This file can be used to patch the paths.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defvar rncpp-this-dir
+ (file-name-as-directory
+ (file-name-directory
+ (if load-file-name load-file-name buffer-file-name))))
+
+(defun rncpp-get-nxml-schema-dir ()
+ ;; First look for nxml-mode included with Emacs
+ (let ((schema-dir (file-name-as-directory
+ (expand-file-name "schema" data-directory))))
+ (unless (file-directory-p schema-dir)
+ ;; This is an old nxml-mode, look for its schemas dir.
+ (let ((nxml-mode-dir (file-name-as-directory
+ (file-name-directory (locate-library "nxml-mode")))))
+ (setq schema-dir (file-name-as-directory
+ (expand-file-name "schema" nxml-mode-dir)))))
+ (unless (file-directory-p schema-dir)
+ (error "Can't find schema-dir=%s" schema-dir))
+ schema-dir))
+
+;; Use xhtml-loader.rnc (an idea from Bryan Waite):
+(defun rncpp-patch-xhtml-loader ()
+ "Patch xhtml-loader.rnc so genshi and mjt rnc files works."
+ ;;(interactive)
+ (let* ((default-directory rncpp-this-dir)
+ (loader-path (expand-file-name "xhtml-loader.rnc"))
+ (loader-buf (find-buffer-visiting loader-path))
+ (schema-dir (rncpp-get-nxml-schema-dir))
+ (schema-relative-dir (file-relative-name schema-dir))
+ (loader-string (concat "include \""
+ schema-relative-dir
+ "xhtml.rnc\"\n")))
+ (when loader-buf (kill-buffer loader-buf))
+ (setq loader-buf (find-file-noselect loader-path))
+ (with-current-buffer loader-buf
+ (unless (file-exists-p loader-path)
+ (insert loader-string))
+ ;; Test if correct
+ (if (string= (buffer-substring-no-properties (point-min) (point-max))
+ loader-string)
+ (message "xhtml-loader.rnc was ok")
+ (message "Patching xhtml-loader.rnc")
+ (delete-region (point-min) (point-max))
+ (insert loader-string))
+ (basic-save-buffer)
+ (kill-buffer (current-buffer)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; schema-path-patch.el ends here
--- /dev/null
+default namespace = "http://www.w3.org/2001/XInclude"\r
+namespace xi = "http://www.w3.org/2001/XInclude"\r
+\r
+xi.include.attlist =\r
+ attribute href { xsd:anyURI }?,\r
+ attribute parse { "xml" | "text" }?,\r
+ attribute xpointer { xsd:string }?,\r
+ attribute encoding { xsd:string }?,\r
+ attribute accept { xsd:string }?,\r
+ attribute accept-language { xsd:string }?\r
+\r
+xi.include.attlist.extra =\r
+ attribute * - xi.include.attlist { text }*\r
+\r
+xi.include =\r
+ element xi:include {\r
+ xi.include.attlist,\r
+ xi.include.attlist.extra,\r
+ (xi.fallback? | xi.include.extra)*\r
+ }\r
+\r
+xi.include.extra = notAllowed\r
+\r
+xi.fallback.attlist =\r
+ attribute * { text }*\r
+\r
+xi.fallback =\r
+ element xi:fallback {\r
+ xi.fallback.attlist, \r
+ (xi.include | xi.fallback.extra)*\r
+ }\r
+\r
+xi.fallback.extra = notAllowed\r
+\r
+xi.class = xi.include | xi.fallback
\ No newline at end of file
--- /dev/null
+ROLLOVER_SPEC a {
+ /* Image */
+ display: block;
+ background: transparent url("IMG_URL") 0 0 no-repeat;
+ overflow: hidden;
+ width: IMG_WIDTHpx;
+ /* Text placement and size, etc */
+ CENTER_OR_PAD;
+ padding-top: PADDING_TOPpx;
+ font-size: FONT_SIZEpx;
+ padding-bottom: PADDING_BOTTOMpx;
+ text-decoration: none;
+ white-space: nowrap;
+ border: none;
+ margin: 0;
+}
+ROLLOVER_SPEC a:hover {
+ background-position: 0 -IMG_HEIGHT_2px;
+}
+ROLLOVER_SPEC li {
+ display: inline;
+ padding: 0;
+ margin: 0;
+ HOR_OR_VER;
+}
--- /dev/null
+# Recommended Identifier Profiles for IDN\r
+# File: idnchars.txt\r
+# Version: 2.0\r
+# Generated: 2006-08-15, 04:35:10 GMT\r
+# Checkin: $Revision: 1.11 $\r
+#\r
+# For documentation and usage, see http://www.unicode.org/reports/tr39/\r
+#\r
+# Allowed as output characters\r
+\r
+002D ; output # (-) HYPHEN-MINUS\r
+0030..0039 ; output # [10] (0..9) DIGIT ZERO..DIGIT NINE\r
+0041..005A ; output # [26] (A..Z) LATIN CAPITAL LETTER A..LATIN CAPITAL LETTER Z\r
+0061..007A ; output # [26] (a..z) LATIN SMALL LETTER A..LATIN SMALL LETTER Z\r
+00B7 ; output # (·) MIDDLE DOT\r
+00E0..00F6 ; output # [23] (à..ö) LATIN SMALL LETTER A WITH GRAVE..LATIN SMALL LETTER O WITH DIAERESIS\r
+00F8..00FF ; output # [8] (ø..ÿ) LATIN SMALL LETTER O WITH STROKE..LATIN SMALL LETTER Y WITH DIAERESIS\r
+0101 ; output # (ā) LATIN SMALL LETTER A WITH MACRON\r
+0103 ; output # (ă) LATIN SMALL LETTER A WITH BREVE\r
+0105 ; output # (ą) LATIN SMALL LETTER A WITH OGONEK\r
+0107 ; output # (ć) LATIN SMALL LETTER C WITH ACUTE\r
+0109 ; output # (ĉ) LATIN SMALL LETTER C WITH CIRCUMFLEX\r
+010B ; output # (ċ) LATIN SMALL LETTER C WITH DOT ABOVE\r
+010D ; output # (č) LATIN SMALL LETTER C WITH CARON\r
+010F ; output # (ď) LATIN SMALL LETTER D WITH CARON\r
+0111 ; output # (đ) LATIN SMALL LETTER D WITH STROKE\r
+0113 ; output # (ē) LATIN SMALL LETTER E WITH MACRON\r
+0115 ; output # (ĕ) LATIN SMALL LETTER E WITH BREVE\r
+0117 ; output # (ė) LATIN SMALL LETTER E WITH DOT ABOVE\r
+0119 ; output # (ę) LATIN SMALL LETTER E WITH OGONEK\r
+011B ; output # (ě) LATIN SMALL LETTER E WITH CARON\r
+011D ; output # (ĝ) LATIN SMALL LETTER G WITH CIRCUMFLEX\r
+011F ; output # (ğ) LATIN SMALL LETTER G WITH BREVE\r
+0121 ; output # (ġ) LATIN SMALL LETTER G WITH DOT ABOVE\r
+0123 ; output # (ģ) LATIN SMALL LETTER G WITH CEDILLA\r
+0125 ; output # (ĥ) LATIN SMALL LETTER H WITH CIRCUMFLEX\r
+0127 ; output # (ħ) LATIN SMALL LETTER H WITH STROKE\r
+0129 ; output # (ĩ) LATIN SMALL LETTER I WITH TILDE\r
+012B ; output # (ī) LATIN SMALL LETTER I WITH MACRON\r
+012D ; output # (ĭ) LATIN SMALL LETTER I WITH BREVE\r
+012F ; output # (į) LATIN SMALL LETTER I WITH OGONEK\r
+0131 ; output # (ı) LATIN SMALL LETTER DOTLESS I\r
+0135 ; output # (ĵ) LATIN SMALL LETTER J WITH CIRCUMFLEX\r
+0137..0138 ; output # [2] (ķ..ĸ) LATIN SMALL LETTER K WITH CEDILLA..LATIN SMALL LETTER KRA\r
+013A ; output # (ĺ) LATIN SMALL LETTER L WITH ACUTE\r
+013C ; output # (ļ) LATIN SMALL LETTER L WITH CEDILLA\r
+013E ; output # (ľ) LATIN SMALL LETTER L WITH CARON\r
+0142 ; output # (ł) LATIN SMALL LETTER L WITH STROKE\r
+0144 ; output # (ń) LATIN SMALL LETTER N WITH ACUTE\r
+0146 ; output # (ņ) LATIN SMALL LETTER N WITH CEDILLA\r
+0148 ; output # (ň) LATIN SMALL LETTER N WITH CARON\r
+014B ; output # (ŋ) LATIN SMALL LETTER ENG\r
+014D ; output # (ō) LATIN SMALL LETTER O WITH MACRON\r
+014F ; output # (ŏ) LATIN SMALL LETTER O WITH BREVE\r
+0151 ; output # (ő) LATIN SMALL LETTER O WITH DOUBLE ACUTE\r
+0153 ; output # (œ) LATIN SMALL LIGATURE OE\r
+0155 ; output # (ŕ) LATIN SMALL LETTER R WITH ACUTE\r
+0157 ; output # (ŗ) LATIN SMALL LETTER R WITH CEDILLA\r
+0159 ; output # (ř) LATIN SMALL LETTER R WITH CARON\r
+015B ; output # (ś) LATIN SMALL LETTER S WITH ACUTE\r
+015D ; output # (ŝ) LATIN SMALL LETTER S WITH CIRCUMFLEX\r
+015F ; output # (ş) LATIN SMALL LETTER S WITH CEDILLA\r
+0161 ; output # (š) LATIN SMALL LETTER S WITH CARON\r
+0163 ; output # (ţ) LATIN SMALL LETTER T WITH CEDILLA\r
+0165 ; output # (ť) LATIN SMALL LETTER T WITH CARON\r
+0167 ; output # (ŧ) LATIN SMALL LETTER T WITH STROKE\r
+0169 ; output # (ũ) LATIN SMALL LETTER U WITH TILDE\r
+016B ; output # (ū) LATIN SMALL LETTER U WITH MACRON\r
+016D ; output # (ŭ) LATIN SMALL LETTER U WITH BREVE\r
+016F ; output # (ů) LATIN SMALL LETTER U WITH RING ABOVE\r
+0171 ; output # (ű) LATIN SMALL LETTER U WITH DOUBLE ACUTE\r
+0173 ; output # (ų) LATIN SMALL LETTER U WITH OGONEK\r
+0175 ; output # (ŵ) LATIN SMALL LETTER W WITH CIRCUMFLEX\r
+0177 ; output # (ŷ) LATIN SMALL LETTER Y WITH CIRCUMFLEX\r
+017A ; output # (ź) LATIN SMALL LETTER Z WITH ACUTE\r
+017C ; output # (ż) LATIN SMALL LETTER Z WITH DOT ABOVE\r
+017E ; output # (ž) LATIN SMALL LETTER Z WITH CARON\r
+0183 ; output # (ƃ) LATIN SMALL LETTER B WITH TOPBAR\r
+0185 ; output # (ƅ) LATIN SMALL LETTER TONE SIX\r
+0188 ; output # (ƈ) LATIN SMALL LETTER C WITH HOOK\r
+018C ; output # (ƌ) LATIN SMALL LETTER D WITH TOPBAR\r
+0192 ; output # (ƒ) LATIN SMALL LETTER F WITH HOOK\r
+0195 ; output # (ƕ) LATIN SMALL LETTER HV\r
+0199..019B ; output # [3] (ƙ..ƛ) LATIN SMALL LETTER K WITH HOOK..LATIN SMALL LETTER LAMBDA WITH STROKE\r
+019E ; output # (ƞ) LATIN SMALL LETTER N WITH LONG RIGHT LEG\r
+01A1 ; output # (ơ) LATIN SMALL LETTER O WITH HORN\r
+01A3 ; output # (ƣ) LATIN SMALL LETTER OI\r
+01A5 ; output # (ƥ) LATIN SMALL LETTER P WITH HOOK\r
+01A8 ; output # (ƨ) LATIN SMALL LETTER TONE TWO\r
+01AD ; output # (ƭ) LATIN SMALL LETTER T WITH HOOK\r
+01B0 ; output # (ư) LATIN SMALL LETTER U WITH HORN\r
+01B4 ; output # (ƴ) LATIN SMALL LETTER Y WITH HOOK\r
+01B6 ; output # (ƶ) LATIN SMALL LETTER Z WITH STROKE\r
+01BD ; output # (ƽ) LATIN SMALL LETTER TONE FIVE\r
+01CE ; output # (ǎ) LATIN SMALL LETTER A WITH CARON\r
+01D0 ; output # (ǐ) LATIN SMALL LETTER I WITH CARON\r
+01D2 ; output # (ǒ) LATIN SMALL LETTER O WITH CARON\r
+01D4 ; output # (ǔ) LATIN SMALL LETTER U WITH CARON\r
+01D6 ; output # (ǖ) LATIN SMALL LETTER U WITH DIAERESIS AND MACRON\r
+01D8 ; output # (ǘ) LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE\r
+01DA ; output # (ǚ) LATIN SMALL LETTER U WITH DIAERESIS AND CARON\r
+01DC..01DD ; output # [2] (ǜ..ǝ) LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE..LATIN SMALL LETTER TURNED E\r
+01DF ; output # (ǟ) LATIN SMALL LETTER A WITH DIAERESIS AND MACRON\r
+01E1 ; output # (ǡ) LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON\r
+01E3 ; output # (ǣ) LATIN SMALL LETTER AE WITH MACRON\r
+01E5 ; output # (ǥ) LATIN SMALL LETTER G WITH STROKE\r
+01E7 ; output # (ǧ) LATIN SMALL LETTER G WITH CARON\r
+01E9 ; output # (ǩ) LATIN SMALL LETTER K WITH CARON\r
+01EB ; output # (ǫ) LATIN SMALL LETTER O WITH OGONEK\r
+01ED ; output # (ǭ) LATIN SMALL LETTER O WITH OGONEK AND MACRON\r
+01EF..01F0 ; output # [2] (ǯ..ǰ) LATIN SMALL LETTER EZH WITH CARON..LATIN SMALL LETTER J WITH CARON\r
+01F5 ; output # (ǵ) LATIN SMALL LETTER G WITH ACUTE\r
+01F9 ; output # (ǹ) LATIN SMALL LETTER N WITH GRAVE\r
+01FB ; output # (ǻ) LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE\r
+01FD ; output # (ǽ) LATIN SMALL LETTER AE WITH ACUTE\r
+01FF ; output # (ǿ) LATIN SMALL LETTER O WITH STROKE AND ACUTE\r
+0201 ; output # (ȁ) LATIN SMALL LETTER A WITH DOUBLE GRAVE\r
+0203 ; output # (ȃ) LATIN SMALL LETTER A WITH INVERTED BREVE\r
+0205 ; output # (ȅ) LATIN SMALL LETTER E WITH DOUBLE GRAVE\r
+0207 ; output # (ȇ) LATIN SMALL LETTER E WITH INVERTED BREVE\r
+0209 ; output # (ȉ) LATIN SMALL LETTER I WITH DOUBLE GRAVE\r
+020B ; output # (ȋ) LATIN SMALL LETTER I WITH INVERTED BREVE\r
+020D ; output # (ȍ) LATIN SMALL LETTER O WITH DOUBLE GRAVE\r
+020F ; output # (ȏ) LATIN SMALL LETTER O WITH INVERTED BREVE\r
+0211 ; output # (ȑ) LATIN SMALL LETTER R WITH DOUBLE GRAVE\r
+0213 ; output # (ȓ) LATIN SMALL LETTER R WITH INVERTED BREVE\r
+0215 ; output # (ȕ) LATIN SMALL LETTER U WITH DOUBLE GRAVE\r
+0217 ; output # (ȗ) LATIN SMALL LETTER U WITH INVERTED BREVE\r
+0219 ; output # (ș) LATIN SMALL LETTER S WITH COMMA BELOW\r
+021B ; output # (ț) LATIN SMALL LETTER T WITH COMMA BELOW\r
+021F ; output # (ȟ) LATIN SMALL LETTER H WITH CARON\r
+0223 ; output # (ȣ) LATIN SMALL LETTER OU\r
+0225 ; output # (ȥ) LATIN SMALL LETTER Z WITH HOOK\r
+0227 ; output # (ȧ) LATIN SMALL LETTER A WITH DOT ABOVE\r
+0229 ; output # (ȩ) LATIN SMALL LETTER E WITH CEDILLA\r
+022B ; output # (ȫ) LATIN SMALL LETTER O WITH DIAERESIS AND MACRON\r
+022D ; output # (ȭ) LATIN SMALL LETTER O WITH TILDE AND MACRON\r
+022F ; output # (ȯ) LATIN SMALL LETTER O WITH DOT ABOVE\r
+0231 ; output # (ȱ) LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON\r
+0233 ; output # (ȳ) LATIN SMALL LETTER Y WITH MACRON\r
+0253..0254 ; output # [2] (ɓ..ɔ) LATIN SMALL LETTER B WITH HOOK..LATIN SMALL LETTER OPEN O\r
+0256..0257 ; output # [2] (ɖ..ɗ) LATIN SMALL LETTER D WITH TAIL..LATIN SMALL LETTER D WITH HOOK\r
+0259 ; output # (ə) LATIN SMALL LETTER SCHWA\r
+025B ; output # (ɛ) LATIN SMALL LETTER OPEN E\r
+0260 ; output # (ɠ) LATIN SMALL LETTER G WITH HOOK\r
+0263 ; output # (ɣ) LATIN SMALL LETTER GAMMA\r
+0268..0269 ; output # [2] (ɨ..ɩ) LATIN SMALL LETTER I WITH STROKE..LATIN SMALL LETTER IOTA\r
+026F ; output # (ɯ) LATIN SMALL LETTER TURNED M\r
+0272 ; output # (ɲ) LATIN SMALL LETTER N WITH LEFT HOOK\r
+0275 ; output # (ɵ) LATIN SMALL LETTER BARRED O\r
+0280 ; output # (ʀ) LATIN LETTER SMALL CAPITAL R\r
+0283 ; output # (ʃ) LATIN SMALL LETTER ESH\r
+0288 ; output # (ʈ) LATIN SMALL LETTER T WITH RETROFLEX HOOK\r
+028A..028B ; output # [2] (ʊ..ʋ) LATIN SMALL LETTER UPSILON..LATIN SMALL LETTER V WITH HOOK\r
+0292 ; output # (ʒ) LATIN SMALL LETTER EZH\r
+0294 ; output # (ʔ) LATIN LETTER GLOTTAL STOP\r
+0300..033F ; output # [64] (̀..̿) COMBINING GRAVE ACCENT..COMBINING DOUBLE OVERLINE\r
+0342 ; output # (͂) COMBINING GREEK PERISPOMENI\r
+0346..034E ; output # [9] (͆..͎) COMBINING BRIDGE ABOVE..COMBINING UPWARDS ARROW BELOW\r
+0360..036F ; output # [16] (͠..ͯ) COMBINING DOUBLE TILDE..COMBINING LATIN SMALL LETTER X\r
+0390 ; output # (ΐ) GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS\r
+03AC..03C1 ; output # [22] (ά..ρ) GREEK SMALL LETTER ALPHA WITH TONOS..GREEK SMALL LETTER RHO\r
+03C3..03CE ; output # [12] (σ..ώ) GREEK SMALL LETTER SIGMA..GREEK SMALL LETTER OMEGA WITH TONOS\r
+0430..045F ; output # [48] (а..џ) CYRILLIC SMALL LETTER A..CYRILLIC SMALL LETTER DZHE\r
+0461 ; output # (ѡ) CYRILLIC SMALL LETTER OMEGA\r
+0463 ; output # (ѣ) CYRILLIC SMALL LETTER YAT\r
+0465 ; output # (ѥ) CYRILLIC SMALL LETTER IOTIFIED E\r
+0467 ; output # (ѧ) CYRILLIC SMALL LETTER LITTLE YUS\r
+0469 ; output # (ѩ) CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS\r
+046B ; output # (ѫ) CYRILLIC SMALL LETTER BIG YUS\r
+046D ; output # (ѭ) CYRILLIC SMALL LETTER IOTIFIED BIG YUS\r
+046F ; output # (ѯ) CYRILLIC SMALL LETTER KSI\r
+0471 ; output # (ѱ) CYRILLIC SMALL LETTER PSI\r
+0473 ; output # (ѳ) CYRILLIC SMALL LETTER FITA\r
+0475 ; output # (ѵ) CYRILLIC SMALL LETTER IZHITSA\r
+0477 ; output # (ѷ) CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT\r
+0479 ; output # (ѹ) CYRILLIC SMALL LETTER UK\r
+047B ; output # (ѻ) CYRILLIC SMALL LETTER ROUND OMEGA\r
+047D ; output # (ѽ) CYRILLIC SMALL LETTER OMEGA WITH TITLO\r
+047F ; output # (ѿ) CYRILLIC SMALL LETTER OT\r
+0481 ; output # (ҁ) CYRILLIC SMALL LETTER KOPPA\r
+048B ; output # (ҋ) CYRILLIC SMALL LETTER SHORT I WITH TAIL\r
+048D ; output # (ҍ) CYRILLIC SMALL LETTER SEMISOFT SIGN\r
+048F ; output # (ҏ) CYRILLIC SMALL LETTER ER WITH TICK\r
+0491 ; output # (ґ) CYRILLIC SMALL LETTER GHE WITH UPTURN\r
+0493 ; output # (ғ) CYRILLIC SMALL LETTER GHE WITH STROKE\r
+0495 ; output # (ҕ) CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK\r
+0497 ; output # (җ) CYRILLIC SMALL LETTER ZHE WITH DESCENDER\r
+0499 ; output # (ҙ) CYRILLIC SMALL LETTER ZE WITH DESCENDER\r
+049B ; output # (қ) CYRILLIC SMALL LETTER KA WITH DESCENDER\r
+049D ; output # (ҝ) CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE\r
+049F ; output # (ҟ) CYRILLIC SMALL LETTER KA WITH STROKE\r
+04A1 ; output # (ҡ) CYRILLIC SMALL LETTER BASHKIR KA\r
+04A3 ; output # (ң) CYRILLIC SMALL LETTER EN WITH DESCENDER\r
+04A5 ; output # (ҥ) CYRILLIC SMALL LIGATURE EN GHE\r
+04A7 ; output # (ҧ) CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK\r
+04A9 ; output # (ҩ) CYRILLIC SMALL LETTER ABKHASIAN HA\r
+04AB ; output # (ҫ) CYRILLIC SMALL LETTER ES WITH DESCENDER\r
+04AD ; output # (ҭ) CYRILLIC SMALL LETTER TE WITH DESCENDER\r
+04AF ; output # (ү) CYRILLIC SMALL LETTER STRAIGHT U\r
+04B1 ; output # (ұ) CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE\r
+04B3 ; output # (ҳ) CYRILLIC SMALL LETTER HA WITH DESCENDER\r
+04B5 ; output # (ҵ) CYRILLIC SMALL LIGATURE TE TSE\r
+04B7 ; output # (ҷ) CYRILLIC SMALL LETTER CHE WITH DESCENDER\r
+04B9 ; output # (ҹ) CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE\r
+04BB ; output # (һ) CYRILLIC SMALL LETTER SHHA\r
+04BD ; output # (ҽ) CYRILLIC SMALL LETTER ABKHASIAN CHE\r
+04BF..04C0 ; output # [2] (ҿ..Ӏ) CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER..CYRILLIC LETTER PALOCHKA\r
+04C2 ; output # (ӂ) CYRILLIC SMALL LETTER ZHE WITH BREVE\r
+04C4 ; output # (ӄ) CYRILLIC SMALL LETTER KA WITH HOOK\r
+04C6 ; output # (ӆ) CYRILLIC SMALL LETTER EL WITH TAIL\r
+04C8 ; output # (ӈ) CYRILLIC SMALL LETTER EN WITH HOOK\r
+04CA ; output # (ӊ) CYRILLIC SMALL LETTER EN WITH TAIL\r
+04CC ; output # (ӌ) CYRILLIC SMALL LETTER KHAKASSIAN CHE\r
+04CE ; output # (ӎ) CYRILLIC SMALL LETTER EM WITH TAIL\r
+04D1 ; output # (ӑ) CYRILLIC SMALL LETTER A WITH BREVE\r
+04D3 ; output # (ӓ) CYRILLIC SMALL LETTER A WITH DIAERESIS\r
+04D5 ; output # (ӕ) CYRILLIC SMALL LIGATURE A IE\r
+04D7 ; output # (ӗ) CYRILLIC SMALL LETTER IE WITH BREVE\r
+04D9 ; output # (ә) CYRILLIC SMALL LETTER SCHWA\r
+04DB ; output # (ӛ) CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS\r
+04DD ; output # (ӝ) CYRILLIC SMALL LETTER ZHE WITH DIAERESIS\r
+04DF ; output # (ӟ) CYRILLIC SMALL LETTER ZE WITH DIAERESIS\r
+04E1 ; output # (ӡ) CYRILLIC SMALL LETTER ABKHASIAN DZE\r
+04E3 ; output # (ӣ) CYRILLIC SMALL LETTER I WITH MACRON\r
+04E5 ; output # (ӥ) CYRILLIC SMALL LETTER I WITH DIAERESIS\r
+04E7 ; output # (ӧ) CYRILLIC SMALL LETTER O WITH DIAERESIS\r
+04E9 ; output # (ө) CYRILLIC SMALL LETTER BARRED O\r
+04EB ; output # (ӫ) CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS\r
+04ED ; output # (ӭ) CYRILLIC SMALL LETTER E WITH DIAERESIS\r
+04EF ; output # (ӯ) CYRILLIC SMALL LETTER U WITH MACRON\r
+04F1 ; output # (ӱ) CYRILLIC SMALL LETTER U WITH DIAERESIS\r
+04F3 ; output # (ӳ) CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE\r
+04F5 ; output # (ӵ) CYRILLIC SMALL LETTER CHE WITH DIAERESIS\r
+04F9 ; output # (ӹ) CYRILLIC SMALL LETTER YERU WITH DIAERESIS\r
+0501 ; output # (ԁ) CYRILLIC SMALL LETTER KOMI DE\r
+0503 ; output # (ԃ) CYRILLIC SMALL LETTER KOMI DJE\r
+0505 ; output # (ԅ) CYRILLIC SMALL LETTER KOMI ZJE\r
+0507 ; output # (ԇ) CYRILLIC SMALL LETTER KOMI DZJE\r
+0509 ; output # (ԉ) CYRILLIC SMALL LETTER KOMI LJE\r
+050B ; output # (ԋ) CYRILLIC SMALL LETTER KOMI NJE\r
+050D ; output # (ԍ) CYRILLIC SMALL LETTER KOMI SJE\r
+050F ; output # (ԏ) CYRILLIC SMALL LETTER KOMI TJE\r
+0561..0586 ; output # [38] (ա..ֆ) ARMENIAN SMALL LETTER AYB..ARMENIAN SMALL LETTER FEH\r
+0591..05A1 ; output # [17] (֑..֡) HEBREW ACCENT ETNAHTA..HEBREW ACCENT PAZER\r
+05A3..05B9 ; output # [23] (֣..ֹ) HEBREW ACCENT MUNAH..HEBREW POINT HOLAM\r
+05BB..05BD ; output # [3] (ֻ..ֽ) HEBREW POINT QUBUTS..HEBREW POINT METEG\r
+05BF ; output # (ֿ) HEBREW POINT RAFE\r
+05C1..05C2 ; output # [2] (ׁ..ׂ) HEBREW POINT SHIN DOT..HEBREW POINT SIN DOT\r
+05C4 ; output # (ׄ) HEBREW MARK UPPER DOT\r
+05D0..05EA ; output # [27] (א..ת) HEBREW LETTER ALEF..HEBREW LETTER TAV\r
+05F0..05F2 ; output # [3] (װ..ײ) HEBREW LIGATURE YIDDISH DOUBLE VAV..HEBREW LIGATURE YIDDISH DOUBLE YOD\r
+0621..063A ; output # [26] (ء..غ) ARABIC LETTER HAMZA..ARABIC LETTER GHAIN\r
+0641..0655 ; output # [21] (ف..ٕ) ARABIC LETTER FEH..ARABIC HAMZA BELOW\r
+0660..0669 ; output # [10] (٠..٩) ARABIC-INDIC DIGIT ZERO..ARABIC-INDIC DIGIT NINE\r
+0670..0674 ; output # [5] (ٰ..ٴ) ARABIC LETTER SUPERSCRIPT ALEF..ARABIC LETTER HIGH HAMZA\r
+0679..068D ; output # [21] (ٹ..ڍ) ARABIC LETTER TTEH..ARABIC LETTER DDAHAL\r
+068F..06D3 ; output # [69] (ڏ..ۓ) ARABIC LETTER DAL WITH THREE DOTS ABOVE DOWNWARDS..ARABIC LETTER YEH BARREE WITH HAMZA ABOVE\r
+06D5..06DC ; output # [8] (ە..ۜ) ARABIC LETTER AE..ARABIC SMALL HIGH SEEN\r
+06DF..06E8 ; output # [10] (۟..ۨ) ARABIC SMALL HIGH ROUNDED ZERO..ARABIC SMALL HIGH NOON\r
+06EA..06ED ; output # [4] (۪..ۭ) ARABIC EMPTY CENTRE LOW STOP..ARABIC SMALL LOW MEEM\r
+06F0..06FC ; output # [13] (۰..ۼ) EXTENDED ARABIC-INDIC DIGIT ZERO..ARABIC LETTER GHAIN WITH DOT BELOW\r
+0710..072C ; output # [29] (ܐ..ܬ) SYRIAC LETTER ALAPH..SYRIAC LETTER TAW\r
+0730..073F ; output # [16] (ܰ..ܿ) SYRIAC PTHAHA ABOVE..SYRIAC RWAHA\r
+0780..07B1 ; output # [50] (ހ..ޱ) THAANA LETTER HAA..THAANA LETTER NAA\r
+0901..0903 ; output # [3] (ँ..ः) DEVANAGARI SIGN CANDRABINDU..DEVANAGARI SIGN VISARGA\r
+0905..0939 ; output # [53] (अ..ह) DEVANAGARI LETTER A..DEVANAGARI LETTER HA\r
+093C..094D ; output # [18] (़..्) DEVANAGARI SIGN NUKTA..DEVANAGARI SIGN VIRAMA\r
+0950..0954 ; output # [5] (ॐ..॔) DEVANAGARI OM..DEVANAGARI ACUTE ACCENT\r
+0960..0963 ; output # [4] (ॠ..ॣ) DEVANAGARI LETTER VOCALIC RR..DEVANAGARI VOWEL SIGN VOCALIC LL\r
+0966..096F ; output # [10] (०..९) DEVANAGARI DIGIT ZERO..DEVANAGARI DIGIT NINE\r
+0981..0983 ; output # [3] (ঁ..ঃ) BENGALI SIGN CANDRABINDU..BENGALI SIGN VISARGA\r
+0985..098C ; output # [8] (অ..ঌ) BENGALI LETTER A..BENGALI LETTER VOCALIC L\r
+098F..0990 ; output # [2] (এ..ঐ) BENGALI LETTER E..BENGALI LETTER AI\r
+0993..09A8 ; output # [22] (ও..ন) BENGALI LETTER O..BENGALI LETTER NA\r
+09AA..09B0 ; output # [7] (প..র) BENGALI LETTER PA..BENGALI LETTER RA\r
+09B2 ; output # (ল) BENGALI LETTER LA\r
+09B6..09B9 ; output # [4] (শ..হ) BENGALI LETTER SHA..BENGALI LETTER HA\r
+09BC ; output # (়) BENGALI SIGN NUKTA\r
+09BE..09C4 ; output # [7] (া..ৄ) BENGALI VOWEL SIGN AA..BENGALI VOWEL SIGN VOCALIC RR\r
+09C7..09C8 ; output # [2] (ে..ৈ) BENGALI VOWEL SIGN E..BENGALI VOWEL SIGN AI\r
+09CB..09CD ; output # [3] (ো..্) BENGALI VOWEL SIGN O..BENGALI SIGN VIRAMA\r
+09D7 ; output # (ৗ) BENGALI AU LENGTH MARK\r
+09E0..09E3 ; output # [4] (ৠ..ৣ) BENGALI LETTER VOCALIC RR..BENGALI VOWEL SIGN VOCALIC LL\r
+09E6..09F1 ; output # [12] (০..ৱ) BENGALI DIGIT ZERO..BENGALI LETTER RA WITH LOWER DIAGONAL\r
+0A02 ; output # (ਂ) GURMUKHI SIGN BINDI\r
+0A05..0A0A ; output # [6] (ਅ..ਊ) GURMUKHI LETTER A..GURMUKHI LETTER UU\r
+0A0F..0A10 ; output # [2] (ਏ..ਐ) GURMUKHI LETTER EE..GURMUKHI LETTER AI\r
+0A13..0A28 ; output # [22] (ਓ..ਨ) GURMUKHI LETTER OO..GURMUKHI LETTER NA\r
+0A2A..0A30 ; output # [7] (ਪ..ਰ) GURMUKHI LETTER PA..GURMUKHI LETTER RA\r
+0A32 ; output # (ਲ) GURMUKHI LETTER LA\r
+0A35 ; output # (ਵ) GURMUKHI LETTER VA\r
+0A38..0A39 ; output # [2] (ਸ..ਹ) GURMUKHI LETTER SA..GURMUKHI LETTER HA\r
+0A3C ; output # (਼) GURMUKHI SIGN NUKTA\r
+0A3E..0A42 ; output # [5] (ਾ..ੂ) GURMUKHI VOWEL SIGN AA..GURMUKHI VOWEL SIGN UU\r
+0A47..0A48 ; output # [2] (ੇ..ੈ) GURMUKHI VOWEL SIGN EE..GURMUKHI VOWEL SIGN AI\r
+0A4B..0A4D ; output # [3] (ੋ..੍) GURMUKHI VOWEL SIGN OO..GURMUKHI SIGN VIRAMA\r
+0A5C ; output # (ੜ) GURMUKHI LETTER RRA\r
+0A66..0A74 ; output # [15] (੦..ੴ) GURMUKHI DIGIT ZERO..GURMUKHI EK ONKAR\r
+0A81..0A83 ; output # [3] (ઁ..ઃ) GUJARATI SIGN CANDRABINDU..GUJARATI SIGN VISARGA\r
+0A85..0A8B ; output # [7] (અ..ઋ) GUJARATI LETTER A..GUJARATI LETTER VOCALIC R\r
+0A8D ; output # (ઍ) GUJARATI VOWEL CANDRA E\r
+0A8F..0A91 ; output # [3] (એ..ઑ) GUJARATI LETTER E..GUJARATI VOWEL CANDRA O\r
+0A93..0AA8 ; output # [22] (ઓ..ન) GUJARATI LETTER O..GUJARATI LETTER NA\r
+0AAA..0AB0 ; output # [7] (પ..ર) GUJARATI LETTER PA..GUJARATI LETTER RA\r
+0AB2..0AB3 ; output # [2] (લ..ળ) GUJARATI LETTER LA..GUJARATI LETTER LLA\r
+0AB5..0AB9 ; output # [5] (વ..હ) GUJARATI LETTER VA..GUJARATI LETTER HA\r
+0ABC..0AC5 ; output # [10] (઼..ૅ) GUJARATI SIGN NUKTA..GUJARATI VOWEL SIGN CANDRA E\r
+0AC7..0AC9 ; output # [3] (ે..ૉ) GUJARATI VOWEL SIGN E..GUJARATI VOWEL SIGN CANDRA O\r
+0ACB..0ACD ; output # [3] (ો..્) GUJARATI VOWEL SIGN O..GUJARATI SIGN VIRAMA\r
+0AD0 ; output # (ૐ) GUJARATI OM\r
+0AE0 ; output # (ૠ) GUJARATI LETTER VOCALIC RR\r
+0AE6..0AEF ; output # [10] (૦..૯) GUJARATI DIGIT ZERO..GUJARATI DIGIT NINE\r
+0B01..0B03 ; output # [3] (ଁ..ଃ) ORIYA SIGN CANDRABINDU..ORIYA SIGN VISARGA\r
+0B05..0B0C ; output # [8] (ଅ..ଌ) ORIYA LETTER A..ORIYA LETTER VOCALIC L\r
+0B0F..0B10 ; output # [2] (ଏ..ଐ) ORIYA LETTER E..ORIYA LETTER AI\r
+0B13..0B28 ; output # [22] (ଓ..ନ) ORIYA LETTER O..ORIYA LETTER NA\r
+0B2A..0B30 ; output # [7] (ପ..ର) ORIYA LETTER PA..ORIYA LETTER RA\r
+0B32..0B33 ; output # [2] (ଲ..ଳ) ORIYA LETTER LA..ORIYA LETTER LLA\r
+0B36..0B39 ; output # [4] (ଶ..ହ) ORIYA LETTER SHA..ORIYA LETTER HA\r
+0B3C..0B43 ; output # [8] (଼..ୃ) ORIYA SIGN NUKTA..ORIYA VOWEL SIGN VOCALIC R\r
+0B47..0B48 ; output # [2] (େ..ୈ) ORIYA VOWEL SIGN E..ORIYA VOWEL SIGN AI\r
+0B4B..0B4D ; output # [3] (ୋ..୍) ORIYA VOWEL SIGN O..ORIYA SIGN VIRAMA\r
+0B56..0B57 ; output # [2] (ୖ..ୗ) ORIYA AI LENGTH MARK..ORIYA AU LENGTH MARK\r
+0B5F..0B61 ; output # [3] (ୟ..ୡ) ORIYA LETTER YYA..ORIYA LETTER VOCALIC LL\r
+0B66..0B6F ; output # [10] (୦..୯) ORIYA DIGIT ZERO..ORIYA DIGIT NINE\r
+0B82..0B83 ; output # [2] (ஂ..ஃ) TAMIL SIGN ANUSVARA..TAMIL SIGN VISARGA\r
+0B85..0B8A ; output # [6] (அ..ஊ) TAMIL LETTER A..TAMIL LETTER UU\r
+0B8E..0B90 ; output # [3] (எ..ஐ) TAMIL LETTER E..TAMIL LETTER AI\r
+0B92..0B95 ; output # [4] (ஒ..க) TAMIL LETTER O..TAMIL LETTER KA\r
+0B99..0B9A ; output # [2] (ங..ச) TAMIL LETTER NGA..TAMIL LETTER CA\r
+0B9C ; output # (ஜ) TAMIL LETTER JA\r
+0B9E..0B9F ; output # [2] (ஞ..ட) TAMIL LETTER NYA..TAMIL LETTER TTA\r
+0BA3..0BA4 ; output # [2] (ண..த) TAMIL LETTER NNA..TAMIL LETTER TA\r
+0BA8..0BAA ; output # [3] (ந..ப) TAMIL LETTER NA..TAMIL LETTER PA\r
+0BAE..0BB5 ; output # [8] (ம..வ) TAMIL LETTER MA..TAMIL LETTER VA\r
+0BB7..0BB9 ; output # [3] (ஷ..ஹ) TAMIL LETTER SSA..TAMIL LETTER HA\r
+0BBE..0BC2 ; output # [5] (ா..ூ) TAMIL VOWEL SIGN AA..TAMIL VOWEL SIGN UU\r
+0BC6..0BC8 ; output # [3] (ெ..ை) TAMIL VOWEL SIGN E..TAMIL VOWEL SIGN AI\r
+0BCA..0BCD ; output # [4] (ொ..்) TAMIL VOWEL SIGN O..TAMIL SIGN VIRAMA\r
+0BD7 ; output # (ௗ) TAMIL AU LENGTH MARK\r
+0BE7..0BEF ; output # [9] (௧..௯) TAMIL DIGIT ONE..TAMIL DIGIT NINE\r
+0C01..0C03 ; output # [3] (ఁ..ః) TELUGU SIGN CANDRABINDU..TELUGU SIGN VISARGA\r
+0C05..0C0C ; output # [8] (అ..ఌ) TELUGU LETTER A..TELUGU LETTER VOCALIC L\r
+0C0E..0C10 ; output # [3] (ఎ..ఐ) TELUGU LETTER E..TELUGU LETTER AI\r
+0C12..0C28 ; output # [23] (ఒ..న) TELUGU LETTER O..TELUGU LETTER NA\r
+0C2A..0C33 ; output # [10] (ప..ళ) TELUGU LETTER PA..TELUGU LETTER LLA\r
+0C35..0C39 ; output # [5] (వ..హ) TELUGU LETTER VA..TELUGU LETTER HA\r
+0C3E..0C44 ; output # [7] (ా..ౄ) TELUGU VOWEL SIGN AA..TELUGU VOWEL SIGN VOCALIC RR\r
+0C46..0C48 ; output # [3] (ె..ై) TELUGU VOWEL SIGN E..TELUGU VOWEL SIGN AI\r
+0C4A..0C4D ; output # [4] (ొ..్) TELUGU VOWEL SIGN O..TELUGU SIGN VIRAMA\r
+0C55..0C56 ; output # [2] (ౕ..ౖ) TELUGU LENGTH MARK..TELUGU AI LENGTH MARK\r
+0C60..0C61 ; output # [2] (ౠ..ౡ) TELUGU LETTER VOCALIC RR..TELUGU LETTER VOCALIC LL\r
+0C66..0C6F ; output # [10] (౦..౯) TELUGU DIGIT ZERO..TELUGU DIGIT NINE\r
+0C82..0C83 ; output # [2] (ಂ..ಃ) KANNADA SIGN ANUSVARA..KANNADA SIGN VISARGA\r
+0C85..0C8C ; output # [8] (ಅ..ಌ) KANNADA LETTER A..KANNADA LETTER VOCALIC L\r
+0C8E..0C90 ; output # [3] (ಎ..ಐ) KANNADA LETTER E..KANNADA LETTER AI\r
+0C92..0CA8 ; output # [23] (ಒ..ನ) KANNADA LETTER O..KANNADA LETTER NA\r
+0CAA..0CB3 ; output # [10] (ಪ..ಳ) KANNADA LETTER PA..KANNADA LETTER LLA\r
+0CB5..0CB9 ; output # [5] (ವ..ಹ) KANNADA LETTER VA..KANNADA LETTER HA\r
+0CBE..0CC4 ; output # [7] (ಾ..ೄ) KANNADA VOWEL SIGN AA..KANNADA VOWEL SIGN VOCALIC RR\r
+0CC6..0CC8 ; output # [3] (ೆ..ೈ) KANNADA VOWEL SIGN E..KANNADA VOWEL SIGN AI\r
+0CCA..0CCD ; output # [4] (ೊ..್) KANNADA VOWEL SIGN O..KANNADA SIGN VIRAMA\r
+0CD5..0CD6 ; output # [2] (ೕ..ೖ) KANNADA LENGTH MARK..KANNADA AI LENGTH MARK\r
+0CE0..0CE1 ; output # [2] (ೠ..ೡ) KANNADA LETTER VOCALIC RR..KANNADA LETTER VOCALIC LL\r
+0CE6..0CEF ; output # [10] (೦..೯) KANNADA DIGIT ZERO..KANNADA DIGIT NINE\r
+0D02..0D03 ; output # [2] (ം..ഃ) MALAYALAM SIGN ANUSVARA..MALAYALAM SIGN VISARGA\r
+0D05..0D0C ; output # [8] (അ..ഌ) MALAYALAM LETTER A..MALAYALAM LETTER VOCALIC L\r
+0D0E..0D10 ; output # [3] (എ..ഐ) MALAYALAM LETTER E..MALAYALAM LETTER AI\r
+0D12..0D28 ; output # [23] (ഒ..ന) MALAYALAM LETTER O..MALAYALAM LETTER NA\r
+0D2A..0D39 ; output # [16] (പ..ഹ) MALAYALAM LETTER PA..MALAYALAM LETTER HA\r
+0D3E..0D43 ; output # [6] (ാ..ൃ) MALAYALAM VOWEL SIGN AA..MALAYALAM VOWEL SIGN VOCALIC R\r
+0D46..0D48 ; output # [3] (െ..ൈ) MALAYALAM VOWEL SIGN E..MALAYALAM VOWEL SIGN AI\r
+0D4A..0D4D ; output # [4] (ൊ..്) MALAYALAM VOWEL SIGN O..MALAYALAM SIGN VIRAMA\r
+0D57 ; output # (ൗ) MALAYALAM AU LENGTH MARK\r
+0D60..0D61 ; output # [2] (ൠ..ൡ) MALAYALAM LETTER VOCALIC RR..MALAYALAM LETTER VOCALIC LL\r
+0D66..0D6F ; output # [10] (൦..൯) MALAYALAM DIGIT ZERO..MALAYALAM DIGIT NINE\r
+0D82..0D83 ; output # [2] (ං..ඃ) SINHALA SIGN ANUSVARAYA..SINHALA SIGN VISARGAYA\r
+0D85..0D96 ; output # [18] (අ..ඖ) SINHALA LETTER AYANNA..SINHALA LETTER AUYANNA\r
+0D9A..0DB1 ; output # [24] (ක..න) SINHALA LETTER ALPAPRAANA KAYANNA..SINHALA LETTER DANTAJA NAYANNA\r
+0DB3..0DBB ; output # [9] (ඳ..ර) SINHALA LETTER SANYAKA DAYANNA..SINHALA LETTER RAYANNA\r
+0DBD ; output # (ල) SINHALA LETTER DANTAJA LAYANNA\r
+0DC0..0DC6 ; output # [7] (ව..ෆ) SINHALA LETTER VAYANNA..SINHALA LETTER FAYANNA\r
+0DCA ; output # (්) SINHALA SIGN AL-LAKUNA\r
+0DCF..0DD4 ; output # [6] (ා..ු) SINHALA VOWEL SIGN AELA-PILLA..SINHALA VOWEL SIGN KETTI PAA-PILLA\r
+0DD6 ; output # (ූ) SINHALA VOWEL SIGN DIGA PAA-PILLA\r
+0DD8..0DDF ; output # [8] (ෘ..ෟ) SINHALA VOWEL SIGN GAETTA-PILLA..SINHALA VOWEL SIGN GAYANUKITTA\r
+0DF2..0DF3 ; output # [2] (ෲ..ෳ) SINHALA VOWEL SIGN DIGA GAETTA-PILLA..SINHALA VOWEL SIGN DIGA GAYANUKITTA\r
+0E01..0E32 ; output # [50] (ก..า) THAI CHARACTER KO KAI..THAI CHARACTER SARA AA\r
+0E34..0E3A ; output # [7] (ิ..ฺ) THAI CHARACTER SARA I..THAI CHARACTER PHINTHU\r
+0E40..0E4E ; output # [15] (เ..๎) THAI CHARACTER SARA E..THAI CHARACTER YAMAKKAN\r
+0E50..0E59 ; output # [10] (๐..๙) THAI DIGIT ZERO..THAI DIGIT NINE\r
+0E81..0E82 ; output # [2] (ກ..ຂ) LAO LETTER KO..LAO LETTER KHO SUNG\r
+0E84 ; output # (ຄ) LAO LETTER KHO TAM\r
+0E87..0E88 ; output # [2] (ງ..ຈ) LAO LETTER NGO..LAO LETTER CO\r
+0E8A ; output # (ຊ) LAO LETTER SO TAM\r
+0E8D ; output # (ຍ) LAO LETTER NYO\r
+0E94..0E97 ; output # [4] (ດ..ທ) LAO LETTER DO..LAO LETTER THO TAM\r
+0E99..0E9F ; output # [7] (ນ..ຟ) LAO LETTER NO..LAO LETTER FO SUNG\r
+0EA1..0EA3 ; output # [3] (ມ..ຣ) LAO LETTER MO..LAO LETTER LO LING\r
+0EA5 ; output # (ລ) LAO LETTER LO LOOT\r
+0EA7 ; output # (ວ) LAO LETTER WO\r
+0EAA..0EAB ; output # [2] (ສ..ຫ) LAO LETTER SO SUNG..LAO LETTER HO SUNG\r
+0EAD..0EB2 ; output # [6] (ອ..າ) LAO LETTER O..LAO VOWEL SIGN AA\r
+0EB4..0EB9 ; output # [6] (ິ..ູ) LAO VOWEL SIGN I..LAO VOWEL SIGN UU\r
+0EBB..0EBD ; output # [3] (ົ..ຽ) LAO VOWEL SIGN MAI KON..LAO SEMIVOWEL SIGN NYO\r
+0EC0..0EC4 ; output # [5] (ເ..ໄ) LAO VOWEL SIGN E..LAO VOWEL SIGN AI\r
+0EC6 ; output # (ໆ) LAO KO LA\r
+0EC8..0ECD ; output # [6] (່..ໍ) LAO TONE MAI EK..LAO NIGGAHITA\r
+0ED0..0ED9 ; output # [10] (໐..໙) LAO DIGIT ZERO..LAO DIGIT NINE\r
+0F00 ; output # (ༀ) TIBETAN SYLLABLE OM\r
+0F18..0F19 ; output # [2] (༘..༙) TIBETAN ASTROLOGICAL SIGN -KHYUD PA..TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS\r
+0F20..0F29 ; output # [10] (༠..༩) TIBETAN DIGIT ZERO..TIBETAN DIGIT NINE\r
+0F35 ; output # (༵) TIBETAN MARK NGAS BZUNG NYI ZLA\r
+0F37 ; output # (༷) TIBETAN MARK NGAS BZUNG SGOR RTAGS\r
+0F39 ; output # (༹) TIBETAN MARK TSA -PHRU\r
+0F3E..0F42 ; output # [5] (༾..ག) TIBETAN SIGN YAR TSHES..TIBETAN LETTER GA\r
+0F44..0F47 ; output # [4] (ང..ཇ) TIBETAN LETTER NGA..TIBETAN LETTER JA\r
+0F49..0F4C ; output # [4] (ཉ..ཌ) TIBETAN LETTER NYA..TIBETAN LETTER DDA\r
+0F4E..0F51 ; output # [4] (ཎ..ད) TIBETAN LETTER NNA..TIBETAN LETTER DA\r
+0F53..0F56 ; output # [4] (ན..བ) TIBETAN LETTER NA..TIBETAN LETTER BA\r
+0F58..0F5B ; output # [4] (མ..ཛ) TIBETAN LETTER MA..TIBETAN LETTER DZA\r
+0F5D..0F68 ; output # [12] (ཝ..ཨ) TIBETAN LETTER WA..TIBETAN LETTER A\r
+0F6A ; output # (ཪ) TIBETAN LETTER FIXED-FORM RA\r
+0F71..0F72 ; output # [2] (ཱ..ི) TIBETAN VOWEL SIGN AA..TIBETAN VOWEL SIGN I\r
+0F74 ; output # (ུ) TIBETAN VOWEL SIGN U\r
+0F7A..0F80 ; output # [7] (ེ..ྀ) TIBETAN VOWEL SIGN E..TIBETAN VOWEL SIGN REVERSED I\r
+0F82..0F84 ; output # [3] (ྂ..྄) TIBETAN SIGN NYI ZLA NAA DA..TIBETAN MARK HALANTA\r
+0F86..0F8B ; output # [6] (྆..ྋ) TIBETAN SIGN LCI RTAGS..TIBETAN SIGN GRU MED RGYINGS\r
+0F90..0F92 ; output # [3] (ྐ..ྒ) TIBETAN SUBJOINED LETTER KA..TIBETAN SUBJOINED LETTER GA\r
+0F94..0F97 ; output # [4] (ྔ..ྗ) TIBETAN SUBJOINED LETTER NGA..TIBETAN SUBJOINED LETTER JA\r
+0F99..0F9C ; output # [4] (ྙ..ྜ) TIBETAN SUBJOINED LETTER NYA..TIBETAN SUBJOINED LETTER DDA\r
+0F9E..0FA1 ; output # [4] (ྞ..ྡ) TIBETAN SUBJOINED LETTER NNA..TIBETAN SUBJOINED LETTER DA\r
+0FA3..0FA6 ; output # [4] (ྣ..ྦ) TIBETAN SUBJOINED LETTER NA..TIBETAN SUBJOINED LETTER BA\r
+0FA8..0FAB ; output # [4] (ྨ..ྫ) TIBETAN SUBJOINED LETTER MA..TIBETAN SUBJOINED LETTER DZA\r
+0FAD..0FB8 ; output # [12] (ྭ..ྸ) TIBETAN SUBJOINED LETTER WA..TIBETAN SUBJOINED LETTER A\r
+0FBA..0FBC ; output # [3] (ྺ..ྼ) TIBETAN SUBJOINED LETTER FIXED-FORM WA..TIBETAN SUBJOINED LETTER FIXED-FORM RA\r
+0FC6 ; output # (࿆) TIBETAN SYMBOL PADMA GDAN\r
+1000..1021 ; output # [34] (က..အ) MYANMAR LETTER KA..MYANMAR LETTER A\r
+1023..1027 ; output # [5] (ဣ..ဧ) MYANMAR LETTER I..MYANMAR LETTER E\r
+1029..102A ; output # [2] (ဩ..ဪ) MYANMAR LETTER O..MYANMAR LETTER AU\r
+102C..1032 ; output # [7] (ာ..ဲ) MYANMAR VOWEL SIGN AA..MYANMAR VOWEL SIGN AI\r
+1036..1039 ; output # [4] (ံ..္) MYANMAR SIGN ANUSVARA..MYANMAR SIGN VIRAMA\r
+1040..1049 ; output # [10] (၀..၉) MYANMAR DIGIT ZERO..MYANMAR DIGIT NINE\r
+1050..1059 ; output # [10] (ၐ..ၙ) MYANMAR LETTER SHA..MYANMAR VOWEL SIGN VOCALIC LL\r
+10A0..10C5 ; output # [38] (Ⴀ..Ⴥ) GEORGIAN CAPITAL LETTER AN..GEORGIAN CAPITAL LETTER HOE\r
+10D0..10F0 ; output # [33] (ა..ჰ) GEORGIAN LETTER AN..GEORGIAN LETTER HAE\r
+10F7..10F8 ; output # [2] (ჷ..ჸ) GEORGIAN LETTER YN..GEORGIAN LETTER ELIFI\r
+1200..1206 ; output # [7] (ሀ..ሆ) ETHIOPIC SYLLABLE HA..ETHIOPIC SYLLABLE HO\r
+1208..1246 ; output # [63] (ለ..ቆ) ETHIOPIC SYLLABLE LA..ETHIOPIC SYLLABLE QO\r
+1248 ; output # (ቈ) ETHIOPIC SYLLABLE QWA\r
+124A..124D ; output # [4] (ቊ..ቍ) ETHIOPIC SYLLABLE QWI..ETHIOPIC SYLLABLE QWE\r
+1250..1256 ; output # [7] (ቐ..ቖ) ETHIOPIC SYLLABLE QHA..ETHIOPIC SYLLABLE QHO\r
+1258 ; output # (ቘ) ETHIOPIC SYLLABLE QHWA\r
+125A..125D ; output # [4] (ቚ..ቝ) ETHIOPIC SYLLABLE QHWI..ETHIOPIC SYLLABLE QHWE\r
+1260..1286 ; output # [39] (በ..ኆ) ETHIOPIC SYLLABLE BA..ETHIOPIC SYLLABLE XO\r
+1288 ; output # (ኈ) ETHIOPIC SYLLABLE XWA\r
+128A..128D ; output # [4] (ኊ..ኍ) ETHIOPIC SYLLABLE XWI..ETHIOPIC SYLLABLE XWE\r
+1290..12AE ; output # [31] (ነ..ኮ) ETHIOPIC SYLLABLE NA..ETHIOPIC SYLLABLE KO\r
+12B0 ; output # (ኰ) ETHIOPIC SYLLABLE KWA\r
+12B2..12B5 ; output # [4] (ኲ..ኵ) ETHIOPIC SYLLABLE KWI..ETHIOPIC SYLLABLE KWE\r
+12B8..12BE ; output # [7] (ኸ..ኾ) ETHIOPIC SYLLABLE KXA..ETHIOPIC SYLLABLE KXO\r
+12C0 ; output # (ዀ) ETHIOPIC SYLLABLE KXWA\r
+12C2..12C5 ; output # [4] (ዂ..ዅ) ETHIOPIC SYLLABLE KXWI..ETHIOPIC SYLLABLE KXWE\r
+12C8..12CE ; output # [7] (ወ..ዎ) ETHIOPIC SYLLABLE WA..ETHIOPIC SYLLABLE WO\r
+12D0..12D6 ; output # [7] (ዐ..ዖ) ETHIOPIC SYLLABLE PHARYNGEAL A..ETHIOPIC SYLLABLE PHARYNGEAL O\r
+12D8..12EE ; output # [23] (ዘ..ዮ) ETHIOPIC SYLLABLE ZA..ETHIOPIC SYLLABLE YO\r
+12F0..130E ; output # [31] (ደ..ጎ) ETHIOPIC SYLLABLE DA..ETHIOPIC SYLLABLE GO\r
+1310 ; output # (ጐ) ETHIOPIC SYLLABLE GWA\r
+1312..1315 ; output # [4] (ጒ..ጕ) ETHIOPIC SYLLABLE GWI..ETHIOPIC SYLLABLE GWE\r
+1318..131E ; output # [7] (ጘ..ጞ) ETHIOPIC SYLLABLE GGA..ETHIOPIC SYLLABLE GGO\r
+1320..1346 ; output # [39] (ጠ..ፆ) ETHIOPIC SYLLABLE THA..ETHIOPIC SYLLABLE TZO\r
+1348..135A ; output # [19] (ፈ..ፚ) ETHIOPIC SYLLABLE FA..ETHIOPIC SYLLABLE FYA\r
+1369..1371 ; output # [9] (፩..፱) ETHIOPIC DIGIT ONE..ETHIOPIC DIGIT NINE\r
+13A0..13F4 ; output # [85] (Ꭰ..Ᏼ) CHEROKEE LETTER A..CHEROKEE LETTER YV\r
+1401..166C ; output # [620] (ᐁ..ᙬ) CANADIAN SYLLABICS E..CANADIAN SYLLABICS CARRIER TTSA\r
+166F..1676 ; output # [8] (ᙯ..ᙶ) CANADIAN SYLLABICS QAI..CANADIAN SYLLABICS NNGAA\r
+1780..17A2 ; output # [35] (ក..អ) KHMER LETTER KA..KHMER LETTER QA\r
+17A5..17A7 ; output # [3] (ឥ..ឧ) KHMER INDEPENDENT VOWEL QI..KHMER INDEPENDENT VOWEL QU\r
+17A9..17B3 ; output # [11] (ឩ..ឳ) KHMER INDEPENDENT VOWEL QUU..KHMER INDEPENDENT VOWEL QAU\r
+17B6..17D0 ; output # [27] (ា..័) KHMER VOWEL SIGN AA..KHMER SIGN SAMYOK SANNYA\r
+17D2 ; output # (្) KHMER SIGN COENG\r
+17D7 ; output # (ៗ) KHMER SIGN LEK TOO\r
+17DC ; output # (ៜ) KHMER SIGN AVAKRAHASANYA\r
+17E0..17E9 ; output # [10] (០..៩) KHMER DIGIT ZERO..KHMER DIGIT NINE\r
+1810..1819 ; output # [10] (᠐..᠙) MONGOLIAN DIGIT ZERO..MONGOLIAN DIGIT NINE\r
+1820..1877 ; output # [88] (ᠠ..ᡷ) MONGOLIAN LETTER A..MONGOLIAN LETTER MANCHU ZHA\r
+1880..18A9 ; output # [42] (ᢀ..ᢩ) MONGOLIAN LETTER ALI GALI ANUSVARA ONE..MONGOLIAN LETTER ALI GALI DAGALGA\r
+1E01 ; output # (ḁ) LATIN SMALL LETTER A WITH RING BELOW\r
+1E03 ; output # (ḃ) LATIN SMALL LETTER B WITH DOT ABOVE\r
+1E05 ; output # (ḅ) LATIN SMALL LETTER B WITH DOT BELOW\r
+1E07 ; output # (ḇ) LATIN SMALL LETTER B WITH LINE BELOW\r
+1E09 ; output # (ḉ) LATIN SMALL LETTER C WITH CEDILLA AND ACUTE\r
+1E0B ; output # (ḋ) LATIN SMALL LETTER D WITH DOT ABOVE\r
+1E0D ; output # (ḍ) LATIN SMALL LETTER D WITH DOT BELOW\r
+1E0F ; output # (ḏ) LATIN SMALL LETTER D WITH LINE BELOW\r
+1E11 ; output # (ḑ) LATIN SMALL LETTER D WITH CEDILLA\r
+1E13 ; output # (ḓ) LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW\r
+1E15 ; output # (ḕ) LATIN SMALL LETTER E WITH MACRON AND GRAVE\r
+1E17 ; output # (ḗ) LATIN SMALL LETTER E WITH MACRON AND ACUTE\r
+1E19 ; output # (ḙ) LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW\r
+1E1B ; output # (ḛ) LATIN SMALL LETTER E WITH TILDE BELOW\r
+1E1D ; output # (ḝ) LATIN SMALL LETTER E WITH CEDILLA AND BREVE\r
+1E1F ; output # (ḟ) LATIN SMALL LETTER F WITH DOT ABOVE\r
+1E21 ; output # (ḡ) LATIN SMALL LETTER G WITH MACRON\r
+1E23 ; output # (ḣ) LATIN SMALL LETTER H WITH DOT ABOVE\r
+1E25 ; output # (ḥ) LATIN SMALL LETTER H WITH DOT BELOW\r
+1E27 ; output # (ḧ) LATIN SMALL LETTER H WITH DIAERESIS\r
+1E29 ; output # (ḩ) LATIN SMALL LETTER H WITH CEDILLA\r
+1E2B ; output # (ḫ) LATIN SMALL LETTER H WITH BREVE BELOW\r
+1E2D ; output # (ḭ) LATIN SMALL LETTER I WITH TILDE BELOW\r
+1E2F ; output # (ḯ) LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE\r
+1E31 ; output # (ḱ) LATIN SMALL LETTER K WITH ACUTE\r
+1E33 ; output # (ḳ) LATIN SMALL LETTER K WITH DOT BELOW\r
+1E35 ; output # (ḵ) LATIN SMALL LETTER K WITH LINE BELOW\r
+1E37 ; output # (ḷ) LATIN SMALL LETTER L WITH DOT BELOW\r
+1E39 ; output # (ḹ) LATIN SMALL LETTER L WITH DOT BELOW AND MACRON\r
+1E3B ; output # (ḻ) LATIN SMALL LETTER L WITH LINE BELOW\r
+1E3D ; output # (ḽ) LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW\r
+1E3F ; output # (ḿ) LATIN SMALL LETTER M WITH ACUTE\r
+1E41 ; output # (ṁ) LATIN SMALL LETTER M WITH DOT ABOVE\r
+1E43 ; output # (ṃ) LATIN SMALL LETTER M WITH DOT BELOW\r
+1E45 ; output # (ṅ) LATIN SMALL LETTER N WITH DOT ABOVE\r
+1E47 ; output # (ṇ) LATIN SMALL LETTER N WITH DOT BELOW\r
+1E49 ; output # (ṉ) LATIN SMALL LETTER N WITH LINE BELOW\r
+1E4B ; output # (ṋ) LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW\r
+1E4D ; output # (ṍ) LATIN SMALL LETTER O WITH TILDE AND ACUTE\r
+1E4F ; output # (ṏ) LATIN SMALL LETTER O WITH TILDE AND DIAERESIS\r
+1E51 ; output # (ṑ) LATIN SMALL LETTER O WITH MACRON AND GRAVE\r
+1E53 ; output # (ṓ) LATIN SMALL LETTER O WITH MACRON AND ACUTE\r
+1E55 ; output # (ṕ) LATIN SMALL LETTER P WITH ACUTE\r
+1E57 ; output # (ṗ) LATIN SMALL LETTER P WITH DOT ABOVE\r
+1E59 ; output # (ṙ) LATIN SMALL LETTER R WITH DOT ABOVE\r
+1E5B ; output # (ṛ) LATIN SMALL LETTER R WITH DOT BELOW\r
+1E5D ; output # (ṝ) LATIN SMALL LETTER R WITH DOT BELOW AND MACRON\r
+1E5F ; output # (ṟ) LATIN SMALL LETTER R WITH LINE BELOW\r
+1E61 ; output # (ṡ) LATIN SMALL LETTER S WITH DOT ABOVE\r
+1E63 ; output # (ṣ) LATIN SMALL LETTER S WITH DOT BELOW\r
+1E65 ; output # (ṥ) LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE\r
+1E67 ; output # (ṧ) LATIN SMALL LETTER S WITH CARON AND DOT ABOVE\r
+1E69 ; output # (ṩ) LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE\r
+1E6B ; output # (ṫ) LATIN SMALL LETTER T WITH DOT ABOVE\r
+1E6D ; output # (ṭ) LATIN SMALL LETTER T WITH DOT BELOW\r
+1E6F ; output # (ṯ) LATIN SMALL LETTER T WITH LINE BELOW\r
+1E71 ; output # (ṱ) LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW\r
+1E73 ; output # (ṳ) LATIN SMALL LETTER U WITH DIAERESIS BELOW\r
+1E75 ; output # (ṵ) LATIN SMALL LETTER U WITH TILDE BELOW\r
+1E77 ; output # (ṷ) LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW\r
+1E79 ; output # (ṹ) LATIN SMALL LETTER U WITH TILDE AND ACUTE\r
+1E7B ; output # (ṻ) LATIN SMALL LETTER U WITH MACRON AND DIAERESIS\r
+1E7D ; output # (ṽ) LATIN SMALL LETTER V WITH TILDE\r
+1E7F ; output # (ṿ) LATIN SMALL LETTER V WITH DOT BELOW\r
+1E81 ; output # (ẁ) LATIN SMALL LETTER W WITH GRAVE\r
+1E83 ; output # (ẃ) LATIN SMALL LETTER W WITH ACUTE\r
+1E85 ; output # (ẅ) LATIN SMALL LETTER W WITH DIAERESIS\r
+1E87 ; output # (ẇ) LATIN SMALL LETTER W WITH DOT ABOVE\r
+1E89 ; output # (ẉ) LATIN SMALL LETTER W WITH DOT BELOW\r
+1E8B ; output # (ẋ) LATIN SMALL LETTER X WITH DOT ABOVE\r
+1E8D ; output # (ẍ) LATIN SMALL LETTER X WITH DIAERESIS\r
+1E8F ; output # (ẏ) LATIN SMALL LETTER Y WITH DOT ABOVE\r
+1E91 ; output # (ẑ) LATIN SMALL LETTER Z WITH CIRCUMFLEX\r
+1E93 ; output # (ẓ) LATIN SMALL LETTER Z WITH DOT BELOW\r
+1E95..1E99 ; output # [5] (ẕ..ẙ) LATIN SMALL LETTER Z WITH LINE BELOW..LATIN SMALL LETTER Y WITH RING ABOVE\r
+1EA1 ; output # (ạ) LATIN SMALL LETTER A WITH DOT BELOW\r
+1EA3 ; output # (ả) LATIN SMALL LETTER A WITH HOOK ABOVE\r
+1EA5 ; output # (ấ) LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE\r
+1EA7 ; output # (ầ) LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE\r
+1EA9 ; output # (ẩ) LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE\r
+1EAB ; output # (ẫ) LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE\r
+1EAD ; output # (ậ) LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW\r
+1EAF ; output # (ắ) LATIN SMALL LETTER A WITH BREVE AND ACUTE\r
+1EB1 ; output # (ằ) LATIN SMALL LETTER A WITH BREVE AND GRAVE\r
+1EB3 ; output # (ẳ) LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE\r
+1EB5 ; output # (ẵ) LATIN SMALL LETTER A WITH BREVE AND TILDE\r
+1EB7 ; output # (ặ) LATIN SMALL LETTER A WITH BREVE AND DOT BELOW\r
+1EB9 ; output # (ẹ) LATIN SMALL LETTER E WITH DOT BELOW\r
+1EBB ; output # (ẻ) LATIN SMALL LETTER E WITH HOOK ABOVE\r
+1EBD ; output # (ẽ) LATIN SMALL LETTER E WITH TILDE\r
+1EBF ; output # (ế) LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE\r
+1EC1 ; output # (ề) LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE\r
+1EC3 ; output # (ể) LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE\r
+1EC5 ; output # (ễ) LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE\r
+1EC7 ; output # (ệ) LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW\r
+1EC9 ; output # (ỉ) LATIN SMALL LETTER I WITH HOOK ABOVE\r
+1ECB ; output # (ị) LATIN SMALL LETTER I WITH DOT BELOW\r
+1ECD ; output # (ọ) LATIN SMALL LETTER O WITH DOT BELOW\r
+1ECF ; output # (ỏ) LATIN SMALL LETTER O WITH HOOK ABOVE\r
+1ED1 ; output # (ố) LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE\r
+1ED3 ; output # (ồ) LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE\r
+1ED5 ; output # (ổ) LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE\r
+1ED7 ; output # (ỗ) LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE\r
+1ED9 ; output # (ộ) LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW\r
+1EDB ; output # (ớ) LATIN SMALL LETTER O WITH HORN AND ACUTE\r
+1EDD ; output # (ờ) LATIN SMALL LETTER O WITH HORN AND GRAVE\r
+1EDF ; output # (ở) LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE\r
+1EE1 ; output # (ỡ) LATIN SMALL LETTER O WITH HORN AND TILDE\r
+1EE3 ; output # (ợ) LATIN SMALL LETTER O WITH HORN AND DOT BELOW\r
+1EE5 ; output # (ụ) LATIN SMALL LETTER U WITH DOT BELOW\r
+1EE7 ; output # (ủ) LATIN SMALL LETTER U WITH HOOK ABOVE\r
+1EE9 ; output # (ứ) LATIN SMALL LETTER U WITH HORN AND ACUTE\r
+1EEB ; output # (ừ) LATIN SMALL LETTER U WITH HORN AND GRAVE\r
+1EED ; output # (ử) LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE\r
+1EEF ; output # (ữ) LATIN SMALL LETTER U WITH HORN AND TILDE\r
+1EF1 ; output # (ự) LATIN SMALL LETTER U WITH HORN AND DOT BELOW\r
+1EF3 ; output # (ỳ) LATIN SMALL LETTER Y WITH GRAVE\r
+1EF5 ; output # (ỵ) LATIN SMALL LETTER Y WITH DOT BELOW\r
+1EF7 ; output # (ỷ) LATIN SMALL LETTER Y WITH HOOK ABOVE\r
+1EF9 ; output # (ỹ) LATIN SMALL LETTER Y WITH TILDE\r
+1F00..1F07 ; output # [8] (ἀ..ἇ) GREEK SMALL LETTER ALPHA WITH PSILI..GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI\r
+1F10..1F15 ; output # [6] (ἐ..ἕ) GREEK SMALL LETTER EPSILON WITH PSILI..GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA\r
+1F20..1F27 ; output # [8] (ἠ..ἧ) GREEK SMALL LETTER ETA WITH PSILI..GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI\r
+1F30..1F37 ; output # [8] (ἰ..ἷ) GREEK SMALL LETTER IOTA WITH PSILI..GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI\r
+1F40..1F45 ; output # [6] (ὀ..ὅ) GREEK SMALL LETTER OMICRON WITH PSILI..GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA\r
+1F50..1F57 ; output # [8] (ὐ..ὗ) GREEK SMALL LETTER UPSILON WITH PSILI..GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI\r
+1F60..1F67 ; output # [8] (ὠ..ὧ) GREEK SMALL LETTER OMEGA WITH PSILI..GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI\r
+1F70 ; output # (ὰ) GREEK SMALL LETTER ALPHA WITH VARIA\r
+1F72 ; output # (ὲ) GREEK SMALL LETTER EPSILON WITH VARIA\r
+1F74 ; output # (ὴ) GREEK SMALL LETTER ETA WITH VARIA\r
+1F76 ; output # (ὶ) GREEK SMALL LETTER IOTA WITH VARIA\r
+1F78 ; output # (ὸ) GREEK SMALL LETTER OMICRON WITH VARIA\r
+1F7A ; output # (ὺ) GREEK SMALL LETTER UPSILON WITH VARIA\r
+1F7C ; output # (ὼ) GREEK SMALL LETTER OMEGA WITH VARIA\r
+1FB0..1FB1 ; output # [2] (ᾰ..ᾱ) GREEK SMALL LETTER ALPHA WITH VRACHY..GREEK SMALL LETTER ALPHA WITH MACRON\r
+1FB6 ; output # (ᾶ) GREEK SMALL LETTER ALPHA WITH PERISPOMENI\r
+1FC6 ; output # (ῆ) GREEK SMALL LETTER ETA WITH PERISPOMENI\r
+1FD0..1FD2 ; output # [3] (ῐ..ῒ) GREEK SMALL LETTER IOTA WITH VRACHY..GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA\r
+1FD6..1FD7 ; output # [2] (ῖ..ῗ) GREEK SMALL LETTER IOTA WITH PERISPOMENI..GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI\r
+1FE0..1FE2 ; output # [3] (ῠ..ῢ) GREEK SMALL LETTER UPSILON WITH VRACHY..GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA\r
+1FE4..1FE7 ; output # [4] (ῤ..ῧ) GREEK SMALL LETTER RHO WITH PSILI..GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI\r
+1FF6 ; output # (ῶ) GREEK SMALL LETTER OMEGA WITH PERISPOMENI\r
+2132 ; output # (Ⅎ) TURNED CAPITAL F\r
+3005..3007 ; output # [3] (々..〇) IDEOGRAPHIC ITERATION MARK..IDEOGRAPHIC NUMBER ZERO\r
+3041..3096 ; output # [86] (ぁ..ゖ) HIRAGANA LETTER SMALL A..HIRAGANA LETTER SMALL KE\r
+3099..309A ; output # [2] (゙..゚) COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK..COMBINING KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK\r
+309D..309E ; output # [2] (ゝ..ゞ) HIRAGANA ITERATION MARK..HIRAGANA VOICED ITERATION MARK\r
+30A1..30FE ; output # [94] (ァ..ヾ) KATAKANA LETTER SMALL A..KATAKANA VOICED ITERATION MARK\r
+3105..312C ; output # [40] (ㄅ..ㄬ) BOPOMOFO LETTER B..BOPOMOFO LETTER GN\r
+31A0..31B7 ; output # [24] (ㆠ..ㆷ) BOPOMOFO LETTER BU..BOPOMOFO FINAL LETTER H\r
+31F0..31FF ; output # [16] (ㇰ..ㇿ) KATAKANA LETTER SMALL KU..KATAKANA LETTER SMALL RO\r
+3447 ; output # (㑇) CJK UNIFIED IDEOGRAPH-3447\r
+3473 ; output # (㑳) CJK UNIFIED IDEOGRAPH-3473\r
+34E4 ; output # (㓤) CJK UNIFIED IDEOGRAPH-34E4\r
+3577 ; output # (㕷) CJK UNIFIED IDEOGRAPH-3577\r
+359E ; output # (㖞) CJK UNIFIED IDEOGRAPH-359E\r
+35A1 ; output # (㖡) CJK UNIFIED IDEOGRAPH-35A1\r
+35AD ; output # (㖭) CJK UNIFIED IDEOGRAPH-35AD\r
+35BF ; output # (㖿) CJK UNIFIED IDEOGRAPH-35BF\r
+35CE ; output # (㗎) CJK UNIFIED IDEOGRAPH-35CE\r
+35F3 ; output # (㗳) CJK UNIFIED IDEOGRAPH-35F3\r
+35FE ; output # (㗾) CJK UNIFIED IDEOGRAPH-35FE\r
+360E ; output # (㘎) CJK UNIFIED IDEOGRAPH-360E\r
+361A ; output # (㘚) CJK UNIFIED IDEOGRAPH-361A\r
+3918 ; output # (㤘) CJK UNIFIED IDEOGRAPH-3918\r
+3960 ; output # (㥠) CJK UNIFIED IDEOGRAPH-3960\r
+396E ; output # (㥮) CJK UNIFIED IDEOGRAPH-396E\r
+39CF..39D0 ; output # [2] (㧏..㧐) CJK UNIFIED IDEOGRAPH-39CF..CJK UNIFIED IDEOGRAPH-39D0\r
+39DF ; output # (㧟) CJK UNIFIED IDEOGRAPH-39DF\r
+39F8 ; output # (㧸) CJK UNIFIED IDEOGRAPH-39F8\r
+39FE ; output # (㧾) CJK UNIFIED IDEOGRAPH-39FE\r
+3A18 ; output # (㨘) CJK UNIFIED IDEOGRAPH-3A18\r
+3A52 ; output # (㩒) CJK UNIFIED IDEOGRAPH-3A52\r
+3A67 ; output # (㩧) CJK UNIFIED IDEOGRAPH-3A67\r
+3A73 ; output # (㩳) CJK UNIFIED IDEOGRAPH-3A73\r
+3B39 ; output # (㬹) CJK UNIFIED IDEOGRAPH-3B39\r
+3B4E ; output # (㭎) CJK UNIFIED IDEOGRAPH-3B4E\r
+3C6E ; output # (㱮) CJK UNIFIED IDEOGRAPH-3C6E\r
+3CE0 ; output # (㳠) CJK UNIFIED IDEOGRAPH-3CE0\r
+3DE7 ; output # (㷧) CJK UNIFIED IDEOGRAPH-3DE7\r
+3DEB ; output # (㷫) CJK UNIFIED IDEOGRAPH-3DEB\r
+3E74 ; output # (㹴) CJK UNIFIED IDEOGRAPH-3E74\r
+3ED0 ; output # (㻐) CJK UNIFIED IDEOGRAPH-3ED0\r
+4056 ; output # (䁖) CJK UNIFIED IDEOGRAPH-4056\r
+4065 ; output # (䁥) CJK UNIFIED IDEOGRAPH-4065\r
+406A ; output # (䁪) CJK UNIFIED IDEOGRAPH-406A\r
+40BB ; output # (䂻) CJK UNIFIED IDEOGRAPH-40BB\r
+40DF ; output # (䃟) CJK UNIFIED IDEOGRAPH-40DF\r
+4137 ; output # (䄷) CJK UNIFIED IDEOGRAPH-4137\r
+415F ; output # (䅟) CJK UNIFIED IDEOGRAPH-415F\r
+4337 ; output # (䌷) CJK UNIFIED IDEOGRAPH-4337\r
+43AC ; output # (䎬) CJK UNIFIED IDEOGRAPH-43AC\r
+43B1 ; output # (䎱) CJK UNIFIED IDEOGRAPH-43B1\r
+43DD ; output # (䏝) CJK UNIFIED IDEOGRAPH-43DD\r
+44D6 ; output # (䓖) CJK UNIFIED IDEOGRAPH-44D6\r
+44EA ; output # (䓪) CJK UNIFIED IDEOGRAPH-44EA\r
+4606 ; output # (䘆) CJK UNIFIED IDEOGRAPH-4606\r
+464C ; output # (䙌) CJK UNIFIED IDEOGRAPH-464C\r
+4661 ; output # (䙡) CJK UNIFIED IDEOGRAPH-4661\r
+4723 ; output # (䜣) CJK UNIFIED IDEOGRAPH-4723\r
+4729 ; output # (䜩) CJK UNIFIED IDEOGRAPH-4729\r
+477C ; output # (䝼) CJK UNIFIED IDEOGRAPH-477C\r
+478D ; output # (䞍) CJK UNIFIED IDEOGRAPH-478D\r
+47F4 ; output # (䟴) CJK UNIFIED IDEOGRAPH-47F4\r
+48B5 ; output # (䢵) CJK UNIFIED IDEOGRAPH-48B5\r
+48BC ; output # (䢼) CJK UNIFIED IDEOGRAPH-48BC\r
+48C5 ; output # (䣅) CJK UNIFIED IDEOGRAPH-48C5\r
+48D3 ; output # (䣓) CJK UNIFIED IDEOGRAPH-48D3\r
+4947 ; output # (䥇) CJK UNIFIED IDEOGRAPH-4947\r
+497A ; output # (䥺) CJK UNIFIED IDEOGRAPH-497A\r
+497D ; output # (䥽) CJK UNIFIED IDEOGRAPH-497D\r
+4982..4983 ; output # [2] (䦂..䦃) CJK UNIFIED IDEOGRAPH-4982..CJK UNIFIED IDEOGRAPH-4983\r
+4985..4986 ; output # [2] (䦅..䦆) CJK UNIFIED IDEOGRAPH-4985..CJK UNIFIED IDEOGRAPH-4986\r
+499B ; output # (䦛) CJK UNIFIED IDEOGRAPH-499B\r
+499F ; output # (䦟) CJK UNIFIED IDEOGRAPH-499F\r
+49B6..49B7 ; output # [2] (䦶..䦷) CJK UNIFIED IDEOGRAPH-49B6..CJK UNIFIED IDEOGRAPH-49B7\r
+49D1 ; output # (䧑) CJK UNIFIED IDEOGRAPH-49D1\r
+4A12 ; output # (䨒) CJK UNIFIED IDEOGRAPH-4A12\r
+4AB8 ; output # (䪸) CJK UNIFIED IDEOGRAPH-4AB8\r
+4C77 ; output # (䱷) CJK UNIFIED IDEOGRAPH-4C77\r
+4C7D ; output # (䱽) CJK UNIFIED IDEOGRAPH-4C7D\r
+4C81 ; output # (䲁) CJK UNIFIED IDEOGRAPH-4C81\r
+4C85 ; output # (䲅) CJK UNIFIED IDEOGRAPH-4C85\r
+4C9F..4CA3 ; output # [5] (䲟..䲣) CJK UNIFIED IDEOGRAPH-4C9F..CJK UNIFIED IDEOGRAPH-4CA3\r
+4CB3 ; output # (䲳) CJK UNIFIED IDEOGRAPH-4CB3\r
+4D08 ; output # (䴈) CJK UNIFIED IDEOGRAPH-4D08\r
+4D13..4D19 ; output # [7] (䴓..䴙) CJK UNIFIED IDEOGRAPH-4D13..CJK UNIFIED IDEOGRAPH-4D19\r
+4DAE ; output # (䶮) CJK UNIFIED IDEOGRAPH-4DAE\r
+4E00..9FA5 ; output # [20902] (一..龥) CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FA5\r
+A000..A48C ; output # [1165] (ꀀ..ꒌ) YI SYLLABLE IT..YI SYLLABLE YYR\r
+AC00..D7A3 ; output # [11172] (가..힣) HANGUL SYLLABLE GA..HANGUL SYLLABLE HIH\r
+FA0E..FA0F ; output # [2] (﨎..﨏) CJK COMPATIBILITY IDEOGRAPH-FA0E..CJK COMPATIBILITY IDEOGRAPH-FA0F\r
+FA11 ; output # (﨑) CJK COMPATIBILITY IDEOGRAPH-FA11\r
+FA13..FA14 ; output # [2] (﨓..﨔) CJK COMPATIBILITY IDEOGRAPH-FA13..CJK COMPATIBILITY IDEOGRAPH-FA14\r
+FA1F ; output # (﨟) CJK COMPATIBILITY IDEOGRAPH-FA1F\r
+FA21 ; output # (﨡) CJK COMPATIBILITY IDEOGRAPH-FA21\r
+FA23..FA24 ; output # [2] (﨣..﨤) CJK COMPATIBILITY IDEOGRAPH-FA23..CJK COMPATIBILITY IDEOGRAPH-FA24\r
+FA27..FA29 ; output # [3] (﨧..﨩) CJK COMPATIBILITY IDEOGRAPH-FA27..CJK COMPATIBILITY IDEOGRAPH-FA29\r
+2070E ; output # (𠜎) CJK UNIFIED IDEOGRAPH-2070E\r
+20731 ; output # (𠜱) CJK UNIFIED IDEOGRAPH-20731\r
+20779 ; output # (𠝹) CJK UNIFIED IDEOGRAPH-20779\r
+20C53 ; output # (𠱓) CJK UNIFIED IDEOGRAPH-20C53\r
+20C78 ; output # (𠱸) CJK UNIFIED IDEOGRAPH-20C78\r
+20C96 ; output # (𠲖) CJK UNIFIED IDEOGRAPH-20C96\r
+20CCF ; output # (𠳏) CJK UNIFIED IDEOGRAPH-20CCF\r
+20CD5 ; output # (𠳕) CJK UNIFIED IDEOGRAPH-20CD5\r
+20D15 ; output # (𠴕) CJK UNIFIED IDEOGRAPH-20D15\r
+20D7C ; output # (𠵼) CJK UNIFIED IDEOGRAPH-20D7C\r
+20D7F ; output # (𠵿) CJK UNIFIED IDEOGRAPH-20D7F\r
+20E0E..20E0F ; output # [2] (𠸎..𠸏) CJK UNIFIED IDEOGRAPH-20E0E..CJK UNIFIED IDEOGRAPH-20E0F\r
+20E77 ; output # (𠹷) CJK UNIFIED IDEOGRAPH-20E77\r
+20E9D ; output # (𠺝) CJK UNIFIED IDEOGRAPH-20E9D\r
+20EA2 ; output # (𠺢) CJK UNIFIED IDEOGRAPH-20EA2\r
+20ED7 ; output # (𠻗) CJK UNIFIED IDEOGRAPH-20ED7\r
+20EF9..20EFA ; output # [2] (𠻹..𠻺) CJK UNIFIED IDEOGRAPH-20EF9..CJK UNIFIED IDEOGRAPH-20EFA\r
+20F2D..20F2E ; output # [2] (𠼭..𠼮) CJK UNIFIED IDEOGRAPH-20F2D..CJK UNIFIED IDEOGRAPH-20F2E\r
+20F4C ; output # (𠽌) CJK UNIFIED IDEOGRAPH-20F4C\r
+20FB4 ; output # (𠾴) CJK UNIFIED IDEOGRAPH-20FB4\r
+20FBC ; output # (𠾼) CJK UNIFIED IDEOGRAPH-20FBC\r
+20FEA ; output # (𠿪) CJK UNIFIED IDEOGRAPH-20FEA\r
+2105C ; output # (𡁜) CJK UNIFIED IDEOGRAPH-2105C\r
+2106F ; output # (𡁯) CJK UNIFIED IDEOGRAPH-2106F\r
+21075..21076 ; output # [2] (𡁵..𡁶) CJK UNIFIED IDEOGRAPH-21075..CJK UNIFIED IDEOGRAPH-21076\r
+2107B ; output # (𡁻) CJK UNIFIED IDEOGRAPH-2107B\r
+210C1 ; output # (𡃁) CJK UNIFIED IDEOGRAPH-210C1\r
+210C9 ; output # (𡃉) CJK UNIFIED IDEOGRAPH-210C9\r
+211D9 ; output # (𡇙) CJK UNIFIED IDEOGRAPH-211D9\r
+220C7 ; output # (𢃇) CJK UNIFIED IDEOGRAPH-220C7\r
+227B5 ; output # (𢞵) CJK UNIFIED IDEOGRAPH-227B5\r
+22AD5 ; output # (𢫕) CJK UNIFIED IDEOGRAPH-22AD5\r
+22B43 ; output # (𢭃) CJK UNIFIED IDEOGRAPH-22B43\r
+22BCA ; output # (𢯊) CJK UNIFIED IDEOGRAPH-22BCA\r
+22C51 ; output # (𢱑) CJK UNIFIED IDEOGRAPH-22C51\r
+22C55 ; output # (𢱕) CJK UNIFIED IDEOGRAPH-22C55\r
+22CC2 ; output # (𢳂) CJK UNIFIED IDEOGRAPH-22CC2\r
+22D08 ; output # (𢴈) CJK UNIFIED IDEOGRAPH-22D08\r
+22D4C ; output # (𢵌) CJK UNIFIED IDEOGRAPH-22D4C\r
+22D67 ; output # (𢵧) CJK UNIFIED IDEOGRAPH-22D67\r
+22EB3 ; output # (𢺳) CJK UNIFIED IDEOGRAPH-22EB3\r
+23CB7 ; output # (𣲷) CJK UNIFIED IDEOGRAPH-23CB7\r
+244D3 ; output # (𤓓) CJK UNIFIED IDEOGRAPH-244D3\r
+24DB8 ; output # (𤶸) CJK UNIFIED IDEOGRAPH-24DB8\r
+24DEA ; output # (𤷪) CJK UNIFIED IDEOGRAPH-24DEA\r
+2512B ; output # (𥄫) CJK UNIFIED IDEOGRAPH-2512B\r
+26258 ; output # (𦉘) CJK UNIFIED IDEOGRAPH-26258\r
+267CC ; output # (𦟌) CJK UNIFIED IDEOGRAPH-267CC\r
+269F2 ; output # (𦧲) CJK UNIFIED IDEOGRAPH-269F2\r
+269FA ; output # (𦧺) CJK UNIFIED IDEOGRAPH-269FA\r
+27A3E ; output # (𧨾) CJK UNIFIED IDEOGRAPH-27A3E\r
+2815D ; output # (𨅝) CJK UNIFIED IDEOGRAPH-2815D\r
+28207 ; output # (𨈇) CJK UNIFIED IDEOGRAPH-28207\r
+282E2 ; output # (𨋢) CJK UNIFIED IDEOGRAPH-282E2\r
+28CCA ; output # (𨳊) CJK UNIFIED IDEOGRAPH-28CCA\r
+28CCD ; output # (𨳍) CJK UNIFIED IDEOGRAPH-28CCD\r
+28CD2 ; output # (𨳒) CJK UNIFIED IDEOGRAPH-28CD2\r
+29D98 ; output # (𩶘) CJK UNIFIED IDEOGRAPH-29D98\r
+\r
+# Total code points: 37201\r
+\r
+# Not allowed at start of identifier\r
+\r
+0300..033F ; nonstarting # [64] (̀..̿) COMBINING GRAVE ACCENT..COMBINING DOUBLE OVERLINE\r
+0342 ; nonstarting # (͂) COMBINING GREEK PERISPOMENI\r
+0345..034E ; nonstarting # [10] (ͅ..͎) COMBINING GREEK YPOGEGRAMMENI..COMBINING UPWARDS ARROW BELOW\r
+0360..036F ; nonstarting # [16] (͠..ͯ) COMBINING DOUBLE TILDE..COMBINING LATIN SMALL LETTER X\r
+0591..05A1 ; nonstarting # [17] (֑..֡) HEBREW ACCENT ETNAHTA..HEBREW ACCENT PAZER\r
+05A3..05B9 ; nonstarting # [23] (֣..ֹ) HEBREW ACCENT MUNAH..HEBREW POINT HOLAM\r
+05BB..05BD ; nonstarting # [3] (ֻ..ֽ) HEBREW POINT QUBUTS..HEBREW POINT METEG\r
+05BF ; nonstarting # (ֿ) HEBREW POINT RAFE\r
+05C1..05C2 ; nonstarting # [2] (ׁ..ׂ) HEBREW POINT SHIN DOT..HEBREW POINT SIN DOT\r
+05C4 ; nonstarting # (ׄ) HEBREW MARK UPPER DOT\r
+064B..0655 ; nonstarting # [11] (ً..ٕ) ARABIC FATHATAN..ARABIC HAMZA BELOW\r
+0670 ; nonstarting # (ٰ) ARABIC LETTER SUPERSCRIPT ALEF\r
+06D6..06DC ; nonstarting # [7] (ۖ..ۜ) ARABIC SMALL HIGH LIGATURE SAD WITH LAM WITH ALEF MAKSURA..ARABIC SMALL HIGH SEEN\r
+06DF..06E4 ; nonstarting # [6] (۟..ۤ) ARABIC SMALL HIGH ROUNDED ZERO..ARABIC SMALL HIGH MADDA\r
+06E7..06E8 ; nonstarting # [2] (ۧ..ۨ) ARABIC SMALL HIGH YEH..ARABIC SMALL HIGH NOON\r
+06EA..06ED ; nonstarting # [4] (۪..ۭ) ARABIC EMPTY CENTRE LOW STOP..ARABIC SMALL LOW MEEM\r
+0711 ; nonstarting # (ܑ) SYRIAC LETTER SUPERSCRIPT ALAPH\r
+0730..073F ; nonstarting # [16] (ܰ..ܿ) SYRIAC PTHAHA ABOVE..SYRIAC RWAHA\r
+07A6..07B0 ; nonstarting # [11] (ަ..ް) THAANA ABAFILI..THAANA SUKUN\r
+0901..0903 ; nonstarting # [3] (ँ..ः) DEVANAGARI SIGN CANDRABINDU..DEVANAGARI SIGN VISARGA\r
+093C ; nonstarting # (़) DEVANAGARI SIGN NUKTA\r
+093E..094D ; nonstarting # [16] (ा..्) DEVANAGARI VOWEL SIGN AA..DEVANAGARI SIGN VIRAMA\r
+0951..0954 ; nonstarting # [4] (॑..॔) DEVANAGARI STRESS SIGN UDATTA..DEVANAGARI ACUTE ACCENT\r
+0962..0963 ; nonstarting # [2] (ॢ..ॣ) DEVANAGARI VOWEL SIGN VOCALIC L..DEVANAGARI VOWEL SIGN VOCALIC LL\r
+0981..0983 ; nonstarting # [3] (ঁ..ঃ) BENGALI SIGN CANDRABINDU..BENGALI SIGN VISARGA\r
+09BC ; nonstarting # (়) BENGALI SIGN NUKTA\r
+09BE..09C4 ; nonstarting # [7] (া..ৄ) BENGALI VOWEL SIGN AA..BENGALI VOWEL SIGN VOCALIC RR\r
+09C7..09C8 ; nonstarting # [2] (ে..ৈ) BENGALI VOWEL SIGN E..BENGALI VOWEL SIGN AI\r
+09CB..09CD ; nonstarting # [3] (ো..্) BENGALI VOWEL SIGN O..BENGALI SIGN VIRAMA\r
+09D7 ; nonstarting # (ৗ) BENGALI AU LENGTH MARK\r
+09E2..09E3 ; nonstarting # [2] (ৢ..ৣ) BENGALI VOWEL SIGN VOCALIC L..BENGALI VOWEL SIGN VOCALIC LL\r
+0A02 ; nonstarting # (ਂ) GURMUKHI SIGN BINDI\r
+0A3C ; nonstarting # (਼) GURMUKHI SIGN NUKTA\r
+0A3E..0A42 ; nonstarting # [5] (ਾ..ੂ) GURMUKHI VOWEL SIGN AA..GURMUKHI VOWEL SIGN UU\r
+0A47..0A48 ; nonstarting # [2] (ੇ..ੈ) GURMUKHI VOWEL SIGN EE..GURMUKHI VOWEL SIGN AI\r
+0A4B..0A4D ; nonstarting # [3] (ੋ..੍) GURMUKHI VOWEL SIGN OO..GURMUKHI SIGN VIRAMA\r
+0A70..0A71 ; nonstarting # [2] (ੰ..ੱ) GURMUKHI TIPPI..GURMUKHI ADDAK\r
+0A81..0A83 ; nonstarting # [3] (ઁ..ઃ) GUJARATI SIGN CANDRABINDU..GUJARATI SIGN VISARGA\r
+0ABC ; nonstarting # (઼) GUJARATI SIGN NUKTA\r
+0ABE..0AC5 ; nonstarting # [8] (ા..ૅ) GUJARATI VOWEL SIGN AA..GUJARATI VOWEL SIGN CANDRA E\r
+0AC7..0AC9 ; nonstarting # [3] (ે..ૉ) GUJARATI VOWEL SIGN E..GUJARATI VOWEL SIGN CANDRA O\r
+0ACB..0ACD ; nonstarting # [3] (ો..્) GUJARATI VOWEL SIGN O..GUJARATI SIGN VIRAMA\r
+0B01..0B03 ; nonstarting # [3] (ଁ..ଃ) ORIYA SIGN CANDRABINDU..ORIYA SIGN VISARGA\r
+0B3C ; nonstarting # (଼) ORIYA SIGN NUKTA\r
+0B3E..0B43 ; nonstarting # [6] (ା..ୃ) ORIYA VOWEL SIGN AA..ORIYA VOWEL SIGN VOCALIC R\r
+0B47..0B48 ; nonstarting # [2] (େ..ୈ) ORIYA VOWEL SIGN E..ORIYA VOWEL SIGN AI\r
+0B4B..0B4D ; nonstarting # [3] (ୋ..୍) ORIYA VOWEL SIGN O..ORIYA SIGN VIRAMA\r
+0B56..0B57 ; nonstarting # [2] (ୖ..ୗ) ORIYA AI LENGTH MARK..ORIYA AU LENGTH MARK\r
+0B82 ; nonstarting # (ஂ) TAMIL SIGN ANUSVARA\r
+0BBE..0BC2 ; nonstarting # [5] (ா..ூ) TAMIL VOWEL SIGN AA..TAMIL VOWEL SIGN UU\r
+0BC6..0BC8 ; nonstarting # [3] (ெ..ை) TAMIL VOWEL SIGN E..TAMIL VOWEL SIGN AI\r
+0BCA..0BCD ; nonstarting # [4] (ொ..்) TAMIL VOWEL SIGN O..TAMIL SIGN VIRAMA\r
+0BD7 ; nonstarting # (ௗ) TAMIL AU LENGTH MARK\r
+0C01..0C03 ; nonstarting # [3] (ఁ..ః) TELUGU SIGN CANDRABINDU..TELUGU SIGN VISARGA\r
+0C3E..0C44 ; nonstarting # [7] (ా..ౄ) TELUGU VOWEL SIGN AA..TELUGU VOWEL SIGN VOCALIC RR\r
+0C46..0C48 ; nonstarting # [3] (ె..ై) TELUGU VOWEL SIGN E..TELUGU VOWEL SIGN AI\r
+0C4A..0C4D ; nonstarting # [4] (ొ..్) TELUGU VOWEL SIGN O..TELUGU SIGN VIRAMA\r
+0C55..0C56 ; nonstarting # [2] (ౕ..ౖ) TELUGU LENGTH MARK..TELUGU AI LENGTH MARK\r
+0C82..0C83 ; nonstarting # [2] (ಂ..ಃ) KANNADA SIGN ANUSVARA..KANNADA SIGN VISARGA\r
+0CBE..0CC4 ; nonstarting # [7] (ಾ..ೄ) KANNADA VOWEL SIGN AA..KANNADA VOWEL SIGN VOCALIC RR\r
+0CC6..0CC8 ; nonstarting # [3] (ೆ..ೈ) KANNADA VOWEL SIGN E..KANNADA VOWEL SIGN AI\r
+0CCA..0CCD ; nonstarting # [4] (ೊ..್) KANNADA VOWEL SIGN O..KANNADA SIGN VIRAMA\r
+0CD5..0CD6 ; nonstarting # [2] (ೕ..ೖ) KANNADA LENGTH MARK..KANNADA AI LENGTH MARK\r
+0D02..0D03 ; nonstarting # [2] (ം..ഃ) MALAYALAM SIGN ANUSVARA..MALAYALAM SIGN VISARGA\r
+0D3E..0D43 ; nonstarting # [6] (ാ..ൃ) MALAYALAM VOWEL SIGN AA..MALAYALAM VOWEL SIGN VOCALIC R\r
+0D46..0D48 ; nonstarting # [3] (െ..ൈ) MALAYALAM VOWEL SIGN E..MALAYALAM VOWEL SIGN AI\r
+0D4A..0D4D ; nonstarting # [4] (ൊ..്) MALAYALAM VOWEL SIGN O..MALAYALAM SIGN VIRAMA\r
+0D57 ; nonstarting # (ൗ) MALAYALAM AU LENGTH MARK\r
+0D82..0D83 ; nonstarting # [2] (ං..ඃ) SINHALA SIGN ANUSVARAYA..SINHALA SIGN VISARGAYA\r
+0DCA ; nonstarting # (්) SINHALA SIGN AL-LAKUNA\r
+0DCF..0DD4 ; nonstarting # [6] (ා..ු) SINHALA VOWEL SIGN AELA-PILLA..SINHALA VOWEL SIGN KETTI PAA-PILLA\r
+0DD6 ; nonstarting # (ූ) SINHALA VOWEL SIGN DIGA PAA-PILLA\r
+0DD8..0DDF ; nonstarting # [8] (ෘ..ෟ) SINHALA VOWEL SIGN GAETTA-PILLA..SINHALA VOWEL SIGN GAYANUKITTA\r
+0DF2..0DF3 ; nonstarting # [2] (ෲ..ෳ) SINHALA VOWEL SIGN DIGA GAETTA-PILLA..SINHALA VOWEL SIGN DIGA GAYANUKITTA\r
+0E31 ; nonstarting # (ั) THAI CHARACTER MAI HAN-AKAT\r
+0E34..0E3A ; nonstarting # [7] (ิ..ฺ) THAI CHARACTER SARA I..THAI CHARACTER PHINTHU\r
+0E47..0E4E ; nonstarting # [8] (็..๎) THAI CHARACTER MAITAIKHU..THAI CHARACTER YAMAKKAN\r
+0EB1 ; nonstarting # (ັ) LAO VOWEL SIGN MAI KAN\r
+0EB4..0EB9 ; nonstarting # [6] (ິ..ູ) LAO VOWEL SIGN I..LAO VOWEL SIGN UU\r
+0EBB..0EBC ; nonstarting # [2] (ົ..ຼ) LAO VOWEL SIGN MAI KON..LAO SEMIVOWEL SIGN LO\r
+0EC8..0ECD ; nonstarting # [6] (່..ໍ) LAO TONE MAI EK..LAO NIGGAHITA\r
+0F18..0F19 ; nonstarting # [2] (༘..༙) TIBETAN ASTROLOGICAL SIGN -KHYUD PA..TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS\r
+0F35 ; nonstarting # (༵) TIBETAN MARK NGAS BZUNG NYI ZLA\r
+0F37 ; nonstarting # (༷) TIBETAN MARK NGAS BZUNG SGOR RTAGS\r
+0F39 ; nonstarting # (༹) TIBETAN MARK TSA -PHRU\r
+0F3E..0F3F ; nonstarting # [2] (༾..༿) TIBETAN SIGN YAR TSHES..TIBETAN SIGN MAR TSHES\r
+0F71..0F72 ; nonstarting # [2] (ཱ..ི) TIBETAN VOWEL SIGN AA..TIBETAN VOWEL SIGN I\r
+0F74 ; nonstarting # (ུ) TIBETAN VOWEL SIGN U\r
+0F76 ; nonstarting # (ྲྀ) TIBETAN VOWEL SIGN VOCALIC R\r
+0F78 ; nonstarting # (ླྀ) TIBETAN VOWEL SIGN VOCALIC L\r
+0F7A..0F80 ; nonstarting # [7] (ེ..ྀ) TIBETAN VOWEL SIGN E..TIBETAN VOWEL SIGN REVERSED I\r
+0F82..0F84 ; nonstarting # [3] (ྂ..྄) TIBETAN SIGN NYI ZLA NAA DA..TIBETAN MARK HALANTA\r
+0F86..0F87 ; nonstarting # [2] (྆..྇) TIBETAN SIGN LCI RTAGS..TIBETAN SIGN YANG RTAGS\r
+0F90..0F97 ; nonstarting # [8] (ྐ..ྗ) TIBETAN SUBJOINED LETTER KA..TIBETAN SUBJOINED LETTER JA\r
+0F99..0FBC ; nonstarting # [36] (ྙ..ྼ) TIBETAN SUBJOINED LETTER NYA..TIBETAN SUBJOINED LETTER FIXED-FORM RA\r
+0FC6 ; nonstarting # (࿆) TIBETAN SYMBOL PADMA GDAN\r
+102C..1032 ; nonstarting # [7] (ာ..ဲ) MYANMAR VOWEL SIGN AA..MYANMAR VOWEL SIGN AI\r
+1036..1039 ; nonstarting # [4] (ံ..္) MYANMAR SIGN ANUSVARA..MYANMAR SIGN VIRAMA\r
+1056..1059 ; nonstarting # [4] (ၖ..ၙ) MYANMAR VOWEL SIGN VOCALIC R..MYANMAR VOWEL SIGN VOCALIC LL\r
+17B6..17D0 ; nonstarting # [27] (ា..័) KHMER VOWEL SIGN AA..KHMER SIGN SAMYOK SANNYA\r
+17D2 ; nonstarting # (្) KHMER SIGN COENG\r
+18A9 ; nonstarting # (ᢩ) MONGOLIAN LETTER ALI GALI DAGALGA\r
+3099..309A ; nonstarting # [2] (゙..゚) COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK..COMBINING KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK\r
+\r
+# Total code points: 524\r
--- /dev/null
+Viper tutorial #0: Introduction\r
+\r
+This Viper tutorial is based on the vi tutorial VILEARN. Some things\r
+works differently in Emacs and corresponding parts of the tutorial has\r
+been changed for this. There has also been added some basic\r
+information about Emacs that are useful to get started if you already\r
+are a vi user.\r
+\r
+This tutorial is a hands-on-tutorial for Viper. If you want more\r
+information about Viper, please read the VIPER-MANUAL.\r
+\r
+Note that if you are using Viper you probably still want to know quite\r
+a bit about Emacs to use Emacs efficiently. Therefore you can also\r
+run the Emacs tutorial from here - with special support for\r
+Viper. This is part 6 below. You should run this part also to get to\r
+know which Emacs standard key bindings are shadowed by Viper.\r
+\r
+The tutorial consists of these parts:\r
+\r
+ 0 Introduction\r
+ (this file)\r
+\r
+ 1 Basic Editing\r
+ Covers the handful of commands required to both navigate all\r
+ five tutorials and do basic editing.\r
+\r
+ 2 Moving Efficiently\r
+ Covers all of the cursor positioning commands. These are the\r
+ commands used later as arguments to editing commands.\r
+\r
+ 3 Cutting and Pasting\r
+ Introduces the first compound commands, numbering, and copy\r
+ buffers.\r
+\r
+ 4 Inserting Techniques\r
+ Continues the discussion of compound commands, while completing\r
+ the list of insertion commands first discussed in tutorial one.\r
+\r
+ 5 Tricks and Timesavers\r
+ This is less a tutorial than a description of common vi commands\r
+ which don't fit correctly into normal logic.\r
+\r
+ 6 Emacs Tutorial for Viper Users\r
+ Even Viper users use a lot of keys from Emacs. Therefore you can\r
+ run the Emacs tutorial here too. It will show you which keys in\r
+ the tutorial that are changed because you are using Viper. This\r
+ depends of which Viper state you are in, vi state or some insert\r
+ state. If you switch Viper state the tutorial will immediately\r
+ show which keys are affected.\r
+\r
+\r
+BUGS\r
+Vilearn has the remark that it "Still doesn't cover variables, ex\r
+commands, or tags. At least one more tutorial is necessary for a\r
+complete introduction to vi." - I do not think you have to learn those\r
+parts to use Viper. There are other ways to do these things in Emacs!\r
+\r
+For more information about vilearn see the the README-FILE.\r
+\r
--- /dev/null
+Viper tutorial #1: The Basics
+
+This lesson lasts 10-15 minutes and teaches simple editing. Lines
+which begin with >>> mark exercises you should try. When you
+want to exit this tutorial type 'Z''Z' (type capital Z, twice).
+
+When you type commands in vi they do not appear on the screen. If the
+letters you type unexpectedly appear on the screen, press the ESC key.
+
+
+BASIC CURSOR MOVEMENT
+---------------------
+To move through the tutorial use C-d (control d) and C-u (control u).
+
+ C-d Move DOWN one half-screen
+ (depress the control key and type d)
+
+ C-u Move UP one half-screen
+ (depress the control key and type u)
+
+* EMACS-NOTICE: C-u is normally used in Emacs for UNIVERSAL-ARGUMENT.
+ You can in most cases use DIGIT-ARGUMENT instead.
+
+>>> Now type C-d (control d) and C-u (control u) to move down and back up.
+
+When you are done reading a screen, you are expected to type C-d to move
+down to the next screen. You must remember to type C-d throughout the
+tutorial.
+
+To move the cursor line by line, or character by character, use the
+four keys 'h', 'j', 'k', and 'l'.
+
+ 'h' Move left one character
+ 'j' Move down one line
+ 'k' Move up one line
+ 'l' Move right one character
+
+You will notice that these keys are in a straight line on the
+keyboard. Study the diagram below showing the function of h, j, k, l.
+
+ UP
+ ....... ....... ....... .......
+ : : : : : : : :
+ LEFT : h : : j : : k : : l : RIGHT
+ :.....: :.....: :.....: :.....:
+
+ DOWN
+
+>>> Now type 'j' or 'k' a few times to bring the cursor to this line.
+
+>>> Try moving off the right end of a line using 'l' . Notice that
+>>> vi will not allow you to move off the end of the line using 'l' .
+>>> Likewise, you cannot use 'h' and 'l' on a blank line.
+
+>>> Try moving past the bottom of the screen using 'j' . Notice how
+>>> how the screen scrolls downward.
+
+>>> Now practice using 'k' to move up, and 'h' to move left.
+
+
+DELETION
+--------
+To delete characters and lines, use 'x' and 'd''d'.
+
+ 'x' X-OUT one character
+ 'd''d' DELETE one line
+
+To undo your changes, use 'u'.
+
+ 'u' UNDO last change only
+
+>>> Delete this SCRAP line. Move to this line with 'j' or 'k' , now type 'd''d' .
+>>> Try undoing the deletion with 'u' .
+
+>>> Move to this line and x-out the Y's with 'x' : "whY ask whY?"
+
+>>> Try undoing the deletion with 'u' . Try typing 'u' several times.
+>>> Notice that 'u' only undoes the last change.
+
+* EMACS-NOTICE: In Viper you can use the repeat command '.' (just a dot)
+ to undo more changes. This goes in both direction, ie undoing and
+ redoing. Typing just 'u' changes direction.
+
+Here are more lines on which to practice deleting and undoing (use: 'd''d' 'x' 'u' )
+
+ Emacs is a nice creation. Emacs is a nice creation.
+ Emacs is a nice creation. Emacs is a nice creation.
+ Emacs is a nice creation. Emacs is a nice creation.
+
+
+QUIT COMMANDS
+-------------
+(DO NOT QUIT the tutorial at this time.)
+
+To quit a file without saving any changes you have made (for instance,
+with the 'd''d' or 'x' commands) use :q!<RETURN> . To quit and save your
+changes, use 'Z''Z' . When you are editing your own files, you normally
+use 'Z''Z' to quit.
+
+ :q!<RETURN> QUIT without saving changes
+ (type a colon, then the letter q, then an
+ exclamation point, and press RETURN)
+
+ 'Z''Z' Exit and save any changes
+ (type capital Z, twice)
+
+
+
+INSERTION
+---------
+You enter insert mode with 'i' or 'o' . Anything you type during insert
+mode appears on the screen. When you are done inserting, press ESC
+to exit insert mode. Type C-[ (control [ ), if you do not have an ESC key.
+
+ 'o' OPEN a line for inserting text
+ 'i' INSERT starting at the cursor
+
+ ESC ESCAPE from insert mode
+
+During insert mode, use your erase character (usually backspace or
+delete) to delete mistakes. The characters you delete will remain on
+the screen until you press ESC.
+
+>>> Insert your name and phone number below the next blank line. To do this:
+>>> Open a line below using 'o' .
+>>> Type your first and last name. Press RETURN.
+>>> Then type your phone number and press ESC.
+>>> Use 'x' to erase part of your phone number.
+
+>>> Type the date below your phone number. To do this:
+>>> Open another line using 'o' .
+>>> Type the date and press ESC.
+
+>>> Type 'u' to undo the insertion.
+
+>>> Insert a nickname between your first and last names, using 'i'. To do this:
+>>> Move the cursor to the spot between your names using 'h', 'j', 'k', 'l'.
+>>> Press 'i' .
+>>> Type the nickname, use DELETE or BACKSPACE to erase any typos.
+>>> Then press ESC.
+
+On some computers, a line may be longer than the width of the screen.
+This means that a very long line may appear to be two lines on the
+screen. This happens when you keep typing without pressing RETURN at
+the edge of the screen. To avoid any confusion when you're inserting
+text, be sure to press RETURN before reaching the right edge of the
+screen.
+
+
+SUMMARY
+-------
+These are the vi commands you should know after tutorial #1:
+
+ C-d Move DOWN one half-screen
+ (depress the control key and type d)
+
+ C-u Move UP one half-screen
+ (depress the control key and type u)
+
+ 'h' Move left one character
+ 'j' Move down one line
+ 'k' Move up one line
+ 'l' Move right one character
+
+ 'd''d' DELETE one line
+ 'x' X-OUT one character
+
+ 'u' UNDO last change
+
+ :q!<RETURN> QUIT without saving changes
+ (type a colon, then the letter q, then an
+ exclamation point, and press RETURN)
+
+ 'Z''Z' Exit and save any changes
+ (type capital Z, twice)
+
+ 'o' OPEN a line for inserting text
+ 'i' INSERT starting at the cursor
+
+ ESC ESCAPE from insert mode
+
+
+You are now prepared to do simple editing on your own files. Practice
+using vi for a few days. Then take the second vi tutorial to learn
+more powerful and useful vi commands.
+
+Copyright (c) 1992 Jill Kliger and Wesley Craig. All Rights Reserved.
--- /dev/null
+Viper tutorial #2: Moving Through Files Efficiently
+
+This lesson lasts 15-20 minutes. The material taught here is used in
+tutorial #3: Cutting and Pasting. Lines which begin with >>> mark
+exercises you should try. When you want to exit this tutorial type 'Z''Z'.
+
+
+WORDS
+-----
+There are many ways to move from one word to another. Consider these:
+
+ 'w' Move to the beginning of the next WORD
+ 'e' Move to the END of the next word
+ 'b' Move BACK to the beginning to the previous word
+
+For 'w', 'e', and 'b', a word is delimited by any non-alphanumeric
+character. The capitalized versions, 'W', 'E', and 'B', also move from word
+to word. The difference is that for 'W', 'E', and 'B', a word is delimited
+by any blank space.
+
+>>> Try out 'w', 'b', 'e', on the lines provided below.
+>>> Next practice using 'B', 'W', 'b', 'E' on the lines provided below.
+
+ EX-PER-IMENT on these lines;test moving back &forth.
+ EX-PER-IMENT on these lines;test moving back &forth.
+
+
+ON THE LINE
+-----------
+You can move immediately to any point on the current line.
+
+ '$' Move to the end of the line
+ '^' Move to the first non-white character on the line
+
+ '0' Move to the first column on the line (column zero)
+ #'|' Move to an exact column on the line (column #) e.g. 5| 12|
+
+>>> Experiment with '$' and '^' on the line provided below. Notice
+>>> that '^' moves to the first non-white character, not the beginning.
+
+ This is a PRACTICE LINE. There is white space at the front. END
+
+'0' (zero) will always take you to the far left edge of the screen.
+
+#'|' (number vertical-bar) is for moving to an explicit column on a line.
+Just type any number 1-80 and press | . For example: 5| 20| 30|
+Note that you can't move beyond the last column on a line.
+
+
+FINDING CHARACTERS
+------------------
+Often you want to move to a specific letter or character on a line.
+
+ 'f' char FIND the next occurrence of char on the line
+ 't' char Move 'TIL the next occurrence of char on the line
+
+ 'F' char FIND the previous occurrence of char on the line
+ 'T' char Move 'TIL the previous occurrence of char on the line
+
+ ';' Repeat the last f, t, F, or T
+ ',' Reverse the last f, t, F, or T
+
+'f' and 'F' land on the character. 't' and 'T' land next to the character.
+'f' and 't' move forward, while 'F' and 'T' move backward.
+
+If the specified character is not on the line, vi will beep.
+
+>>> Move to the beginning of the line below, and try out these commands:
+>>> 'f'e 'f'E ';' ';' ',' ',' 't'@ 'T'P 't'e 't'E ',' ';' ',' ';'
+
+ "PRACTICE line?" "Each and Every?" "Find thE char@cter and move to it.END
+
+
+MATCHING
+--------
+vi has a handy way to determine if (), {}, and [] pairs match up.
+
+ '%' Move to matching () or {} or []
+
+>>> On the practice lines below, move your cursor over a (,),{,},[, or ].
+>>> Then type '%' .
+
+ [TRY THIS. ((Whether) the pairs match up is the question.) [One]
+ pair is incomplete]. Can you tell {which one? ]} END
+
+
+WINDOW POSITIONS
+----------------
+You can move the cursor to the top, middle, or bottom of the vi window.
+
+ 'H' Move to the HIGHEST position in the window
+ 'M' Move to the MIDDLE position in the window
+ 'L' Move to the LOWEST position in the window
+
+>>> Try out these commands: type H then M and L and then M again.
+
+
+MARKING LOCATIONS
+-----------------
+You can mark positions in the file and return to them.
+
+ 'm' char MARK this location and name it char
+ ''' char (quote character) return to line named char
+ '''''' (quote quote) return from last movement
+
+char can be any lower case letter, a-z. A mark persists until you:
+ 1) use the same char to mark another location
+ or 2) delete the marked line
+
+>>> Move to this line and type ma to mark it a
+>>> Move to this line and type mb to mark it b
+>>> Move to this line and type mz to mark it z
+>>> Type 'a to return to line a
+>>> Type 'b to return to line b
+>>> Type 'z to return to line z
+
+Certain commands can move you large distances. These commands cause
+your last position to be remembered in the special mark named ' (quote).
+To move to this special mark, just type '' (quote quote).
+
+>>> Try this: 'b to return to line b, and then '' to return here.
+
+
+GO TO A LINE
+------------
+
+ 'G' GO to the last line in the file
+ #'G' GO to line #. (e.g., 3G , 5G , 124G )
+
+Read these directions carefully:
+>>> Type '1''G' to go to the top of the file, and then '''''' (quote quote)
+>>> to return here.
+>>> Now try 'G' to go to the end of the file, and then '''''' to return here.
+
+
+BLOCKS OF TEXT
+--------------
+It is often convenient to move through files jumping from one block of
+text to the next. To do this use braces and parentheses:
+
+ '{' (left brace) Move to the beginning of a paragraph
+ '}' (right brace) Move to the end of a paragraph
+
+ '(' (left paren) Move to the beginning of a sentence
+ ')' (right paren) Move to the beginning of the next sentence
+
+>>> Experiment with '}' and '{' on the two paragraphs provided below.
+>>> Note that paragraphs are separated by a blank line.
+
+ EXPERIMENT on this first paragraph. The quick brown fox jumped
+ over the seven lazy dogs. The fox must have been very large to
+ jump over seven dogs!
+
+ EXPERIMENT on this second paragraph. The quick brown dog
+ jumped over the seven lazy foxes. The dog didn't have to be nearly
+ as large, since foxes aren't too big.
+
+>>> Try out ')' and '(' on the two paragraphs provided above.
+>>> Notice that sentences are separated by two blank spaces.
+
+C programmers find it useful to move by sections, since sections may be
+delimited by a left brace in the first column. By placing the opening
+brace of a C subroutine in the first column, you can move to the top of
+the next subroutine, using '[''[' and ']'']' .
+
+ '[''[' Move to the beginning of a section
+ ']'']' Move to the end of a section
+
+Note that if vi does not find a left brace at the far left, it will
+move to the top or bottom of the file.
+
+>>> Now try ']'']' then ']'']' and '[''[' on the subroutines provided below:
+
+main()
+{
+ helloworld();
+}
+
+helloworld()
+{
+ printf( "Hello world\n" );
+}
+
+
+SEARCHING
+---------
+This enables you to jump to the next occurrence of a string in a file.
+To initially find the string use:
+
+ '/'string Find string looking forward
+ '?'string Find string looking backward
+
+To find additional occurrences of the string type:
+
+ 'n' Repeat last / or ? command
+ 'N' Reverse last / or ? command
+
+vi may search past the bottom of the file and then start again at the top.
+(Or, vi may search past the top and then start again at the bottom.)
+
+>>> You are going to search for a string, find the next three
+>>> occurrences. Then flip directions and find the string until you
+>>> return to this location. To do this:
+>>> Type '/''t''h''e' then press RETURN.
+>>> Type 'n' three times.
+>>> Type 'N' until you return to this location.
+
+* EMACS-NOTICE: Emacs has very powerful SEARCH-COMMANDS which you may
+ want to use in parallell to those above. One of the first you want
+ to try is probably C-s (ISEARCH-FORWARD).
+
+
+SUMMARY
+-------
+
+ 'w' Move to the beginning of the next WORD
+ 'e' Move to the END of the next word
+ 'b' Move BACK to the beginning to the previous word
+
+ '$' Move to the end of the line
+ '^' Move to the first non-white character on the line
+
+ '0' Move to the first column on the line (column zero)
+ #'|' Move to an exact column on the line (column #) e.g. 5| 12|
+
+ 'f' char FIND the next occurrence of char on the line
+ 't' char Move 'TIL the next occurrence of char on the line
+
+ 'F' char FIND the previous occurrence of char on the line
+ 'T' char Move 'TIL the previous occurrence of char on the line
+
+ ';' Repeat the last f, t, F, or T
+ ',' Reverse the last f, t, F, or T
+
+ '%' Show matching () or {} or []
+
+ 'H' Move to the HIGHEST position in the window
+ 'M' Move to the MIDDLE position in the window
+ 'L' Move to the LOWEST position in the window
+
+ 'm' char MARK this location and name it char
+ ''' char (quote character) return to line named char
+ '''''' (quote quote) return from last movement
+
+ 'G' GO to the last line in the file
+ #'G' GO to line #. (e.g., 3G , 5G , 175G )
+
+ '{' (left brace) Move to the beginning of a paragraph
+ '}' (right brace) Move to the end of a paragraph
+
+ '(' (left paren) Move to the beginning of a sentence
+ ')' (right paren) Move to the beginning of the next sentence
+
+ '[''[' Move to the beginning of a section
+ ']'']' Move to the end of a section
+
+ '/'string Find string looking forward
+ '?'string Find string looking backward
+
+ 'n' Repeat last / or ? command
+ 'N' Reverse last / or ? command
+
+You should now be able to move around files very efficiently. These
+commands are especially useful if you are using vi over a slow modem.
+Practice the material in this lesson for a few days and then take
+either the third vi tutorial to learn how to copy, cut, and paste, or
+the forth vi tutorial to learn additional insertion techniques.
+
+Copyright (c) 1992 Jill Kliger and Wesley Craig. All Rights Reserved.
--- /dev/null
+Viper tutorial #3: Copying, Cutting, and Pasting
+
+This lesson lasts 15-20 minutes. This tutorial assumes full knowledge
+of tutorial #1, and familiarity with tutorial #2. Lines which begin
+with >>> mark exercises you should try.
+
+When you want to exit this tutorial type 'Z''Z' to exit and save your
+changes. Or type :q!<RETURN> to exit without saving changes.
+Remember that typing u will UNDO your last change.
+
+
+CUTTING TEXT
+------------
+The delete command can be combined with any of the movement commands
+taught throughout tutorial #2. The resulting command is of the form:
+
+ 'd'movement DELETE to where the movement command specifies
+
+Consider the following examples:
+
+ 'd''w' DELETE to the beginning of the next WORD
+ 'd''$' DELETE to the end of the line
+ 'd'')' DELETE to the beginning of the next sentence
+ 'd''t'e DELETE 'TIL the next e
+ 'd''d' DELETE a line (dd is a special case of the d command)
+
+>>> Experiment with 'd''w' 'd''$' 'd'')' 'd''t'e 'd''d' on the paragraph provided below:
+
+ PRACTICE here. Now is the time for all good users to learn the
+ editor. The quick brown fox jumped over the seven lazy fish. Now
+ is the time for all good users to learn the editor. The quick
+ brown computer jumped over the seven lazy users. END PRACTICE
+
+* EMACS-NOTICE: In Viper you can also use 'r' and 'R' for Emacs region and
+ Viper line extended region. This is very convenient together with
+ CUA-MODE where the region is visible (it is usually called the
+ selected text or something similar in other applications).
+
+
+PASTING TEXT
+------------
+When text is deleted it is put into a buffer which contains the most
+recently deleted text. To paste the contents of this buffer elsewhere
+in the file use the p or P command.
+
+ 'P' (upper p) PUT the contents of the buffer before the cursor
+ 'p' (lower p) PUT the contents of the buffer after the cursor
+
+>>> Try this sequence of commands on the practice lines below:
+>>> 'd''d' to delete one line
+>>> 'j' to move down a line
+>>> 'p' (lower p) to PUT the deleted text after the cursor
+>>> '}' to move to the end of the paragraph
+>>> 'P' (upper p) to PUT the deleted text before the cursor
+
+ PRACTICE line. Cut and Paste this line to the bottom of the
+ paragraph. Here is some filler, feel free to cut and paste the
+ text in this practice region. Remember that u undoes the last
+ action. END OF PRACTICE
+
+>>> Try this sequence of commands at the beginning of a word:
+>>> 'd''w' 'w' 'P'
+
+The fastest way to swap two letters is to type: 'x''p'
+
+>>> Use xp to correct the misspelled words below:
+
+ PRACTICE. Thier weird quiet recieved an inconvenient shriek.
+ Thier belief is that to recieve grief from nieghbors outwieghs
+ all else. Biege skies lead to wierd science. END.
+
+
+NUMBERING
+---------
+Consider cutting and pasting 3 words. Based on previous exercises you
+would type 'd''w' , move to the new location, and type 'p' , and repeat
+this procedure twice more. There is an easier way to do this:
+
+>>> Using the practice lines below, try the following sequence of commands:
+>>> Move to the beginning of the first sentence.
+>>> Type 'd''3''w' to DELETE 3 WORDS.
+>>> Type 'w' to move ahead one WORD.
+>>> Type 'P' (upper p) to PUT the three words before the cursor.
+
+ PRACTICE Numbering vi commands is easy to do. Now is the time for
+ all good users to learn the editor. The quick brown fox jumped
+ over the seven lazy dogs. Numbering vi commands is easy to do.
+ Now is the time for all good users to learn the editor. END PRACTICE
+
+>>> Type 'd''2''d' to DELETE 2 lines, using the practice paragraph above.
+>>> Move to the top of the paragraph.
+>>> Type 'p' (lower p) to PUT the two lines after of the cursor.
+
+Numbering also works for movement commands.
+
+>>> Now try '4''w' to move ahead 4 WORDs, on the lines provided above.
+>>> Then use '3''b' to move BACK 3 words.
+
+When you type '4''w' THINK "4 words", when you type d4w think "delete 4
+words". In general, we can write
+
+ #movement repeat movement # times
+ d#movement DELETE to where the #movement command specifies
+
+
+COPYING TEXT
+------------
+The YANK command works just like the DELETE command, except 'y' is used
+instead of 'd' .
+
+ 'y'movement YANK to where the movement command specifies
+
+YANK and DELETE are identical except that YANK only copies the specified
+text into the buffer.
+
+>>> Try this sequence of commands on the practice lines below:
+>>> 'y''y' to YANK a line (yy is a special case of the y command)
+>>> '3''j' to move down 3 lines
+>>> 'p' (lower p) to PUT the yanked text after the cursor
+
+ PRACTICE line. Copy and Paste this line to the bottom of the
+ paragraph. Here is some filler, feel free to copy and paste the
+ text in this practice region. Remember that u undoes the last
+ action. END OF PRACTICE
+
+Please note that copy, cutting, and pasting large blocks of text may
+significantly alter the tutorial file. Remember that you can always get
+a new copy of the tutorial file and that u UNDOes your last change.
+
+Here are some examples which show the similarity between y and d .
+
+ 'y''w' YANK to the beginning of the next WORD
+ 'y''$' YANK to the end of the line
+ 'y'')' YANK to the beginning of the next sentence
+ 'y''t'e YANK 'TIL the next e
+ 'y''y' YANK a line
+
+Here are some more examples using commands from tutorial #2.
+
+ 'y''L' YANK from here to the lowest point of the window
+ 'y''/'and YANK from here to the word "and"
+ 'y''2''}' YANK 2 paragraphs
+ 'y''''a YANK from here to the marked line "a" (mark line first)
+
+>>> Experiment with 'y''w' 'y''t'e 'y''4''w' 'y''2''}' 'y''3''y' and 'y''$' on the paragraph
+>>> provided below. Copy text AND use 'p' or 'P' to paste it.
+
+ PRACTICE line. Copy and Paste this line to the bottom of the
+ paragraph. Here is some filler, feel free to copy and paste
+ the text in this practice region. Remember that u undoes the
+ last action. END OF PRACTICE
+
+
+NUMBERED BUFFERS
+----------------
+In all of the previous pasting exercises you've used the "un-named"
+buffer. The un-named buffer contains the text you most recently cut or
+copied. When you make a new cut or copy, the old contents of the
+un-named buffer are moved to one of the "numbered" buffers. The
+buffers are numbered 1-9. Each time you cut or copy text,
+
+ vi saves your current cut or copy in a buffer #1
+ vi saves your 2nd to last cut or copy in a buffer #2
+ The cut or copy before that is saved in a buffer #3 ...
+ vi saves your 8th oldest cut or copy in a buffer #8
+ vi saves your 9th oldest cut or copy in a buffer #9
+
+Note that buffer #1 is the same as the un-named buffer. Here's how to
+paste from the numbered buffers:
+
+ "#P (upper p) PUT contents of buffer # before the cursor
+ "#p (lower p) PUT contents of buffer # after the cursor
+
+For example:
+
+ "1p PUT buffer 1 after the cursor
+ "7p PUT buffer 7 after the cursor
+
+>>> Delete this 1st line with dd
+>>> Delete this 2nd line with dd
+>>> Delete this 3rd block with d2d
+>>> (2nd half of block 3)
+>>> Delete this 4th block with dd
+>>> Now type "1p "2p "3p "4p
+
+If you are using vi and have made accidental deletions, just PUT the
+contents of each numbered buffer to recover the deleted text.
+
+
+NAMED BUFFERS
+-------------
+vi maintains the un-named and numbered buffers automatically. You can
+maintain your own buffers named a-z. That is, you can cut or copy text
+into buffer x and later paste the text from buffer x.
+
+ '"'aDELETE DELETE text into buffer a
+ "aYANK YANK text into buffer a
+ "aPUT PUT text from buffer a
+
+Note, don't actually type 'DELETE', 'YANK', or 'PUT'; type one of the
+DELETE commands, YANK commands, or PUT commands. See the examples below:
+
+ "ad} DELETE paragraph into buffer a
+ "by3y YANK 3 lines into buffer b
+ "cy200G YANK to line 200 into buffer c
+ "dp PUT buffer d after the cursor
+ "zP PUT buffer z before the cursor
+
+The contents of a named buffer are lost if:
+ 1) you store new text in a buffer with the same name
+ or 2) you quit vi (using 'Z''Z' or :q!<RETURN> )
+
+>>> Delete this START line into buffer a by typing "add
+>>> Paste buffer a by typing "ap
+
+>>> Delete this INTERMEDIATE line into buffer b by typing "bdd
+>>> Paste buffer b by typing "bp
+
+To put new material into buffer a
+>>> Delete this FINAL line into buffer a by typing "add
+>>> Paste buffer a by typing "ap
+
+
+SAVING WITHOUT QUITTING
+-----------------------
+With ZZ you save changes and kill the current buffer. (In vi you also
+exit with 'Z''Z'.) With :w you can save and not quit vi. It is a safe
+practice to save changes to a file regularly. This reduces re-typing
+in the event your computer crashes.
+
+ :w<RETURN> WRITE contents of the file (without quitting)
+ (type a colon, type w , then press the RETURN key)
+
+>>> Try :w now. Note the message at the bottom of the screen.
+
+
+PASTING BETWEEN FILES
+---------------------
+
+* EMACS-NOTICE: In Emacs there are no problems editing several
+ files. You can however do it in the more complicated vi way below if
+ you really want to ;-)
+
+This is an extremely useful procedure in vi. Only one new command is
+required for pasting between files, the EDIT command
+
+ :e filename<RETURN> Begin EDITing the file called "filename"
+
+The EDIT command allows you to edit another file without quitting vi.
+This is useful since named buffers are lost when you quit vi.
+
+Let's say you want to copy 6 lines from the file called "3temp" into
+this file which is named "3cutpaste":
+(Note that "3temp" has already been created for you)
+
+ 1) WRITE "3cutpaste". vi will not allow :w (press RETURN)
+ you to edit another file without first
+ saving any changes you've made.
+
+ 2) EDIT "3temp" without quitting vi. :e 3temp (press RETURN)
+
+ 3) YANK 6 lines from "3temp". "ay6y
+
+ 4) Return to "3cutpaste". :e 3cutpaste (press RETURN)
+
+ 5) PUT from buffer a "ap
+
+Note that the un-named and numbered buffers are lost when the EDIT
+command is used. Only named buffers are preserved with EDIT.
+
+>>> Follow the 5-step procedure outlined above. Don't be concerned
+>>> with remembering all 5 steps, the instructions are repeated in
+>>> "3temp". Paste the text from "3temp" near this line of this file,
+>>> "3cutpaste".
+
+You can use this 5-step procedure on any two files, with any cutting or
+copying action (here, y6y is the example).
+
+
+SUMMARY
+-------
+
+ #movement repeat movement # times
+ * EMACS-NOTICE: You may also use 'r' or 'R' in Viper.
+
+ 'd'movement DELETE to where "movement" command specifies
+ 'd'#movement DELETE to where the #movement command specifies
+ (e.g. 'd''w' 'd''3''w' )
+
+ 'y'movement YANK to where "movement" command specifies
+ 'y'#movement YANK to where the #movement command specifies
+ (e.g. 'y''w' 'y''3''w' )
+
+ 'P' (upper p) PUT the contents of the buffer before the cursor
+ 'p' (lower p) PUT the contents of the buffer after the cursor
+
+ '"'#P (upper p) PUT contents of buffer # before the cursor
+ '"'#p (lower p) PUT contents of buffer # after the cursor
+ (e.g. '"''2''p' '"''7''P' )
+
+ '"'aDELETE DELETE text into buffer a
+ '"'aYANK YANK text into buffer a
+ '"'aPUT PUT text from named buffer a
+ (Note, don't actually type 'DELETE', 'YANK', or 'PUT';
+ type one of the DELETE commands, YANK commands, or PUT
+ commands, e.g. '"''a''d''}' '"''b''y''3''y' '"''c''y''2''0''0''G' '"''d''p' '"''z''P' )
+
+ :w<RETURN> WRITE contents of the file (without quitting)
+ (type a colon, type w , then press the RETURN key)
+
+ :e filename<RETURN> Begin EDITing the file called "filename"
+
+
+You are now prepared to handle all cutting, copying and pasting tasks
+which may arise. If you practice what you've learned you'll find editing
+in vi to be fast and convenient.
+
+Copyright (c) 1992 Jill Kliger and Wesley Craig. All Rights Reserved.
--- /dev/null
+Viper tutorial #4: Insertion Techniques
+
+This lesson lasts 5-10 minutes. This tutorial assumes full knowledge
+of tutorial #1, and familiarity with tutorial #2. Lines which begin
+with >>> mark exercises you should try. When you want to exit this
+tutorial type 'Z''Z' .
+
+
+SIMPLE INSERTION
+----------------
+You spend most of your time in vi inserting text. As you might expect,
+there are several commands to begin insertion.
+
+ 'o' OPEN a line below the cursor
+ 'O' OPEN a line above the cursor
+
+ 'i' INSERT starting before the cursor
+ 'I' INSERT at the beginning of the line
+
+ 'a' APPEND starting after the cursor
+ 'A' APPEND at the end of the line
+
+Remember to type ESC to leave insert mode. If you don't have an ESC key
+type C-[ (control [ ).
+
+ ESC ESCAPE from insert mode
+
+>>> Move the cursor to this line. Type 'O' , enter your name. Press ESC.
+>>> Next type 'o' , enter the date. Press ESC.
+
+Note that 'O' opens the line above and puts you in insert mode,
+while 'o' opens the line below and also puts you in insert mode.
+
+>>> Type 'a' on any line above, enter your name. Press ESC. Do the
+>>> same for 'A'.
+
+>>> Read the following. Your goal is to take the sentence fragment below:
+
+ BROWN FOX OVER THE SEVEN LAZY
+
+>>> and convert it to
+
+ THE QUICK BROWN FOX JUMPED OVER THE SEVEN LAZY DOGS.
+
+>>> To do this type:
+>>> 'I' to insert THE QUICK (then press ESC)
+>>> move the cursor to after the X in FOX
+>>> 'a' to insert JUMPED (then press ESC)
+>>> 'A' to insert DOGS. (then press ESC)
+>>> Now move to the sentence fragment and make the changes outlined above.
+
+
+JOINING LINES
+-------------
+Often it is convenient to join two short lines into one line. There
+are several ways to do this. The easiest is the J command. Other
+methods will be explored in tutorial #5.
+
+ 'J' JOIN two lines
+
+>>> Go to the first line in the block below. Type J. Type J again.
+
+ Example: NOW IS THE TIME
+ the walrus said
+ TO THINK OF MANY THINGS
+
+In the event that joining lines creates a line which exceeds the width
+of the screen, you can break the line by typing i and pressing RETURN.
+
+
+SUBSTITUTING TEXT
+-----------------
+Substituting combines the delete command and the insert command into a
+single step.
+
+ #'s' SUBSTITUTE for # characters
+ #'S' SUBSTITUTE for # whole lines
+
+
+In order to substitute text you have to know how much text you want to
+delete. Consider the following examples:
+
+ '3''s' SUBSTITUTE the next 3 characters for what will be typed
+ '7''s' SUBSTITUTE the next 7 characters for what will be typed
+
+>>> Change the SAMPLE DEFINITION below. To do this:
+>>> move the cursor to the T in TWO
+>>> type '3's
+>>> type FOUR then press ESC
+
+ SAMPLE DEFINITION: A string quartet is defined to be
+ a group of TWO musicians.
+
+
+REPLACING TEXT
+--------------
+The 'r' and 'R' commands allow you to directly type over existing text.
+
+ 'r' REPLACE character (NO need to press ESC)
+ 'R' enter over-type mode
+
+>>> Correct each of the TYPOs on the sample line below. To do this:
+>>> move the cursor to the misspelled character
+>>> type 'r'
+>>> type the correct character
+
+ SAMPLE: maintanence conveniance complience applience dilagent
+
+>>> Use the over-type command, 'R' , on the sample line above.
+>>> Type 'R' then type the name of a local restaurant. Press ESC.
+
+
+CHANGING TEXT
+-------------
+The change command combines insertion, deletion, and the movement
+commands. (Recall that the movement commands were taught in tutorial
+#2.) Change is probably more useful than replace or substitute. The
+general form of the change command is:
+
+ 'c'movement CHANGE to where the movement command specifies
+
+Consider the following examples:
+
+ 'c''w' CHANGE to the beginning of the next WORD
+ 'c''$' CHANGE to the end of the line
+ 'c'')' CHANGE to the beginning of the next sentence
+ 'c''t'e CHANGE 'TIL the next e
+ 'c''3''w' CHANGE the next 3 WORDS
+ 'c''c' CHANGE a line (cc is a special case of the c command)
+ 'c''}' CHANGE to the end of the paragraph
+
+>>> Follow these steps:
+>>> 1. move to the desired location in the practice paragraph below
+>>> 2. type 'c''w' (change to the beginning of the next WORD)
+>>> 3. type your name
+>>> 4. press ESC
+
+ PRACTICE here. Now is the time for all good users to learn the
+ editor. The quick red fox jumped over the seven lazy fish. Now
+ is the time for all good users to learn the editor. The quick
+ brown computer jumped over the seven lazy users. END PRACTICE
+
+>>> Experiment by using a variety of options for step #2. Try
+>>> out 'c''$' 'c'')' 'c''t'e 'c''3''w' 'c''c' 'c''}' on the practice paragraph above.
+
+Note that the change command follows the same pattern as the delete
+and yank commands which were explored in tutorial #3.
+
+
+SUMMARY
+-------
+
+ 'o' OPEN a line below the cursor
+ 'O' OPEN a line above the cursor
+
+ 'i' INSERT starting before the cursor
+ 'I' INSERT at the beginning of the line
+
+ 'a' APPEND starting after the cursor
+ 'A' APPEND at the end of the line
+
+ ESC ESCAPE from insert mode
+
+ 'J' JOIN two lines
+
+ #'s' SUBSTITUTE for # characters
+ #'S' SUBSTITUTE for # whole lines
+
+ 'r' REPLACE character (NO need to press ESC)
+ 'R' enter over-type mode
+
+ 'c'movement CHANGE to where the movement commands specifies
+ (e.g. 'c''3''w' 'c''$' 'c''c' )
+
+
+These commands should improve your ability to insert text efficiently.
+The next tutorials deal with advanced commands and tricks which can
+further speed up your editing.
+
+Copyright (c) 1992 Jill Kliger and Wesley Craig. All Rights Reserved.
--- /dev/null
+Viper tutorial #5: Tricks and Timesavers
+
+This lesson lasts 10-15 minutes. You should have a strong
+understanding of tutorials #1-3 before working through these timesaving
+techniques. Lines which begin with >>> mark exercises you should
+try. When you want to exit this tutorial type 'Z''Z' .
+
+
+CASE CONVERSION
+---------------
+When you want to change an upper-case character to a lower-case
+character (or lower-case to upper-case) there is a single command which
+does both:
+
+ '~' (tilde) Convert case of current character
+
+>>> Move the cursor to be OVER the first character in the example
+>>> line below. Press '~' until you have changed the case of the
+>>> entire line. ( '~' will advance to the right automatically).
+
+ bOB WENT TO pARIS, fRANCE, TO SEE THE #1 CYCLING EVENT. end.
+
+Note that '~' only affects alphabetic characters.
+
+
+UNDOING
+-------
+* EMACS-NOTICE: Uppercase U does the same thing as lowercase u in
+ Viper so this part of the tutorial which was about U has been
+ removed.
+
+
+REPEAT LAST COMMAND
+-------------------
+Often you want to make the same change at multiple locations in the
+file. To help accomplish this, vi remembers your previous action.
+
+ '.' (dot) repeat last change
+
+>>> Go through the example below changing "FISH" to "TOAD":
+>>> Go to the "F" in the first instance of "FISH"
+>>> To change the word: type 'c''w' then type TOAD then press ESC
+>>> Move the cursor to "F" in the second occurence of "FISH"
+>>> Type '.' (dot)
+>>> Move the cursor to "F" in the final occurence of "FISH"
+>>> Type '.' (dot)
+>>> Now move the cursor to each occurence of "CROW"; Type '.' (dot)
+
+ EXAMPLE: The FISH fed the cat. The CROW fed the cat. Example
+ text is FISH to make interesting. The man fed the CROW. The
+ worm fed the FISH. Example text is hard to make CROW. END.
+
+>>> Go through the example above deleting all occurences of "TOAD":
+>>> Move to the beginning of the EXAMPLE paragraph above.
+>>> Type '/''T''O''A''D' and press RETURN (recall tutorial #2)
+>>> Delete the word by typing 'd''w'
+>>> Type 'n' to move to the next occurence of "TOAD"
+>>> Type '.' (dot) to repeat the dw command
+>>> Use 'n''.' to delete the remaining "TOAD"s
+
+Note that '.' only repeats changes, not cursor movements.
+
+* EMACS-NOTICE: In Emacs '.' also repeat undo and redo.
+
+* EMACS-NOTICE: Emacs KEYBOARD-MACROS are very powerful for repeating
+ whole sequences of keyboard commands.
+
+
+WINDOW ACTIONS
+--------------
+You are already familiar with the C-u (depress the control key and
+type u) and C-d commands from tutorial #1.
+
+ C-d Move DOWN one half-screen
+ C-u Move UP one half-screen
+
+There are several related commands:
+
+ C-f Move FORWARD one full-screen
+ C-b Move BACKWARD one full-screen
+
+ C-e Move the window down one line without moving cursor
+ C-y Move the window up one line without moving cursor
+
+The C-e and C-y commands may seem obscure; however, notice that on
+the keyboard, e and y are close to d and u respectively. This
+should help you remember that C-e moves DOWN, and C-y moves UP.
+
+Recall the 'H' 'M' 'L' (HIGH MIDDLE LOW) window commands from Tutorial 2.
+Consider a scenario where you want to yank from the current line to a
+line near the top of the window. You could use C-e and C-y to
+position the text in the window before you use the yH command.
+
+The 'z' command also moves the window without moving your cursor:
+
+ 'z'<RETURN> Position the current line to top of window
+ 'z''.' Position the current line to middle of window
+ 'z''-' Position the current line to bottom of window
+
+>>> Move to this line. Type 'z' and press RETURN. Notice that
+>>> this text and the cursor have moved to the top of the window.
+>>> Try 'z''-' and 'z''.' also.
+
+
+FILE AND DISPLAY CONTROL
+------------------------
+
+* EMACS-NOTICE: In vi C-g shows the status of the current file, but
+ C-g in Emacs in most situation stops what Emacs is doing. To get
+ information about the current file you can use C-c C-g instead when
+ Viper is in vi state.
+
+* EMACS-NOTICE: In vi C-l refreshes the screen, but C-l in Emacs calls
+ the command recenter.
+
+
+SUSPENDING VI
+-------------
+* EMACS-NOTICE: In vi C-z suspends vi. However in Viper C-z is by
+ default the VIPER-TOGGLE-KEY. To suspend or iconify Emacs use C-x
+ C-z.
+
+
+BANG COMMAND
+------------
+* EMACS-NOTICE: Emacs has builtin commands to sort etc.
+
+The exclamation point, '!' (aka BANG), command allows you to feed text
+to any Unix command. The output of the Unix command replaces the
+original text. Here is a useful Unix command to use from within vi:
+
+ !}fmt Format the paragraph, joining and filling lines to
+ produce output lines of up to 72 characters
+
+>>> Move to the example paragraph below. Type !}fmt and press
+>>> RETURN. Notice the paragraph will be reformatted such that
+>>> the lines are of approximately equal length.
+
+ EXAMPLE:
+ So we grow together,
+ Like to a double cherry, seeming parted,
+ But yet an union in partition;
+ Two lovely berries moulded on one stem;
+ So, with two seeming bodies, but one heart;
+ END.
+
+Another useful command is:
+
+ !}sort Sort lines of a paragraph alphabetically
+
+>>> Move to the example text below. Type !}sort and press RETURN.
+
+ OBERON king of the fairies.
+ PUCK or Robin Goodfellow.
+ HERMIA daughter to Egeus, in love with Lysander.
+ HELENA in love with Demetrius.
+ LYSANDER in love with Hermia.
+ DEMETRIUS in love with Hermia.
+
+Remember, any Unix command may be used this way.
+
+
+SHIFTING TEXT
+-------------
+It is possible to shift large blocks of text right and left with the '>'
+and '<' commands.
+
+ '>'movement Shift right to where the movement command specifies
+ '<'movement Shift left to where the movement command specifies
+
+These commands work like the 'd' command. For example:
+
+ '>''}' Shift right to the end of the paragraph
+ '<''}' Shift left to the end of the paragraph
+ '>''>' Shift the current line right
+ '<''<' Shift the current line left
+
+>>> Move the cursor to the first line of the paragraph below.
+>>> Type '>''>' and '<''<' to shift the line back and forth. Next
+>>> try '>''}' to shift the paragraph to the right, then '<''}' to shift
+>>> it left, then type '.' until all four lines start at the left edge.
+
+ THIS IS THE FIRST LINE OF EXAMPLE TEXT
+ IS
+ EXAMPLE
+ TEXT END
+
+
+SUMMARY
+-------
+
+ '~' (tilde) Convert case of current character
+
+ 'U' * EMACS-NOTICE: Same as lowercase u undo in Viper.
+
+ '.' (dot) repeat last change
+
+ C-d Move DOWN one half-screen
+ (depress the control key and type d)
+
+ C-u Move UP one half-screen
+ (depress the control key and type u)
+
+ C-f Move FORWARD one full-screen
+ C-b Move BACKWARD one full-screen
+
+ C-e Move the window down one line without moving cursor
+ C-y Move the window up one line without moving cursor
+
+ 'z'<RETURN> Position the current line to top of window
+ 'z''.' Position the current line to middle of window
+ 'z''-' Position the current line to bottom of window
+
+ C-c C-g Show status of current file
+ C-l Recenter
+
+ '!'}fmt Format the paragraph, joining and filling lines to
+ produce output lines of up to 72 characters
+
+ '!'}sort Sort lines of a paragraph alphabetically
+
+ '>'movement Shift right to where the movement command specifies
+ '<'movement Shift left to where the movement command specifies
+
+
+These commands should significantly speed up your editing. Have a nice
+day. Tutorial 6 contains even more nifty commands.
+
+Copyright (c) 1992 Jill Kliger and Wesley Craig. All Rights Reserved.
--- /dev/null
+Viper Tutorial README
+=====================
+
+To install the Viper tutorial you must do two things:
+
+1) Put viper-tutorial.el in your Emacs load-path.
+
+2) Put the tutorial files (0intro, 1basics etc) in subdirectory to
+ where you put viper-tutorial.el with the name viper-tut.
+ Optionally you may put those file any where and customize the
+ option viper-tut-directory.
+
+The tutorial is started by
+
+ M-x viper-tutorial RET
+
+
+
+
+Viper tutorial is based on vilearn version 1.0 which was downloaded
+from http://vilearn.org.
+
+Below is the original readme from vilearn. Note that the only part
+that applies here is the copyright notice.
+
+---------------------------------------------------
+This is version 1.0 of vilearn, an interactive vi tutorial.
+
+Copyright (c) 1992 Jill Kliger and Wesley Craig. All Rights Reserved.
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appears in all copies and that
+the copyright notice, this permission notice, and an explicit record of
+any local changes, appear in supporting documentation. This software
+is supplied as is without expressed or implied warranties of any kind.
+
+To install, edit the Makefile and type
+
+ make install
+
+We have a mailing list, vilearn-admins@terminator.rs.itd.umich.edu. To
+be added to the list, send mail to vilearn-admins-request. The list is
+intended to discuss the tutorials, coordinate projects relating to
+them, and provide help to those who may need it.
+
+Wesley Craig & Jill Kliger
+1317 Packard Street vilearn@terminator.rs.itd.umich.edu
+Ann Arbor, MI 48104
--- /dev/null
+
+*
+* tutorial 1 FILENAME: 1basics
+* basics
+*
+
+C-d down
+C-u up
+
+h left
+j down
+k up
+l right
+
+dd delete line
+x x-out character
+
+u undo
+
+:q! force quit
+ZZ good bye
+
+o open
+i insert
+
+*
+* tutorial 2 FILENAME: 2moving
+* objects, finds & marks
+*
+
+w W word
+b B back
+e E end
+
+{ } paragraph
+( ) sentence
+[ ] sections
+
+$ end of line
+^ first non-white
+| column
+0 beginning of line
+
+f F find
+t T to
+; repeat fFtT
+, reverse fFtT
+
+G goto
+
+H high
+M middle
+L low
+
+n N next
+? / regex
+
+% match
+
+' move to marked line
+m mark
+
+
+*
+* tutorial 3 FILENAME: 3cutpaste & 3temp
+*
+* cutting, pasting, buffers, and files
+*
+
+d D deletes
+y Y yank
+p P put
+" buffer
+:e edit
+
+*
+* tutorial 4 FILENAME: 4inserting
+* insertion
+*
+
+a A append
+c C change
+i I insert
+o O open
+r R replace
+s S substitute
+
+J join
+
+*
+* tutorial 5 FILENAME: 5tricks
+* tricks
+*
+
+~ case
+
+u U undo
+
+. do again
+
+C-b back
+C-f forward
+C-e down line
+C-y up line
+z zero
+
+C-g status
+C-l refresh
+
+C-z suspend
+
+C-t pop tag proposed
+C-] follow tag proposed
+
+! command
+
+< > shift
+
+*
+* tutorial 6 PROPOSED
+* commands from hell
+*
+
+: colon commands
+Q quit
+C-r redraw
+@ execute buffer as macro
+& like :&
+
+C-t shift (insert)
+C-d unshift (insert)
--- /dev/null
+;;; nxhtml-base.el --- The very, very basic vars...
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2010-01-13 Wed
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Things that always must be loaded and that are often necessary when
+;; byte compiling.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;(eval-when-compile (require 'web-vcs nil t))
+(eval-when-compile (require 'flymake-js nil t))
+(eval-when-compile (require 'flymake-css nil t))
+(eval-when-compile (require 'flymake-java-1 nil t))
+
+(defconst nxhtml-menu:version "2.08")
+(setq message-log-max t)
+(setq debug-on-error t)
+
+(defconst nxhtml-install-dir
+ (file-name-directory (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+ "Installation directory for nXhtml.")
+
+(define-minor-mode nxhtml-autoload-web
+ "If on download elisp files from web when they are needed.
+If t then during `require' nXhtml elisp files can be downloaded
+from the nXhtml repository on the web. This will currently
+download the development sources, latest version.
+
+Other files that are used by a command may also be downloaded.
+
+Note that files are not updated automatically. You have to use
+`nxhtml-update-existing-files' for that."
+ :global t
+ ;;:lighter (propertize " nX" 'face 'font-lock-comment-face)
+ :lighter " nX"
+ :group 'nxhtml)
+
+(defun nxhtml-autoload (fun src &optional docstring interactive type)
+ "Generalized `autoload'. May setup autoload from the web.
+If `nxhtml-autoload-web' is t then setup autoloading from the web.
+Otherwise setup for normal local autoloading."
+ (if nxhtml-autoload-web
+ (progn
+ ;; Do not require this until we really need it.
+ (require 'web-autoload)
+ (web-autoload fun src docstring interactive type))
+ (let ((file src))
+ (when (listp file)
+ (setq file (file-name-nondirectory (nth 2 file))))
+ (autoload fun file docstring interactive type))))
+
+;; Fix-me: web autoload defcustoms.
+;;
+;; I have no good idea how to fix this. It looks like I have to
+;; defadvice `custom-load-symbol'. I thought that should not be
+;; necessary since it does (require load) on line 605 but the web
+;; autoload does not start. Why? Hm, you never know since it is inside
+;; a (condition-case nil ...).
+;;
+;; Ah, found it. The require is only done if custom loads contains a
+;; symbol, not a string. So I changed this to a symbol instead in
+;; nxhtml-loaddefs.el. Maybe `load' instead of `require' should be
+;; advised?
+
+;; What a hell is this below? Have things been rewritten in custom or
+;; did I mix somethintg?
+(defun nxhtml-custom-autoload (symbol load &optional noset)
+ "Like `custom-autoload', but also run :set for defcustoms etc."
+ ;; Fix-me: is-boundp is currently always t because of the order in
+ ;; loaddefs. Hm, so this worked just by chance...
+ (let* ((is-boundp (prog1 (boundp symbol)
+ (custom-autoload symbol load noset)))
+ (standard (get symbol 'standard-value))
+ (saved (get symbol 'saved-value))
+ ;; Fix-me: property custom-set etc are not available
+ (custom-set (get symbol 'custom-set))
+ (custom-initialize (get symbol 'custom-initialize))
+ (set (or custom-set 'custom-set-default))) ;; Fix-me: initialize
+ (setq custom-set t) ;; Not available here
+ (when (or custom-initialize
+ (and saved
+ (not (equal (car saved) (symbol-value symbol)))
+ custom-set))
+ (funcall set symbol (car saved))
+ (custom-load-symbol symbol))))
+
+(defun flymake-init-load-flymakemsg ()
+ (require 'flymakemsg))
+
+(define-minor-mode nxhtml-flymake-setup
+ "Let nXhtml add some addtions to flymake.
+This adds support for CSS and JavaScript files.
+
+It also adds showing of errors in minibuffer when point is on
+them.
+
+If you turn this off you must restart Emacs for it to take
+effect."
+ :group 'nxhtml
+ :group 'flymake
+ (when nxhtml-flymake-setup
+ (flymake-js-load)
+ (flymake-css-load)
+ (flymake-java-1-load)
+ (add-hook 'flymake-mode-hook 'flymake-init-load-flymakemsg)))
+
+
+(provide 'nxhtml-base)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtml-base.el ends here
--- /dev/null
+;; Autoloads for nXthml
+;;
+;; This file should be updated by `nxhtmlmaint-get-file-autoloads',
+;; `nxhtmlmaint-get-dir-autoloads' or `nxhtmlmaint-get-all-autoloads'.
+(eval-when-compile (require 'nxhtml-base))
+(eval-when-compile (require 'web-vcs))
+\f
+;;;### (autoloads (cancel-secondary-selection set-secondary-selection
+;;;;;; anchored-transpose) "anchored-transpose" "util/anchored-transpose.el"
+;;;;;; (19333 54924))
+;;; Generated autoloads from util/anchored-transpose.el
+(web-autoload-require 'anchored-transpose 'lp '(nxhtml-download-root-url nil) "util/anchored-transpose" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'anchored-transpose `(lp '(nxhtml-download-root-url nil) "util/anchored-transpose" nxhtml-install-dir) "\
+Transpose portions of the region around an anchor phrase.
+
+`this phrase but not that word' can be transposed into
+`that word but not this phrase'
+
+I want this phrase but not that word.
+ |----------------------------|. .This is the entire phrase.
+ |-------|. . . . . . .This is the anchor phrase.
+
+First select the entire phrase and type \\[anchored-transpose].
+This set the secondary selection.
+
+Then select the anchor phrase and type \\[anchored-transpose]
+again. Alternatively you can do the selections like this:
+
+I want this phrase but not that word.
+ |----------| |---------| Separate phrase selection.
+
+By default the anchor phrase will automatically include
+any surrounding whitespace even if you don't explicitly select
+it. Also, it won't include certain trailing punctuation. See
+`anchored-transpose-do-fuzzy' for details. A prefix arg prior to
+either selection means `no fuzzy logic, use selections
+literally'.
+
+You can select the regions to be swapped separately in any
+order.
+
+After swapping both primary and secondary selection are still
+active. They will be canceled after second next command if you
+do not swap regions again. (Second because this allow you to
+adjust the regions and try again.)
+
+You can also swap text between different buffers this way.
+
+Typing \\[anchored-transpose] with nothing selected clears any
+prior selection, ie secondary selection.
+
+\(fn BEG1 END1 FLG1 &optional BEG2 END2 FLG2 WIN2)" t nil)
+
+(nxhtml-autoload 'set-secondary-selection `(lp '(nxhtml-download-root-url nil) "util/anchored-transpose" nxhtml-install-dir) "\
+Set the secondary selection to the current region.
+This must be bound to a mouse drag event.
+
+\(fn BEG END)" t nil)
+
+(nxhtml-autoload 'cancel-secondary-selection `(lp '(nxhtml-download-root-url nil) "util/anchored-transpose" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (appmenu-mode appmenu-add appmenu) "appmenu" "util/appmenu.el"
+;;;;;; (19275 63380))
+;;; Generated autoloads from util/appmenu.el
+(web-autoload-require 'appmenu 'lp '(nxhtml-download-root-url nil) "util/appmenu" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'appmenu 'custom-loads))) (if (member '"appmenu" loads) nil (put 'appmenu 'custom-loads (cons '"appmenu" loads))))
+
+(nxhtml-autoload 'appmenu-add `(lp '(nxhtml-download-root-url nil) "util/appmenu" nxhtml-install-dir) "\
+Add entry to `appmenu-alist'.
+Add an entry to this list with ID, PRIORITY, TEST, TITLE and
+DEFINITION as explained there.
+
+\(fn ID PRIORITY TEST TITLE DEFINITION)" nil nil)
+
+(defvar appmenu-mode nil "\
+Non-nil if Appmenu mode is enabled.
+See the command `appmenu-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `appmenu-mode'.")
+
+(nxhtml-custom-autoload 'appmenu-mode 'appmenu nil)
+
+(nxhtml-autoload 'appmenu-mode `(lp '(nxhtml-download-root-url nil) "util/appmenu" nxhtml-install-dir) "\
+Use a context sensitive popup menu.
+AppMenu (appmenu.el) is a framework for creating cooperative
+context sensitive popup menus with commands from different major
+and minor modes. Using this different modes may cooperate about
+the use of popup menus.
+
+There is also the command `appmenu-as-help' that shows the key
+bindings at current point in the help buffer.
+
+The popup menu and the help buffer version are on these keys:
+
+\\{appmenu-mode-map}
+
+The variable `appmenu-alist' is where the popup menu entries
+comes from.
+
+If there is a `keymap' property at point then relevant bindings
+from this is also shown in the popup menu.
+
+You can write functions that use whatever information you want in
+Emacs to construct these entries. Since this information is only
+collected when the popup menu is shown you do not have to care as
+much about computation time as for entries in the menu bar.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (as-external-mode as-external-for-wiki as-external-for-mail-mode
+;;;;;; as-external-for-xhtml as-external) "as-external" "util/as-external.el"
+;;;;;; (19292 49706))
+;;; Generated autoloads from util/as-external.el
+(web-autoload-require 'as-external 'lp '(nxhtml-download-root-url nil) "util/as-external" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'as-external 'custom-loads))) (if (member '"as-external" loads) nil (put 'as-external 'custom-loads (cons '"as-external" loads))))
+
+(nxhtml-autoload 'as-external-for-xhtml `(lp '(nxhtml-download-root-url nil) "util/as-external" nxhtml-install-dir) "\
+Setup for Firefox addon It's All Text to edit XHTML.
+It's All Text is a Firefox add-on for editing textareas with an
+external editor.
+See URL `https://addons.mozilla.org/en-US/firefox/addon/4125'.
+
+In this case Emacs is used to edit textarea fields on a web page.
+The text will most often be part of a web page later, like on a
+blog. Therefore turn on these:
+
+- `nxhtml-mode' since some XHTML tags may be allowed.
+- `nxhtml-validation-header-mode' since it is not a full page.
+- `wrap-to-fill-column-mode' to see what you are writing.
+- `html-write-mode' to see it even better.
+
+Also bypass the question for line end conversion when using
+emacsw32-eol.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'as-external-for-mail-mode `(lp '(nxhtml-download-root-url nil) "util/as-external" nxhtml-install-dir) "\
+Setup for Firefox addon It's All Text to edit mail.
+Set normal mail comment markers in column 1 (ie >).
+
+Set `fill-column' to 90 and enable `wrap-to-fill-column-mode' so
+that it will look similar to how it will look in the sent plain
+text mail.
+
+See also `as-external-mode'.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'as-external-for-wiki `(lp '(nxhtml-download-root-url nil) "util/as-external" nxhtml-install-dir) "\
+Setup for Firefox addon It's All Text to edit MediaWikis.
+
+\(fn)" t nil)
+
+(defvar as-external-mode nil "\
+Non-nil if As-External mode is enabled.
+See the command `as-external-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `as-external-mode'.")
+
+(nxhtml-custom-autoload 'as-external-mode 'as-external nil)
+
+(nxhtml-autoload 'as-external-mode `(lp '(nxhtml-download-root-url nil) "util/as-external" nxhtml-install-dir) "\
+If non-nil check if Emacs is called as external editor.
+When Emacs is called as an external editor for example to edit
+text areas on a web page viewed with Firefox this library tries
+to help to setup the buffer in a useful way. It may for example
+set major and minor modes for the buffer.
+
+This can for example be useful when blogging or writing comments
+on blogs.
+
+See `as-external-alist' for more information.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (buffer-bg-set-color) "buffer-bg" "util/buffer-bg.el"
+;;;;;; (19254 64104))
+;;; Generated autoloads from util/buffer-bg.el
+(web-autoload-require 'buffer-bg 'lp '(nxhtml-download-root-url nil) "util/buffer-bg" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'buffer-bg-set-color `(lp '(nxhtml-download-root-url nil) "util/buffer-bg" nxhtml-install-dir) "\
+Add an overlay with background color COLOR to buffer BUFFER.
+If COLOR is nil remove previously added overlay.
+
+\(fn COLOR BUFFER)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (chartg-make-chart chartg-complete) "chartg" "util/chartg.el"
+;;;;;; (19278 15746))
+;;; Generated autoloads from util/chartg.el
+(web-autoload-require 'chartg 'lp '(nxhtml-download-root-url nil) "util/chartg" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'chartg-complete `(lp '(nxhtml-download-root-url nil) "util/chartg" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'chartg-make-chart `(lp '(nxhtml-download-root-url nil) "util/chartg" nxhtml-install-dir) "\
+Try to make a new chart.
+If region is active then make a new chart from data in the
+selected region.
+
+Else if current buffer is in `chartg-mode' then do it from the
+chart specifications in this buffer. Otherwise create a new
+buffer and initialize it with `chartg-mode'.
+
+If the chart specifications are complete enough to make a chart
+then do it and show the resulting chart image. If not then tell
+user what is missing.
+
+NOTE: This is beta, no alpha code. It is not ready.
+
+Below are some examples. To test them mark an example and do
+
+ M-x chartg-make-chart
+
+* Example, simple x-y chart:
+
+ Output-file: \"~/temp-chart.png\"
+ Size: 200 200
+ Data: 3 8 5 | 10 20 30
+ Type: line-chartg-xy
+
+* Example, pie:
+
+ Output-file: \"~/temp-depression.png\"
+ Size: 400 200
+ Data:
+ 2,160,000
+ 3,110,000
+ 1,510,000
+ 73,600
+ 775,000
+ 726,000
+ 8,180,000
+ 419,000
+ Type: pie-3-dimensional
+ Chartg-title: \"Depression hits on Google\"
+ Legends:
+ \"SSRI\"
+ | \"Psychotherapy\"
+ | \"CBT\"
+ | \"IPT\"
+ | \"Psychoanalysis\"
+ | \"Mindfulness\"
+ | \"Meditation\"
+ | \"Exercise\"
+
+
+* Example, pie:
+
+ Output-file: \"~/temp-panic.png\"
+ Size: 400 200
+ Data:
+ 979,000
+ 969,000
+ 500,000
+ 71,900
+ 193,000
+ 154,000
+ 2,500,000
+ 9,310,000
+ Type: pie-3-dimensional
+ Chartg-title: \"Depression hits on Google\"
+ Legends:
+ \"SSRI\"
+ | \"Psychotherapy\"
+ | \"CBT\"
+ | \"IPT\"
+ | \"Psychoanalysis\"
+ | \"Mindfulness\"
+ | \"Meditation\"
+ | \"Exercise\"
+
+
+* Example using raw:
+
+ Output-file: \"~/temp-chartg-slipsen-kostar.png\"
+ Size: 400 130
+ Data: 300 1000 30000
+ Type: bar-chartg-horizontal
+ Chartg-title: \"Vad killen i slips tjänar jämfört med dig och mig\"
+ Google-chartg-raw: \"&chds=0,30000&chco=00cd00|ff4500|483d8b&chxt=y,x&chxl=0:|Killen+i+slips|Partiledarna|Du+och+jag&chf=bg,s,ffd700\"
+
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (css-color-test css-color-global-mode css-color-mode
+;;;;;; css-color) "css-color" "util/css-color.el" (19386 34254))
+;;; Generated autoloads from util/css-color.el
+(web-autoload-require 'css-color 'lp '(nxhtml-download-root-url nil) "util/css-color" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'css-color 'custom-loads))) (if (member '"css-color" loads) nil (put 'css-color 'custom-loads (cons '"css-color" loads))))
+
+(nxhtml-autoload 'css-color-mode `(lp '(nxhtml-download-root-url nil) "util/css-color" nxhtml-install-dir) "\
+Show hex color literals with the given color as background.
+In this mode hexadecimal colour specifications like #6600ff are
+displayed with the specified colour as background.
+
+Certain keys are bound to special colour editing commands when
+point is at a hexadecimal colour:
+
+\\{css-color-map}
+
+\(fn &optional ARG)" t nil)
+
+(defvar css-color-global-mode nil "\
+Non-nil if Css-Color-Global mode is enabled.
+See the command `css-color-global-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `css-color-global-mode'.")
+
+(nxhtml-custom-autoload 'css-color-global-mode 'css-color nil)
+
+(nxhtml-autoload 'css-color-global-mode `(lp '(nxhtml-download-root-url nil) "util/css-color" nxhtml-install-dir) "\
+Toggle Css-Color mode in every possible buffer.
+With prefix ARG, turn Css-Color-Global mode on if and only if
+ARG is positive.
+Css-Color mode is enabled in all buffers where
+`css-color-turn-on-in-buffer' would do it.
+See `css-color-mode' for more information on Css-Color mode.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'css-color-test `(lp '(nxhtml-download-root-url nil) "util/css-color" nxhtml-install-dir) "\
+Test colors interactively.
+The colors are displayed in the echo area. You can specify the
+colors as any viable css color. Example:
+
+ red
+ #f00
+ #0C0
+ #b0ff00
+ hsla(100, 50%, 25%)
+ rgb(255,100,120)
+
+\(fn FG-COLOR BG-COLOR)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (css-palette-global-mode css-palette css-palette-mode)
+;;;;;; "css-palette" "util/css-palette.el" (19235 1650))
+;;; Generated autoloads from util/css-palette.el
+(web-autoload-require 'css-palette 'lp '(nxhtml-download-root-url nil) "util/css-palette" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'css-palette-mode `(lp '(nxhtml-download-root-url nil) "util/css-palette" nxhtml-install-dir) "\
+Minor mode for palettes in CSS.
+
+The mode `css-palette-mode' acts on the first COLORS declaration in your
+ file of the form:
+
+COLORS:
+\(
+c0 \"#6f5d25\" ;tainted sand
+c1 \"#000000\" ;Black
+c2 \"#cca42b\" ;goldenslumber
+c3 \"#6889cb\" ;far off sky
+c4 \"#fff\" ;strange aeons
+)
+
+Such declarations should appear inside a block comment, in order
+ to be parsed properly by the LISP reader.
+
+Type \\[css-palette-update-all], and any occurence of
+
+ color: #f55; /*[c3]*/
+
+will be updated with
+
+ color: #6899cb; /*[c3]*/
+
+The following commands are available to insert key-value pairs
+ and palette declarations:
+ \\{css-palette-mode-map}
+
+You can extend or redefine the types of palettes by defining a
+ new palette specification of the form (PATTERN REGEXP
+ REF-FOLLOWS-VALUE), named according to the naming scheme
+ css-palette:my-type, where
+
+PATTERN is a pattern containing two (%s) format directives which
+ will be filled in with the variable and its value,
+
+REGEXP is a regular expression to match a value - variable
+ pattern,
+
+and REF-FOLLOWS-VALUE defined whether or not the reference comes
+ after the value. This allows for more flexibility.
+
+Note that, although the w3c spec at URL
+ `http://www.w3.org/TR/CSS2/syndata.html#comments' says that
+ comments \" may occur anywhere between tokens, and their
+ contents have no influence on the rendering\", Internet
+ Explorer does not think so. Better keep all your comments after
+ a \"statement\", as per the default. This means `css-palette'
+ is ill-suited for use within shorthands.
+
+See variable `css-palette:colors' for an example of a palette
+ type.
+
+The extension mechanism means that palette types can be used to
+ contain arbitrary key-value mappings.
+
+Besides the colors palette, css-palette defines the palette
+ definition variables `css-palette:colors-outside' and
+ `css-palette:files', for colors with the reference outside and
+ for file url()'s respectively.
+
+You can fine-control which palette types css-palette should look
+ at via the variable `css-palette-types'.
+
+\(fn &optional ARG)" t nil)
+
+(let ((loads (get 'css-palette 'custom-loads))) (if (member '"css-palette" loads) nil (put 'css-palette 'custom-loads (cons '"css-palette" loads))))
+
+(defvar css-palette-global-mode nil "\
+Non-nil if Css-Palette-Global mode is enabled.
+See the command `css-palette-global-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `css-palette-global-mode'.")
+
+(nxhtml-custom-autoload 'css-palette-global-mode 'css-palette nil)
+
+(nxhtml-autoload 'css-palette-global-mode `(lp '(nxhtml-download-root-url nil) "util/css-palette" nxhtml-install-dir) "\
+Toggle Css-Palette mode in every possible buffer.
+With prefix ARG, turn Css-Palette-Global mode on if and only if
+ARG is positive.
+Css-Palette mode is enabled in all buffers where
+`css-palette-turn-on-in-buffer' would do it.
+See `css-palette-mode' for more information on Css-Palette mode.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (cusnu-export-my-skin-options customize-for-new-user)
+;;;;;; "cus-new-user" "util/cus-new-user.el" (19173 56140))
+;;; Generated autoloads from util/cus-new-user.el
+(web-autoload-require 'cus-new-user 'lp '(nxhtml-download-root-url nil) "util/cus-new-user" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'customize-for-new-user `(lp '(nxhtml-download-root-url nil) "util/cus-new-user" nxhtml-install-dir) "\
+Show special customization page for new user.
+
+\(fn &optional NAME)" t nil)
+
+(nxhtml-autoload 'cusnu-export-my-skin-options `(lp '(nxhtml-download-root-url nil) "util/cus-new-user" nxhtml-install-dir) "\
+Export to file FILE custom options in `cusnu-my-skin-options'.
+The options is exported to elisp code that other users can run to
+set the options that you have added to `cusnu-my-skin-options'.
+
+For more information about this see `cusnu-export-cust-group'.
+
+\(fn FILE)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (ediff-url) "ediff-url" "util/ediff-url.el" (19362
+;;;;;; 34258))
+;;; Generated autoloads from util/ediff-url.el
+(web-autoload-require 'ediff-url 'lp '(nxhtml-download-root-url nil) "util/ediff-url" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'ediff-url `(lp '(nxhtml-download-root-url nil) "util/ediff-url" nxhtml-install-dir) "\
+Compare current buffer to a web URL using `ediff-buffers'.
+Check URL using `ediff-url-redirects' before fetching the file.
+
+This is for checking downloaded file. A the file may have a comment
+telling the download URL of thise form in the header:
+
+ ;; URL: http://the-server.net/the-path/the-file.el
+
+If not the user is asked for the URL.
+
+\(fn URL)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (ffip-find-file-in-dirtree ffip-set-current-project)
+;;;;;; "ffip" "util/ffip.el" (19257 25432))
+;;; Generated autoloads from util/ffip.el
+(web-autoload-require 'ffip 'lp '(nxhtml-download-root-url nil) "util/ffip" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'ffip-set-current-project `(lp '(nxhtml-download-root-url nil) "util/ffip" nxhtml-install-dir) "\
+Setup ffip project NAME with top directory ROOT of type TYPE.
+ROOT can either be just a directory or a list of directory where
+the first used just for prompting purposes and the files in the
+rest are read into the ffip project.
+
+Type is a type in `ffip-project-file-types'.
+
+\(fn NAME ROOT TYPE)" nil nil)
+
+(nxhtml-autoload 'ffip-find-file-in-dirtree `(lp '(nxhtml-download-root-url nil) "util/ffip" nxhtml-install-dir) "\
+Find files in directory tree ROOT.
+
+\(fn ROOT)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (fold-dwim-turn-on-outline-and-hide-all fold-dwim-turn-on-hs-and-hide
+;;;;;; fold-dwim-unhide-hs-and-outline fold-dwim-mode fold-dwim-toggle
+;;;;;; fold-dwim) "fold-dwim" "util/fold-dwim.el" (19218 42180))
+;;; Generated autoloads from util/fold-dwim.el
+(web-autoload-require 'fold-dwim 'lp '(nxhtml-download-root-url nil) "util/fold-dwim" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'fold-dwim 'custom-loads))) (if (member '"fold-dwim" loads) nil (put 'fold-dwim 'custom-loads (cons '"fold-dwim" loads))))
+
+(nxhtml-autoload 'fold-dwim-toggle `(lp '(nxhtml-download-root-url nil) "util/fold-dwim" nxhtml-install-dir) "\
+Toggle visibility or some other visual things.
+Try toggling different visual things in this order:
+
+- Images shown at point with `inlimg-mode'
+- Text at point prettified by `html-write-mode'.
+
+For the rest it unhides if possible, otherwise hides in this
+order:
+
+- `org-mode' header or something else using that outlines.
+- Maybe `fold-dwim-toggle-selective-display'.
+- `Tex-fold-mode' things.
+- In html if `outline-minor-mode' and after heading hide content.
+- `hs-minor-mode' things.
+- `outline-minor-mode' things. (Turns maybe on this.)
+
+It uses `fold-dwim-show' to show any hidden text at point; if no
+hidden fold is found, try `fold-dwim-hide' to hide the
+construction at the cursor.
+
+Note: Also first turn on `fold-dwim-mode' to get the keybinding
+for this function from it.
+
+\(fn)" t nil)
+
+(defvar fold-dwim-mode nil "\
+Non-nil if Fold-Dwim mode is enabled.
+See the command `fold-dwim-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `fold-dwim-mode'.")
+
+(nxhtml-custom-autoload 'fold-dwim-mode 'fold-dwim nil)
+
+(nxhtml-autoload 'fold-dwim-mode `(lp '(nxhtml-download-root-url nil) "util/fold-dwim" nxhtml-install-dir) "\
+Key binding for `fold-dwim-toggle'.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'fold-dwim-unhide-hs-and-outline `(lp '(nxhtml-download-root-url nil) "util/fold-dwim" nxhtml-install-dir) "\
+Unhide everything hidden by Hide/Show and Outline.
+Ie everything hidden by `hs-minor-mode' and
+`outline-minor-mode'.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'fold-dwim-turn-on-hs-and-hide `(lp '(nxhtml-download-root-url nil) "util/fold-dwim" nxhtml-install-dir) "\
+Turn on minor mode `hs-minor-mode' and hide.
+If major mode is derived from `nxml-mode' call `hs-hide-block'
+else call `hs-hide-all'.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'fold-dwim-turn-on-outline-and-hide-all `(lp '(nxhtml-download-root-url nil) "util/fold-dwim" nxhtml-install-dir) "\
+Turn on `outline-minor-mode' and call `hide-body'.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (foldit-global-mode foldit-mode foldit) "foldit"
+;;;;;; "util/foldit.el" (19275 63380))
+;;; Generated autoloads from util/foldit.el
+(web-autoload-require 'foldit 'lp '(nxhtml-download-root-url nil) "util/foldit" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'foldit 'custom-loads))) (if (member '"foldit" loads) nil (put 'foldit 'custom-loads (cons '"foldit" loads))))
+
+(nxhtml-autoload 'foldit-mode `(lp '(nxhtml-download-root-url nil) "util/foldit" nxhtml-install-dir) "\
+Minor mode providing visual aids for folding.
+Shows some hints about what you have hidden and how to reveal it.
+
+Supports `hs-minor-mode', `outline-minor-mode' and major modes
+derived from `outline-mode'.
+
+\(fn &optional ARG)" t nil)
+
+(defvar foldit-global-mode nil "\
+Non-nil if Foldit-Global mode is enabled.
+See the command `foldit-global-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `foldit-global-mode'.")
+
+(nxhtml-custom-autoload 'foldit-global-mode 'foldit nil)
+
+(nxhtml-autoload 'foldit-global-mode `(lp '(nxhtml-download-root-url nil) "util/foldit" nxhtml-install-dir) "\
+Toggle Foldit mode in every possible buffer.
+With prefix ARG, turn Foldit-Global mode on if and only if
+ARG is positive.
+Foldit mode is enabled in all buffers where
+`(lambda nil (foldit-mode 1))' would do it.
+See `foldit-mode' for more information on Foldit mode.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (gimpedit-can-edit gimpedit-edit-buffer gimpedit-edit-file
+;;;;;; gimpedit) "gimpedit" "util/gimpedit.el" (19275 63380))
+;;; Generated autoloads from util/gimpedit.el
+(web-autoload-require 'gimpedit 'lp '(nxhtml-download-root-url nil) "util/gimpedit" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'gimpedit 'custom-loads))) (if (member '"gimpedit" loads) nil (put 'gimpedit 'custom-loads (cons '"gimpedit" loads))))
+
+(nxhtml-autoload 'gimpedit-edit-file `(lp '(nxhtml-download-root-url nil) "util/gimpedit" nxhtml-install-dir) "\
+Edit IMAGE-FILE with GIMP.
+See also `gimpedit-edit-file'.
+
+\(fn IMAGE-FILE &optional EXTRA-ARGS)" t nil)
+
+(nxhtml-autoload 'gimpedit-edit-buffer `(lp '(nxhtml-download-root-url nil) "util/gimpedit" nxhtml-install-dir) "\
+Edit image file in current buffer with GIMP.
+See also `gimpedit-edit-file'.
+
+You may also be interested in gimpedit-mode with which you can edit
+gimp files from within Emacs using GIMP's scripting
+possibilities. See
+
+ URL `http://www.emacswiki.org/emacs/GimpMode'
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'gimpedit-can-edit `(lp '(nxhtml-download-root-url nil) "util/gimpedit" nxhtml-install-dir) "\
+Not documented
+
+\(fn FILE-NAME)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (gpl-mode) "gpl" "util/gpl.el" (18795 27308))
+;;; Generated autoloads from util/gpl.el
+(web-autoload-require 'gpl 'lp '(nxhtml-download-root-url nil) "util/gpl" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'gpl-mode `(lp '(nxhtml-download-root-url nil) "util/gpl" nxhtml-install-dir) "\
+Mode for font-locking and editing color palettes of the GPL format.
+
+Such palettes are used and produced by free software applications
+such as the GIMP, Inkscape, Scribus, Agave and on-line tools such
+as http://colourlovers.com.
+
+You can also use
+URL `http://niels.kicks-ass.org/public/elisp/css-palette.el' to import
+such palette into a css-file as hexadecimal color palette.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (hfyview-frame hfyview-window hfyview-region hfyview-buffer
+;;;;;; hfyview-quick-print-in-files-menu) "hfyview" "util/hfyview.el"
+;;;;;; (19400 17335))
+;;; Generated autoloads from util/hfyview.el
+(web-autoload-require 'hfyview 'lp '(nxhtml-download-root-url nil) "util/hfyview" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(defvar hfyview-quick-print-in-files-menu nil "\
+Add Quick print entries to File menu if non-nil.
+If you set this to nil you have to restart Emacs to get rid of
+the Quick Print entry.")
+
+(nxhtml-custom-autoload 'hfyview-quick-print-in-files-menu 'hfyview nil)
+
+(nxhtml-autoload 'hfyview-buffer `(lp '(nxhtml-download-root-url nil) "util/hfyview" nxhtml-install-dir) "\
+Convert buffer to html preserving faces and show in web browser.
+With command prefix ARG also show html source in other window.
+
+\(fn ARG)" t nil)
+
+(nxhtml-autoload 'hfyview-region `(lp '(nxhtml-download-root-url nil) "util/hfyview" nxhtml-install-dir) "\
+Convert region to html preserving faces and show in web browser.
+With command prefix ARG also show html source in other window.
+
+\(fn ARG)" t nil)
+
+(nxhtml-autoload 'hfyview-window `(lp '(nxhtml-download-root-url nil) "util/hfyview" nxhtml-install-dir) "\
+Convert window to html preserving faces and show in web browser.
+With command prefix ARG also show html source in other window.
+
+\(fn ARG)" t nil)
+
+(nxhtml-autoload 'hfyview-frame `(lp '(nxhtml-download-root-url nil) "util/hfyview" nxhtml-install-dir) "\
+Convert frame to html preserving faces and show in web browser.
+Make an XHTML view of the current Emacs frame. Put it in a buffer
+named *hfyview-frame* and show that buffer in a web browser.
+
+If WHOLE-BUFFERS is non-nil then the whole content of the buffers
+is shown in the XHTML page, otherwise just the part that is
+visible currently on the frame.
+
+If you turn on the minor mode `hfyview-frame-mode' you can also
+get the minibuffer/echo area in the output. See this mode for
+details.
+
+With command prefix also show html source in other window.
+
+\(fn WHOLE-BUFFERS)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (hl-needed-mode hl-needed) "hl-needed" "util/hl-needed.el"
+;;;;;; (19394 16942))
+;;; Generated autoloads from util/hl-needed.el
+(web-autoload-require 'hl-needed 'lp '(nxhtml-download-root-url nil) "util/hl-needed" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'hl-needed 'custom-loads))) (if (member '"hl-needed" loads) nil (put 'hl-needed 'custom-loads (cons '"hl-needed" loads))))
+
+(defvar hl-needed-mode nil "\
+Non-nil if Hl-Needed mode is enabled.
+See the command `hl-needed-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `hl-needed-mode'.")
+
+(nxhtml-custom-autoload 'hl-needed-mode 'hl-needed nil)
+
+(nxhtml-autoload 'hl-needed-mode `(lp '(nxhtml-download-root-url nil) "util/hl-needed" nxhtml-install-dir) "\
+Try to highlight current line and column when needed.
+This is a global minor mode. It can operate in some different
+ways:
+
+- Highlighting can be on always, see `hl-needed-always'.
+
+Or, it can be turned on depending on some conditions. In this
+case highlighting is turned off after each command and turned on
+again in the current window when either:
+
+- A new window was selected, see `hl-needed-on-new-window'.
+- A new buffer was selected, see `hl-needed-on-new-buffer'.
+- Window configuration was changed, see `hl-needed-on-config-change'.
+- Buffer was scrolled see `hl-needed-on-scrolling'.
+- A window was clicked with the mouse, see `hl-needed-on-mouse'.
+
+After this highlighting may be turned off again, normally after a
+short delay, see `hl-needed-flash'.
+
+If either highlighting was not turned on or was turned off again
+it will be turned on when
+
+- Emacs has been idle for `hl-needed-idle-time' seconds.
+
+See also `hl-needed-not-in-modes' and `hl-needed-currently-fun'.
+
+Note 1: For columns to be highlighted vline.el must be available.
+
+Note 2: This mode depends on `hl-line-mode' and `vline-mode' and
+tries to cooperate with them. If you turn on either of these that
+overrides the variables for turning on the respective
+highlighting here.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (html-write-mode html-write) "html-write" "util/html-write.el"
+;;;;;; (19275 63380))
+;;; Generated autoloads from util/html-write.el
+(web-autoload-require 'html-write 'lp '(nxhtml-download-root-url nil) "util/html-write" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'html-write 'custom-loads))) (if (member '"html-write" loads) nil (put 'html-write 'custom-loads (cons '"html-write" loads))))
+
+(nxhtml-autoload 'html-write-mode `(lp '(nxhtml-download-root-url nil) "util/html-write" nxhtml-install-dir) "\
+Minor mode for convenient display of some HTML tags.
+When this mode is on a tag in `html-write-tag-list' is displayed as
+the inner text of the tag with a face corresponding to the tag.
+By default for example <i>...</i> is displayed as italic and
+<a>...</a> is displayed as an underlined clickable link.
+
+Only non-nested tags are hidden. The idea is just that it should
+be easier to read and write, not that it should look as html
+rendered text.
+
+See the customization group `html-write' for more information about
+faces.
+
+The following keys are defined when you are on a tag handled by
+this minor mode:
+
+\\{html-write-keymap}
+
+IMPORTANT: Most commands you use works also on the text that is
+hidden. The movement commands is an exception, but as soon as
+you edit the buffer you may also change the hidden parts.
+
+Hint: Together with `wrap-to-fill-column-mode' this can make it
+easier to see what text you are actually writing in html parts of
+a web file.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (inlimg-toggle-slicing inlimg-toggle-display inlimg-global-mode
+;;;;;; inlimg-mode inlimg) "inlimg" "util/inlimg.el" (19269 33008))
+;;; Generated autoloads from util/inlimg.el
+(web-autoload-require 'inlimg 'lp '(nxhtml-download-root-url nil) "util/inlimg" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'inlimg 'custom-loads))) (if (member '"inlimg" loads) nil (put 'inlimg 'custom-loads (cons '"inlimg" loads))))
+
+(nxhtml-autoload 'inlimg-mode `(lp '(nxhtml-download-root-url nil) "util/inlimg" nxhtml-install-dir) "\
+Display images inline.
+Search buffer for image tags. Display found images.
+
+Image tags are setup per major mode in `inlimg-mode-specs'.
+
+Images are displayed on a line below the tag referencing them.
+The whole image or a slice of it may be displayed, see
+`inlimg-slice'. Margins relative text are specified in
+`inlimg-margins'.
+
+See also the commands `inlimg-toggle-display' and
+`inlimg-toggle-slicing'.
+
+Note: This minor mode uses `font-lock-mode'.
+
+\(fn &optional ARG)" t nil)
+
+(defvar inlimg-global-mode nil "\
+Non-nil if Inlimg-Global mode is enabled.
+See the command `inlimg-global-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `inlimg-global-mode'.")
+
+(nxhtml-custom-autoload 'inlimg-global-mode 'inlimg nil)
+
+(nxhtml-autoload 'inlimg-global-mode `(lp '(nxhtml-download-root-url nil) "util/inlimg" nxhtml-install-dir) "\
+Toggle Inlimg mode in every possible buffer.
+With prefix ARG, turn Inlimg-Global mode on if and only if
+ARG is positive.
+Inlimg mode is enabled in all buffers where
+`inlimg--global-turn-on' would do it.
+See `inlimg-mode' for more information on Inlimg mode.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'inlimg-toggle-display `(lp '(nxhtml-download-root-url nil) "util/inlimg" nxhtml-install-dir) "\
+Toggle display of image at point POINT.
+See also the command `inlimg-mode'.
+
+\(fn POINT)" t nil)
+
+(nxhtml-autoload 'inlimg-toggle-slicing `(lp '(nxhtml-download-root-url nil) "util/inlimg" nxhtml-install-dir) "\
+Toggle slicing of image at point POINT.
+See also the command `inlimg-mode'.
+
+\(fn POINT)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (majmodpri majmodpri-apply-priorities majmodpri-apply
+;;;;;; majmodpri-sort-lists) "majmodpri" "util/majmodpri.el" (19407
+;;;;;; 18407))
+;;; Generated autoloads from util/majmodpri.el
+(web-autoload-require 'majmodpri 'lp '(nxhtml-download-root-url nil) "util/majmodpri" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'majmodpri-sort-lists `(lp '(nxhtml-download-root-url nil) "util/majmodpri" nxhtml-install-dir) "\
+Sort the list used when selecting major mode.
+Only sort those lists choosen in `majmodpri-lists-to-sort'.
+Sort according to priorities in `majmodpri-mode-priorities'.
+Keep the old order in the list otherwise.
+
+The lists can be sorted when loading elisp libraries, see
+`majmodpri-sort-after-load'.
+
+See also `majmodpri-apply-priorities'.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'majmodpri-apply `(lp '(nxhtml-download-root-url nil) "util/majmodpri" nxhtml-install-dir) "\
+Sort major mode lists and apply to existing buffers.
+Note: This function is suitable to add to
+`desktop-after-read-hook'. It will restore the multi major modes
+in buffers.
+
+\(fn)" nil nil)
+
+(nxhtml-autoload 'majmodpri-apply-priorities `(lp '(nxhtml-download-root-url nil) "util/majmodpri" nxhtml-install-dir) "\
+Apply major mode priorities.
+First run `majmodpri-sort-lists' and then if CHANGE-MODES is
+non-nil apply to existing file buffers. If interactive ask
+before applying.
+
+\(fn CHANGE-MODES)" t nil)
+
+(let ((loads (get 'majmodpri 'custom-loads))) (if (member '"majmodpri" loads) nil (put 'majmodpri 'custom-loads (cons '"majmodpri" loads))))
+
+;;;***
+\f
+;;;### (autoloads (markchars-global-mode markchars-mode markchars)
+;;;;;; "markchars" "util/markchars.el" (19372 5886))
+;;; Generated autoloads from util/markchars.el
+(web-autoload-require 'markchars 'lp '(nxhtml-download-root-url nil) "util/markchars" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'markchars 'custom-loads))) (if (member '"markchars" loads) nil (put 'markchars 'custom-loads (cons '"markchars" loads))))
+
+(nxhtml-autoload 'markchars-mode `(lp '(nxhtml-download-root-url nil) "util/markchars" nxhtml-install-dir) "\
+Mark special characters.
+Which characters to mark are defined by `markchars-keywords'.
+
+The default is to mark non-IDN, non-ascii chars with a magenta
+underline.
+
+For information about IDN chars see `idn-is-recommended'.
+
+If you change anything in the customization group `markchars' you
+must restart this minor mode for the changes to take effect.
+
+\(fn &optional ARG)" t nil)
+
+(defvar markchars-global-mode nil "\
+Non-nil if Markchars-Global mode is enabled.
+See the command `markchars-global-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `markchars-global-mode'.")
+
+(nxhtml-custom-autoload 'markchars-global-mode 'markchars nil)
+
+(nxhtml-autoload 'markchars-global-mode `(lp '(nxhtml-download-root-url nil) "util/markchars" nxhtml-install-dir) "\
+Toggle Markchars mode in every possible buffer.
+With prefix ARG, turn Markchars-Global mode on if and only if
+ARG is positive.
+Markchars mode is enabled in all buffers where
+`(lambda nil (markchars-mode 1))' would do it.
+See `markchars-mode' for more information on Markchars mode.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (mlinks-global-mode mlinks-mode mlinks) "mlinks"
+;;;;;; "util/mlinks.el" (19364 56214))
+;;; Generated autoloads from util/mlinks.el
+(web-autoload-require 'mlinks 'lp '(nxhtml-download-root-url nil) "util/mlinks" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'mlinks 'custom-loads))) (if (member '"mlinks" loads) nil (put 'mlinks 'custom-loads (cons '"mlinks" loads))))
+
+(nxhtml-autoload 'mlinks-mode `(lp '(nxhtml-download-root-url nil) "util/mlinks" nxhtml-install-dir) "\
+Recognizes certain parts of a buffer as hyperlinks.
+The hyperlinks are created in different ways for different major
+modes with the help of the functions in the list
+`mlinks-mode-functions'.
+
+The hyperlinks can be hilighted when point is over them. Use
+`mlinks-toggle-hilight' to toggle this feature for the current
+buffer.
+
+All keybindings in this mode are by default done under the prefi§x
+key
+
+ C-c RET
+
+which is supposed to be a kind of mnemonic for link (alluding to
+the RET key commonly used in web browser to follow a link).
+\(Unfortunately this breaks the rules in info node `Key Binding
+Conventions'.) Below are the key bindings defined by this mode:
+
+\\{mlinks-mode-map}
+
+For some major modes `mlinks-backward-link' and
+`mlinks-forward-link' will take you to the previous/next link.
+By default the link moved to will be active, see
+`mlinks-active-links'.
+
+\(fn &optional ARG)" t nil)
+
+(defvar mlinks-global-mode nil "\
+Non-nil if Mlinks-Global mode is enabled.
+See the command `mlinks-global-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `mlinks-global-mode'.")
+
+(nxhtml-custom-autoload 'mlinks-global-mode 'mlinks nil)
+
+(nxhtml-autoload 'mlinks-global-mode `(lp '(nxhtml-download-root-url nil) "util/mlinks" nxhtml-install-dir) "\
+Toggle Mlinks mode in every possible buffer.
+With prefix ARG, turn Mlinks-Global mode on if and only if
+ARG is positive.
+Mlinks mode is enabled in all buffers where
+`mlinks-turn-on-in-buffer' would do it.
+See `mlinks-mode' for more information on Mlinks mode.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (mumamo-multi-major-modep mumamo-list-defined-multi-major-modes
+;;;;;; mumamo-mark-for-refontification mumamo-hi-lock-faces mumamo
+;;;;;; mumamo-add-to-defined-multi-major-modes define-mumamo-multi-major-mode)
+;;;;;; "mumamo" "util/mumamo.el" (19412 26290))
+;;; Generated autoloads from util/mumamo.el
+(web-autoload-require 'mumamo 'lp '(nxhtml-download-root-url nil) "util/mumamo" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'define-mumamo-multi-major-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo" nxhtml-install-dir) "\
+Define a function that turn on support for multiple major modes.
+Define a function FUN-SYM that set up to divide the current
+buffer into chunks with different major modes.
+
+The documentation string for FUN-SYM should contain the special
+documentation in the string SPEC-DOC, general documentation for
+functions of this type and information about chunks.
+
+The new function will use the definitions in CHUNKS (which is
+called a \"chunk family\") to make the dividing of the buffer.
+
+The function FUN-SYM can be used to setup a buffer instead of a
+major mode function:
+
+- The function FUN-SYM can be called instead of calling a major
+ mode function when you want to use multiple major modes in a
+ buffer.
+
+- The defined function can be used instead of a major mode
+ function in for example `auto-mode-alist'.
+
+- As the very last thing FUN-SYM will run the hook FUN-SYM-hook,
+ just as major modes do.
+
+- There is also a general hook, `mumamo-turn-on-hook', which is
+ run when turning on mumamo with any of these functions. This
+ is run right before the hook specific to any of the functions
+ above that turns on the multiple major mode support.
+
+- The multi major mode FUN-SYM has a keymap named FUN-SYM-map.
+ This overrides the major modes' keymaps since it is handled as
+ a minor mode keymap.
+
+- There is also a special mumamo keymap, `mumamo-map' that is
+ active in every buffer with a multi major mode. This is also
+ handled as a minor mode keymap and therefor overrides the major
+ modes' keymaps.
+
+- However when this support for multiple major mode is on the
+ buffer is divided into chunks, each with its own major mode.
+
+- The chunks are fontified according the major mode assigned to
+ them for that.
+
+- Indenting is also done according to the major mode assigned to
+ them for that.
+
+- The actual major mode used in the buffer is changed to the one
+ in the chunk when moving point between these chunks.
+
+- When major mode is changed the hooks for the new major mode,
+ `after-change-major-mode-hook' and `change-major-mode-hook' are
+ run.
+
+- There will be an alias for FUN-SYM called mumamo-alias-FUN-SYM.
+ This can be used to check whic multi major modes have been
+ defined.
+
+** A little bit more technical description:
+
+The dividing of a buffer into chunks is done during fontification
+by `mumamo-get-chunk-at'.
+
+The name of the function is saved in in the buffer local variable
+`mumamo-multi-major-mode' when the function is called.
+
+All functions defined by this macro is added to the list
+`mumamo-defined-multi-major-modes'.
+
+Basically Mumamo handles only major modes that uses jit-lock.
+However as a special effort also `nxml-mode' and derivatives
+thereof are handled. Since it seems impossible to me to restrict
+those major modes fontification to only a chunk without changing
+`nxml-mode' the fontification is instead done by
+`html-mode'/`sgml-mode' for chunks using `nxml-mode' and its
+derivates.
+
+CHUNKS is a list where each entry have the format
+
+ (CHUNK-DEF-NAME MAIN-MAJOR-MODE SUBMODE-CHUNK-FUNCTIONS)
+
+CHUNK-DEF-NAME is the key name by which the entry is recognized.
+MAIN-MAJOR-MODE is the major mode used when there is no chunks.
+If this is nil then `major-mode' before turning on this mode will
+be used.
+
+SUBMODE-CHUNK-FUNCTIONS is a list of the functions that does the
+chunk division of the buffer. They are tried in the order they
+appear here during the chunk division process.
+
+If you want to write new functions for chunk divisions then
+please see `mumamo-find-possible-chunk'. You can perhaps also
+use `mumamo-quick-static-chunk' which is more easy-to-use
+alternative. See also the file mumamo-fun.el where there are
+many routines for chunk division.
+
+When you write those new functions you may want to use some of
+the functions for testing chunks:
+
+ `mumamo-test-create-chunk-at' `mumamo-test-create-chunks-at-all'
+ `mumamo-test-easy-make' `mumamo-test-fontify-region'
+
+These are in the file mumamo-test.el.
+
+\(fn FUN-SYM SPEC-DOC CHUNKS)" nil (quote macro))
+
+(nxhtml-autoload 'mumamo-add-to-defined-multi-major-modes `(lp '(nxhtml-download-root-url nil) "util/mumamo" nxhtml-install-dir) "\
+Not documented
+
+\(fn ENTRY)" nil nil)
+
+(let ((loads (get 'mumamo 'custom-loads))) (if (member '"mumamo" loads) nil (put 'mumamo 'custom-loads (cons '"mumamo" loads))))
+
+(let ((loads (get 'mumamo-hi-lock-faces 'custom-loads))) (if (member '"mumamo" loads) nil (put 'mumamo-hi-lock-faces 'custom-loads (cons '"mumamo" loads))))
+
+(nxhtml-autoload 'mumamo-mark-for-refontification `(lp '(nxhtml-download-root-url nil) "util/mumamo" nxhtml-install-dir) "\
+Mark region between MIN and MAX for refontification.
+
+\(fn MIN MAX)" nil nil)
+
+(nxhtml-autoload 'mumamo-list-defined-multi-major-modes `(lp '(nxhtml-download-root-url nil) "util/mumamo" nxhtml-install-dir) "\
+List currently defined multi major modes.
+If SHOW-DOC is non-nil show the doc strings added when defining
+them. (This is not the full doc string. To show the full doc
+string you can click on the multi major mode in the list.)
+
+If SHOW-CHUNKS is non-nil show the names of the chunk dividing
+functions each multi major mode uses.
+
+If MATCH then show only multi major modes whos names matches.
+
+\(fn SHOW-DOC SHOW-CHUNKS MATCH)" t nil)
+
+(nxhtml-autoload 'mumamo-multi-major-modep `(lp '(nxhtml-download-root-url nil) "util/mumamo" nxhtml-install-dir) "\
+Return t if VALUE is a multi major mode function.
+
+\(fn VALUE)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (python-rst-mumamo-mode latex-haskell-mumamo-mode
+;;;;;; latex-clojure-mumamo-mode markdown-html-mumamo-mode xsl-sgml-mumamo-mode
+;;;;;; xsl-nxml-mumamo-mode mako-html-mumamo-mode org-mumamo-mode
+;;;;;; asp-html-mumamo-mode noweb2-mumamo-mode mumamo-noweb2 csound-sgml-mumamo-mode
+;;;;;; laszlo-nxml-mumamo-mode metapost-mumamo-mode ruby-heredoc-mumamo-mode
+;;;;;; python-heredoc-mumamo-mode cperl-heredoc-mumamo-mode perl-heredoc-mumamo-mode
+;;;;;; php-heredoc-mumamo-mode sh-heredoc-mumamo-mode eruby-javascript-mumamo-mode
+;;;;;; eruby-html-mumamo-mode eruby-mumamo-mode jsp-html-mumamo-mode
+;;;;;; gsp-html-mumamo-mode ssjs-html-mumamo-mode smarty-html-mumamo-mode
+;;;;;; mjt-html-mumamo-mode genshi-html-mumamo-mode django-html-mumamo-mode
+;;;;;; embperl-html-mumamo-mode mason-html-mumamo-mode nxml-mumamo-mode
+;;;;;; html-mumamo-mode mumamo-define-html-file-wide-keys) "mumamo-fun"
+;;;;;; "util/mumamo-fun.el" (19410 22971))
+;;; Generated autoloads from util/mumamo-fun.el
+(web-autoload-require 'mumamo-fun 'lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'mumamo-define-html-file-wide-keys `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Define keys in multi major mode keymap for html files.
+
+\(fn)" nil nil)
+
+(nxhtml-autoload 'html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for (X)HTML with main mode `html-mode'.
+This covers inlined style and javascript and PHP." t)
+
+(nxhtml-autoload 'nxml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for (X)HTML with main mode `nxml-mode'.
+This covers inlined style and javascript and PHP.
+
+See also `mumamo-alt-php-tags-mode'." t)
+
+(nxhtml-autoload 'mason-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Mason using main mode `html-mode'.
+This covers inlined style and javascript." t)
+
+(nxhtml-autoload 'embperl-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Embperl files with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'django-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Django with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'genshi-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Genshi with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'mjt-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for MJT with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'smarty-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Smarty with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'ssjs-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for SSJS with main mode `html-mode'.
+This covers inlined style and javascript." t)
+
+(nxhtml-autoload 'gsp-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for GSP with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'jsp-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for JSP with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'eruby-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major mode for eRuby with unspecified main mode.
+Current major-mode will be used as the main major mode." t)
+
+(nxhtml-autoload 'eruby-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for eRuby with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'eruby-javascript-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for eRuby with main mode `javascript-mode'." t)
+
+(nxhtml-autoload 'sh-heredoc-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for sh heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes." t)
+
+(nxhtml-autoload 'php-heredoc-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for PHP heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes." t)
+
+(nxhtml-autoload 'perl-heredoc-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Perl heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes." t)
+
+(nxhtml-autoload 'cperl-heredoc-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Perl heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes." t)
+
+(nxhtml-autoload 'python-heredoc-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Perl heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes." t)
+
+(nxhtml-autoload 'ruby-heredoc-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Ruby heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes." t)
+
+(nxhtml-autoload 'metapost-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for MetaPost." t)
+
+(nxhtml-autoload 'laszlo-nxml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for OpenLaszlo." t)
+
+(nxhtml-autoload 'csound-sgml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on mutiple major modes for CSound orc/sco Modes." t)
+
+(let ((loads (get 'mumamo-noweb2 'custom-loads))) (if (member '"mumamo-fun" loads) nil (put 'mumamo-noweb2 'custom-loads (cons '"mumamo-fun" loads))))
+
+(nxhtml-autoload 'noweb2-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Multi major mode for noweb files." t)
+
+(nxhtml-autoload 'asp-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for ASP with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'org-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for `org-mode' files with main mode `org-mode'.
+** Note about HTML subchunks:
+Unfortunately this only allows `html-mode' (not `nxhtml-mode') in
+sub chunks." t)
+
+(nxhtml-autoload 'mako-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Mako with main mode `html-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'xsl-nxml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multi major mode for XSL with main mode `nxml-mode'.
+This covers inlined style and javascript." t)
+
+(nxhtml-autoload 'xsl-sgml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multi major mode for XSL with main mode `sgml-mode'.
+This covers inlined style and javascript." t)
+
+(nxhtml-autoload 'markdown-html-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multi major markdown mode in buffer.
+Main major mode will be `markdown-mode'.
+Inlined html will be in `html-mode'.
+
+You need `markdown-mode' which you can download from URL
+`http://jblevins.org/projects/markdown-mode/'." t)
+
+(nxhtml-autoload 'latex-clojure-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multi major mode latex+clojure.
+Main major mode will be `latex-mode'.
+Subchunks will be in `clojure-mode'.
+
+You will need `clojure-mode' which you can download from URL
+`http://github.com/jochu/clojure-mode/tree'." t)
+
+(nxhtml-autoload 'latex-haskell-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multi major mode latex+haskell.
+Main major mode will be `latex-mode'.
+Subchunks will be in `haskell-mode'.
+
+You will need `haskell-mode' which you can download from URL
+`http://projects.haskell.org/haskellmode-emacs/'." t)
+
+(nxhtml-autoload 'python-rst-mumamo-mode `(lp '(nxhtml-download-root-url nil) "util/mumamo-fun" nxhtml-install-dir) "\
+Turn on multiple major modes for Python with RestructuredText docstrings." t)
+
+;;;***
+\f
+;;;### (autoloads (mumamo-add-region-from-string mumamo-add-region)
+;;;;;; "mumamo-regions" "util/mumamo-regions.el" (19275 63380))
+;;; Generated autoloads from util/mumamo-regions.el
+(web-autoload-require 'mumamo-regions 'lp '(nxhtml-download-root-url nil) "util/mumamo-regions" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'mumamo-add-region `(lp '(nxhtml-download-root-url nil) "util/mumamo-regions" nxhtml-install-dir) "\
+Add a mumamo region from selection.
+Mumamo regions are like another layer of chunks above the normal chunks.
+They does not affect the normal chunks, but they overrides them.
+
+To create a mumamo region first select a visible region and then
+call this function.
+
+If the buffer is not in a multi major mode a temporary multi
+major mode will be created applied to the buffer first.
+To get out of this and get back to a single major mode just use
+
+ M-x normal-mode
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'mumamo-add-region-from-string `(lp '(nxhtml-download-root-url nil) "util/mumamo-regions" nxhtml-install-dir) "\
+Add a mumamo region from string at point.
+Works as `mumamo-add-region' but for string or comment at point.
+
+Buffer must be fontified.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (n-back-game n-back) "n-back" "util/n-back.el"
+;;;;;; (19278 15746))
+;;; Generated autoloads from util/n-back.el
+(web-autoload-require 'n-back 'lp '(nxhtml-download-root-url nil) "util/n-back" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'n-back 'custom-loads))) (if (member '"n-back" loads) nil (put 'n-back 'custom-loads (cons '"n-back" loads))))
+
+(nxhtml-autoload 'n-back-game `(lp '(nxhtml-download-root-url nil) "util/n-back" nxhtml-install-dir) "\
+Emacs n-Back game.
+This game is supposed to increase your working memory and fluid
+intelligence.
+
+In this game something is shown for half a second on the screen
+and maybe a sound is played. You should then answer if parts of
+it is the same as you have seen or heard before. This is
+repeated for about 20 trials.
+
+You answer with the keys shown in the bottom window.
+
+In the easiest version of the game you should answer if you have
+just seen or heard what is shown now. By default the game gets
+harder as you play it with success. Then first the number of
+items presented in a trial grows. After that it gets harder by
+that you have to somehow remember not the last item, but the item
+before that (or even earlier). That is what \"n-Back\" stands
+for.
+
+Note that remember does not really mean remember clearly. The
+game is for training your brain getting used to keep those things
+in the working memory, maybe as a cross-modal unit. You are
+supposed to just nearly be able to do what you do in the game.
+And you are supposed to have fun, that is what your brain like.
+
+You should probably not overdue this. Half an hour a day playing
+might be an optimal time according to some people.
+
+The game is shamelessly modeled after Brain Workshop, see URL
+`http://brainworkshop.sourceforge.net/' just for the fun of
+getting it into Emacs. The game resembles but it not the same as
+that used in the report by Jaeggi mentioned at the above URL.
+
+Not all features in Brain Workshop are implemented here, but some
+new are maybe ... - and you have it available here in Emacs.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (nxhtmltest-run nxhtmltest-run-indent) "nxhtmltest-suites"
+;;;;;; "tests/nxhtmltest-suites.el" (19360 6294))
+;;; Generated autoloads from tests/nxhtmltest-suites.el
+(web-autoload-require 'nxhtmltest-suites 'lp '(nxhtml-download-root-url nil) "tests/nxhtmltest-suites" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'nxhtmltest-run-indent `(lp '(nxhtml-download-root-url nil) "tests/nxhtmltest-suites" nxhtml-install-dir) "\
+Run indentation tests.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'nxhtmltest-run `(lp '(nxhtml-download-root-url nil) "tests/nxhtmltest-suites" nxhtml-install-dir) "\
+Run all tests defined for nXhtml.
+Currently there are only tests using ert.el defined.
+
+Note that it is currently expected that the following tests will
+fail (they corresponds to known errors in nXhtml/Emacs):
+
+ `nxhtml-ert-nxhtml-changes-jump-back-10549'
+ `nxhtml-ert-nxhtml-changes-jump-back-7014'
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (nxhtmltest-run-Q) "nxhtmltest-Q" "tests/nxhtmltest-Q.el"
+;;;;;; (19264 36684))
+;;; Generated autoloads from tests/nxhtmltest-Q.el
+(web-autoload-require 'nxhtmltest-Q 'lp '(nxhtml-download-root-url nil) "tests/nxhtmltest-Q" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'nxhtmltest-run-Q `(lp '(nxhtml-download-root-url nil) "tests/nxhtmltest-Q" nxhtml-install-dir) "\
+Run all tests defined for nXhtml in fresh Emacs.
+See `nxhtmltest-run' for more information about the tests.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (ert-run-tests-interactively ert-deftest) "ert"
+;;;;;; "tests/ert.el" (19173 56140))
+;;; Generated autoloads from tests/ert.el
+(web-autoload-require 'ert 'lp '(nxhtml-download-root-url nil) "tests/ert" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'ert-deftest `(lp '(nxhtml-download-root-url nil) "tests/ert" nxhtml-install-dir) "\
+Define NAME (a symbol) as a test.
+
+\(fn NAME () [:documentation DOCSTRING] [:expected-result TYPE] BODY...)" nil (quote macro))
+
+(nxhtml-autoload 'ert-run-tests-interactively `(lp '(nxhtml-download-root-url nil) "tests/ert" nxhtml-install-dir) "\
+Run the tests specified by SELECTOR and display the results in a buffer.
+
+\(fn SELECTOR &optional OUTPUT-BUFFER-NAME MESSAGE-FN)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (ocr-user-mode) "ocr-user" "util/ocr-user.el" (19290
+;;;;;; 21626))
+;;; Generated autoloads from util/ocr-user.el
+(web-autoload-require 'ocr-user 'lp '(nxhtml-download-root-url nil) "util/ocr-user" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'ocr-user-mode `(lp '(nxhtml-download-root-url nil) "util/ocr-user" nxhtml-install-dir) "\
+Color up digits three by three.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (ourcomments-warning ourcomments-M-x-menu-mode
+;;;;;; ourcomments-paste-with-convert-mode use-custom-style info-open-file
+;;;;;; replace-read-files rdir-query-replace ldir-query-replace
+;;;;;; grep-query-replace emacs-Q-nxhtml emacs-Q emacs--no-desktop
+;;;;;; emacs--debug-init emacs-buffer-file emacs emacs-restart ourcomments-ido-ctrl-tab
+;;;;;; ourcomments-ido-buffer-raise-frame ourcomments-ido-buffer-other-frame
+;;;;;; ourcomments-ido-buffer-other-window describe-symbol describe-defstruct
+;;;;;; describe-custom-group narrow-to-comment buffer-narrowed-p
+;;;;;; describe-command ourcomments-ediff-files find-emacs-other-file
+;;;;;; ourcomments-insert-date-and-time describe-timers ourcomments-copy+paste-set-point
+;;;;;; better-fringes-mode describe-key-and-map-briefly ourcomments-move-end-of-line
+;;;;;; ourcomments-move-beginning-of-line ourcomments-mark-whole-buffer-or-field
+;;;;;; fill-dwim unfill-individual-paragraphs unfill-region unfill-paragraph
+;;;;;; define-toggle-old define-toggle popup-menu-at-point ourcomments-indirect-fun)
+;;;;;; "ourcomments-util" "util/ourcomments-util.el" (19411 29548))
+;;; Generated autoloads from util/ourcomments-util.el
+(web-autoload-require 'ourcomments-util 'lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'ourcomments-indirect-fun `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Get the alias symbol for function FUN if any.
+
+\(fn FUN)" nil nil)
+
+(nxhtml-autoload 'popup-menu-at-point `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Popup the given menu at point.
+This is similar to `popup-menu' and MENU and PREFIX has the same
+meaning as there. The position for the popup is however where
+the window point is.
+
+\(fn MENU &optional PREFIX)" nil nil)
+
+(nxhtml-autoload 'define-toggle `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Declare SYMBOL as a customizable variable with a toggle function.
+The purpose of this macro is to define a defcustom and a toggle
+function suitable for use in a menu.
+
+The arguments have the same meaning as for `defcustom' with these
+restrictions:
+
+- The :type keyword cannot be used. Type is always 'boolean.
+- VALUE must be t or nil.
+
+DOC and ARGS are just passed to `defcustom'.
+
+A `defcustom' named SYMBOL with doc-string DOC and a function
+named SYMBOL-toggle is defined. The function toggles the value
+of SYMBOL. It takes no parameters.
+
+To create a menu item something similar to this can be used:
+
+ (define-key map [SYMBOL]
+ (list 'menu-item \"Toggle nice SYMBOL\"
+ 'SYMBOL-toggle
+ :button '(:toggle . SYMBOL)))
+
+\(fn SYMBOL VALUE DOC &rest ARGS)" nil (quote macro))
+
+(nxhtml-autoload 'define-toggle-old `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Not documented
+
+\(fn SYMBOL VALUE DOC &rest ARGS)" nil (quote macro))
+
+(nxhtml-autoload 'unfill-paragraph `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Unfill the current paragraph.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'unfill-region `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Unfill the current region.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'unfill-individual-paragraphs `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Unfill individual paragraphs in the current region.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'fill-dwim `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Fill or unfill paragraph or region.
+With prefix ARG fill only current line.
+
+\(fn ARG)" t nil)
+
+(nxhtml-autoload 'ourcomments-mark-whole-buffer-or-field `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Mark whole buffer or editable field at point.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'ourcomments-move-beginning-of-line `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Move point to beginning of line or indentation.
+See `beginning-of-line' for ARG.
+
+If `line-move-visual' is non-nil then the visual line beginning
+is first tried.
+
+If in a widget field stay in that.
+
+\(fn ARG)" t nil)
+
+(nxhtml-autoload 'ourcomments-move-end-of-line `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Move point to end of line or after last non blank char.
+See `end-of-line' for ARG.
+
+Similar to `ourcomments-move-beginning-of-line' but for end of
+line.
+
+\(fn ARG)" t nil)
+
+(nxhtml-autoload 'describe-key-and-map-briefly `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Try to print names of keymap from which KEY fetch its definition.
+Look in current active keymaps and find keymap variables with the
+same value as the keymap where KEY is bound. Print a message
+with those keymap variable names. Return a list with the keymap
+variable symbols.
+
+When called interactively prompt for KEY.
+
+INSERT and UNTRANSLATED should normall be nil (and I am not sure
+what they will do ;-).
+
+\(fn &optional KEY INSERT UNTRANSLATED)" t nil)
+
+(defvar better-fringes-mode nil "\
+Non-nil if Better-Fringes mode is enabled.
+See the command `better-fringes-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `better-fringes-mode'.")
+
+(nxhtml-custom-autoload 'better-fringes-mode 'ourcomments-util nil)
+
+(nxhtml-autoload 'better-fringes-mode `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Choose another fringe bitmap color and bottom angle.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'ourcomments-copy+paste-set-point `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Set point for copy+paste here.
+Enable temporary minor mode `ourcomments-copy+paste-mode'.
+However if point for copy+paste already is set then cancel it and
+disable the minor mode.
+
+The purpose of this command is to make it easy to grab a piece of
+text and paste it at current position. After this command you
+should select a piece of text to copy and then call the command
+`ourcomments-copy+paste'.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'describe-timers `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Show timers with readable time format.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'ourcomments-insert-date-and-time `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Insert date and time.
+See option `ourcomments-insert-date-and-time' for how to
+customize it.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'find-emacs-other-file `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Find corresponding file to source or installed elisp file.
+If you have checked out and compiled Emacs yourself you may have
+Emacs lisp files in two places, the checked out source tree and
+the installed Emacs tree. If buffer contains an Emacs elisp file
+in one of these places then find the corresponding elisp file in
+the other place. Return the file name of this file.
+
+Rename current buffer using your `uniquify-buffer-name-style' if
+it is set.
+
+When DISPLAY-FILE is non-nil display this file in other window
+and go to the same line number as in the current buffer.
+
+\(fn DISPLAY-FILE)" t nil)
+
+(nxhtml-autoload 'ourcomments-ediff-files `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+In directory DEF-DIR run `ediff-files' on files FILE-A and FILE-B.
+The purpose of this function is to make it eaiser to start
+`ediff-files' from a shell through Emacs Client.
+
+This is used in EmacsW32 in the file ediff.cmd where Emacs Client
+is called like this:
+
+ @%emacs_client% -e \"(setq default-directory \\\"%emacs_cd%\\\")\"
+ @%emacs_client% -n -e \"(ediff-files \\\"%f1%\\\" \\\"%f2%\\\")\"
+
+It can of course be done in a similar way with other shells.
+
+\(fn DEF-DIR FILE-A FILE-B)" nil nil)
+
+(nxhtml-autoload 'describe-command `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Like `describe-function', but prompts only for interactive commands.
+
+\(fn COMMAND)" t nil)
+
+(nxhtml-autoload 'buffer-narrowed-p `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Return non-nil if the current buffer is narrowed.
+
+\(fn)" nil nil)
+
+(nxhtml-autoload 'narrow-to-comment `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'describe-custom-group `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Describe customization group SYMBOL.
+
+\(fn SYMBOL)" t nil)
+
+(nxhtml-autoload 'describe-defstruct `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Not documented
+
+\(fn SYMBOL)" t nil)
+
+(nxhtml-autoload 'describe-symbol `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Show information about SYMBOL.
+Show SYMBOL plist and whether is is a variable or/and a
+function.
+
+\(fn SYMBOL)" t nil)
+
+(nxhtml-autoload 'ourcomments-ido-buffer-other-window `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Show buffer in other window.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'ourcomments-ido-buffer-other-frame `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Show buffer in other frame.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'ourcomments-ido-buffer-raise-frame `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Raise frame showing buffer.
+
+\(fn)" t nil)
+
+(defvar ourcomments-ido-ctrl-tab nil "\
+Non-nil if Ourcomments-Ido-Ctrl-Tab mode is enabled.
+See the command `ourcomments-ido-ctrl-tab' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `ourcomments-ido-ctrl-tab'.")
+
+(nxhtml-custom-autoload 'ourcomments-ido-ctrl-tab 'ourcomments-util nil)
+
+(nxhtml-autoload 'ourcomments-ido-ctrl-tab `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Enable buffer switching using C-Tab with function `ido-mode'.
+This changes buffer switching with function `ido-mode' the
+following way:
+
+- You can use C-Tab.
+
+- You can show the selected buffer in three ways independent of
+ how you entered function `ido-mode' buffer switching:
+
+ * S-return: other window
+ * C-return: other frame
+ * M-return: raise frame
+
+Those keys are selected to at least be a little bit reminiscent
+of those in for example common web browsers.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'emacs-restart `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Restart Emacs and start `server-mode' if on before.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'emacs `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Start a new Emacs with default parameters.
+Additional ARGS are passed to the new Emacs.
+
+See also `ourcomments-started-emacs-use-output-buffer'.
+
+\(fn &rest ARGS)" t nil)
+
+(nxhtml-autoload 'emacs-buffer-file `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Start a new Emacs showing current buffer file.
+Go to the current line and column in that file.
+If there is no buffer file then instead start with `dired'.
+
+This calls the function `emacs' with argument --no-desktop and
+the file or a call to dired.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'emacs--debug-init `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Start a new Emacs with --debug-init parameter.
+This calls the function `emacs' with added arguments ARGS.
+
+\(fn &rest ARGS)" t nil)
+
+(nxhtml-autoload 'emacs--no-desktop `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Start a new Emacs with --no-desktop parameter.
+This calls the function `emacs' with added arguments ARGS.
+
+\(fn &rest ARGS)" t nil)
+
+(nxhtml-autoload 'emacs-Q `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Start a new Emacs with -Q parameter.
+Start new Emacs without any customization whatsoever.
+This calls the function `emacs' with added arguments ARGS.
+
+\(fn &rest ARGS)" t nil)
+
+(nxhtml-autoload 'emacs-Q-nxhtml `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Start new Emacs with -Q and load nXhtml.
+This calls the function `emacs' with added arguments ARGS.
+
+\(fn &rest ARGS)" t nil)
+
+(nxhtml-autoload 'grep-query-replace `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Do `query-replace-regexp' of FROM with TO, on all files in *grep*.
+Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
+If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
+with the command \\[tags-loop-continue].
+
+\(fn FROM TO &optional DELIMITED)" t nil)
+
+(nxhtml-autoload 'ldir-query-replace `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Replace FROM with TO in FILES in directory DIR.
+This runs `query-replace-regexp' in files matching FILES in
+directory DIR.
+
+See `tags-query-replace' for DELIMETED and more information.
+
+\(fn FROM TO FILES DIR &optional DELIMITED)" t nil)
+
+(nxhtml-autoload 'rdir-query-replace `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Replace FROM with TO in FILES in directory tree ROOT.
+This runs `query-replace-regexp' in files matching FILES in
+directory tree ROOT.
+
+See `tags-query-replace' for DELIMETED and more information.
+
+\(fn FROM TO FILE-REGEXP ROOT &optional DELIMITED)" t nil)
+
+(nxhtml-autoload 'replace-read-files `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Read files arg for replace.
+
+\(fn REGEXP &optional REPLACE)" nil nil)
+
+(nxhtml-autoload 'info-open-file `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Open an info file in `Info-mode'.
+
+\(fn INFO-FILE)" t nil)
+
+(nxhtml-autoload 'use-custom-style `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Setup like in `Custom-mode', but without things specific to Custom.
+
+\(fn)" nil nil)
+
+(defvar ourcomments-paste-with-convert-mode nil "\
+Non-nil if Ourcomments-Paste-With-Convert mode is enabled.
+See the command `ourcomments-paste-with-convert-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `ourcomments-paste-with-convert-mode'.")
+
+(nxhtml-custom-autoload 'ourcomments-paste-with-convert-mode 'ourcomments-util nil)
+
+(nxhtml-autoload 'ourcomments-paste-with-convert-mode `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Pasted text may be automatically converted in this mode.
+The functions in `ourcomments-paste-with-convert-hook' are run
+after commands in `ourcomments-paste-with-convert-commands' if any
+of the functions returns non-nil that text is inserted instead of
+the original text.
+
+For exampel when this mode is on and you paste an html link in an
+`org-mode' buffer it will be directly converted to an org style
+link. (This is the default behaviour.)
+
+Tip: The Firefox plugin Copy as HTML Link is handy, see URL
+ `https://addons.mozilla.org/en-US/firefox/addon/2617'.
+
+Note: This minor mode will defadvice the paste commands.
+
+\(fn &optional ARG)" t nil)
+
+(defvar ourcomments-M-x-menu-mode nil "\
+Non-nil if Ourcomments-M-X-Menu mode is enabled.
+See the command `ourcomments-M-x-menu-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `ourcomments-M-x-menu-mode'.")
+
+(nxhtml-custom-autoload 'ourcomments-M-x-menu-mode 'ourcomments-util nil)
+
+(nxhtml-autoload 'ourcomments-M-x-menu-mode `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Add commands started from Emacs menus to M-x history.
+The purpose of this is to make it easier to redo them and easier
+to learn how to do them from the command line (which is often
+faster if you know how to do it).
+
+Only commands that are not already in M-x history are added.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'ourcomments-warning `(lp '(nxhtml-download-root-url nil) "util/ourcomments-util" nxhtml-install-dir) "\
+Not documented
+
+\(fn FORMAT-STRING &rest ARGS)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (major-modep major-or-multi-majorp) "ourcomments-widgets"
+;;;;;; "util/ourcomments-widgets.el" (19275 63380))
+;;; Generated autoloads from util/ourcomments-widgets.el
+(web-autoload-require 'ourcomments-widgets 'lp '(nxhtml-download-root-url nil) "util/ourcomments-widgets" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+ (nxhtml-autoload 'command "ourcomments-widgets")
+
+(nxhtml-autoload 'major-or-multi-majorp `(lp '(nxhtml-download-root-url nil) "util/ourcomments-widgets" nxhtml-install-dir) "\
+Return t if VALUE is a major or multi major mode function.
+
+\(fn VALUE)" nil nil)
+
+(nxhtml-autoload 'major-modep `(lp '(nxhtml-download-root-url nil) "util/ourcomments-widgets" nxhtml-install-dir) "\
+Return t if VALUE is a major mode function.
+
+\(fn VALUE)" nil nil)
+ (nxhtml-autoload 'major-mode-function "ourcomments-widgets")
+
+;;;***
+\f
+;;;### (autoloads (pause-start-in-new-emacs pause-mode pause) "pause"
+;;;;;; "util/pause.el" (19335 58922))
+;;; Generated autoloads from util/pause.el
+(web-autoload-require 'pause 'lp '(nxhtml-download-root-url nil) "util/pause" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'pause 'custom-loads))) (if (member '"pause" loads) nil (put 'pause 'custom-loads (cons '"pause" loads))))
+
+(defvar pause-mode nil "\
+Non-nil if Pause mode is enabled.
+See the command `pause-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `pause-mode'.")
+
+(nxhtml-custom-autoload 'pause-mode 'pause nil)
+
+(nxhtml-autoload 'pause-mode `(lp '(nxhtml-download-root-url nil) "util/pause" nxhtml-install-dir) "\
+This minor mode tries to make you take a break.
+It will jump up and temporary stop your work - even if you are
+not in Emacs. If you are in Emacs it will however try to be
+gentle and wait until you have been idle with the keyboard for a
+short while. (If you are not in Emacs it can't be gentle. How
+could it?)
+
+Then it will show you a special screen with a link to a yoga
+exercise you can do when you pause.
+
+After the pause you continue your work where you were
+interrupted.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'pause-start-in-new-emacs `(lp '(nxhtml-download-root-url nil) "util/pause" nxhtml-install-dir) "\
+Start pause with interval AFTER-MINUTES in a new Emacs instance.
+The new Emacs instance will be started with -Q. However if
+`custom-file' is non-nil it will be loaded so you can still
+customize pause.
+
+One way of using this function may be to put in your .emacs
+something like
+
+ ;; for just one Emacs running pause
+ (when server-mode (pause-start-in-new-emacs 15))
+
+See `pause-start' for more info.
+
+\(fn AFTER-MINUTES)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (global-pointback-mode pointback-mode) "pointback"
+;;;;;; "util/pointback.el" (19023 47096))
+;;; Generated autoloads from util/pointback.el
+(web-autoload-require 'pointback 'lp '(nxhtml-download-root-url nil) "util/pointback" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'pointback-mode `(lp '(nxhtml-download-root-url nil) "util/pointback" nxhtml-install-dir) "\
+Restore previous window point when switching back to a buffer.
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-pointback-mode nil "\
+Non-nil if Global-Pointback mode is enabled.
+See the command `global-pointback-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-pointback-mode'.")
+
+(nxhtml-custom-autoload 'global-pointback-mode 'pointback nil)
+
+(nxhtml-autoload 'global-pointback-mode `(lp '(nxhtml-download-root-url nil) "util/pointback" nxhtml-install-dir) "\
+Toggle Pointback mode in every possible buffer.
+With prefix ARG, turn Global-Pointback mode on if and only if
+ARG is positive.
+Pointback mode is enabled in all buffers where
+`pointback-on' would do it.
+See `pointback-mode' for more information on Pointback mode.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (popcmp-completing-read popcmp-completion-style
+;;;;;; popcmp) "popcmp" "util/popcmp.el" (19365 33760))
+;;; Generated autoloads from util/popcmp.el
+(web-autoload-require 'popcmp 'lp '(nxhtml-download-root-url nil) "util/popcmp" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'popcmp 'custom-loads))) (if (member '"popcmp" loads) nil (put 'popcmp 'custom-loads (cons '"popcmp" loads))))
+
+(defvar popcmp-completion-style (cond (t 'popcmp-popup)) "\
+Completion style.
+The currently available completion styles are:
+
+- popcmp-popup: Use OS popup menus (default).
+- emacs-default: Emacs default completion.
+- Company Mode completion.
+- anything: The Anything elisp lib completion style.
+
+The style of completion set here is not implemented for all
+completions. The scope varies however with which completion
+style you have choosen.
+
+For information about Company Mode and how to use it see URL
+`http://www.emacswiki.org/emacs/CompanyMode'.
+
+For information about Anything and how to use it see URL
+`http://www.emacswiki.org/emacs/Anything'.
+
+See also the options `popcmp-short-help-beside-alts' and
+`popcmp-group-alternatives' which are also availabe when popup
+completion is available.")
+
+(nxhtml-custom-autoload 'popcmp-completion-style 'popcmp nil)
+
+(nxhtml-autoload 'popcmp-completing-read `(lp '(nxhtml-download-root-url nil) "util/popcmp" nxhtml-install-dir) "\
+Read a string in the minubuffer with completion, or popup a menu.
+This function can be used instead `completing-read'. The main
+purpose is to provide a popup style menu for completion when
+completion is tighed to text at point in a buffer. If a popup
+menu is used it will be shown at window point. Whether a popup
+menu or minibuffer completion is used is governed by
+`popcmp-completion-style'.
+
+The variables PROMPT, TABLE, PREDICATE, REQUIRE-MATCH,
+INITIAL-INPUT, POP-HIST, DEF and INHERIT-INPUT-METHOD all have the
+same meaning is for `completing-read'.
+
+ALT-HELP should be nil or a hash variable or an association list
+with the completion alternative as key and a short help text as
+value. You do not need to supply help text for all alternatives.
+The use of ALT-HELP is set by `popcmp-short-help-beside-alts'.
+
+ALT-SETS should be nil or an association list that has as keys
+groups and as second element an alternative that should go into
+this group.
+
+\(fn PROMPT TABLE &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT POP-HIST DEF INHERIT-INPUT-METHOD ALT-HELP ALT-SETS)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (rebind-keys-mode rebind) "rebind" "util/rebind.el"
+;;;;;; (19292 11678))
+;;; Generated autoloads from util/rebind.el
+(web-autoload-require 'rebind 'lp '(nxhtml-download-root-url nil) "util/rebind" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'rebind 'custom-loads))) (if (member '"rebind" loads) nil (put 'rebind 'custom-loads (cons '"rebind" loads))))
+
+(defvar rebind-keys-mode nil "\
+Non-nil if Rebind-Keys mode is enabled.
+See the command `rebind-keys-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `rebind-keys-mode'.")
+
+(nxhtml-custom-autoload 'rebind-keys-mode 'rebind nil)
+
+(nxhtml-autoload 'rebind-keys-mode `(lp '(nxhtml-download-root-url nil) "util/rebind" nxhtml-install-dir) "\
+Rebind keys as defined in `rebind-keys'.
+The key bindings will override almost all other key bindings
+since it is put on emulation level, like for example ``cua-mode'
+and `viper-mode'.
+
+This is for using for example C-a to mark the whole buffer (or a
+field). There are some predifined keybindings for this.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (rnc-mode) "rnc-mode" "util/rnc-mode.el" (18775
+;;;;;; 60004))
+;;; Generated autoloads from util/rnc-mode.el
+(web-autoload-require 'rnc-mode 'lp '(nxhtml-download-root-url nil) "util/rnc-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'rnc-mode `(lp '(nxhtml-download-root-url nil) "util/rnc-mode" nxhtml-install-dir) "\
+Major mode for editing RELAX NG Compact Syntax schemas.
+\\{rnc-mode-map}
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (search-form) "search-form" "util/search-form.el"
+;;;;;; (19275 63380))
+;;; Generated autoloads from util/search-form.el
+(web-autoload-require 'search-form 'lp '(nxhtml-download-root-url nil) "util/search-form" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'search-form `(lp '(nxhtml-download-root-url nil) "util/search-form" nxhtml-install-dir) "\
+Display a form for search and replace.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (sex-mode sex) "sex-mode" "util/sex-mode.el" (19218
+;;;;;; 42182))
+;;; Generated autoloads from util/sex-mode.el
+(web-autoload-require 'sex-mode 'lp '(nxhtml-download-root-url nil) "util/sex-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'sex 'custom-loads))) (if (member '"sex-mode" loads) nil (put 'sex 'custom-loads (cons '"sex-mode" loads))))
+
+(defvar sex-mode nil "\
+Non-nil if Sex mode is enabled.
+See the command `sex-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `sex-mode'.")
+
+(nxhtml-custom-autoload 'sex-mode 'sex-mode nil)
+
+(nxhtml-autoload 'sex-mode `(lp '(nxhtml-download-root-url nil) "util/sex-mode" nxhtml-install-dir) "\
+Open certain files in external programs.
+See `sex-get-file-open-cmd' for how to determine which files to
+open by external applications. Note that this selection is
+nearly the same as in `org-mode'. The main difference is that
+the fallback always is to open a file in Emacs. (This is
+necessary to avoid to disturb many of Emacs operations.)
+
+This affects all functions that opens files, like `find-file',
+`find-file-noselect' etc.
+
+However it does not affect files opened through Emacs client.
+
+Urls can also be handled, see `sex-handle-urls'.
+
+When opening a file with the shell a (temporary) dummy buffer is
+created in Emacs with major mode `sex-file-mode' and an external
+program is called to handle the file. How this dummy buffer is
+handled is governed by `sex-keep-dummy-buffer'.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (sml-modeline-mode sml-modeline) "sml-modeline"
+;;;;;; "util/sml-modeline.el" (19362 49086))
+;;; Generated autoloads from util/sml-modeline.el
+(web-autoload-require 'sml-modeline 'lp '(nxhtml-download-root-url nil) "util/sml-modeline" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'sml-modeline 'custom-loads))) (if (member '"sml-modeline" loads) nil (put 'sml-modeline 'custom-loads (cons '"sml-modeline" loads))))
+
+(defvar sml-modeline-mode nil "\
+Non-nil if Sml-Modeline mode is enabled.
+See the command `sml-modeline-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `sml-modeline-mode'.")
+
+(nxhtml-custom-autoload 'sml-modeline-mode 'sml-modeline nil)
+
+(nxhtml-autoload 'sml-modeline-mode `(lp '(nxhtml-download-root-url nil) "util/sml-modeline" nxhtml-install-dir) "\
+Show buffer size and position like scrollbar in mode line.
+You can customize this minor mode, see option `sml-modeline-mode'.
+
+Note: If you turn this mode on then you probably want to turn off
+option `scroll-bar-mode'.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (tabkey2-emma-without-tabkey2 tabkey2-mode tabkey2)
+;;;;;; "tabkey2" "util/tabkey2.el" (19277 65356))
+;;; Generated autoloads from util/tabkey2.el
+(web-autoload-require 'tabkey2 'lp '(nxhtml-download-root-url nil) "util/tabkey2" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'tabkey2 'custom-loads))) (if (member '"tabkey2" loads) nil (put 'tabkey2 'custom-loads (cons '"tabkey2" loads))))
+
+(defvar tabkey2-mode nil "\
+Non-nil if Tabkey2 mode is enabled.
+See the command `tabkey2-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `tabkey2-mode'.")
+
+(nxhtml-custom-autoload 'tabkey2-mode 'tabkey2 nil)
+
+(nxhtml-autoload 'tabkey2-mode `(lp '(nxhtml-download-root-url nil) "util/tabkey2" nxhtml-install-dir) "\
+More fun with Tab key number two (completion etc).
+This global minor mode by default binds Tab in a way that let you
+do completion with Tab in all buffers (where it is possible).
+
+The Tab key is easy to type on your keyboard. Then why not use
+it for completion, something that is very useful? Shells usually
+use Tab for completion so many are used to it. This was the idea
+of Smart Tabs and this is a generalization of that idea.
+
+However in Emacs the Tab key is usually used for indentation.
+The idea here is that if Tab has been pressed once for
+indentation, then as long as point stays further Tab keys might
+as well do completion.
+
+So you kind of do Tab-Tab for first completion (and then just
+Tab for further completions as long as point is not moved).
+
+And there is even kind of Tab-Tab-Tab completion: If completion
+fails the next completion function will be the one you try with
+next Tab. (You get some notification of this, of course.)
+
+See `tabkey2-first' for more information about usage.
+
+Note: If you do not want the Tab-Tab behaviour above, but still
+want an easy way to reach the available completion functions,
+then you can instead of turning on tabkey2-mode enter this in
+your .emacs:
+
+ (global-set-key [f8] 'tabkey2-cycle-completion-functions)
+
+After hitting f8 you will then be in the same state as after the
+first in tabkey2-mode.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'tabkey2-emma-without-tabkey2 `(lp '(nxhtml-download-root-url nil) "util/tabkey2" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (tyda-mode) "tyda" "util/tyda.el" (19275 63380))
+;;; Generated autoloads from util/tyda.el
+(web-autoload-require 'tyda 'lp '(nxhtml-download-root-url nil) "util/tyda" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(defvar tyda-mode nil "\
+Non-nil if Tyda mode is enabled.
+See the command `tyda-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `tyda-mode'.")
+
+(nxhtml-custom-autoload 'tyda-mode 'tyda nil)
+
+(nxhtml-autoload 'tyda-mode `(lp '(nxhtml-download-root-url nil) "util/tyda" nxhtml-install-dir) "\
+Minor mode for key bindings for `tyda-lookup-word'.
+It binds Alt-Mouse-1 just as the Tyda add-on does in Firefox.
+Here are all key bindings
+
+\\{tyda-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (udev-call-first-step) "udev" "util/udev.el" (19412
+;;;;;; 25976))
+;;; Generated autoloads from util/udev.el
+(web-autoload-require 'udev 'lp '(nxhtml-download-root-url nil) "util/udev" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'udev-call-first-step `(lp '(nxhtml-download-root-url nil) "util/udev" nxhtml-install-dir) "\
+Set up and call first step.
+Set up buffer LOG-BUFFER to be used for log messages and
+controling of the execution of the functions in list STEPS which
+are executed one after another.
+
+Write HEADER at the end of LOG-BUFFER.
+
+Call first step.
+
+If FINISH-FUN non-nil it should be a function. This is called
+after last step with LOG-BUFFER as parameter.
+
+\(fn LOG-BUFFER STEPS HEADER FINISH-FUN)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (udev-ecb-customize-startup udev-ecb-update) "udev-ecb"
+;;;;;; "util/udev-ecb.el" (19256 5410))
+;;; Generated autoloads from util/udev-ecb.el
+(web-autoload-require 'udev-ecb 'lp '(nxhtml-download-root-url nil) "util/udev-ecb" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'udev-ecb-update `(lp '(nxhtml-download-root-url nil) "util/udev-ecb" nxhtml-install-dir) "\
+Fetch and install ECB from the devel sources.
+To determine where to store the sources see `udev-ecb-dir'.
+For how to start ECB see `udev-ecb-load-ecb'.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'udev-ecb-customize-startup `(lp '(nxhtml-download-root-url nil) "util/udev-ecb" nxhtml-install-dir) "\
+Customize ECB dev nXhtml startup group.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (udev-rinari-update) "udev-rinari" "util/udev-rinari.el"
+;;;;;; (19256 5410))
+;;; Generated autoloads from util/udev-rinari.el
+(web-autoload-require 'udev-rinari 'lp '(nxhtml-download-root-url nil) "util/udev-rinari" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'udev-rinari-update `(lp '(nxhtml-download-root-url nil) "util/udev-rinari" nxhtml-install-dir) "\
+Fetch and install Rinari from the devel sources.
+To determine where to store the sources and how to start rinari
+see `udev-rinari-dir' and `udev-rinari-load-rinari'.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (viper-tutorial) "viper-tut" "util/viper-tut.el"
+;;;;;; (19388 44990))
+;;; Generated autoloads from util/viper-tut.el
+(web-autoload-require 'viper-tut 'lp '(nxhtml-download-root-url nil) "util/viper-tut" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'viper-tutorial `(lp '(nxhtml-download-root-url nil) "util/viper-tut" nxhtml-install-dir) "\
+Run a tutorial for Viper.
+
+A simple classic tutorial in 5 parts that have been used by many
+people starting to learn vi keys. You may learn enough to start
+using `viper-mode' in Emacs.
+
+Some people find that vi keys helps against repetetive strain
+injury, see URL
+
+ `http://www.emacswiki.org/emacs/RepeatedStrainInjury'.
+
+Note: There might be a few clashes between vi key binding and
+Emacs standard key bindings. You will be notified about those in
+the tutorial. Even more, if your own key bindings comes in
+between you will be notified about that too.
+
+\(fn PART &optional DONT-ASK-FOR-REVERT)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (vline-global-mode vline-mode) "vline" "util/vline.el"
+;;;;;; (19157 2168))
+;;; Generated autoloads from util/vline.el
+(web-autoload-require 'vline 'lp '(nxhtml-download-root-url nil) "util/vline" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'vline-mode `(lp '(nxhtml-download-root-url nil) "util/vline" nxhtml-install-dir) "\
+Display vertical line mode.
+
+\(fn &optional ARG)" t nil)
+
+(defvar vline-global-mode nil "\
+Non-nil if Vline-Global mode is enabled.
+See the command `vline-global-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `vline-global-mode'.")
+
+(nxhtml-custom-autoload 'vline-global-mode 'vline nil)
+
+(nxhtml-autoload 'vline-global-mode `(lp '(nxhtml-download-root-url nil) "util/vline" nxhtml-install-dir) "\
+Display vertical line mode as globally.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (whelp) "whelp" "util/whelp.el" (19277 65356))
+;;; Generated autoloads from util/whelp.el
+(web-autoload-require 'whelp 'lp '(nxhtml-download-root-url nil) "util/whelp" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'whelp 'custom-loads))) (if (member '"whelp" loads) nil (put 'whelp 'custom-loads (cons '"whelp" loads))))
+
+;;;***
+\f
+;;;### (autoloads (wikipedia-draft-buffer wikipedia-draft-page wikipedia-draft
+;;;;;; wikipedia-mode) "wikipedia-mode" "related/wikipedia-mode.el"
+;;;;;; (19277 65356))
+;;; Generated autoloads from related/wikipedia-mode.el
+(web-autoload-require 'wikipedia-mode 'lp '(nxhtml-download-root-url nil) "related/wikipedia-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'wikipedia-mode `(lp '(nxhtml-download-root-url nil) "related/wikipedia-mode" nxhtml-install-dir) "\
+Major mode for editing wikimedia style wikis.
+Major mode for editing articles written in the markup language
+used by Wikipedia, the free on-line
+encyclopedia (see URL `http://www.wikipedia.org').
+
+There are several ways to use wikipedia-mode:
+
+- You can simply cut and paste articles between Emacs and your
+ web browser's text box.
+- If you are using Firefox you can use the It's All Text add-on
+ for Firefox.
+- You can use MozEx, a Mozilla/Firefox web browser extension that
+ allows you to call Emacs from a text
+ box (see URL `http://mozex.mozdev.org/').
+- Another way is to use the PERL script ee-helper, which allows
+ you to up and download wiki texts.
+
+Wikipedia articles are usually unfilled: newline characters are not
+used for breaking paragraphs into lines. Unfortunately, Emacs does not
+handle word wrapping yet. As a workaround, wikipedia-mode turns on
+longlines-mode automatically. In case something goes wrong, the
+following commands may come in handy:
+
+\\[wikipedia-fill-article] fills the buffer.
+\\[wikipedia-unfill-article] unfills the buffer.
+Be warned that function can be dead slow, better use wikipedia-unfill-paragraph-or-region.
+\\[wikipedia-unfill-paragraph-or-region] unfills the paragraph
+\\[wikipedia-unfill-paragraph-simple] doehe same but simpler.
+
+
+
+The following commands put in markup structures.
+
+\\[wikipedia-insert-bold-italic] bold+italic
+\\[wikipedia-insert-bold] bold text
+\\[wikipedia-insert-italics] italics
+\\[wikipedia-insert-nowiki] no wiki markup
+\\[wikipedia-insert-link-wiki] inserts a link
+
+The following commands are also defined:
+\\[wikipedia-insert-user] inserts user name
+\\[wikipedia-insert-signature] inserts ~~~~
+\\[wikipedia-insert-enumerate] inserts enumerate type structures
+\\[wikipedia-insert-itemize] inserts itemize type structures
+\\[wikipedia-insert-hline] inserts a hline
+
+The draft functionality
+\\[wikipedia-draft]
+\\[wikipedia-draft-region]
+\\[wikipedia-draft-view-draft]
+\\[wikipedia-draft-page]
+\\[wikipedia-draft-buffer]
+
+Replying and sending functionality
+\\[wikipedia-reply-at-point-simple]
+\\[wikipedia-draft-reply]
+
+
+The register functionality
+\\[wikipedia-copy-page-to-register]
+\\[defun wikipedia-insert-page-to-register]
+
+
+Some simple editing commands.
+\\[wikipedia-enhance-indent]
+\\[wikipedia-yank-prefix]
+\\[wikipedia-unfill-paragraph-or-region]
+
+
+
+\\[wikipedia-terminate-paragraph] starts a new list item or paragraph in a context-aware manner.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'wikipedia-draft `(lp '(nxhtml-download-root-url nil) "related/wikipedia-mode" nxhtml-install-dir) "\
+Open a temporary buffer in wikipedia mode for editing an
+ wikipedia draft, which an arbitrary piece of data. After
+ finishing the editing either use \\[wikipedia-draft-buffer] to
+ send the data into the wikipedia-draft-data-file, or send the
+ buffer using `wikipedia-draft-send-to-mozex' and insert it later
+ into a wikipedia article.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'wikipedia-draft-page `(lp '(nxhtml-download-root-url nil) "related/wikipedia-mode" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'wikipedia-draft-buffer `(lp '(nxhtml-download-root-url nil) "related/wikipedia-mode" nxhtml-install-dir) "\
+Wikipedia-draft-buffer sends the contents of the current (temporary)
+buffer to the wikipedia-draft-buffer, see the variable
+wikipedia-draft-data-file.
+
+\(fn)" t nil)
+
+(defvar wikipedia-draft-send-archive t "\
+*Archive the reply.")
+
+;;;***
+\f
+;;;### (autoloads (visual-basic-mode) "visual-basic-mode" "related/visual-basic-mode.el"
+;;;;;; (19235 1650))
+;;; Generated autoloads from related/visual-basic-mode.el
+(web-autoload-require 'visual-basic-mode 'lp '(nxhtml-download-root-url nil) "related/visual-basic-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'visual-basic-mode `(lp '(nxhtml-download-root-url nil) "related/visual-basic-mode" nxhtml-install-dir) "\
+A mode for editing Microsoft Visual Basic programs.
+Features automatic indentation, font locking, keyword capitalization,
+and some minor convenience functions.
+Commands:
+\\{visual-basic-mode-map}
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (tt-mode) "tt-mode" "related/tt-mode.el" (18603
+;;;;;; 15792))
+;;; Generated autoloads from related/tt-mode.el
+(web-autoload-require 'tt-mode 'lp '(nxhtml-download-root-url nil) "related/tt-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'tt-mode `(lp '(nxhtml-download-root-url nil) "related/tt-mode" nxhtml-install-dir) "\
+Major mode for editing Template Toolkit files.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (smarty-mode smarty) "smarty-mode" "related/smarty-mode.el"
+;;;;;; (19235 1650))
+;;; Generated autoloads from related/smarty-mode.el
+(web-autoload-require 'smarty-mode 'lp '(nxhtml-download-root-url nil) "related/smarty-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'smarty 'custom-loads))) (if (member '"smarty-mode" loads) nil (put 'smarty 'custom-loads (cons '"smarty-mode" loads))))
+
+(nxhtml-autoload 'smarty-mode `(lp '(nxhtml-download-root-url nil) "related/smarty-mode" nxhtml-install-dir) "\
+Smarty Mode
+***********
+
+Smarty Mode is a GNU XEmacs major mode for editing Smarty templates.
+
+1 Introduction
+**************
+
+Smarty-Mode is a mode allowing easy edit of Smarty templates:
+highlight, templates, navigation into source files...
+
+
+
+Features (new features in bold) :
+
+ * Completion
+
+ * Customizable
+
+ * Highlight
+
+ * Menu
+
+ * Stuttering
+
+ * Templates
+ - Built-in Functions
+
+ - User Functions
+
+ - Variable Modifiers
+
+ - Plugin (Functions)
+ * BlockRepeatPlugin
+
+ * ClipCache
+
+ * Smarty Formtool
+
+ * Smarty Paginate
+
+ * Smarty Validate
+
+ - Plugin (Variable Modifiers)
+ * AlternativeDateModifierPlugin
+
+ * B2Smilies
+
+ * BBCodePlugin
+
+ - Fonctions Non-Smarty
+
+
+
+This manual describes Smarty Mode version 0.0.5.
+
+2 Installation
+**************
+
+2.1 Requirements
+================
+
+Smarty Mode is a XEmacs major mode that needs the following
+software/packages:
+
+ * XEmacs (http://www.xemacs.org/).
+
+ * `font-lock' mode generaly installed with XEmacs.
+
+ * `assoc' mode generaly installed with XEmacs.
+
+ * `easymenu' mode generaly installed with XEmacs.
+
+ * `hippie-exp' mode generaly installed with XEmacs.
+
+Before continuing, you must be sure to have all this packages
+installed.
+
+2.2 Download
+============
+
+Two internet address to download Smarty Mode :
+
+ * Principal: Smarty-Mode 0.0.5
+ (http://deboutv.free.fr/lisp/smarty/download/smarty-0.0.5.tar.gz)
+ (http://deboutv.free.fr/lisp/smarty/)
+
+ * Secondary: Smarty-Mode 0.0.5
+ (http://www.morinie.fr/lisp/smarty/download/smarty-0.0.5.tar.gz)
+ (http://www.morinie.fr/lisp/smarty/)
+
+ * Old releases: Smarty-Mode
+ (http://deboutv.free.fr/lisp/smarty/download.php)
+ (http://deboutv.free.fr/lisp/smarty/)
+
+2.3 Installation
+================
+
+2.3.1 Installation
+------------------
+
+To install Smarty Mode you need to choose an installation directory
+\(for example `/usr/local/share/lisp' or `c:lisp'). The administrator
+must have the write rights on this directory.
+
+With your favorite unzip software, unzip the archive in the
+installation directory.
+
+Example:
+ cd /usr/local/share/lisp
+ tar zxvf smarty-0.0.5.tar.gz
+Now you have a `smarty' directory in the installation directory. This
+directory contains 2 files `smarty-mode.el' and `smarty-mode.elc' and
+another directory `docs' containing the documentation.
+
+You need to configure XEmacs. open you initialization file `init.el'
+\(open the file or start XEmacs then choose the Options menu and Edit
+Init File). Add the following lines (the installation directory in
+this example is `/usr/local/share/lisp') :
+
+ (setq load-path
+ (append (list \"/usr/local/share/lisp/\") load-path))
+ (nxhtml-autoload 'smarty-mode \"smarty-mode\" \"Smarty Mode\" t)
+
+2.3.2 Update
+------------
+
+The update is easy. You need to unzip the archive in the installation
+directory to remove the old release.
+
+Example:
+ cd /usr/local/share/lisp
+ rm -rf smarty
+ tar zxvf smarty-0.0.5.tar.gz
+
+2.4 Invoke Smarty-Mode
+======================
+
+You have two possibilities to invoke the Smarty Mode.
+
+ - Manually: At each file opening you need to launch Smarty Mode
+ with the following command:
+
+ `M-x smarty-mode'
+
+ - Automatically: Add the following linesin your initialization
+ file `init.el' :
+
+ (setq auto-mode-alist
+ (append
+ '((\"\\.tpl$\" . smarty-mode))
+ auto-mode-alist))
+
+
+3 Customization
+***************
+
+This chapter describes the differents parameters and functions that
+you can change to customize Smarty Mode. To do that, open a Smarty
+file, click on the Smarty menu and choose Options then Browse
+Options....
+
+3.1 Parameters
+==============
+
+3.1.1 Mode
+----------
+
+Smarty Mode has 2 modes allowing to simplify the writing of Smarty
+templates. You can enable/disable each mode individually.
+
+`smarty-electric-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable automatic generation of template.
+ If `nil'; template generators can still be invoked through key
+ bindings and menu. Is indicated in the modeline by \"/e\" after
+ the mode name and can be toggled by `smarty-electric-mode'.
+
+`smarty-stutter-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable the stuttering. Is indicated in the
+ modeline by \"/s\" after the mode name and can be toggled by
+ `smarty-stutter-mode'.
+
+3.1.2 Menu
+----------
+
+Smarty Mode has also 1 menu that you can enable/disable. The menu
+Sources is specific to each Smarty files opened.
+
+`smarty-source-file-menu'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; the Sources menu is enabled. This menu
+ contains the list of Smarty file located in the current
+ directory. The Sources menu scans the directory when a file is
+ opened.
+
+3.1.3 Menu
+----------
+
+`smarty-highlight-plugin-functions'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; the functions described in the smarty
+ plugins are highlighted.
+
+3.1.4 Templates
+---------------
+
+3.1.4.1 Header
+..............
+
+`smarty-file-header'
+ Type: string
+ Default value: `\"\"'
+ Description: String or file to insert as file header. If the
+ string specifies an existing file name the contents of the file
+ is inserted; otherwise the string itself is inserted as file
+ header.
+ Type `C-j' for newlines.
+ The follonwing keywords are supported:
+ <filename>: replaced by the file name.
+ <author>: replaced by the user name and email address.
+ <login>: replaced by `user-login-name'.
+ <company>: replaced by `smarty-company-name' content.
+ <date>: replaced by the current date.
+ <year>: replaced by the current year.
+ <copyright>: replaced by `smarty-copyright-string' content.
+ <cursor>: final cursor position.
+
+`smarty-file-footer'
+ Type: string
+ Default value: `\"\"'
+ Description: String or file to insert as file footer. See
+ `smarty-file-header'
+
+`smarty-company-name'
+ Type: string
+ Default value: `\"\"'
+ Description: Name of the company to insert in file header.
+
+`smarty-copyright-string'
+ Type: string
+ Default value: `\"\"'
+ Description: Coryright string to insert in file header.
+
+`smarty-date-format'
+ Type: string
+ Default value: `\"%Y-%m-%d\"'
+ Description: Date format.
+
+`smarty-modify-date-prefix-string'
+ Type: string
+ Default value: `\"\"'
+ Description: Prefix string of modification date in Smarty file
+ header.
+
+`smarty-modify-date-on-saving'
+ Type: bool
+ Default value: `nil'
+ Description: If `t'; update the modification date when the
+ buffer is saved.
+
+3.1.5 Miscellaneous
+-------------------
+
+`smarty-left-delimiter'
+ Type: string
+ Default value: `\"\"'
+ Description: Left escaping delimiter for Smarty templates.
+
+`smarty-right-delimiter'
+ Type: string
+ Default value: `\"\"'
+ Description: Right escaping delimiter for Smarty templates.
+
+`smarty-intelligent-tab'
+ Type: bool
+ Default value: `t'
+ Description: If `t'; TAB does indentation; completion and insert
+ tabulations. If `nil'; TAB does only indentation.
+
+`smarty-word-completion-in-minibuffer'
+ Type: bool
+ Default value: `t'
+ Description: If `t'; enable completion in the minibuffer.
+
+`smarty-word-completion-case-sensitive'
+ Type: bool
+ Default value: `nil'
+ Description: If `t'; completion is case sensitive.
+
+3.2 Functions
+=============
+
+3.2.1 Mode
+----------
+
+`smarty-electric-mode'
+ Menu: Smarty -> Options -> Mode -> Electric Mode
+ Keybinding: `C-c C-m C-e'
+ Description: This functions is used to enable/disable the
+ electric mode.
+
+`smarty-stutter-mode'
+ Menu: Smarty -> Options -> Mode -> Stutter Mode
+ Keybinding: `C-c C-m C-s'
+ Description: This function is used to enable/disable the stutter
+ mode.
+
+4 Menus
+*******
+
+There are 2 menus: Smarty and Sources. All theses menus can be
+accessed from the menubar or from the right click. This chapter
+describes each menus.
+
+4.1 Smarty
+==========
+
+This is the main menu of Smarty Mode. It allows an easy access to the
+main features of the Smarty Mode: Templates (see *Note Templates::)
+and Options (see *Note Customization::).
+
+This menu contains also 3 functions that are discussed in the next
+part.
+
+4.1.1 Functions
+---------------
+
+`smarty-show-messages'
+ Menu: Smarty -> Show Messages
+ Keybinding: `C-c M-m'
+ Description: This function opens the *Messages* buffer to
+ display previous error messages.
+
+`smarty-doc-mode'
+ Menu: Smarty -> Smarty Mode Documentation
+ Keybinding: `C-c C-h'
+ Description: This function opens the *Help* buffer and prints in
+ it the Smarty Mode documentation.
+
+`smarty-version'
+ Menu: Smarty -> Version
+ Keybinding: `C-c C-v'
+ Description: This function displays in the minibuffer the
+ current Smarty Mode version with the timestamp.
+
+4.2 Sources
+===========
+
+The Sources menu shows the Smarty files in the current directory. If
+you add or delete a file in the current directory, you need to
+refresh the menu.
+
+4.2.1 Customization
+-------------------
+
+`smarty-source-file-menu'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; the Sources menu is enabled. This menu
+ contains the list of Smarty file located in the current
+ directory. The Sources menu scans the directory when a file is
+ opened.
+
+4.2.2 Functions
+---------------
+
+`smarty-add-source-files-menu'
+ Menu: Sources -> *Rescan*
+ Keybinding: `C-c C-s C-u'
+ Description: This function is used to refresh the Sources menu.
+
+5 Stuttering
+************
+
+The stutter mode is a mode that affects a function to a key. For
+example, when you use the `ENTER' key, the associated function will
+create a new line and indent it.
+
+5.1 Customization
+=================
+
+`smarty-stutter-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable the stuttering. Is indicated in the
+ modeline by \"/s\" after the mode name and can be toggled by
+ `smarty-stutter-mode'.
+
+5.2 Functions
+=============
+
+`SPACE'
+ If in comment, indent the comment and add new line if necessary.
+ In other case, add a space.
+
+`('
+ If the previous character is a `(', the `((' will be replaced by
+ `['.
+ If the previous character is a `[', the `[(' will be replaced by
+ `{'.
+ In other case, insert a `('.
+
+`)'
+ If the previous character is a `)', the `))' will be replaced by
+ `]'.
+ If the previous character is a `]', the `])' will be replaced by
+ `}'.
+ In other case, insert a `)'.
+
+6 Templates
+***********
+
+In the Smarty Mode, the Smarty functions (like if, while, for, fopen,
+fclose) are predefined in functions called \"Templates\".
+
+Each template can be invoked by the function name or by using the
+<SPACE> key after the Smarty function name in the buffer (Note, using
+`M-<SPACE>' disable the template).
+
+A template can be aborted by using the `C-g' or by lefting empty the
+tempate prompt (in the minibuffer).
+
+6.1 Customization
+=================
+
+`smarty-electric-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable automatic generation of template.
+ If `nil'; template generators can still be invoked through key
+ bindings and menu. Is indicated in the modeline by \"/e\" after
+ the mode name and can be toggled by `smarty-electric-mode'.
+
+For a complete description of the template customizable variables,
+see *Note Cu01-Pa01-Template::
+
+6.2 Functions
+=============
+
+6.2.1 Smarty Functions
+----------------------
+
+For Smarty functions, see PDF or HTML documentation.
+
+6.2.2 Non-Smarty Functions
+--------------------------
+
+`smarty-template-header'
+ Menu: Smarty -> Templates -> Insert Header
+ Keybinding: `C-c C-t C-h'
+ Description: This function is used to insert a header in the
+ current buffer.
+
+`smarty-template-footer'
+ Menu: Smarty -> Templates -> Insert Footer
+ Keybinding: `C-c C-t C-f'
+ Description: This function is used to insert a footer in the
+ current buffer.
+
+`smarty-template-insert-date'
+ Menu: Smarty -> Templates -> Insert Date
+ Keybinding: `C-c C-t C-d i'
+ Description: This function is used to insert the date in the
+ current buffer.
+
+`smarty-template-modify'
+ Menu: Smarty -> Templates -> Modify Date
+ Keybinding: `C-c C-t C-d m'
+ Description: This function is used to modify the last
+ modification date in the current buffer.
+
+7 Bugs, Help
+************
+
+ * To report bugs: Bugtracker
+ (http://bugtracker.morinie.fr/lisp/set_project.php?project_id=2)
+
+ * To obtain help you can post on the dedicated forum: Forum
+ (http://forum.morinie.fr/lisp/)
+
+8 Key bindings
+**************
+
+\\{smarty-mode-map}
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (php-mode php-file-patterns php) "php-mode" "related/php-mode.el"
+;;;;;; (19218 42180))
+;;; Generated autoloads from related/php-mode.el
+(web-autoload-require 'php-mode 'lp '(nxhtml-download-root-url nil) "related/php-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'php 'custom-loads))) (if (member '"php-mode" loads) nil (put 'php 'custom-loads (cons '"php-mode" loads))))
+
+(defvar php-file-patterns '("\\.php[s34]?\\'" "\\.phtml\\'" "\\.inc\\'") "\
+List of file patterns for which to automatically invoke `php-mode'.")
+
+(nxhtml-custom-autoload 'php-file-patterns 'php-mode nil)
+
+(nxhtml-autoload 'php-mode `(lp '(nxhtml-download-root-url nil) "related/php-mode" nxhtml-install-dir) "\
+Major mode for editing PHP code.
+
+\\{php-mode-map}
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (global-mozadd-mirror-mode mozadd-mirror-mode global-mozadd-refresh-edited-on-save-mode
+;;;;;; mozadd-refresh-edited-on-save-mode) "mozadd" "related/mozadd.el"
+;;;;;; (19235 1650))
+;;; Generated autoloads from related/mozadd.el
+(web-autoload-require 'mozadd 'lp '(nxhtml-download-root-url nil) "related/mozadd" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'mozadd-refresh-edited-on-save-mode `(lp '(nxhtml-download-root-url nil) "related/mozadd" nxhtml-install-dir) "\
+Refresh mozadd edited file in Firefox when saving file.
+The mozadd edited file is the file in the last buffer visited in
+`mozadd-mirror-mode'.
+
+You can use this for example when you edit CSS files.
+
+The mozadd edited file must be shown in Firefox and visible.
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-mozadd-refresh-edited-on-save-mode nil "\
+Non-nil if Global-Mozadd-Refresh-Edited-On-Save mode is enabled.
+See the command `global-mozadd-refresh-edited-on-save-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-mozadd-refresh-edited-on-save-mode'.")
+
+(nxhtml-custom-autoload 'global-mozadd-refresh-edited-on-save-mode 'mozadd nil)
+
+(nxhtml-autoload 'global-mozadd-refresh-edited-on-save-mode `(lp '(nxhtml-download-root-url nil) "related/mozadd" nxhtml-install-dir) "\
+Toggle Mozadd-Refresh-Edited-On-Save mode in every possible buffer.
+With prefix ARG, turn Global-Mozadd-Refresh-Edited-On-Save mode on if and only if
+ARG is positive.
+Mozadd-Refresh-Edited-On-Save mode is enabled in all buffers where
+`(lambda nil (when (or (derived-mode-p (quote css-mode)) (mozadd-html-buffer-file-p)) (mozadd-refresh-edited-on-save-mode 1)))' would do it.
+See `mozadd-refresh-edited-on-save-mode' for more information on Mozadd-Refresh-Edited-On-Save mode.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'mozadd-mirror-mode `(lp '(nxhtml-download-root-url nil) "related/mozadd" nxhtml-install-dir) "\
+Mirror content of current file buffer immediately in Firefox.
+When you turn on this mode the file will be opened in Firefox.
+Every change you make in the buffer will trigger a redraw in
+Firefox - regardless of if you save the file or not.
+
+For the mirroring to work the edited file must be shown in
+Firefox and visible.
+
+If `nxml-where-mode' is on the marks will also be shown in
+Firefox as CSS outline style. You can customize the style
+through the option `mozadd-xml-path-outline-style'.
+
+See also `mozadd-refresh-edited-on-save-mode'.
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-mozadd-mirror-mode nil "\
+Non-nil if Global-Mozadd-Mirror mode is enabled.
+See the command `global-mozadd-mirror-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-mozadd-mirror-mode'.")
+
+(nxhtml-custom-autoload 'global-mozadd-mirror-mode 'mozadd nil)
+
+(nxhtml-autoload 'global-mozadd-mirror-mode `(lp '(nxhtml-download-root-url nil) "related/mozadd" nxhtml-install-dir) "\
+Toggle Mozadd-Mirror mode in every possible buffer.
+With prefix ARG, turn Global-Mozadd-Mirror mode on if and only if
+ARG is positive.
+Mozadd-Mirror mode is enabled in all buffers where
+`(lambda nil (when (mozadd-html-buffer-file-p) (mozadd-mirror-mode 1)))' would do it.
+See `mozadd-mirror-mode' for more information on Mozadd-Mirror mode.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (inferior-moz-mode moz-minor-mode) "moz" "related/moz.el"
+;;;;;; (19048 2102))
+;;; Generated autoloads from related/moz.el
+(web-autoload-require 'moz 'lp '(nxhtml-download-root-url nil) "related/moz" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'moz-minor-mode `(lp '(nxhtml-download-root-url nil) "related/moz" nxhtml-install-dir) "\
+MozRepl minor mode for interaction with Firefox.
+With no argument, this command toggles the mode.
+Non-null prefix argument turns on the mode.
+Null prefix argument turns off the mode.
+
+When this minor mode is enabled, some commands become available
+to send current code area (as understood by c-mark-function) or
+region or buffer to an inferior MozRepl process (which will be
+started as needed).
+
+The following keys are bound in this minor mode:
+
+\\{moz-minor-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'inferior-moz-mode `(lp '(nxhtml-download-root-url nil) "related/moz" nxhtml-install-dir) "\
+Major mode for interacting with Firefox via MozRepl.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (iss-mumamo-mode) "iss-mumamo" "related/iss-mumamo.el"
+;;;;;; (19294 54042))
+;;; Generated autoloads from related/iss-mumamo.el
+(web-autoload-require 'iss-mumamo 'lp '(nxhtml-download-root-url nil) "related/iss-mumamo" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'iss-mumamo-mode `(lp '(nxhtml-download-root-url nil) "related/iss-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes Inno Setup .iss files.
+The main major mode will be `iss-mode'.
+The [code] section, if any, will be in `pascal-mode'." t)
+
+;;;***
+\f
+;;;### (autoloads (iss-mode) "iss-mode" "related/iss-mode.el" (19294
+;;;;;; 54042))
+;;; Generated autoloads from related/iss-mode.el
+(web-autoload-require 'iss-mode 'lp '(nxhtml-download-root-url nil) "related/iss-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'iss-mode `(lp '(nxhtml-download-root-url nil) "related/iss-mode" nxhtml-install-dir) "\
+Major mode for editing InnoSetup script files. Upon startup iss-mode-hook is run.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (flymake-js-load flymake-js) "flymake-js" "related/flymake-js.el"
+;;;;;; (19218 42180))
+;;; Generated autoloads from related/flymake-js.el
+(web-autoload-require 'flymake-js 'lp '(nxhtml-download-root-url nil) "related/flymake-js" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'flymake-js 'custom-loads))) (if (member '"flymake-js" loads) nil (put 'flymake-js 'custom-loads (cons '"flymake-js" loads))))
+
+(nxhtml-autoload 'flymake-js-load `(lp '(nxhtml-download-root-url nil) "related/flymake-js" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (flymake-java-1-load) "flymake-java-1" "related/flymake-java-1.el"
+;;;;;; (19264 27004))
+;;; Generated autoloads from related/flymake-java-1.el
+(web-autoload-require 'flymake-java-1 'lp '(nxhtml-download-root-url nil) "related/flymake-java-1" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'flymake-java-1-load `(lp '(nxhtml-download-root-url nil) "related/flymake-java-1" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (flymake-css-load) "flymake-css" "related/flymake-css.el"
+;;;;;; (19292 11678))
+;;; Generated autoloads from related/flymake-css.el
+(web-autoload-require 'flymake-css 'lp '(nxhtml-download-root-url nil) "related/flymake-css" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'flymake-css-load `(lp '(nxhtml-download-root-url nil) "related/flymake-css" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (django-mode) "django" "related/django.el" (19411
+;;;;;; 8520))
+;;; Generated autoloads from related/django.el
+(web-autoload-require 'django 'lp '(nxhtml-download-root-url nil) "related/django" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'django-mode `(lp '(nxhtml-download-root-url nil) "related/django" nxhtml-install-dir) "\
+Simple Django mode for use with mumamo.
+This mode only provides syntax highlighting.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (csharp-mode csharp-mode-hook) "csharp-mode" "related/csharp-mode.el"
+;;;;;; (19410 9973))
+;;; Generated autoloads from related/csharp-mode.el
+(web-autoload-require 'csharp-mode 'lp '(nxhtml-download-root-url nil) "related/csharp-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(add-to-list 'auto-mode-alist '("\\.cs$" . csharp-mode))
+
+(defvar csharp-mode-hook nil "\
+*Hook called by `csharp-mode'.")
+
+(nxhtml-custom-autoload 'csharp-mode-hook 'csharp-mode t)
+
+(nxhtml-autoload 'csharp-mode `(lp '(nxhtml-download-root-url nil) "related/csharp-mode" nxhtml-install-dir) "\
+Major mode for editing C# code. This mode is derived from CC Mode to
+support C#.
+
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `csharp-mode-hook'.
+
+This mode will automatically add a regexp for Csc.exe error and warning
+messages to the `compilation-error-regexp-alist'.
+
+Key bindings:
+\\{csharp-mode-map}
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (winring-rename-configuration winring-delete-configuration
+;;;;;; winring-jump-to-configuration winring-prev-configuration
+;;;;;; winring-next-configuration winring-duplicate-configuration
+;;;;;; winring-new-configuration) "winring" "util/winring.el" (19392
+;;;;;; 30980))
+;;; Generated autoloads from util/winring.el
+(web-autoload-require 'winring 'lp '(nxhtml-download-root-url nil) "util/winring" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'winring-new-configuration `(lp '(nxhtml-download-root-url nil) "util/winring" nxhtml-install-dir) "\
+Save the current window configuration and create an empty new one.
+The buffer shown in the new empty configuration is defined by
+`winring-new-config-buffer-name'.
+
+With \\[universal-argument] prompt for the new configuration's name.
+Otherwise, the function in `winring-name-generator' will be called to
+get the new configuration's name.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'winring-duplicate-configuration `(lp '(nxhtml-download-root-url nil) "util/winring" nxhtml-install-dir) "\
+Push the current window configuration on the ring, and duplicate it.
+
+With \\[universal-argument] prompt for the new configuration's name.
+Otherwise, the function in `winring-name-generator' will be called to
+get the new configuration's name.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'winring-next-configuration `(lp '(nxhtml-download-root-url nil) "util/winring" nxhtml-install-dir) "\
+Switch to the next window configuration for this frame.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'winring-prev-configuration `(lp '(nxhtml-download-root-url nil) "util/winring" nxhtml-install-dir) "\
+Switch to the previous window configuration for this frame.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'winring-jump-to-configuration `(lp '(nxhtml-download-root-url nil) "util/winring" nxhtml-install-dir) "\
+Go to the named window configuration.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'winring-delete-configuration `(lp '(nxhtml-download-root-url nil) "util/winring" nxhtml-install-dir) "\
+Delete the current configuration and switch to the next one.
+With \\[universal-argument] prompt for named configuration to delete.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'winring-rename-configuration `(lp '(nxhtml-download-root-url nil) "util/winring" nxhtml-install-dir) "\
+Rename the current configuration to NAME.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (winsav-switch-config winsav-save-full-config winsav-save-mode
+;;;;;; winsav winsav-put-window-tree) "winsav" "util/winsav.el"
+;;;;;; (19295 38082))
+;;; Generated autoloads from util/winsav.el
+(web-autoload-require 'winsav 'lp '(nxhtml-download-root-url nil) "util/winsav" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'winsav-put-window-tree `(lp '(nxhtml-download-root-url nil) "util/winsav" nxhtml-install-dir) "\
+Put window structure SAVED-TREE into WINDOW.
+Restore a structure SAVED-TREE returned from
+`winsav-get-window-tree' into window WINDOW.
+
+If COPY-WIN-OVL is non-nil then overlays having a 'window
+property pointing to one of the windows in SAVED-TREE where this
+window still is shown will be copied to a new overlay with
+'window property pointing to the corresponding new window.
+
+If WIN-OVL-ALL-BUFS is non-nil then all buffers will be searched
+for overlays with a 'window property of the kind above.
+
+At the very end of this function the hook `winsav-after-put' is
+run.
+
+\(fn SAVED-TREE WINDOW &optional COPY-WIN-OVL WIN-OVL-ALL-BUFS)" nil nil)
+
+(let ((loads (get 'winsav 'custom-loads))) (if (member '"winsav" loads) nil (put 'winsav 'custom-loads (cons '"winsav" loads))))
+
+(defvar winsav-save-mode nil "\
+Non-nil if Winsav-Save mode is enabled.
+See the command `winsav-save-mode' for a description of this minor mode.")
+
+(nxhtml-custom-autoload 'winsav-save-mode 'winsav nil)
+
+(nxhtml-autoload 'winsav-save-mode `(lp '(nxhtml-download-root-url nil) "util/winsav" nxhtml-install-dir) "\
+Toggle winsav configuration saving mode.
+With numeric ARG, turn winsav saving on if ARG is positive, off
+otherwise.
+
+When this mode is turned on, winsav configurations are saved from
+one session to another. A winsav configuration consists of
+frames, windows and visible buffers configurations plus
+optionally buffers and files managed by the functions used by
+option `desktop-save-mode'
+
+By default this is integrated with `desktop-save-mode'. If
+`desktop-save-mode' is on and `winsav-handle-also-desktop' is
+non-nil then save and restore also desktop.
+
+See the command `winsav-switch-config' for more information and
+other possibilities.
+
+Note: If you want to avoid saving when you exit just turn off
+this minor mode.
+
+For information about what is saved and restored and how to save
+and restore additional information see the function
+`winsav-save-configuration'.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'winsav-save-full-config `(lp '(nxhtml-download-root-url nil) "util/winsav" nxhtml-install-dir) "\
+Saved current winsav configuration in directory DIRNAME.
+Then change to this configuration.
+
+See also `winsav-switch-config'.
+
+\(fn DIRNAME)" nil nil)
+
+(nxhtml-autoload 'winsav-switch-config `(lp '(nxhtml-download-root-url nil) "util/winsav" nxhtml-install-dir) "\
+Change to winsav configuration in directory DIRNAME.
+If DIRNAME is the current winsav configuration directory then
+offer to save it or restore it from saved values.
+
+Otherwise, before switching offer to save the current winsav
+configuration. Then finally switch to the new winsav
+configuration, creating it if it does not exist.
+
+If option `desktop-save-mode' is on then buffers and files are also
+restored and saved the same way.
+
+See also option `winsav-save-mode' and command
+`winsav-tell-configuration'.
+
+\(fn DIRNAME)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (winsav-rotate winsize-set-mode-line-colors winsize-save-window-configuration
+;;;;;; winsize-balance-siblings resize-windows) "winsize" "util/winsize.el"
+;;;;;; (19292 49706))
+;;; Generated autoloads from util/winsize.el
+(web-autoload-require 'winsize 'lp '(nxhtml-download-root-url nil) "util/winsize" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'resize-windows `(lp '(nxhtml-download-root-url nil) "util/winsize" nxhtml-install-dir) "\
+Start window resizing.
+During resizing a window is selected. You can move its
+borders. In the default configuration the arrow keys moves the
+right or bottom border if they are there. To move the opposite
+border use S-arrowkeys.
+
+You can also do other window operations, like splitting, deleting
+and balancing the sizes. The keybindings below describes the key
+bindings during resizing:\\<winsize-keymap>
+
+ `balance-windows' \\[balance-windows]
+ `winsize-balance-siblings' \\[winsize-balance-siblings]
+ `fit-window-to-buffer' \\[fit-window-to-buffer]
+ `shrink-window-if-larger-than-buffer' \\[shrink-window-if-larger-than-buffer]
+
+ `winsav-rotate' \\[winsav-rotate]
+
+ `winsize-move-border-up' \\[winsize-move-border-up]
+ `winsize-move-border-down' \\[winsize-move-border-down]
+ `winsize-move-border-left' \\[winsize-move-border-left]
+ `winsize-move-border-right' \\[winsize-move-border-right]
+
+ `winsize-to-border-or-window-left' \\[winsize-to-border-or-window-left]
+ `winsize-to-border-or-window-up' \\[winsize-to-border-or-window-up]
+ `winsize-to-border-or-window-right' \\[winsize-to-border-or-window-right]
+ `winsize-to-border-or-window-down' \\[winsize-to-border-or-window-down]
+
+ Note that you can also use your normal keys for
+ `forward-char', `backward-char', `next-line', `previous-line'
+ and what you have on HOME and END to move in the windows. That
+ might sometimes be necessary to directly select a
+ window. (You may however also use `other-window' or click
+ with the mouse, see below.)
+
+ `delete-window' \\[delete-window]
+ `delete-other-windows' \\[delete-other-windows]
+ `split-window-vertically' \\[split-window-vertically]
+ `split-window-horizontally' \\[split-window-horizontally]
+ `other-window' \\[other-window]
+
+ `winsize-save-window-configuration' \\[winsize-save-window-configuration]
+ `winsize-next-window-configuration' \\[winsize-next-window-configuration]
+ `winsize-previous-window-configuration' \\[winsize-previous-window-configuration]
+
+ `mouse-set-point' \\[mouse-set-point]
+
+ `winsize-quit' \\[winsize-quit]
+ `winsize-stop-go-back' \\[winsize-stop-go-back]
+ `winsize-stop' \\[winsize-stop]
+ `winsize-stop-and-execute' \\[winsize-stop-and-execute]
+
+ `winsize-help' \\[winsize-help]
+ `describe-key' \\[describe-key]
+ `describe-key-briefly' \\[describe-key-briefly]
+ (All the normal help keys work, and at least those above will
+ play well with resizing.)
+
+Nearly all other keys exits window resizing and they are also
+executed. However, the key sequences in `winsize-let-me-use' and
+dito for commands there are also executed without exiting
+resizing.
+
+The colors of the modelines are changed to those given in
+`winsize-mode-line-colors' to indicate that you are resizing
+windows. To make this indication more prominent the text in the
+selected window is marked with the face hold in the variable
+`winsize-selected-window-face'.
+
+The option `winsize-juris-way' decides how the borders to move
+are selected. If this option is non-nil then the right or bottom
+border are the ones that are moved with the arrow keys and the
+opposite border with shift arrow keys.
+
+If `winsize-juris-way' is nil then the following apply:
+
+As you select other borders or move to new a window the mouse
+pointer is moved inside the selected window to show which borders
+are beeing moved. The mouse jumps a little bit to make its
+position more visible. You can turn this off by customizing
+`winsize-make-mouse-prominent'.
+
+Which borders initially are choosen are controlled by the
+variable `winsize-autoselect-borders'.
+
+** Example: Border selection, movements and windows.
+
+ Suppose you have a frame divided into windows like in the
+ figure below. If window B is selected when you start resizing
+ then (with default settings) the borders marked with 'v' and
+ 'h' will be the ones that the arrow keys moves. To indicate
+ this the mouse pointer is placed in the right lower corner of
+ the selected window B.
+
+ +----------+-----------+--------+
+ | | v |
+ | | v |
+ | A | _B_ v |
+ | | v |
+ | | v |
+ | | x v |
+ +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ +----------+---------+----------+
+
+ Now if you press M-<left> then the picture below shows what has
+ happened. Note that the selected vertical border is now the one
+ between A and B. The mouse pointer has moved to the
+ corresponding corner in the window B, which is still selected.
+
+ +----------+-----------+--------+
+ | v | |
+ | v | |
+ | A v _B_ | |
+ | v | |
+ | v | |
+ | v x | |
+ +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ +----------+---------+----------+
+
+ Press M-<left> once again. This gives this picture:
+
+ +----------+-----------+--------+
+ | v | |
+ | v | |
+ | _A_ v B | |
+ | v | |
+ | v | |
+ | x v | |
+ +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ +----------+---------+----------+
+
+ Note that the window A is now selected. However there is no
+ border that could be moved to the left of this window (which
+ would otherwise be chosen now) so the border between A and B is
+ still the one that <left> and <right> moves. The mouse has
+ moved to A.
+
+ If we now delete window A the new situation will look like
+ this:
+
+ +----------+-----------+--------+
+ | | |
+ | | |
+ | _B_ | |
+ | | |
+ | | |
+ | x | |
+ +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ +----------+---------+----------+
+
+
+
+>>>> testing stuff >>>>
+`help-mode-hook'
+`temp-buffer-show-function'
+`view-exit-action'
+<<<<<<<<<<<<<<<<<<<<<<<
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'winsize-balance-siblings `(lp '(nxhtml-download-root-url nil) "util/winsize" nxhtml-install-dir) "\
+Make current window siblings the same height or width.
+It works the same way as `balance-windows', but only for the
+current window and its siblings.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'winsize-save-window-configuration `(lp '(nxhtml-download-root-url nil) "util/winsize" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'winsize-set-mode-line-colors `(lp '(nxhtml-download-root-url nil) "util/winsize" nxhtml-install-dir) "\
+Turn mode line colors on if ON is non-nil, otherwise off.
+
+\(fn ON)" nil nil)
+
+(nxhtml-autoload 'winsav-rotate `(lp '(nxhtml-download-root-url nil) "util/winsize" nxhtml-install-dir) "\
+Rotate window configuration on selected frame.
+MIRROR should be either 'mirror-left-right, 'mirror-top-bottom or
+nil. In the first case the window configuration is mirrored
+vertically and in the second case horizontally. If MIRROR is nil
+the configuration is not mirrored.
+
+If TRANSPOSE is non-nil then the window structure is transposed
+along the diagonal from top left to bottom right (in analogy with
+matrix transosition).
+
+If called interactively MIRROR will is 'mirror-left-right by
+default, but 'mirror-top-bottom if called with prefix. TRANSPOSE
+is t. This mean that the window configuration will be turned one
+quarter clockwise (or counter clockwise with prefix).
+
+\(fn MIRROR TRANSPOSE)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (wrap-to-fill-column-mode wrap-to-fill-left-marg-modes
+;;;;;; wrap-to-fill-left-marg wrap-to-fill) "wrap-to-fill" "util/wrap-to-fill.el"
+;;;;;; (19306 50510))
+;;; Generated autoloads from util/wrap-to-fill.el
+(web-autoload-require 'wrap-to-fill 'lp '(nxhtml-download-root-url nil) "util/wrap-to-fill" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'wrap-to-fill 'custom-loads))) (if (member '"wrap-to-fill" loads) nil (put 'wrap-to-fill 'custom-loads (cons '"wrap-to-fill" loads))))
+
+(defvar wrap-to-fill-left-marg nil "\
+Left margin handling for `wrap-to-fill-column-mode'.
+Used by `wrap-to-fill-column-mode'. If nil then center the
+display columns. Otherwise it should be a number which will be
+the left margin.")
+
+(nxhtml-custom-autoload 'wrap-to-fill-left-marg 'wrap-to-fill t)
+
+(defvar wrap-to-fill-left-marg-modes '(text-mode fundamental-mode) "\
+Major modes where `wrap-to-fill-left-margin' may be nil.")
+
+(nxhtml-custom-autoload 'wrap-to-fill-left-marg-modes 'wrap-to-fill t)
+
+(nxhtml-autoload 'wrap-to-fill-column-mode `(lp '(nxhtml-download-root-url nil) "util/wrap-to-fill" nxhtml-install-dir) "\
+Use `fill-column' display columns in buffer windows.
+By default the display columns are centered, but see the option
+`wrap-to-fill-left-marg'.
+
+Fix-me:
+Note 1: When turning this on `visual-line-mode' is also turned on. This
+is not reset when turning off this mode.
+
+Note 2: The text properties 'wrap-prefix and 'wrap-to-fill-prefix
+is set by this mode to indent continuation lines.
+
+Key bindings added by this minor mode:
+
+\\{wrap-to-fill-column-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (xhtml-help xhtml-help-show-tag-ref xhtml-help-tag-at-point
+;;;;;; xhtml-help-show-css-ref) "xhtml-help" "nxhtml/xhtml-help.el"
+;;;;;; (19364 56214))
+;;; Generated autoloads from nxhtml/xhtml-help.el
+(web-autoload-require 'xhtml-help 'lp '(nxhtml-download-root-url nil) "nxhtml/xhtml-help" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'xhtml-help-show-css-ref `(lp '(nxhtml-download-root-url nil) "nxhtml/xhtml-help" nxhtml-install-dir) "\
+Show CSS reference for CSS property name at point.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'xhtml-help-tag-at-point `(lp '(nxhtml-download-root-url nil) "nxhtml/xhtml-help" nxhtml-install-dir) "\
+Get xhtml tag name at or before point.
+
+\(fn)" nil nil)
+
+(nxhtml-autoload 'xhtml-help-show-tag-ref `(lp '(nxhtml-download-root-url nil) "nxhtml/xhtml-help" nxhtml-install-dir) "\
+Show xhtml reference for tag name at or before point.
+
+\(fn)" t nil)
+
+(let ((loads (get 'xhtml-help 'custom-loads))) (if (member '"xhtml-help" loads) nil (put 'xhtml-help 'custom-loads (cons '"xhtml-help" loads))))
+
+;;;***
+\f
+;;;### (autoloads (tidy-build-menu tidy) "tidy-xhtml" "nxhtml/tidy-xhtml.el"
+;;;;;; (19364 56214))
+;;; Generated autoloads from nxhtml/tidy-xhtml.el
+(web-autoload-require 'tidy-xhtml 'lp '(nxhtml-download-root-url nil) "nxhtml/tidy-xhtml" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'tidy 'custom-loads))) (if (member '"tidy-xhtml" loads) nil (put 'tidy 'custom-loads (cons '"tidy-xhtml" loads))))
+
+(nxhtml-autoload 'tidy-build-menu `(lp '(nxhtml-download-root-url nil) "nxhtml/tidy-xhtml" nxhtml-install-dir) "\
+Set up the tidy menu in MAP.
+Used to set up a Tidy menu in your favourite mode.
+
+\(fn &optional MAP)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (rngalt-set-validation-header) "rngalt" "nxhtml/rngalt.el"
+;;;;;; (19365 33760))
+;;; Generated autoloads from nxhtml/rngalt.el
+(web-autoload-require 'rngalt 'lp '(nxhtml-download-root-url nil) "nxhtml/rngalt" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'rngalt-set-validation-header `(lp '(nxhtml-download-root-url nil) "nxhtml/rngalt" nxhtml-install-dir) "\
+Not documented
+
+\(fn START-OF-DOC)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (nxml-where-global-mode nxml-where-mode nxml-where)
+;;;;;; "nxml-where" "nxhtml/nxml-where.el" (19365 33760))
+;;; Generated autoloads from nxhtml/nxml-where.el
+(web-autoload-require 'nxml-where 'lp '(nxhtml-download-root-url nil) "nxhtml/nxml-where" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'nxml-where 'custom-loads))) (if (member '"nxml-where" loads) nil (put 'nxml-where 'custom-loads (cons '"nxml-where" loads))))
+
+(nxhtml-autoload 'nxml-where-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxml-where" nxhtml-install-dir) "\
+Shows path in mode line.
+
+\(fn &optional ARG)" t nil)
+
+(defvar nxml-where-global-mode nil "\
+Non-nil if Nxml-Where-Global mode is enabled.
+See the command `nxml-where-global-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `nxml-where-global-mode'.")
+
+(nxhtml-custom-autoload 'nxml-where-global-mode 'nxml-where nil)
+
+(nxhtml-autoload 'nxml-where-global-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxml-where" nxhtml-install-dir) "\
+Toggle Nxml-Where mode in every possible buffer.
+With prefix ARG, turn Nxml-Where-Global mode on if and only if
+ARG is positive.
+Nxml-Where mode is enabled in all buffers where
+`nxml-where-turn-on-in-nxml-child' would do it.
+See `nxml-where-mode' for more information on Nxml-Where mode.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (nxhtml-features-check nxhtml-customize nxhtml)
+;;;;;; "nxhtml" "nxhtml/nxhtml.el" (19412 25954))
+;;; Generated autoloads from nxhtml/nxhtml.el
+(web-autoload-require 'nxhtml 'lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'nxhtml 'custom-loads))) (if (member '"nxhtml" loads) nil (put 'nxhtml 'custom-loads (cons '"nxhtml" loads))))
+
+(nxhtml-autoload 'nxhtml-customize `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml" nxhtml-install-dir) "\
+Customize nXhtml.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'nxhtml-features-check `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml" nxhtml-install-dir) "\
+Check if external modules used by nXhtml are found.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (mako-nxhtml-mumamo-mode asp-nxhtml-mumamo-mode
+;;;;;; eruby-nxhtml-mumamo-mode jsp-nxhtml-mumamo-mode gsp-nxhtml-mumamo-mode
+;;;;;; smarty-nxhtml-mumamo-mode mjt-nxhtml-mumamo-mode genshi-nxhtml-mumamo-mode
+;;;;;; mason-nxhtml-mumamo-mode django-nxhtml-mumamo-mode embperl-nxhtml-mumamo-mode
+;;;;;; nxhtml-mumamo-mode) "nxhtml-mumamo" "nxhtml/nxhtml-mumamo.el"
+;;;;;; (19389 57826))
+;;; Generated autoloads from nxhtml/nxhtml-mumamo.el
+(web-autoload-require 'nxhtml-mumamo 'lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for (X)HTML with main mode `nxhtml-mode'.
+This covers inlined style and javascript and PHP.
+
+See also `mumamo-alt-php-tags-mode'." t)
+
+(nxhtml-autoload 'embperl-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for Embperl files with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'django-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for Django with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'mason-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for Mason using main mode `nxhtml-mode'.
+This covers inlined style and javascript." t)
+
+(nxhtml-autoload 'genshi-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for Genshi with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'mjt-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for MJT with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'smarty-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for Smarty with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'gsp-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for GSP with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'jsp-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for JSP with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'eruby-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for eRuby with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'asp-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for ASP with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+(nxhtml-autoload 'mako-nxhtml-mumamo-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mumamo" nxhtml-install-dir) "\
+Turn on multiple major modes for Mako with main mode `nxhtml-mode'.
+This also covers inlined style and javascript." t)
+
+;;;***
+\f
+;;;### (autoloads (nxhtml-validation-header-mode nxhtml-short-tag-help
+;;;;;; nxhtml-mode) "nxhtml-mode" "nxhtml/nxhtml-mode.el" (19412
+;;;;;; 25947))
+;;; Generated autoloads from nxhtml/nxhtml-mode.el
+(web-autoload-require 'nxhtml-mode 'lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(when (fboundp 'nxml-mode)
+(nxhtml-autoload 'nxhtml-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mode" nxhtml-install-dir) "\
+Major mode for editing XHTML documents.
+It is based on `nxml-mode' and adds some features that are useful
+when editing XHTML files.\\<nxhtml-mode-map>
+
+To see an overview in html format do \\[nxhtml-overview].
+
+* Note: Please observe that when loading nXhtml some file
+ associations are done, see `nxhtml-setup-file-assoc'.
+
+The nXhtml menu is added by this mode (or actually the minor
+mode `nxhtml-menu-mode') and gives quick access and an overview
+of some other important features. These includes:
+
+- multiple major modes, see `define-mumamo-multi-major-mode'
+- easy uploading and viewing of files, see for example
+ `html-upl-upload-file'
+- validation in XHTML part for php etc, see
+ `nxhtml-validation-header-mode' (you probably also want to know about
+ `nxhtml-toggle-visible-warnings' for this!)
+- converting of html to xhtml, see `tidy-buffer'
+
+The XML menu contains functionality added by `nxml-mode' (on
+which this major mode is based). There is also a popup menu
+added to the [apps] key.
+
+The most important features are probably completion and
+validation, which is inherited from `nxml-mode' with some small
+addtions. In very many situation you can use completion. To
+access it type \\[nxml-complete]. Completion has been enhanced in
+the following way:
+
+- If region is active and visible then completion will surround the
+ region with the chosen tag's start and end tag. However only the
+ starting point is checked for validity. If something is wrong after
+ insertion you will however immediately see it if you have validation
+ on.
+- It can in some cases give assistance with attribute values.
+- Completion can be customized, see the menus XHTML - Completion:
+ * You can use a menu popup style completion.
+ * You can have alternatives grouped.
+ * You can get a short help text shown for each alternative.
+- There does not have to be a '<' before point for tag name
+ completion. (`nxml-mode' requires a '<' before point for tag name
+ completion.)
+- Completes xml version and encoding.
+- Completes in an empty buffer, ie inserts a skeleton.
+
+Some smaller, useful, but easy-to-miss features:
+
+* Following links. The href and src attribute names are
+ underlined and a special keymap is bound to
+ them:\\<mlinks-mode-map>
+
+ \\[mlinks-backward-link], \\[mlinks-forward-link] Move
+ between underlined href/src attributes
+
+ \\[mlinks-goto], Mouse-1 Follow link inside Emacs
+ (if possible)
+
+ It is even a little bit quicker when the links are in an active
+ state (marked with the face `isearch'):\\<mlinks-active-hilight-keymap>
+
+ \\[mlinks-backward-link], \\[mlinks-forward-link] Move
+ between underlined href/src attributes
+ \\[mlinks-goto], Mouse-1 Follow link inside Emacs (if possible)
+
+ If the link is not into a file that you can edit (a mailto link
+ for example) you will be prompted for an alternative action.
+
+* Creating links. To make it easier to create links to id/name
+ attribute in different files there are two special
+ functions:\\<nxhtml-mode-map>
+
+ \\[nxhtml-save-link-to-here] copy link to id/name (you must
+ be in the tag to get the link)
+ \\[nxhtml-paste-link-as-a-tag] paste this as an a-tag.
+
+Here are all key bindings in nxhtml-mode itself:
+
+\\{nxhtml-mode-map}
+
+The minor mode `nxhtml-menu-mode' adds some bindings:
+
+\\{nxhtml-menu-mode-map}
+
+Notice that other minor mode key bindings may also be active, as
+well as emulation modes. Do \\[describe-bindings] to get a list
+of all active key bindings. Also, *VERY IMPORTANT*, if mumamo is
+used in the buffer each mumamo chunk has a different major mode
+with different key bindings. You can however still see all
+bindings with \\[describe-bindings], but you have to do that with
+point in the mumamo chunk you want to know the key bindings in.
+
+---------
+* Note: Some of the features supported by this mode are optional
+ and available only if other Emacs modules are found. Use
+ \\[nxhtml-features-check] to get a list of these optional
+ features and modules needed. You should however have no problem
+ with this if you have followed the installation instructions
+ for nXhtml.
+
+\(fn)" t nil))
+
+(nxhtml-autoload 'nxhtml-short-tag-help `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mode" nxhtml-install-dir) "\
+Display description of tag TAG. If TAG is omitted, try tag at point.
+
+\(fn TAG)" t nil)
+
+(when (fboundp 'nxml-mode)
+(nxhtml-autoload 'nxhtml-validation-header-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-mode" nxhtml-install-dir) "\
+If on use a Fictive XHTML Validation Header for the buffer.
+See `nxhtml-set-validation-header' for information about Fictive XHTML Validation Headers.
+
+This mode may be turned on automatically in two ways:
+- If you try to do completion of a XHTML tag or attribute then
+ `nxthml-mode' may ask you if you want to turn this mode on if
+ needed.
+- You can also choose to have it turned on automatically whenever
+ a mumamo multi major mode is used, see
+ `nxhtml-validation-header-if-mumamo' for further information.
+
+\(fn &optional ARG)" t nil))
+
+;;;***
+\f
+;;;### (autoloads (nxhtml-overview nxhtml-menu-mode nxhtml-browse-region
+;;;;;; nxhtml-browse-file nxhtml-edit-with-gimp) "nxhtml-menu" "nxhtml/nxhtml-menu.el"
+;;;;;; (19412 26360))
+;;; Generated autoloads from nxhtml/nxhtml-menu.el
+(web-autoload-require 'nxhtml-menu 'lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-menu" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'nxhtml-edit-with-gimp `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-menu" nxhtml-install-dir) "\
+Edit with GIMP buffer or file at point.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'nxhtml-browse-file `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-menu" nxhtml-install-dir) "\
+View file in web browser.
+
+\(fn FILE)" t nil)
+
+(nxhtml-autoload 'nxhtml-browse-region `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-menu" nxhtml-install-dir) "\
+View region in web browser.
+
+\(fn)" t nil)
+
+(defvar nxhtml-menu-mode nil "\
+Non-nil if Nxhtml-Menu mode is enabled.
+See the command `nxhtml-menu-mode' for a description of this minor mode.")
+
+(nxhtml-custom-autoload 'nxhtml-menu-mode 'nxhtml-menu nil)
+
+(nxhtml-autoload 'nxhtml-menu-mode `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-menu" nxhtml-install-dir) "\
+Minor mode to turn on some key and menu bindings.
+See `nxhtml-mode' for more information.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'nxhtml-overview `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-menu" nxhtml-install-dir) "\
+Show a HTML page with an overview of nXhtml.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (nxhtml-report-bug) "nxhtml-bug" "nxhtml/nxhtml-bug.el"
+;;;;;; (19277 65354))
+;;; Generated autoloads from nxhtml/nxhtml-bug.el
+(web-autoload-require 'nxhtml-bug 'lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-bug" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'nxhtml-report-bug `(lp '(nxhtml-download-root-url nil) "nxhtml/nxhtml-bug" nxhtml-install-dir) "\
+Report a bug in nXhtml.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (html-wtoc) "html-wtoc" "nxhtml/html-wtoc.el" (19364
+;;;;;; 56214))
+;;; Generated autoloads from nxhtml/html-wtoc.el
+(web-autoload-require 'html-wtoc 'lp '(nxhtml-download-root-url nil) "nxhtml/html-wtoc" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'html-wtoc 'custom-loads))) (if (member '"html-wtoc" loads) nil (put 'html-wtoc 'custom-loads (cons '"html-wtoc" loads))))
+
+;;;***
+\f
+;;;### (autoloads (html-upl-ediff-file html-upl-edit-remote-file-with-toc
+;;;;;; html-upl-edit-remote-file html-upl-upload-file html-upl-remote-dired
+;;;;;; html-upl-upload-site html-upl-upload-site-with-toc html-upl)
+;;;;;; "html-upl" "nxhtml/html-upl.el" (19364 56214))
+;;; Generated autoloads from nxhtml/html-upl.el
+(web-autoload-require 'html-upl 'lp '(nxhtml-download-root-url nil) "nxhtml/html-upl" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'html-upl 'custom-loads))) (if (member '"html-upl" loads) nil (put 'html-upl 'custom-loads (cons '"html-upl" loads))))
+
+(nxhtml-autoload 'html-upl-upload-site-with-toc `(lp '(nxhtml-download-root-url nil) "nxhtml/html-upl" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'html-upl-upload-site `(lp '(nxhtml-download-root-url nil) "nxhtml/html-upl" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'html-upl-remote-dired `(lp '(nxhtml-download-root-url nil) "nxhtml/html-upl" nxhtml-install-dir) "\
+Start dired for remote directory or its parent/ancestor.
+
+\(fn DIRNAME)" t nil)
+
+(nxhtml-autoload 'html-upl-upload-file `(lp '(nxhtml-download-root-url nil) "nxhtml/html-upl" nxhtml-install-dir) "\
+Upload a single file in a site.
+For the definition of a site see `html-site-current'.
+
+\(fn FILENAME)" t nil)
+
+(nxhtml-autoload 'html-upl-edit-remote-file `(lp '(nxhtml-download-root-url nil) "nxhtml/html-upl" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'html-upl-edit-remote-file-with-toc `(lp '(nxhtml-download-root-url nil) "nxhtml/html-upl" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'html-upl-ediff-file `(lp '(nxhtml-download-root-url nil) "nxhtml/html-upl" nxhtml-install-dir) "\
+Run ediff on local and remote file.
+FILENAME could be either the remote or the local file.
+
+\(fn FILENAME)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (html-toc) "html-toc" "nxhtml/html-toc.el" (19364
+;;;;;; 56214))
+;;; Generated autoloads from nxhtml/html-toc.el
+(web-autoload-require 'html-toc 'lp '(nxhtml-download-root-url nil) "nxhtml/html-toc" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'html-toc 'custom-loads))) (if (member '"html-toc" loads) nil (put 'html-toc 'custom-loads (cons '"html-toc" loads))))
+
+(defconst html-toc-menu-map (let ((map (make-sparse-keymap))) (define-key map [html-toc-browse-frames-file] (list 'menu-item "Browse Frames File" 'html-toc-browse-frames-file)) (define-key map [html-toc-write-frames-file] (list 'menu-item "Write Frames File" 'html-toc-write-frames-file)) (define-key map [html-toc-write-toc-file] (list 'menu-item "Write TOC File for Frames" 'html-toc-write-toc-file)) (define-key map [html-toc-sep1] (list 'menu-item "--")) (define-key map [html-toc-edit-pages-file] (list 'menu-item "Edit List of Pages for TOC" 'html-site-edit-pages-file)) (define-key map [html-toc-create-pages-file] (list 'menu-item "Write List of Pages for TOC" 'html-toc-create-pages-file)) map))
+
+;;;***
+\f
+;;;### (autoloads (html-site-query-replace html-site-rgrep html-site-find-file
+;;;;;; html-site-dired-current html-site-set-site html-site-buffer-or-dired-file-name
+;;;;;; html-site) "html-site" "nxhtml/html-site.el" (19364 56214))
+;;; Generated autoloads from nxhtml/html-site.el
+(web-autoload-require 'html-site 'lp '(nxhtml-download-root-url nil) "nxhtml/html-site" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'html-site 'custom-loads))) (if (member '"html-site" loads) nil (put 'html-site 'custom-loads (cons '"html-site" loads))))
+
+(nxhtml-autoload 'html-site-buffer-or-dired-file-name `(lp '(nxhtml-download-root-url nil) "nxhtml/html-site" nxhtml-install-dir) "\
+Return buffer file name or file pointed to in dired.
+
+\(fn)" nil nil)
+
+(nxhtml-autoload 'html-site-set-site `(lp '(nxhtml-download-root-url nil) "nxhtml/html-site" nxhtml-install-dir) "\
+Not documented
+
+\(fn NAME)" t nil)
+
+(nxhtml-autoload 'html-site-dired-current `(lp '(nxhtml-download-root-url nil) "nxhtml/html-site" nxhtml-install-dir) "\
+Open `dired' in current site top directory.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'html-site-find-file `(lp '(nxhtml-download-root-url nil) "nxhtml/html-site" nxhtml-install-dir) "\
+Find file in current site.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'html-site-rgrep `(lp '(nxhtml-download-root-url nil) "nxhtml/html-site" nxhtml-install-dir) "\
+Search current site's files with `rgrep'.
+See `rgrep' for the arguments REGEXP and FILES.
+
+\(fn REGEXP FILES)" t nil)
+
+(nxhtml-autoload 'html-site-query-replace `(lp '(nxhtml-download-root-url nil) "nxhtml/html-site" nxhtml-install-dir) "\
+Query replace in current site's files.
+
+\(fn FROM TO FILE-REGEXP DELIMITED)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (html-pagetoc-rebuild-toc html-pagetoc-insert-toc
+;;;;;; html-pagetoc) "html-pagetoc" "nxhtml/html-pagetoc.el" (19364
+;;;;;; 56214))
+;;; Generated autoloads from nxhtml/html-pagetoc.el
+(web-autoload-require 'html-pagetoc 'lp '(nxhtml-download-root-url nil) "nxhtml/html-pagetoc" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'html-pagetoc 'custom-loads))) (if (member '"html-pagetoc" loads) nil (put 'html-pagetoc 'custom-loads (cons '"html-pagetoc" loads))))
+
+(nxhtml-autoload 'html-pagetoc-insert-toc `(lp '(nxhtml-download-root-url nil) "nxhtml/html-pagetoc" nxhtml-install-dir) "\
+Inserts a table of contents for the current html file.
+The html header tags h1-h6 found in the file are inserted into
+this table. MIN-LEVEL and MAX-LEVEL specifies the minimum and
+maximum level of h1-h6 to include. They should be integers.
+
+\(fn &optional MIN-LEVEL MAX-LEVEL)" t nil)
+
+(nxhtml-autoload 'html-pagetoc-rebuild-toc `(lp '(nxhtml-download-root-url nil) "nxhtml/html-pagetoc" nxhtml-install-dir) "\
+Update the table of contents inserted by `html-pagetoc-insert-toc'.
+
+\(fn)" t nil)
+
+(defconst html-pagetoc-menu-map (let ((map (make-sparse-keymap))) (define-key map [html-pagetoc-rebuild-toc] (list 'menu-item "Update Page TOC" 'html-pagetoc-rebuild-toc)) (define-key map [html-pagetoc-insert-style-guide] (list 'menu-item "Insert CSS Style for Page TOC" 'html-pagetoc-insert-style-guide)) (define-key map [html-pagetoc-insert-toc] (list 'menu-item "Insert Page TOC" 'html-pagetoc-insert-toc)) map))
+
+;;;***
+\f
+;;;### (autoloads (html-chklnk) "html-chklnk" "nxhtml/html-chklnk.el"
+;;;;;; (19364 56214))
+;;; Generated autoloads from nxhtml/html-chklnk.el
+(web-autoload-require 'html-chklnk 'lp '(nxhtml-download-root-url nil) "nxhtml/html-chklnk" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'html-chklnk 'custom-loads))) (if (member '"html-chklnk" loads) nil (put 'html-chklnk 'custom-loads (cons '"html-chklnk" loads))))
+
+;;;***
+\f
+;;;### (autoloads (web-vcs-investigate-elisp-file web-vcs-byte-compile-file
+;;;;;; web-vcs-message-with-face web-vcs-get-files-from-root web-vcs-log-edit
+;;;;;; web-vcs-default-download-directory) "web-vcs" "web-vcs.el"
+;;;;;; (19412 16397))
+;;; Generated autoloads from web-vcs.el
+(web-autoload-require 'web-vcs 'lp '(nxhtml-download-root-url nil) "web-vcs" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'web-vcs-default-download-directory `(lp '(nxhtml-download-root-url nil) "web-vcs" nxhtml-install-dir) "\
+Try to find a suitable place.
+Considers site-start.el, site-
+
+\(fn)" nil nil)
+
+(nxhtml-autoload 'web-vcs-log-edit `(lp '(nxhtml-download-root-url nil) "web-vcs" nxhtml-install-dir) "\
+Open log file.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'web-vcs-get-files-from-root `(lp '(nxhtml-download-root-url nil) "web-vcs" nxhtml-install-dir) "\
+Download a file tree from VCS system using the web interface.
+Use WEB-VCS entry in variable `web-vcs-links-regexp' to download
+files via http from URL to directory DL-DIR.
+
+Show URL first and offer to visit the page. That page will give
+you information about version control system (VCS) system used
+etc.
+
+\(fn WEB-VCS URL DL-DIR)" nil nil)
+
+(nxhtml-autoload 'web-vcs-message-with-face `(lp '(nxhtml-download-root-url nil) "web-vcs" nxhtml-install-dir) "\
+Display a colored message at the bottom of the string.
+FACE is the face to use for the message.
+FORMAT-STRING and ARGS are the same as for `message'.
+
+Also put FACE on the message in *Messages* buffer.
+
+\(fn FACE FORMAT-STRING &rest ARGS)" nil nil)
+
+(nxhtml-autoload 'web-vcs-byte-compile-file `(lp '(nxhtml-download-root-url nil) "web-vcs" nxhtml-install-dir) "\
+Byte compile FILE in a new Emacs sub process.
+EXTRA-LOAD-PATH is added to the front of `load-path' during
+compilation.
+
+FILE is set to `buffer-file-name' when called interactively.
+If LOAD
+
+\(fn FILE &optional LOAD EXTRA-LOAD-PATH COMP-DIR)" t nil)
+
+(nxhtml-autoload 'web-vcs-investigate-elisp-file `(lp '(nxhtml-download-root-url nil) "web-vcs" nxhtml-install-dir) "\
+Not documented
+
+\(fn FILE-OR-BUFFER)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (nxhtmlmaint-byte-uncompile-all nxhtmlmaint-byte-recompile
+;;;;;; nxhtmlmaint-start-byte-compilation) "nxhtmlmaint" "nxhtmlmaint.el"
+;;;;;; (19378 31293))
+;;; Generated autoloads from nxhtmlmaint.el
+(web-autoload-require 'nxhtmlmaint 'lp '(nxhtml-download-root-url nil) "nxhtmlmaint" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'nxhtmlmaint-start-byte-compilation `(lp '(nxhtml-download-root-url nil) "nxhtmlmaint" nxhtml-install-dir) "\
+Start byte compilation of nXhtml in new Emacs instance.
+Byte compiling in general makes elisp code run 5-10 times faster
+which is quite noticeable when you use nXhtml.
+
+This will also update the file nxhtml-loaddefs.el.
+
+You must restart Emacs to use the byte compiled files.
+
+If for some reason the byte compiled files does not work you can
+remove then with `nxhtmlmaint-byte-uncompile-all'.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'nxhtmlmaint-byte-recompile `(lp '(nxhtml-download-root-url nil) "nxhtmlmaint" nxhtml-install-dir) "\
+Recompile or compile all nXhtml files in current Emacs.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'nxhtmlmaint-byte-uncompile-all `(lp '(nxhtml-download-root-url nil) "nxhtmlmaint" nxhtml-install-dir) "\
+Delete byte compiled files in nXhtml.
+This will also update the file nxhtml-loaddefs.el.
+
+See `nxhtmlmaint-start-byte-compilation' for byte compiling.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (zencoding-preview zencoding-expand-yas zencoding-mode
+;;;;;; zencoding-expand-line zencoding) "zencoding-mode" "util/zencoding-mode.el"
+;;;;;; (19275 63380))
+;;; Generated autoloads from util/zencoding-mode.el
+(web-autoload-require 'zencoding-mode 'lp '(nxhtml-download-root-url nil) "util/zencoding-mode" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(let ((loads (get 'zencoding 'custom-loads))) (if (member '"zencoding-mode" loads) nil (put 'zencoding 'custom-loads (cons '"zencoding-mode" loads))))
+
+(nxhtml-autoload 'zencoding-expand-line `(lp '(nxhtml-download-root-url nil) "util/zencoding-mode" nxhtml-install-dir) "\
+Replace the current line's zencode expression with the corresponding expansion.
+If prefix ARG is given or region is visible call `zencoding-preview' to start an
+interactive preview.
+
+Otherwise expand line directly.
+
+For more information see `zencoding-mode'.
+
+\(fn ARG)" t nil)
+
+(nxhtml-autoload 'zencoding-mode `(lp '(nxhtml-download-root-url nil) "util/zencoding-mode" nxhtml-install-dir) "\
+Minor mode for writing HTML and CSS markup.
+With zen coding for HTML and CSS you can write a line like
+
+ ul#name>li.item*2
+
+and have it expanded to
+
+ <ul id=\"name\">
+ <li class=\"item\"></li>
+ <li class=\"item\"></li>
+ </ul>
+
+This minor mode defines keys for quick access:
+
+\\{zencoding-mode-keymap}
+
+Home page URL `http://www.emacswiki.org/emacs/ZenCoding'.
+
+See also `zencoding-expand-line'.
+
+\(fn &optional ARG)" t nil)
+
+(nxhtml-autoload 'zencoding-expand-yas `(lp '(nxhtml-download-root-url nil) "util/zencoding-mode" nxhtml-install-dir) "\
+Not documented
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'zencoding-preview `(lp '(nxhtml-download-root-url nil) "util/zencoding-mode" nxhtml-install-dir) "\
+Expand zencode between BEG and END interactively.
+This will show a preview of the expanded zen code and you can
+accept it or skip it.
+
+\(fn BEG END)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("autostart.el" "autostart22.el" "etc/schema/schema-path-patch.el"
+;;;;;; "nxhtml-base.el" "nxhtml/html-imenu.el" "nxhtml/html-move.el"
+;;;;;; "nxhtml/html-quote.el" "nxhtml/nxhtml-autoload.el" "nxhtml/nxhtml-strval.el"
+;;;;;; "nxhtml/nxhtmljs.el" "nxhtml/outline-magic.el" "nxhtml/wtest.el"
+;;;;;; "related/flymake-helpers.el" "related/flymakemsg.el" "related/flymu.el"
+;;;;;; "related/php-imenu.el" "tests/angus77-setup-jde.el" "tests/emacstest-suites.el"
+;;;;;; "tests/ert2.el" "tests/hfy-test.el" "tests/inemacs/bug1013.el"
+;;;;;; "tests/mumamo-test.el" "tests/nxhtmltest-helpers.el" "tests/temp-test.el"
+;;;;;; "util/appmenu-fold.el" "util/css-simple-completion.el" "util/custsets.el"
+;;;;;; "util/ecb-batch-compile.el" "util/fupd.el" "util/idn.el"
+;;;;;; "util/key-cat.el" "util/mumamo-aspnet.el" "util/mumamo-trace.el"
+;;;;;; "util/new-key-seq-widget.el" "util/nxml-mode-os-additions.el"
+;;;;;; "util/org-panel.el" "util/rxi.el" "util/useful-commands.el"
+;;;;;; "web-autoload.el") (19412 26385 593000))
+
+;;;***
+\f
+;;;### (autoloads (nxhtml-byte-recompile-file nxhtml-byte-compile-file
+;;;;;; nxhtml-get-missing-files nxhtml-update-existing-files nxhtml-setup-download-all
+;;;;;; nxhtml-setup-auto-download nxhtml-setup-install) "nxhtml-web-vcs"
+;;;;;; "nxhtml-web-vcs.el" (19412 16464))
+;;; Generated autoloads from nxhtml-web-vcs.el
+(web-autoload-require 'nxhtml-web-vcs 'lp '(nxhtml-download-root-url nil) "nxhtml-web-vcs" nxhtml-install-dir 'nxhtml-byte-compile-file)
+
+
+(nxhtml-autoload 'nxhtml-setup-install `(lp '(nxhtml-download-root-url nil) "nxhtml-web-vcs" nxhtml-install-dir) "\
+Setup and start nXhtml installation.
+
+This is for installation and updating directly from the nXhtml
+development sources.
+
+There are two different ways to install:
+
+ (1) Download all at once: `nxhtml-setup-download-all'
+ (2) Automatically download part by part: `nxhtml-setup-auto-download'
+
+You can convert between those ways by calling this function again.
+You can also do this by setting the option `nxhtml-autoload-web' yourself.
+
+When you have nXhtml installed you can update it:
+
+ (3) Update new files in nXhtml: `nxhtml-update-existing-files'
+
+To learn more about nXhtml visit its home page at URL
+`http://www.emacswiki.com/NxhtmlMode/'.
+
+If you want to test auto download (but not use it further) there
+is a special function for that, you answer T here:
+
+ (T) Test automatic download part by part: `nxhtml-setup-test-auto-download'
+
+======
+*Note*
+If you want to download a zip file with latest released version instead then
+please see URL `http://ourcomments.org/Emacs/nXhtml/doc/nxhtml.html'.
+
+\(fn WAY)" t nil)
+
+(nxhtml-autoload 'nxhtml-setup-auto-download `(lp '(nxhtml-download-root-url nil) "nxhtml-web-vcs" nxhtml-install-dir) "\
+Set up to autoload nXhtml files from the web.
+
+This function will download some initial files and then setup to
+download the rest when you need them.
+
+Files will be downloaded under the directory root you specify in
+DL-DIR.
+
+Note that files will not be upgraded automatically. The auto
+downloading is just for files you are missing. (This may change a
+bit in the future.) If you want to upgrade those files that you
+have downloaded you can just call `nxhtml-update-existing-files'.
+
+You can easily switch between this mode of downloading or
+downloading the whole of nXhtml by once. To switch just call the
+command `nxhtml-setup-install'.
+
+See also the command `nxhtml-setup-download-all'.
+
+Note: If your nXhtml is to old you can't use this function
+ directly. You have to upgrade first, se the function
+ above. Version 2.07 or above is good for this.
+
+\(fn DL-DIR)" t nil)
+
+(nxhtml-autoload 'nxhtml-setup-download-all `(lp '(nxhtml-download-root-url nil) "nxhtml-web-vcs" nxhtml-install-dir) "\
+Download or update all of nXhtml.
+
+You can download all if nXhtml with this command.
+
+To update existing files use `nxhtml-update-existing-files'.
+
+If you want to download only those files you are actually using
+then call `nxhtml-setup-auto-download' instead.
+
+See the command `nxhtml-setup-install' for a convenient way to
+call these commands.
+
+For more information about auto download of nXhtml files see
+`nxhtml-setup-auto-download'.
+
+\(fn DL-DIR)" t nil)
+
+(nxhtml-autoload 'nxhtml-update-existing-files `(lp '(nxhtml-download-root-url nil) "nxhtml-web-vcs" nxhtml-install-dir) "\
+Update existing nXhtml files from the development sources.
+Only files you already have will be updated.
+
+Note that this works both if you have setup nXhtml to auto
+download files as you need them or if you have downloaded all of
+nXhtml at once.
+
+For more information about installing and updating nXhtml see the
+command `nxhtml-setup-install'.
+
+\(fn)" t nil)
+
+(nxhtml-autoload 'nxhtml-get-missing-files `(lp '(nxhtml-download-root-url nil) "nxhtml-web-vcs" nxhtml-install-dir) "\
+Not documented
+
+\(fn SUB-DIR FILE-NAME-LIST)" nil nil)
+
+(nxhtml-autoload 'nxhtml-byte-compile-file `(lp '(nxhtml-download-root-url nil) "nxhtml-web-vcs" nxhtml-install-dir) "\
+Not documented
+
+\(fn FILE &optional LOAD)" nil nil)
+
+(nxhtml-autoload 'nxhtml-byte-recompile-file `(lp '(nxhtml-download-root-url nil) "nxhtml-web-vcs" nxhtml-install-dir) "\
+Byte recompile FILE file if necessary.
+For more information see `nxhtml-byte-compile-file'.
+Loading is done if recompiled and LOAD is t.
+
+\(fn FILE &optional LOAD)" t nil)
+
+;;;***
--- /dev/null
+;;; nxhtml-web-vcs.el --- nXhtml things for web-vcs.el
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2010-01-13 Wed
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'nxhtml-base nil t))
+;;(eval-when-compile (require 'nxhtmlmaint nil t))
+(eval-when-compile (require 'web-vcs nil t))
+
+(defvar nxhtml-web-vcs-file (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name)
+ "This file.")
+
+(defun nxhtml-require-base ()
+ (require 'nxhtml-base nil t)
+ (unless (featurep 'nxhtml-base)
+ ;; At startup, need to load it by hand.
+ (let ((load-path load-path))
+ (add-to-list 'load-path (file-name-directory nxhtml-web-vcs-file))
+ (require 'nxhtml-base))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Repository URL
+
+
+;;(nxhtml-default-download-directory)
+(defun nxhtml-default-download-directory ()
+ (let* ((ur (expand-file-name "" "~"))
+ (ur-len (length ur))
+ (full (if (and (boundp 'nxhtml-install-dir)
+ nxhtml-install-dir)
+ nxhtml-install-dir
+ (file-name-as-directory
+ (expand-file-name ""
+ (web-vcs-default-download-directory)))))
+ (full-len (length full)))
+ (if (and (> full-len ur-len)
+ (string= ur (substring full 0 ur-len)))
+ (concat "~" (substring full ur-len))
+ full)))
+
+
+(defun nxhtml-web-vcs-read-dl-dir (prompt)
+ "Return current nXhtml install dir or read dir."
+ (or (and (boundp 'nxhtml-install-dir)
+ nxhtml-install-dir)
+ (let* ((pr (concat
+ "A directory named 'nxhtml' will be created below the root you give."
+ "\n"
+ prompt))
+ (root (read-directory-name pr (nxhtml-default-download-directory))))
+ (when root
+ (expand-file-name "nxhtml" root)))))
+
+;;(call-interactively 'nxhtml-setup-install)
+;; (read-key "Prompt: ")
+;; (y-or-n-p "Prompt")
+;;;###autoload
+(defun nxhtml-setup-install (way)
+ "Setup and start nXhtml installation.
+
+This is for installation and updating directly from the nXhtml
+development sources.
+
+There are two different ways to install:
+
+ (1) Download all at once: `nxhtml-setup-download-all'
+ (2) Automatically download part by part: `nxhtml-setup-auto-download'
+
+You can convert between those ways by calling this function again.
+You can also do this by setting the option `nxhtml-autoload-web' yourself.
+
+When you have nXhtml installed you can update it:
+
+ (3) Update new files in nXhtml: `nxhtml-update-existing-files'
+
+To learn more about nXhtml visit its home page at URL
+`http://www.emacswiki.com/NxhtmlMode/'.
+
+If you want to test auto download \(but not use it further) there
+is a special function for that, you answer T here:
+
+ (T) Test automatic download part by part: `nxhtml-setup-test-auto-download'
+
+======
+*Note*
+If you want to download a zip file with latest released version instead then
+please see URL `http://ourcomments.org/Emacs/nXhtml/doc/nxhtml.html'."
+ (interactive (let ((curr-cfg (current-window-configuration)))
+ (describe-function 'nxhtml-setup-install)
+ (select-window (get-buffer-window (help-buffer)))
+ (delete-other-windows)
+ (list
+ (let* ((key nil)
+ (has-nxhtml (and (boundp 'nxhtml-install-dir) nxhtml-install-dir))
+ (current-way (if has-nxhtml
+ (if (and (boundp 'nxhtml-autoload-web)
+ nxhtml-autoload-web)
+ "Your current setup is to download part by part from the web."
+ "Your current setup it to download all of nXhtml at once.")
+ "(You have not currently installed nXhtml.)"))
+ (prompt (concat "Setup nXhtml install."
+ "\n" current-way
+ "\n"
+ "\n(1) Download whole at once, or (2) part by part as needed"
+ (if has-nxhtml "\n(3) Update your existing nXhtml" "")
+ "\n(T) For temporary testing downloading part by part"
+ "\n"
+ "\n(? for help, q to quit): "))
+ (allowed-keys (if has-nxhtml
+ '(?1 ?2 ?3 ?T ?q 7)
+ '(?1 ?2 ?T ?q 7)))
+ (please nil))
+ (while (not (member key allowed-keys))
+ (if (not (member key '(??)))
+ (when key
+ (unless please
+ (setq prompt (concat "Please answer with one of the alternatives.\n\n"
+ prompt))
+ (setq please t)))
+ (describe-function 'nxhtml-setup-install)
+ (select-window (get-buffer-window (help-buffer)))
+ (delete-other-windows))
+ (setq key (web-vcs-read-key prompt))
+ ;;(message "key = %S" key) (sit-for 1)
+ )
+ (case key
+ (7 (set-window-configuration curr-cfg)
+ nil)
+ (?1 'whole)
+ (?2 'part-by-part)
+ (?3 'update-existing)
+ (?T 'test-part-by-part)
+ )))))
+ (message "")
+ (case way
+ (whole (call-interactively 'nxhtml-setup-download-all))
+ (part-by-part (call-interactively 'nxhtml-setup-auto-download))
+ (update-existing (call-interactively 'nxhtml-update-existing-files))
+ (test-part-by-part (call-interactively 'nxhtml-setup-test-auto-download))
+ ((eq nil way) nil)
+ (t (error "Unknown way = %S" way))))
+
+(defvar nxhtml-basic-files '(
+ "nxhtml-base.el"
+ "nxhtml-loaddefs.el"
+ "web-autoload.el"
+ "etc/schema/schema-path-patch.el"
+ "nxhtml/nxhtml-autoload.el"
+ "autostart.el"
+ ))
+
+;;;###autoload
+(defun nxhtml-setup-auto-download (dl-dir)
+ "Set up to autoload nXhtml files from the web.
+
+This function will download some initial files and then setup to
+download the rest when you need them.
+
+Files will be downloaded under the directory root you specify in
+DL-DIR.
+
+Note that files will not be upgraded automatically. The auto
+downloading is just for files you are missing. (This may change a
+bit in the future.) If you want to upgrade those files that you
+have downloaded you can just call `nxhtml-update-existing-files'.
+
+You can easily switch between this mode of downloading or
+downloading the whole of nXhtml by once. To switch just call the
+command `nxhtml-setup-install'.
+
+See also the command `nxhtml-setup-download-all'.
+
+Note: If your nXhtml is to old you can't use this function
+ directly. You have to upgrade first, se the function
+ above. Version 2.07 or above is good for this."
+ (interactive (progn
+ (describe-function 'nxhtml-setup-auto-download)
+ (select-window (get-buffer-window (help-buffer)))
+ (delete-other-windows)
+ (nxhtml-check-convert-to-part-by-part)
+ (list
+ (progn
+ (when (and (boundp 'nxhtml-autoload-web)
+ (not nxhtml-autoload-web))
+ (unless (yes-or-no-p "Convert to updating nXhtml part by part? ")
+ (throw 'command-level nil)))
+ (nxhtml-web-vcs-read-dl-dir "Download nXhtml part by part to directory: ")))))
+ (catch 'command-level
+ (if (not dl-dir)
+ (unless (with-no-warnings (called-interactively-p))
+ (error "dl-dir should be a directory"))
+ (nxhtml-check-convert-to-part-by-part)
+ (when (and (boundp 'nxhtml-install-dir)
+ nxhtml-install-dir)
+ (unless (string= (file-truename dl-dir)
+ (file-truename nxhtml-install-dir))
+ (error "Download dir must be same as nxhtml-install-dir=%S" nxhtml-install-dir)))
+ (let* (;; Need some files:
+ (web-vcs-el-src (concat (file-name-sans-extension web-vcs-el-this) ".el"))
+ (web-vcs-el (expand-file-name (file-name-nondirectory web-vcs-el-src)
+ dl-dir))
+ (vcs 'lp)
+ (base-url (nxhtml-download-root-url nil))
+ (byte-comp (if (boundp 'web-autoload-autocompile)
+ web-autoload-autocompile
+ t))
+ (has-nxhtml (and (boundp 'nxhtml-install-dir)
+ nxhtml-install-dir))
+ (web-vcs-folder-cache nil))
+ (setq nxhtml-install-dir dl-dir)
+ (let ((root (file-name-directory dl-dir)))
+ (unless (file-exists-p root)
+ (unless (yes-or-no-p (format "Directory %S does not exist, create it? " root))
+ (error "Aborted by user"))))
+ (make-directory dl-dir t)
+ (setq message-log-max t)
+ (view-echo-area-messages)
+ (message "")
+ (message "")
+ (web-vcs-message-with-face 'web-vcs-green "==== Starting nXhtml part by part state ====")
+ (message "has-nxhtml=%s" has-nxhtml)
+ ;; Fix-me: First copy this file and web-vcs.el to its destination:
+ (unless (string= (file-truename dl-dir)
+ (file-truename (file-name-directory nxhtml-web-vcs-file)))
+ (dolist (f (list web-vcs-el-src nxhtml-web-vcs-file))
+ (copy-file f (expand-file-name (file-name-nondirectory f) dl-dir)
+ 'ok-overwrite)))
+ (when byte-comp (web-vcs-byte-compile-newer-file web-vcs-el t))
+ ;; Get basic file list:
+ (catch 'web-autoload-comp-restart
+ ;;(let ((file-mask (regexp-opt nxhtml-basic-files)))
+ ;; (web-vcs-get-missing-matching-files vcs base-url dl-dir file-mask))
+ (dolist (f nxhtml-basic-files)
+ (web-vcs-get-missing-matching-files vcs base-url dl-dir f))
+ ;; Autostart.el has not run yet, add download dir to load-path.
+ (let ((load-path (cons (file-name-directory web-vcs-el) load-path)))
+ (when byte-comp
+ (dolist (file nxhtml-basic-files)
+ (let ((el-file (expand-file-name file dl-dir)))
+ (web-vcs-byte-compile-newer-file el-file nil)))))
+ (let ((autostart-file (expand-file-name "autostart" dl-dir)))
+ ;;(ad-deactivate 'require)
+ (web-vcs-set&save-option 'nxhtml-autoload-web t)
+ (web-vcs-log nil nil "* nXhtml: Download Part by Part as Needed\n")
+ (load autostart-file)
+ (unless (ad-is-active 'require) (ad-activate 'require))
+ (web-vcs-log-save)
+ (web-vcs-message-with-face 'web-vcs-green "==== Basic files for nXhtml part by part are now installed ====")
+ (web-vcs-display-messages t)
+ (unless has-nxhtml (nxhtml-add-loading-to-custom-file autostart-file t))))))))
+
+;;(call-interactively 'nxhtml-download)
+;;;###autoload
+(defun nxhtml-setup-download-all (dl-dir)
+ "Download or update all of nXhtml.
+
+You can download all if nXhtml with this command.
+
+To update existing files use `nxhtml-update-existing-files'.
+
+If you want to download only those files you are actually using
+then call `nxhtml-setup-auto-download' instead.
+
+See the command `nxhtml-setup-install' for a convenient way to
+call these commands.
+
+For more information about auto download of nXhtml files see
+`nxhtml-setup-auto-download'."
+ (interactive (progn
+ (describe-function 'nxhtml-setup-auto-download)
+ (select-window (get-buffer-window (help-buffer)))
+ (delete-other-windows)
+ ;;(nxhtml-check-convert-to-part-by-part)
+ (list
+ (nxhtml-web-vcs-read-dl-dir "Download whole nXhtml to directory: "))))
+
+ (let ((root (file-name-directory dl-dir)))
+ (unless (file-exists-p root)
+ (unless (yes-or-no-p (format "Directory %S does not exist, create it? " root))
+ (error "Aborted by user"))))
+ (make-directory dl-dir t)
+ (let ((msg (concat "Downloading nXhtml through Launchpad web interface will take rather long\n"
+ "time (5-15 minutes) so you may want to do it in a separate Emacs session.\n\n"
+ "Do you want to download using this Emacs session? "
+ )))
+ (if (not (y-or-n-p msg))
+ (message "Aborted")
+ (setq message-log-max t)
+ (let ((do-byte (y-or-n-p "Do you want to byte compile the files after downloading? ")))
+ (nxhtml-download-1 dl-dir nil do-byte)))))
+
+
+(defun nxhtml-download-1 (dl-dir revision do-byte)
+ "Download nXhtml to directory DL-DIR.
+If REVISION is nil download latest revision, otherwise the
+specified one.
+
+If DO-BYTE is non-nil byte compile nXhtml after download."
+ (let* ((has-nxhtml (and (boundp 'nxhtml-install-dir)
+ nxhtml-install-dir))
+ (base-url nxhtml-web-vcs-base-url)
+ (files-url (concat base-url "files/"))
+ ;;(revs-url (concat base-url "changes/"))
+ (rev-part (if revision (number-to-string revision) "head%3A/"))
+ (full-root-url (concat files-url rev-part))
+ (web-vcs-folder-cache nil)
+ (web-autoload-paranoid nil))
+ ;;(nxhtml-require-base)
+ (when (web-vcs-get-files-from-root 'lp full-root-url dl-dir)
+ (web-vcs-display-messages t)
+ (web-vcs-log nil nil "* nXhtml: Download All\n")
+ (web-vcs-set&save-option 'nxhtml-autoload-web nil)
+ (message "")
+ (web-vcs-message-with-face 'web-vcs-green "==== Starting downloading whole nXhtml ====")
+ (let ((autostart-file (expand-file-name "autostart" dl-dir)))
+ (load autostart-file)
+ (web-vcs-log-save)
+ (web-vcs-message-with-face 'web-vcs-green "==== All files for nXhtml are now installed ====")
+ (nxhtmlmaint-byte-recompile)
+ (unless has-nxhtml (nxhtml-add-loading-to-custom-file autostart-file nil))))))
+
+(defun nxhtml-check-convert-to-part-by-part ()
+ (when (and (boundp 'nxhtml-install-dir)
+ nxhtml-install-dir)
+ (unless (and (boundp 'nxhtml-autoload-web)
+ nxhtml-autoload-web)
+ (if (not (boundp 'nxhtml-menu:version))
+ (error "nxhtml-install-dir set but no version found")
+ (unless (string-match "[\.0-9]+" nxhtml-menu:version)
+ (error "Can't find current version nxhtml-menu:version=%S" nxhtml-menu:version))
+ (let* ((ver-str (match-string 0 nxhtml-menu:version))
+ (ver-num (string-to-number ver-str)))
+ (when (< ver-num 2.07)
+ (web-vcs-message-with-face 'web-vcs-red "Too old nXhtml for download part by part.")
+ (throw 'command-level nil)))))))
+
+
+;;(directory-files default-directory nil "\\el$")
+;;(directory-files default-directory nil "[^#~]$")
+;;;###autoload
+(defun nxhtml-update-existing-files ()
+ "Update existing nXhtml files from the development sources.
+Only files you already have will be updated.
+
+Note that this works both if you have setup nXhtml to auto
+download files as you need them or if you have downloaded all of
+nXhtml at once.
+
+For more information about installing and updating nXhtml see the
+command `nxhtml-setup-install'."
+ ;; Fix-me: download new files too if you are not auto downloading.
+ (interactive)
+ (when (y-or-n-p "Do you want to update your nXhtml files? ")
+ (message "")
+ (web-vcs-display-messages t)
+ (web-vcs-message-with-face 'web-vcs-yellow "*\nStarting updating your nXhtml files.\n*\n")
+ (message nil)
+ (web-vcs-clear-folder-cache)
+ (let ((vcs 'lp)
+ (base-url (nxhtml-download-root-url nil))
+ (dl-dir nxhtml-install-dir)
+ web-vcs-folder-cache)
+ (setq dl-dir (file-name-as-directory dl-dir))
+ (web-vcs-update-existing-files vcs base-url dl-dir dl-dir)
+ (web-vcs-clear-folder-cache))
+ (display-buffer (get-buffer-create "*Compile-Log*"))
+ (nxhtmlmaint-byte-recompile)
+ (web-vcs-log-save)
+ (web-vcs-message-with-face 'web-vcs-yellow "*\nFinished updating your nXhtml files.\n*\n")
+ (message nil)))
+
+
+;;(nxhtml-maybe-download-files (expand-file-name "nxhtml/doc/img/" nxhtml-install-dir) nil)
+;;;###autoload
+(defun nxhtml-get-missing-files (sub-dir file-name-list)
+ (let (file-mask
+ (root-url (nxhtml-download-root-url nil))
+ files-regexp
+ (full-dir (expand-file-name sub-dir nxhtml-install-dir))
+ miss-names)
+ (if file-name-list
+ (progn
+ (dolist (f file-name-list)
+ (let ((full-f (expand-file-name f full-dir)))
+ (unless (file-exists-p full-f)
+ (setq miss-names (cons f miss-names)))))
+ (setq files-regexp (regexp-opt miss-names)))
+ (setq files-regexp ".*"))
+ ;;(unless (file-exists-p full-dir) (make-directory full-dir t))
+ (setq file-mask
+ (concat (file-relative-name (file-name-as-directory full-dir)
+ nxhtml-install-dir)
+ files-regexp))
+ (let ((web-vcs-folder-cache nil))
+ (web-vcs-get-missing-matching-files 'lp root-url nxhtml-install-dir
+ file-mask))))
+
+;; Fix-me: Does not work, Emacs Bug
+;; Maybe use wget? http://gnuwin32.sourceforge.net/packages/wget.htm
+;; http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?bug=5103
+;; (nxhtml-get-release-revision)
+(defun nxhtml-get-release-revision ()
+ "Get revision number for last release."
+ (let* ((all-rev-url "http://code.launchpad.net/%7Enxhtml/nxhtml/main")
+ (url-buf (url-retrieve-synchronously all-rev-url))
+ (vcs-rec (or (assq 'lp web-vcs-links-regexp)
+ (error "Does not know web-vcs 'lp")))
+ (rel-ver-regexp (nth 6 vcs-rec))
+ )
+ (message "%S" url-buf)
+ (with-current-buffer url-buf
+ (when (re-search-forward rel-ver-regexp nil t)
+ (match-string 1)))))
+
+;;;###autoload
+(defun nxhtml-byte-compile-file (file &optional load)
+ (let ((extra-load-path (when nxhtml-install-dir
+ (mapcar (lambda (p)
+ (file-name-as-directory
+ (expand-file-name p nxhtml-install-dir)))
+ '("tests" "related" "nxhtml" "util" ".")))))
+ ;; (message "nxhtml-byte-compile-file:extra-load-path=%s" extra-load-path)
+ (web-vcs-byte-compile-file file load extra-load-path)))
+
+;; fix-me: change web-vcs-byte-compile-file instead
+;;;###autoload
+(defun nxhtml-byte-recompile-file (file &optional load)
+ "Byte recompile FILE file if necessary.
+For more information see `nxhtml-byte-compile-file'.
+Loading is done if recompiled and LOAD is t."
+ (interactive (list (buffer-file-name)
+ t))
+ (let ((elc-file (byte-compile-dest-file file)))
+ (if (file-newer-than-file-p file elc-file)
+ (nxhtml-byte-compile-file file load)
+ (message "Byte compilation of this file is up to date."))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Add to custom file
+
+
+(defvar nxhtml-handheld-wincfg nil)
+(defun nxhtml-handheld-restore-wincg ()
+ (when nxhtml-handheld-wincfg
+ (set-window-configuration nxhtml-handheld-wincfg)
+ (setq nxhtml-handheld-wincfg nil)))
+
+;;(nxhtml-handheld-add-loading-to-custom-file "TEST-ME")
+(defun nxhtml-handheld-add-loading-to-custom-file (file-to-load)
+ (setq nxhtml-handheld-wincfg (current-window-configuration))
+ (delete-other-windows)
+ (let ((info-buf (get-buffer-create "Information about how to add nXhtml to (custom-file)"))
+ (load-str (format "(load %S)" file-to-load)))
+ (with-current-buffer info-buf
+ (add-hook 'kill-buffer-hook 'nxhtml-handheld-restore-wincg nil t)
+ (insert "Insert the following line to (custom-file), ie the file in the other window:\n\n")
+ (let ((here (point)))
+ (insert " "
+ (propertize load-str 'face 'secondary-selection)
+ "\n")
+ (copy-region-as-kill here (point))
+ (insert "\nThe line above is in the clipboard so you can just paste it where you want it.\n")
+ (insert "When ready kill this buffer.")
+ (goto-char here))
+ (setq buffer-read-only t)
+ (set-buffer-modified-p nil))
+ (set-window-buffer (selected-window) info-buf)
+ (find-file-other-window (custom-file))))
+
+;; (nxhtml-add-loading-to-custom-file "test-file")
+(defun nxhtml-add-loading-to-custom-file (file-to-load part-by-part)
+ (message "")
+ (require 'cus-edit)
+ (if (not (condition-case nil (custom-file) (error nil)))
+ (progn
+ (message "\n\n")
+ (web-vcs-message-with-face
+ 'web-vcs-red
+ (concat "Since you have started this Emacs session without running your init files"
+ "\nthey are unknown and the installation can not add the statement below."
+ "\nTo finish the setup of nXhtml you must add"
+ "\n\n (load %S)"
+ "\n\nto your custom-file if you have not done it yet."
+ "\nYou must also customize the variable `nxhtml-autoload-web' to tell that"
+ (if part-by-part
+ "\nyou want to download nXhml files as you need them."
+ "\nyou do not want to allow automatic downloading of nXhtml files."
+ )
+ "\n")
+ file-to-load)
+ (message "")
+ (web-vcs-display-messages t))
+ (let ((prompt (concat "Basic setup of nXhtml is done, but it must be loaded from (custom-file)."
+ "\nShould I add loading of nXhtml to (custom-file) for you? ")))
+ (if (yes-or-no-p prompt)
+ (nxhtml-add-loading-to-custom-file-auto file-to-load)
+ (if (yes-or-no-p "Should I guide you through how to do it? ")
+ (nxhtml-handheld-add-loading-to-custom-file file-to-load)
+ (web-vcs-message-with-face 'web-vcs-green
+ "OK. You need to add (load %S) to your init file" file-to-load))))))
+
+;; Fix-me: really do this? Is it safe enough?
+(defun nxhtml-add-loading-to-custom-file-auto (file-to-load)
+ (unless (file-name-absolute-p file-to-load)
+ (error "nxhtml-add-loading-to-custom-file: Not abs file name: %S" file-to-load))
+ (let ((old-buf (find-buffer-visiting (custom-file)))
+ (full-to-load (expand-file-name file-to-load)))
+ (with-current-buffer (or old-buf (find-file-noselect (custom-file)))
+ (save-restriction
+ (widen)
+ (catch 'done
+ (while (progn
+ (while (progn (skip-chars-forward " \t\n\^l")
+ (looking-at ";"))
+ (forward-line 1))
+ (not (eobp)))
+ (let ((start (point))
+ (form (read (current-buffer))))
+ (when (eq (nth 0 form) 'load)
+ (let* ((form-file (nth 1 form))
+ (full-form-file (expand-file-name form-file)))
+ (when (string= full-form-file full-to-load)
+ (throw 'done nil))
+ (when (and (string= (file-name-nondirectory full-form-file)
+ (file-name-nondirectory full-to-load))
+ (not (string= full-form-file full-to-load)))
+ (if (yes-or-no-p "Replace current nXhtml loading in (custom-file)? ")
+ (progn
+ (goto-char start) ;; at form start now
+ (forward-char (length "(load "))
+ (skip-chars-forward " \t\n\^l") ;; at start of string
+ (setq start (point))
+ (setq form (read (current-buffer)))
+ (delete-region start (point))
+ (insert (format "%S" full-to-load))
+ (basic-save-buffer))
+ (web-vcs-message-with-face 'web-vcs-red "Can't continue then")
+ (web-vcs-display-messages t)
+ (throw 'command-level nil)))))))
+ ;; At end of file
+ (insert (format "\n(load %S)\n" file-to-load))
+ (basic-save-buffer))
+ (unless old-buf (kill-buffer old-buf))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;; Start Testing function
+(defun emacs-Q-no-nxhtml (&rest args)
+ (let* ((old-env-load-path (getenv "EMACSLOADPATH"))
+ sub-env-load-path
+ (elp-list (or (when old-env-load-path
+ ;;(split-string old-env-load-path ";"))
+ (split-string old-env-load-path path-separator))
+ load-path))
+ (sub-elp-list nil)
+ ret
+ (this-emacs-exe (locate-file invocation-name
+ (list invocation-directory)
+ exec-suffixes)))
+ (dolist (p elp-list)
+ (when (file-exists-p p)
+ (unless (string= nxhtml-install-dir p)
+ (let* ((dir (file-name-directory p))
+ (last (file-name-nondirectory p))
+ (last-dir (file-name-nondirectory
+ (directory-file-name dir))))
+ (unless (and (string= "nxhtml" last-dir)
+ (member last '("util" "test" "nxhtml" "related" "alt")))
+ (setq sub-elp-list (cons p sub-elp-list)))))))
+ ;;(setq sub-env-load-path (mapconcat 'identity (reverse sub-elp-list) ";"))
+ (setq sub-env-load-path (mapconcat 'identity (reverse sub-elp-list) path-separator))
+ (setenv "EMACSLOADPATH" sub-env-load-path)
+ (setq ret (apply 'call-process this-emacs-exe nil 0 nil "-Q" args))
+ (setenv "EMACSLOADPATH" old-env-load-path)
+ ret))
+
+;; (call-interactively-p 'nxhtml-setup-test-auto-download)
+;; (nxhtml-setup-test-auto-download "c:/test2/")
+(defun nxhtml-setup-test-auto-download (test-dir)
+ "Test autoload in a new emacs, started with 'emacs -Q'.
+You can choose where to download the files and just delete them
+when you have tested enough."
+ (interactive (list (read-directory-name "Directory for test of auto download of nXhtml: ")))
+ (let ((this-dir (file-name-directory web-vcs-el-this))
+ (this-name (file-name-nondirectory web-vcs-el-this))
+ that-file)
+ (when (and (file-exists-p test-dir)
+ (not (y-or-n-p (format "Directory %S exists, really test there? " test-dir))))
+ (error "Aborted"))
+ (unless (file-exists-p test-dir) (make-directory test-dir))
+ (setq that-file (expand-file-name this-name test-dir))
+ (when (file-exists-p that-file) (delete-file that-file))
+ (copy-file web-vcs-el-this that-file)
+ (emacs-Q-no-nxhtml "-l" that-file "-f" "nxhtml-setup-test-auto-download-do-it-here")))
+
+(defun nxhtml-setup-test-auto-download-do-it-here ()
+ "Helper for `nxhtml-setup-test-auto-down-load'."
+ (let ((this-dir (file-name-directory web-vcs-el-this)))
+ (nxhtml-setup-auto-download this-dir)))
+
+(defun web-vcs-check-if-modified ()
+ (let (
+ (t1 (format-time-string "%Y-%m-%dT%T%z" (date-to-time "2010-01-01 18:20")))
+ (t2 (format-time-string "%Y-%m-%dT%T%z" (date-to-time "Mon, 28 Dec 2009 08:57:44 GMT")))
+ (url-request-extra-headers
+ (list
+ (cons "If-Modified-Since"
+ (format-time-string
+ ;;"%Y-%m-%dT%T%z"
+ "%a, %e %b %Y %H:%M:%S GMT"
+ (nth 5 (file-attributes "c:/test/temp.el" )))
+ )))
+ xb)
+ (setq xb (url-retrieve-synchronously "http://www.emacswiki.org/emacs/download/anything.el"))
+ (switch-to-buffer xb)
+ ))
+;; (emacs-Q-no-nxhtml "web-vcs.el" "-l" "c:/test/d27/web-autostart.el")
+;; (emacs-Q-no-nxhtml "web-vcs.el" "-l" "c:/test/d27/autostart.el")
+;; (emacs-Q-no-nxhtml "web-vcs.el" "-f" "eval-buffer" "-f" "nxhtml-temp-setup-auto-download")
+;; (emacs-Q-no-nxhtml "-l" "c:/test/d27/web-vcs" "-l" "c:/test/d27/nxhtml-web-vcs" "-f" "nxhtml-temp-setup-auto-download")
+;; (emacs-Q-no-nxhtml "-l" "c:/test/d27/nxhtml-web-vcs" "-f" "nxhtml-temp-setup-auto-download")
+;; (emacs-Q-no-nxhtml "--geometry=200x50+100+100" "-l" "c:/test/d27/web-vcs" "-f" "web-vcs-nxhtml")
+(defun nxhtml-temp-setup-auto-download ()
+ ;;(when (fboundp 'w32-send-sys-command) (w32-send-sys-command #xf030) (sit-for 2))
+ (set-frame-size (selected-frame)
+ (/ 1024 (frame-char-width))
+ (/ 512 (frame-char-height))
+ )
+ (tool-bar-mode -1)
+ (set-frame-position (selected-frame) 100 50)
+ (when (y-or-n-p "Do nXhtml? ")
+ (view-echo-area-messages)
+ (setq truncate-lines t)
+ (split-window-horizontally)
+ (let ((load-path (cons default-directory load-path)))
+ (require 'web-vcs))
+ ;(nxhtml-setup-auto-download "c:/test/d27")
+ (call-interactively 'nxhtml-setup-auto-download)
+ ))
+;;;;;; End Testing function
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(provide 'nxhtml-web-vcs)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtml-web-vcs.el ends here
--- /dev/null
+2006-04-26 <lennart.borgman.073@student.lu.se>\r
+\r
+ * nxhtml.el (nxhtml-insert-skeleton-if-empty)\r
+ (nxhtml-insert-frame-skeleton): New functions.\r
+\r
+2006-04-25 <lennart.borgman.073@student.lu.se>\r
+\r
+ * nxhtml.el (nxhtml-coding-systems-complete)\r
+ (nxhtml-script-url-predicate, nxhtml-script-completion-pattern)\r
+ (nxhtml-image-url-predicate, nxhtml-image-completion-pattern)\r
+ (nxhtml-mailto-predicate, nxhtml-predicate-error)\r
+ (nxhtml-in-xml-attribute-value-regex)\r
+ (nxhtml-read-mail-url-history, nxhtml-read-web-url-history)\r
+ (nxhtml-read-url-history, nxhtml-read-url-type)\r
+ (nxhtml-read-url-type-help, nxhtml-read-url)\r
+ (rng-complete-attribute-value): New entries for completion.\r
+\r
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>nXhtml Short Tour</title>
+ <script type="text/javascript" src="js/smoothgallery/scripts/mootools.js"></script>
+ <script type="text/javascript" src="js/smoothgallery/scripts/jd.gallery.js"></script>
+ <link rel="stylesheet" href="js/smoothgallery/css/layout.css" type="text/css" media="screen"/>
+ <link rel="stylesheet" href="js/smoothgallery/css/jd.gallery.css" type="text/css" media="screen"/>
+ <style type="text/css" media="screen">
+ /* <![CDATA[ */
+ #myGallery {
+ width: 660px;
+ height: 500px;
+ }
+ /* ]] */
+ </style>
+
+ </head>
+ <body>
+ <script type="text/javascript">
+ function startGallery() {
+ var myGallery = new gallery($('myGallery'), {
+ timed: true,
+ delay: 5000,
+ embedLinks: false,
+ showArrows: true,
+ showCarousel: true,
+ showInfopane: true,
+ showDescription: true,
+ });
+ }
+ window.onDomReady(startGallery);
+ </script>
+ <div id="myGallery"><!-- SmoothGallery -->
+
+ <div class="imageElement">
+ <h3>Popup completion</h3>
+ <p>nXhtml can use popup style completion too (for XHTML)</p>
+ <a href="#" title="open image" class="open"></a>
+ <img src="img/popup-compl.png" class="full" alt="Popup completion" />
+ <img src="img/popup-compl.png" class="thumbnail" alt="Popup completion (thumbnail)" />
+ <div>
+ <p>
+ more about popup
+ </p>
+ <p>
+ more about popup
+ </p>
+ </div>
+ </div>
+
+ <div class="imageElement">
+ <h3>Emacs style completion</h3>
+ <p>Emacs default style for completion uses the minibuffer and an Emacs window</p>
+ <a href="#" title="open image" class="open"></a>
+ <img src="img/emacs-style-completion.png" class="full" alt="Emacs style completion" />
+ <img src="img/emacs-style-completion.png" class="thumbnail" alt="Emacs style completion (thumbnail)" />
+ <div>du</div>
+ </div>
+ </div>
+
+ <div id="DescriptionDiv"
+ style="
+ text-align: center;
+ ">
+ desc div
+ </div>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>
+ How to Convert to XHTML
+ </title>
+ <link href="nxhtml.css" rel="StyleSheet" type="text/css" />
+ </head>
+ <body>
+ <h1>
+ How to Convert to XHTML
+ </h1>
+ <p>
+ With nxhtml-mode you can edit XHTML documents, but not HTML
+ dito. So what do you do with your old HTML documents? The
+ answer is simple: You convert them to XHTML! There is today
+ not many reasons not to convert them to XHTML. You may say
+ "but what about old browsers?". Most users just do not have
+ old browsers today. Old browsers are too dangerous to use on the
+ Internet.
+ </p>
+ <p>
+ You can convert the documents easily from within nxhtml-mode
+ with <a href= "http://tidy.sourceforge.net/">Tidy</a>. However
+ Tidy does not come with nxhtml, you have to install it yourself.
+ </p>
+ <p>
+ When Tidy is called from Emacs you can do a whole directory tree
+ at once. When a buffer is in nxhtml-mode (and tidy.el is found)
+ there is an entry on the menus called <b>Tidy</b> from which you
+ can access tidy and set the options for it. Note especially the
+ <b>Quick Options Settings</b> where you can set options for
+ converting to XHTML easily.
+ </p>
+
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+<style type="text/css"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+ --></style>
+<style type="text/css"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default a { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.comment-face-1419 { color: rgb(178, 34, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.comment-face-1419 a { color: rgb(178, 34, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.comment-delimiter-face-1418 { color: rgb(178, 34, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.comment-delimiter-face-1418 a { color: rgb(178, 34, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+ --></style><style type="text/css"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default a { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.help-argument-name-1420 { color: rgb(0, 0, 255); font-style: italic; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-size: 10pt; text-decoration: none; }
+span.help-argument-name-1420 a { color: rgb(0, 0, 255); font-style: italic; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-size: 10pt; text-decoration: underline; }
+span.button-0004 { text-decoration: underline; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; }
+span.button-0004 a { text-decoration: underline; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; }
+ --></style><style type="text/css"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default a { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.completion-tooltip-face-1437 { color: rgb(0, 0, 0); background: rgb(255, 255, 255); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.completion-tooltip-face-1437 a { color: rgb(0, 0, 0); background: rgb(255, 255, 255); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.completion-dynamic-face-1436 { color: rgb(0, 0, 0); background: rgb(255, 165, 0); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.completion-dynamic-face-1436 a { color: rgb(0, 0, 0); background: rgb(255, 165, 0); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.compilation-warning-1435 { color: rgb(255, 165, 0); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.compilation-warning-1435 a { color: rgb(255, 165, 0); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.compilation-line-number-1434 { color: rgb(184, 134, 11); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.compilation-line-number-1434 a { color: rgb(184, 134, 11); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.compilation-info-1433 { color: rgb(0, 205, 0); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.compilation-info-1433 a { color: rgb(0, 205, 0); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.compilation-error-1430 { color: rgb(255, 0, 0); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.compilation-error-1430 a { color: rgb(255, 0, 0); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.compilation-column-number-1429 { color: rgb(34, 139, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.compilation-column-number-1429 a { color: rgb(34, 139, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.comint-highlight-prompt-1428 { color: rgb(0, 0, 139); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.comint-highlight-prompt-1428 a { color: rgb(0, 0, 139); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.button-0004 { text-decoration: underline; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; }
+span.button-0004 a { text-decoration: underline; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; }
+ --></style><style type="text/css"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default a { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.default-0273 { color: rgb(250, 235, 215); font-size: 105%; text-decoration: none; }
+span.default-0273 a { color: rgb(250, 235, 215); font-size: 105%; text-decoration: underline; }
+span.default-0272 { background: rgb(250, 235, 215); font-size: 105%; text-decoration: none; }
+span.default-0272 a { background: rgb(250, 235, 215); font-size: 105%; text-decoration: underline; }
+span.default-0271 { color: rgb(250, 240, 230); font-size: 105%; text-decoration: none; }
+span.default-0271 a { color: rgb(250, 240, 230); font-size: 105%; text-decoration: underline; }
+span.default-0270 { background: rgb(250, 240, 230); font-size: 105%; text-decoration: none; }
+span.default-0270 a { background: rgb(250, 240, 230); font-size: 105%; text-decoration: underline; }
+span.default-0269 { color: rgb(253, 245, 230); font-size: 105%; text-decoration: none; }
+span.default-0269 a { color: rgb(253, 245, 230); font-size: 105%; text-decoration: underline; }
+span.default-0268 { background: rgb(253, 245, 230); font-size: 105%; text-decoration: none; }
+span.default-0268 a { background: rgb(253, 245, 230); font-size: 105%; text-decoration: underline; }
+span.default-0267 { color: rgb(255, 250, 240); font-size: 105%; text-decoration: none; }
+span.default-0267 a { color: rgb(255, 250, 240); font-size: 105%; text-decoration: underline; }
+span.default-0266 { background: rgb(255, 250, 240); font-size: 105%; text-decoration: none; }
+span.default-0266 a { background: rgb(255, 250, 240); font-size: 105%; text-decoration: underline; }
+span.default-0265 { color: rgb(220, 220, 220); font-size: 105%; text-decoration: none; }
+span.default-0265 a { color: rgb(220, 220, 220); font-size: 105%; text-decoration: underline; }
+span.default-0264 { background: rgb(220, 220, 220); font-size: 105%; text-decoration: none; }
+span.default-0264 a { background: rgb(220, 220, 220); font-size: 105%; text-decoration: underline; }
+span.default-0263 { color: rgb(245, 245, 245); font-size: 105%; text-decoration: none; }
+span.default-0263 a { color: rgb(245, 245, 245); font-size: 105%; text-decoration: underline; }
+span.default-0262 { background: rgb(245, 245, 245); font-size: 105%; text-decoration: none; }
+span.default-0262 a { background: rgb(245, 245, 245); font-size: 105%; text-decoration: underline; }
+span.default-0261 { color: rgb(248, 248, 255); font-size: 105%; text-decoration: none; }
+span.default-0261 a { color: rgb(248, 248, 255); font-size: 105%; text-decoration: underline; }
+span.default-0260 { background: rgb(248, 248, 255); font-size: 105%; text-decoration: none; }
+span.default-0260 a { background: rgb(248, 248, 255); font-size: 105%; text-decoration: underline; }
+span.default-0259 { color: rgb(255, 250, 250); font-size: 105%; text-decoration: none; }
+span.default-0259 a { color: rgb(255, 250, 250); font-size: 105%; text-decoration: underline; }
+span.default-0258 { background: rgb(255, 250, 250); font-size: 105%; text-decoration: none; }
+span.default-0258 a { background: rgb(255, 250, 250); font-size: 105%; text-decoration: underline; }
+ --></style><style type="text/css"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default a { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.default-1432 { text-decoration: underline; color: rgb(176, 48, 96); font-weight: 700; font-size: 164%; }
+span.default-1432 a { text-decoration: underline; color: rgb(176, 48, 96); font-weight: 700; font-size: 164%; }
+span.default-1431 { color: rgb(176, 48, 96); font-weight: 700; font-size: 164%; text-decoration: none; }
+span.default-1431 a { color: rgb(176, 48, 96); font-weight: 700; font-size: 164%; text-decoration: underline; }
+ --></style><style type="text/css"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default a { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.custom-button-0022 { border-width: 1px; border-style: outset; color: rgb(0, 0, 0); background: rgb(211, 211, 211); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.custom-button-0022 a { border-width: 1px; border-style: outset; color: rgb(0, 0, 0); background: rgb(211, 211, 211); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.bold-0248 { background: rgb(173, 255, 47); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.bold-0248 a { background: rgb(173, 255, 47); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+ --></style><style type="text/css"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default a { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.match-1438 { background: rgb(255, 255, 0); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.match-1438 a { background: rgb(255, 255, 0); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.underline-1413 { color: rgb(184, 134, 11); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; text-decoration: underline; font-size: 10pt; }
+span.underline-1413 a { color: rgb(184, 134, 11); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; text-decoration: underline; font-size: 10pt; }
+span.underline-0219 { text-decoration: underline; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; }
+span.underline-0219 a { text-decoration: underline; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; }
+span.underline-1412 { color: rgb(0, 205, 0); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; text-decoration: underline; font-size: 10pt; }
+span.underline-1412 a { color: rgb(0, 205, 0); font-weight: 700; font-family: outline-courier new; font-stretch: normal; font-style: normal; text-decoration: underline; font-size: 10pt; }
+ --></style><style type="text/css"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.default a { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.comment-face-1419 { color: rgb(178, 34, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.comment-face-1419 a { color: rgb(178, 34, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.comment-delimiter-face-1418 { color: rgb(178, 34, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.comment-delimiter-face-1418 a { color: rgb(178, 34, 34); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.string-face-1441 { color: rgb(188, 143, 143); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.string-face-1441 a { color: rgb(188, 143, 143); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.match-1438 { background: rgb(255, 255, 0); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+span.match-1438 a { background: rgb(255, 255, 0); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: underline; }
+span.keyword-face-1440 { color: rgb(160, 32, 240); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: none; }
+span.keyword-face-1440 a { color: rgb(160, 32, 240); font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; font-size: 10pt; text-decoration: underline; }
+span.underline-1439 { text-decoration: underline; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; }
+span.underline-1439 a { text-decoration: underline; font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; }
+ --></style>
+ </head>
+ <body style="background: #000000; color: #ff9900; padding:2em; margin:4em; margin-top:2em;">
+
+<h1>Example of htmlfontify.el output</h1>
+
+<p style="font-size: 1.3em; width: 35em;">
+ The following is an example of the output you can get with htmlfontify.el.
+ The version used here is shipped with <a href="nxhtml.html" style="color: #ffbb33; ">nXhtml</a>.
+ (A new version from the original author is on its way.)
+</p>
+
+<table border="0" cellpadding="0" cellspacing="0" style="border: solid rgb(0, 84, 227); width:44.800000000000004em; background:white;">
+<tr>
+<td style="background-color:rgb(0, 84, 227); color:rgb(255, 255, 255);border: none; padding:4px; vertical-align: middle;"><img alt="Emacs Icon (patched)" src="img/emacsP16.png" width="16" height="16" /> Emacs - Frame Dump</td>
+</tr>
+<tr>
+<td style="vertical-align:top;"><table border="0" cellpadding="0" cellspacing="0">
+<tr>
+<td style="vertical-align:top;"><table border="0" cellpadding="0" cellspacing="0">
+<tr><td style="vertical-align:top;"><div style="width:22.514999999999997em; height:15.079999999999998em; border: 1px solid rgb(212, 208, 200); overflow:auto; padding:4px;">
+
+<pre><span class="comment-delimiter-face-1418">;; </span><span class="comment-face-1419">This buffer is for notes you don't want to save, and for Lisp evaluation.
+</span><span class="comment-delimiter-face-1418">;; </span><span class="comment-face-1419">If you want to create a file, visit that file with C-x C-f,
+</span><span class="comment-delimiter-face-1418">;; </span><span class="comment-face-1419">then enter the text in that file's own buffer.
+</span>
+</pre>
+
+ </div>
+<div style="width:22.515em; color:rgb(51, 51, 51); background:rgb(229, 229, 229); white-space:pre; overflow:hidden; font-family:monospace;">-- (Unix)-- <b>*scratch*</b> (Lisp Interaction Abbrev hs) --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------</div></td>
+<td style="vertical-align:top;"><div style="width:23.084999999999997em; height:15.079999999999998em; border: 1px solid rgb(212, 208, 200); overflow:auto; padding:4px;">
+
+
+ <script type="text/javascript">
+ // <![CDATA[
+
+function getObj(name) {
+ if (document.getElementById) {
+ this.obj = document.getElementById(name);
+ this.style = document.getElementById(name).style;
+ }
+}
+function hfy_toggle_display(name) {
+ var x = new getObj("hfy_invis_" + name);
+ var flag = x.style.display == 'inline';
+ x.style.display = (flag) ? 'none' : 'inline'
+}
+
+ // ]]>
+ </script>
+
+<pre>cadr is a compiled Lisp function in `<span class="button-0004">subr.el</span>'.
+(cadr <span class="help-argument-name-1420">x</span>)
+
+Return the car of the cdr of <span class="help-argument-name-1420">x</span>.
+
+<span class="button-0004">[back]</span>
+</pre>
+
+ </div>
+<div style="width:23.085em; color:rgb(51, 51, 51); background:rgb(229, 229, 229); white-space:pre; overflow:hidden; font-family:monospace;">-- (Unix)%% <b>*Help*</b> (Help View Abbrev) --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------</div></td>
+</tr>
+</table>
+</td>
+</tr>
+<tr>
+<td style="vertical-align:top;"><table border="0" cellpadding="0" cellspacing="0">
+<tr><td style="vertical-align:top;"><div style="width:22.514999999999997em; height:12.76em; border: 1px solid rgb(212, 208, 200); overflow:auto; padding:4px;">
+
+
+ <script type="text/javascript">
+ // <![CDATA[
+
+function getObj(name) {
+ if (document.getElementById) {
+ this.obj = document.getElementById(name);
+ this.style = document.getElementById(name).style;
+ }
+}
+function hfy_toggle_display(name) {
+ var x = new getObj("hfy_invis_" + name);
+ var flag = x.style.display == 'inline';
+ x.style.display = (flag) ? 'none' : 'inline'
+}
+
+ // ]]>
+ </script>
+
+<pre><span class="button-0004">comint-highlight-prompt</span> <span class="comint-highlight-prompt-1428">abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ</span>
+<span class="button-0004">compilation-column-number</span> <span class="compilation-column-number-1429">abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ</span>
+<span class="button-0004">compilation-error</span> <span class="compilation-error-1430">abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ</span>
+<span class="button-0004">compilation-info</span> <span class="compilation-info-1433">abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ</span>
+<span class="button-0004">compilation-line-number</span> <span class="compilation-line-number-1434">abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ</span>
+<span class="button-0004">compilation-warning</span> <span class="compilation-warning-1435">abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ</span>
+<span class="button-0004">completion-dynamic-face</span> <span class="completion-dynamic-face-1436">abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ</span>
+<span class="button-0004">completion-tooltip-face</span> <span class="completion-tooltip-face-1437">abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ</span>
+</pre>
+
+
+<div style="margin-top:2em; color: red; text-align: center; "> Truncated to line 11 - 19! </div>
+</div>
+<div style="width:22.515em; color:rgb(0, 0, 0); background:rgb(191, 191, 191); white-space:pre; overflow:hidden; font-family:monospace;">-- (Unix)%% <b>*Faces*</b> (Help View Abbrev) --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------</div></td>
+<td style="vertical-align:top;"><div style="width:23.084999999999997em; height:12.76em; border: 1px solid rgb(212, 208, 200); overflow:auto; padding:4px;">
+
+
+ <script type="text/javascript">
+ // <![CDATA[
+
+function getObj(name) {
+ if (document.getElementById) {
+ this.obj = document.getElementById(name);
+ this.style = document.getElementById(name).style;
+ }
+}
+function hfy_toggle_display(name) {
+ var x = new getObj("hfy_invis_" + name);
+ var flag = x.style.display == 'inline';
+ x.style.display = (flag) ? 'none' : 'inline'
+}
+
+ // ]]>
+ </script>
+
+<pre><span class="default-0258">snow </span><span class="default-0259"> snow </span>#fffafa
+<span class="default-0260">ghost white </span><span class="default-0261"> GhostWhite </span>#f8f8ff
+<span class="default-0262">white smoke </span><span class="default-0263"> WhiteSmoke </span>#f5f5f5
+<span class="default-0264">gainsboro </span><span class="default-0265"> gainsboro </span>#dcdcdc
+<span class="default-0266">floral white </span><span class="default-0267"> FloralWhite </span>#fffaf0
+<span class="default-0268">old lace </span><span class="default-0269"> OldLace </span>#fdf5e6
+<span class="default-0270">linen </span><span class="default-0271"> linen </span>#faf0e6
+<span class="default-0272">antique white </span><span class="default-0273"> AntiqueWhite </span>#faebd7
+</pre>
+
+
+<div style="margin-top:2em; color: red; text-align: center; "> Truncated to line 1 - 9! </div>
+</div>
+<div style="width:23.085em; color:rgb(51, 51, 51); background:rgb(229, 229, 229); white-space:pre; overflow:hidden; font-family:monospace;">-- (Unix)%% <b>*Colors*</b> (Help View Abbrev) --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------</div></td>
+</tr>
+</table>
+</td>
+</tr>
+<tr>
+<td style="vertical-align:top;"><div style="width:47.025em; height:12.76em; border: 1px solid rgb(212, 208, 200); overflow:auto; padding:4px;">
+
+
+ <script type="text/javascript">
+ // <![CDATA[
+
+function getObj(name) {
+ if (document.getElementById) {
+ this.obj = document.getElementById(name);
+ this.style = document.getElementById(name).style;
+ }
+}
+function hfy_toggle_display(name) {
+ var x = new getObj("hfy_invis_" + name);
+ var flag = x.style.display == 'inline';
+ x.style.display = (flag) ? 'none' : 'inline'
+}
+
+ // ]]>
+ </script>
+
+<pre><span class="default-1431">________________________
+</span><span class="default-1432">Program and Value Search</span>
+
+When you use Emacs on MS Windows you sometimes want to fetch values
+and program locations from MS Windows. Many of these values are
+stored in the MS Windows Registry. Since Emacs is written to be used
+on many platforms (with the emphasis on GPL platforms) the effort to
+let Emacs read the Registry directly has not been made. Below you can
+</pre>
+
+
+<div style="margin-top:2em; color: red; text-align: center; "> Truncated to line 29 - 37! </div>
+</div>
+<div style="width:47.025em; color:rgb(51, 51, 51); background:rgb(229, 229, 229); white-space:pre; overflow:hidden; font-family:monospace;">-- (Unix)** <b>*Customize EmacsW32*</b> (Custom Abbrev) --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------</div></td>
+</tr>
+<tr>
+<td style="vertical-align:top;"><div style="width:47.025em; height:12.76em; border: 1px solid rgb(212, 208, 200); overflow:auto; padding:4px;">
+
+
+ <script type="text/javascript">
+ // <![CDATA[
+
+function getObj(name) {
+ if (document.getElementById) {
+ this.obj = document.getElementById(name);
+ this.style = document.getElementById(name).style;
+ }
+}
+function hfy_toggle_display(name) {
+ var x = new getObj("hfy_invis_" + name);
+ var flag = x.style.display == 'inline';
+ x.style.display = (flag) ? 'none' : 'inline'
+}
+
+ // ]]>
+ </script>
+
+<pre> Add quick printing to File menu (htmlize-view-print-visible): <span class="bold-0248">t</span>
+ Keep default print entries in File menu (w32-print-menu-show-print): <span class="bold-0248">nil</span>
+ Keep default ps print entries in File menu (w32-print-menu-show-ps-print): <span class="bold-0248">nil</span>
+ Use keyboard Window keys as Emacs META (w32-meta-style): <span class="bold-0248">w32-lr</span>
+ Underlined accelerators in menu bar (menuacc-active): <span class="bold-0248">t</span>
+ Inferior shell + path for unix style programs (w32shell-shell): <span class="bold-0248">cmd</span>
+
+ <span class="custom-button-0022"> Set all to w32 style! </span> <span class="custom-button-0022"> Reset all to default! </span> <span class="custom-button-0022"> Customize EmacsW32 ... </span>
+</pre>
+
+
+<div style="margin-top:2em; color: red; text-align: center; "> Truncated to line 13 - 21! </div>
+</div>
+<div style="width:47.025em; color:rgb(51, 51, 51); background:rgb(229, 229, 229); white-space:pre; overflow:hidden; font-family:monospace;">-- (Unix)** <b>*Customize EmacsW32*</b> (Custom Abbrev) --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------</div></td>
+</tr>
+<tr>
+<td style="vertical-align:top;"><table border="0" cellpadding="0" cellspacing="0">
+<tr><td style="vertical-align:top;"><div style="width:22.514999999999997em; height:12.76em; border: 1px solid rgb(212, 208, 200); overflow:auto; padding:4px;">
+
+
+ <script type="text/javascript">
+ // <![CDATA[
+
+function getObj(name) {
+ if (document.getElementById) {
+ this.obj = document.getElementById(name);
+ this.style = document.getElementById(name).style;
+ }
+}
+function hfy_toggle_display(name) {
+ var x = new getObj("hfy_invis_" + name);
+ var flag = x.style.display == 'inline';
+ x.style.display = (flag) ? 'none' : 'inline'
+}
+
+ // ]]>
+ </script>
+
+<pre>-*- mode: grep; default-directory: "c:/emacs/p/070604/EmacsW32/nxml/util/" -*-
+Grep started at Fri Dec 28 22:54:06
+
+grep -i -nH -e "hfy-tmpfont-stack" *.el
+<span class="underline-1412">htmlfontify.el</span><span class="underline-0219">:</span><span class="underline-1413">596</span><span class="underline-0219">:</span>(defvar <span class="match-1438">hfy-tmpfont-stack</span> nil
+<span class="underline-1412">htmlfontify.el</span><span class="underline-0219">:</span><span class="underline-1413">999</span><span class="underline-0219">:</span> (entry (assoc key <span class="match-1438">hfy-tmpfont-stack</span>))
+<span class="underline-1412">htmlfontify.el</span><span class="underline-0219">:</span><span class="underline-1413">1003</span><span class="underline-0219">:</span> (setq tag (format "%04d" (length <span class="match-1438">hfy-tmpfont-stack</span>))
+<span class="underline-1412">htmlfontify.el</span><span class="underline-0219">:</span><span class="underline-1413">1005</span><span class="underline-0219">:</span> <span class="match-1438">hfy-tmpfont-stack</span> (cons entry <span class="match-1438">hfy-tmpfont-stack</span>)))
+</pre>
+
+
+<div style="margin-top:2em; color: red; text-align: center; "> Truncated to line 1 - 9! </div>
+</div>
+<div style="width:22.515em; color:rgb(51, 51, 51); background:rgb(229, 229, 229); white-space:pre; overflow:hidden; font-family:monospace;">-- (Unix)%% <b>*grep*</b> (Grep Abbrev) --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------</div></td>
+<td style="vertical-align:top;"><div style="width:23.084999999999997em; height:12.76em; border: 1px solid rgb(212, 208, 200); overflow:auto; padding:4px;">
+
+
+ <script type="text/javascript">
+ // <![CDATA[
+
+function getObj(name) {
+ if (document.getElementById) {
+ this.obj = document.getElementById(name);
+ this.style = document.getElementById(name).style;
+ }
+}
+function hfy_toggle_display(name) {
+ var x = new getObj("hfy_invis_" + name);
+ var flag = x.style.display == 'inline';
+ x.style.display = (flag) ? 'none' : 'inline'
+}
+
+ // ]]>
+ </script>
+
+<pre><span class="underline-1439">5 matches for "hfy-tmpfont-stack" in buffer: htmlfontify.el
+</span> 596:(<span class="keyword-face-1440">defvar</span> <span class="match-1438">hfy-tmpfont-stack</span> nil
+ 999: (entry (assoc key <span class="match-1438">hfy-tmpfont-stack</span>))
+ 1003: (setq tag (format <span class="string-face-1441">"%04d"</span> (length <span class="match-1438">hfy-tmpfont-stack</span>))
+ 1005: <span class="match-1438">hfy-tmpfont-stack</span> (cons entry <span class="match-1438">hfy-tmpfont-stack</span>)))
+ 1228: <span class="comment-delimiter-face-1418">;;</span><span class="comment-face-1419">(</span><span class="match-1438">hfy-tmpfont-stack</span><span class="comment-face-1419"> nil)</span>
+</pre>
+
+ </div>
+<div style="width:23.085em; color:rgb(51, 51, 51); background:rgb(229, 229, 229); white-space:pre; overflow:hidden; font-family:monospace;">-- (Unix)%% <b>*Occur*</b> (Occur Abbrev) --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------</div></td>
+</tr>
+</table>
+</td>
+</tr>
+</table>
+</td>
+</tr>
+<tr>
+<td style="padding:1px; color:rgb(0,0,0); ">
+<span style="background:rgb(255, 215, 0); color:rgb(0,0,0); "> M-x </span> hfyview-frame</td>
+</tr>
+</table>
+</body>
+</html>
--- /dev/null
+#myGallery
+{
+ width: 460px;
+ height: 345px;
+ z-index:5;
+ display: none;
+ border: 1px solid #000;
+}
+
+.jdGallery
+{
+ overflow: hidden;
+ position: relative;
+}
+
+.jdGallery img
+{
+ border: 0;
+ margin: 0;
+}
+
+.jdGallery .slideElement
+{
+ width: 100%;
+ height: 100%;
+ background-color: #000;
+ background-repeat: no-repeat;
+}
+
+.jdGallery .loadingElement
+{
+ width: 100%;
+ height: 100%;
+ position: absolute;
+ left: 0;
+ top: 0;
+ background-color: #000;
+ background-repeat: no-repeat;
+ background-position: center center;
+ background-image: url('img/loading-bar-black.gif');
+}
+
+.jdGallery .slideInfoZone
+{
+ position: absolute;
+ z-index: 10;
+ width: 100%;
+ margin: 0px;
+ left: 0;
+ bottom: 0;
+ height: 40px;
+ background: #333;
+ color: #fff;
+ text-indent: 0;
+ overflow: hidden;
+}
+
+* html .jdGallery .slideInfoZone
+{
+ bottom: -1px;
+}
+
+.jdGallery .slideInfoZone h2
+{
+ padding: 0;
+ font-size: 80%;
+ margin: 0;
+ margin: 2px 5px;
+ font-weight: bold;
+ color: inherit;
+}
+
+.jdGallery .slideInfoZone p
+{
+ padding: 0;
+ font-size: 80%;
+ margin: 2px 5px;
+ color: #eee;
+}
+
+.jdGallery div.carouselContainer
+{
+ position: absolute;
+ height: 135px;
+ width: 100%;
+ z-index: 10;
+ margin: 0px;
+ left: 0;
+ top: 0;
+}
+
+.jdGallery a.carouselBtn
+{
+ position: absolute;
+ bottom: 0;
+ right: 30px;
+ height: 20px;
+ /*width: 100px; background: url('img/carousel_btn.gif') no-repeat;*/
+ text-align: center;
+ padding: 0 10px;
+ font-size: 13px;
+ background: #333;
+ color: #fff;
+ cursor: pointer;
+}
+
+.jdGallery .carousel
+{
+ position: absolute;
+ width: 100%;
+ margin: 0px;
+ left: 0;
+ top: 0;
+ height: 115px;
+ background: #333;
+ color: #fff;
+ text-indent: 0;
+ overflow: hidden;
+}
+
+.jdGallery .carousel .carouselWrapper
+{
+ position: absolute;
+ width: 100%;
+ height: 78px;
+ top: 10px;
+ left: 0;
+ overflow: hidden;
+}
+
+.jdGallery .carousel .carouselInner
+{
+ position: relative;
+}
+
+.jdGallery .carousel .carouselInner .thumbnail
+{
+ cursor: pointer;
+ background: #000;
+ background-position: center center;
+ float: left;
+ border: solid 1px #fff;
+}
+
+.jdGallery .carousel .label
+{
+ font-size: 13px;
+ position: absolute;
+ bottom: 5px;
+ left: 10px;
+ padding: 0;
+ margin: 0;
+}
+
+.jdGallery .carousel .label .number
+{
+ color: #b5b5b5;
+}
+
+.jdGallery a
+{
+ font-size: 100%;
+ text-decoration: none;
+ color: inherit;
+}
+
+.jdGallery a.right, .jdGallery a.left
+{
+ position: absolute;
+ height: 99%;
+ width: 25%;
+ cursor: pointer;
+ z-index:10;
+ filter:alpha(opacity=20);
+ -moz-opacity:0.2;
+ -khtml-opacity: 0.2;
+ opacity: 0.2;
+}
+
+* html .jdGallery a.right, * html .jdGallery a.left
+{
+ filter:alpha(opacity=50);
+}
+
+.jdGallery a.right:hover, .jdGallery a.left:hover
+{
+ filter:alpha(opacity=80);
+ -moz-opacity:0.8;
+ -khtml-opacity: 0.8;
+ opacity: 0.8;
+}
+
+.jdGallery a.left
+{
+ left: 0;
+ top: 0;
+ background: url('img/fleche1.png') no-repeat center left;
+}
+
+* html .jdGallery a.left { background: url('img/fleche1.gif') no-repeat center left; }
+
+.jdGallery a.right
+{
+ right: 0;
+ top: 0;
+ background: url('img/fleche2.png') no-repeat center right;
+}
+
+* html .jdGallery a.right { background: url('img/fleche2.gif') no-repeat center right; }
+
+.jdGallery a.open
+{
+ left: 0;
+ top: 0;
+ width: 100%;
+ height: 100%;
+}
+
+.withArrows a.open
+{
+ position: absolute;
+ top: 0;
+ left: 25%;
+ height: 99%;
+ width: 50%;
+ cursor: pointer;
+ z-index: 10;
+ background: none;
+ -moz-opacity:0.8;
+ -khtml-opacity: 0.8;
+ opacity: 0.8;
+}
+
+.withArrows a.open:hover { background: url('img/open.png') no-repeat center center; }
+
+* html .withArrows a.open:hover { background: url('img/open.gif') no-repeat center center;
+ filter:alpha(opacity=80); }
+
--- /dev/null
+body {
+ color: #ccc;
+ font-family: "Trebuchet MS", "Lucida Grande", Arial, Helvetica, sans-serif;
+ margin: 0 auto;
+ padding: 0;
+ font-size: 1.0em;
+ background: #111 url('../images/bg/gradient1.gif') top left repeat-x;
+}
+
+h1
+{
+ color: #fff;
+ font-size: 47px;
+ font-weight: bolder;
+ margin: 0 40px;
+ padding: 0.08em 0;
+}
+
+h1 sup
+{
+ color: #ddd;
+}
+
+h1 a
+{
+ color: #fff;
+ text-decoration: none;
+}
+
+h1 .company, h1 a .company
+{
+ color: #d01a71;
+}
+
+h2
+{
+ color: #ddd;
+ font-size: 2.5em;
+}
+
+h3
+{
+ color: #fff;
+ font-size: 1.5em;
+}
+
+h4
+{
+ font-size: 1.3em;
+}
+
+.content
+{
+ margin: 0 20px;
+}
+
+.content a
+{
+ color: #fff;
+}
+
+
+.content p.linkage
+{
+ margin-top: 2em;
+ text-align: right;
+ font-size: 1.7em;
+ color: #ddd;
+}
+
+.content p.linkage a { color: #fff; }
+
+/*.content p.linkage a
+{
+ color: #fff;
+ background: url('../images/bg/biglink_off.gif') center right no-repeat;
+ padding: 10px 20px;
+ text-decoration: none;
+}
+
+.content p.linkage a:hover
+{
+ background: url('../images/bg/biglink_on.gif') center right no-repeat;
+ font-style: italic;
+}*/
+
+#myGallery
+{
+ text-align: left;
+ margin: 0 auto;
+}
--- /dev/null
+/*
+ This file is part of JonDesign's SmoothGallery v1.0.1.
+
+ JonDesign's SmoothGallery is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ JonDesign's SmoothGallery is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with JonDesign's SmoothGallery; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+ Main Developer: Jonathan Schemoul (JonDesign: http://www.jondesign.net/)
+ Contributed code by:
+ - Christian Ehret (bugfix)
+ - Nitrix (bugfix)
+ - Valerio from Mad4Milk for his great help with the carousel scrolling and many other things.
+ - Archie Cowan for helping me find a bugfix on carousel inner width problem.
+ Many thanks to:
+ - The mootools team for the great mootools lib, and it's help and support throughout the project.
+*/
+
+
+var $removeEvents = function (object, type)
+{
+ if (!object.events) return object;
+ if (type){
+ if (!object.events[type]) return object;
+ for (var fn in object.events[type]) object.removeEvent(type, fn);
+ object.events[type] = null;
+ } else {
+ for (var evType in object.events) object.removeEvents(evType);
+ object.events = null;
+ }
+ return object;
+};
+
+
+// declaring the class
+var gallery = new Class({
+ initialize: function(element, options) {
+ this.setOptions({
+ showArrows: true,
+ showCarousel: true,
+ showInfopane: true,
+ showDescription: false,
+ thumbHeight: 75,
+ thumbWidth: 100,
+ thumbSpacing: 10,
+ embedLinks: true,
+ fadeDuration: 500,
+ timed: false,
+ delay: 9000,
+ preloader: true,
+ manualData: [],
+ populateData: true,
+ elementSelector: "div.imageElement",
+ titleSelector: "h3",
+ subtitleSelector: "p",
+ descriptionSelector: "div",
+ linkSelector: "a.open",
+ imageSelector: "img.full",
+ thumbnailSelector: "img.thumbnail",
+ slideInfoZoneOpacity: 0.7,
+ carouselMinimizedOpacity: 0.4,
+ carouselMinimizedHeight: 20,
+ carouselMaximizedOpacity: 0.7,
+ destroyAfterPopulate: true,
+ baseClass: 'jdGallery',
+ withArrowsClass: 'withArrows',
+ textShowCarousel: 'Pictures',
+ useThumbGenerator: false,
+ thumbGenerator: 'resizer.php'
+ }, options);
+ this.fireEvent('onInit');
+ this.currentIter = 0;
+ this.lastIter = 0;
+ this.maxIter = 0;
+ this.galleryElement = element;
+ this.galleryData = this.options.manualData;
+ this.galleryInit = 1;
+ this.galleryElements = Array();
+ this.thumbnailElements = Array();
+ this.galleryElement.addClass(this.options.baseClass);
+ if (this.options.populateData)
+ this.populateData();
+ element.style.display="block";
+
+ if (this.options.embedLinks)
+ {
+ this.currentLink = new Element('a').addClass('open').setProperties({
+ href: '#',
+ title: ''
+ }).injectInside(element);
+ if ((!this.options.showArrows) && (!this.options.showCarousel))
+ this.galleryElement = element = this.currentLink;
+ else
+ this.currentLink.setStyle('display', 'none');
+ }
+
+ this.constructElements();
+ if ((data.length>1)&&(this.options.showArrows))
+ {
+ var leftArrow = new Element('a').addClass('left').addEvent(
+ 'click',
+ this.prevItem.bind(this)
+ ).injectInside(element);
+ var rightArrow = new Element('a').addClass('right').addEvent(
+ 'click',
+ this.nextItem.bind(this)
+ ).injectInside(element);
+ this.galleryElement.addClass(this.options.withArrowsClass);
+ }
+ this.loadingElement = new Element('div').addClass('loadingElement').injectInside(element);
+ if (this.options.showInfopane) this.initInfoSlideshow();
+ if (this.options.showCarousel) this.initCarousel();
+ this.doSlideShow(1);
+ },
+ populateData: function() {
+ currentArrayPlace = this.galleryData.length;
+ options = this.options;
+ data = this.galleryData;
+ this.galleryElement.getElements(options.elementSelector).each(function(el) {
+ elementDict = {
+ image: el.getElement(options.imageSelector).getProperty('src'),
+ number: currentArrayPlace
+ };
+ if ((options.showInfopane) | (options.showCarousel))
+ Object.extend(elementDict, {
+ title: el.getElement(options.titleSelector).innerHTML,
+ description: el.getElement(options.subtitleSelector).innerHTML
+ });
+ if ((options.showDescription))
+ Object.extend(elementDict, {
+ outsideDescription: el.getElement(options.descriptionSelector).innerHTML
+ });
+ if (options.embedLinks)
+ Object.extend(elementDict, {
+ link: el.getElement(options.linkSelector).href||false,
+ linkTitle: el.getElement(options.linkSelector).title||false
+ });
+ if ((!options.useThumbGenerator) && (options.showCarousel))
+ Object.extend(elementDict, {
+ thumbnail: el.getElement(options.thumbnailSelector).src
+ });
+ else if (options.useThumbGenerator)
+ Object.extend(elementDict, {
+ thumbnail: 'resizer.php?imgfile=' + elementDict.image + '&max_width=' + options.thumbWidth + '&max_height=' + options.thumbHeight
+ });
+
+ data[currentArrayPlace] = elementDict;
+ currentArrayPlace++;
+ if (this.options.destroyAfterPopulate)
+ el.remove();
+ });
+ this.galleryData = data;
+ this.fireEvent('onPopulated');
+ },
+ constructElements: function() {
+ el = this.galleryElement;
+ this.maxIter = this.galleryData.length;
+ var currentImg;
+ for(i=0;i<this.galleryData.length;i++)
+ {
+ var currentImg = new Fx.Style(
+ new Element('div').addClass('slideElement').setStyles({
+ 'position':'absolute',
+ 'left':'0px',
+ 'right':'0px',
+ 'margin':'0px',
+ 'padding':'0px',
+ 'backgroundImage':"url('" + this.galleryData[i].image + "')",
+ 'backgroundPosition':"center center",
+ 'opacity':'0'\r
+ }).injectInside(el),
+ 'opacity',
+ {duration: this.options.fadeDuration}
+ );
+ this.galleryElements[parseInt(i)] = currentImg;
+ }
+ },
+ destroySlideShow: function(element) {
+ var myClassName = element.className;
+ var newElement = new Element('div').addClass('myClassName');
+ element.parentNode.replaceChild(newElement, element);
+ },
+ startSlideShow: function() {
+ this.fireEvent('onStart');
+ this.loadingElement.style.display = "none";
+ this.lastIter = this.maxIter - 1;
+ this.currentIter = 0;
+ this.galleryInit = 0;
+ this.galleryElements[parseInt(this.currentIter)].set(1);
+ if (this.options.showInfopane)
+ this.showInfoSlideShow.delay(1000, this);
+ this.prepareTimer();
+ if (this.options.embedLinks)
+ this.makeLink(this.currentIter);
+ },
+ nextItem: function() {
+ this.fireEvent('onNextCalled');
+ this.nextIter = this.currentIter+1;
+ if (this.nextIter >= this.maxIter)
+ this.nextIter = 0;
+ this.galleryInit = 0;
+ this.goTo(this.nextIter);
+ },
+ prevItem: function() {
+ this.fireEvent('onPreviousCalled');
+ this.nextIter = this.currentIter-1;
+ if (this.nextIter <= -1)
+ this.nextIter = this.maxIter - 1;
+ this.galleryInit = 0;
+ this.goTo(this.nextIter);
+ },
+ goTo: function(num) {
+ this.clearTimer();
+ if (this.options.embedLinks)
+ this.clearLink();
+ if (this.options.showInfopane)
+ {
+ this.slideInfoZone.clearChain();
+ this.hideInfoSlideShow().chain(this.changeItem.pass(num, this));
+ } else
+ this.changeItem.delay(500, this, num);
+ if (this.options.embedLinks)
+ this.makeLink(num);
+ if (this.options.showDescription)
+ this.showDescription(num);
+ this.prepareTimer();
+ /*if (this.options.showCarousel)
+ this.clearThumbnailsHighlights();*/
+ },
+ changeItem: function(num) {
+ this.fireEvent('onStartChanging');
+ this.galleryInit = 0;
+ if (this.currentIter != num)
+ {
+ for(i=0;i<this.maxIter;i++)
+ {
+ if ((i != this.currentIter)) this.galleryElements[i].set(0);
+ }
+ if (num > this.currentIter) this.galleryElements[num].custom(1);
+ else
+ {
+ this.galleryElements[num].set(1);
+ this.galleryElements[this.currentIter].custom(0);
+ }
+ this.currentIter = num;
+ }
+ this.doSlideShow.bind(this)();
+ this.fireEvent('onChanged');
+ },
+ clearTimer: function() {
+ if (this.options.timed)
+ $clear(this.timer);
+ },
+ prepareTimer: function() {
+ if (this.options.timed)
+ this.timer = this.nextItem.delay(this.options.delay, this);
+ },
+ doSlideShow: function(position) {
+ if (this.galleryInit == 1)
+ {
+ imgPreloader = new Image();
+ imgPreloader.onload=function(){
+ this.startSlideShow.delay(10, this);
+ }.bind(this);
+ imgPreloader.src = this.galleryData[0].image;
+ } else {
+ if (this.options.showInfopane)
+ {
+ if (this.options.showInfopane)
+ {
+ this.showInfoSlideShow.delay((500 + this.options.fadeDuration), this);
+ } else
+ if (this.options.showCarousel)
+ this.centerCarouselOn(position);
+ }
+ }
+ },
+ initCarousel: function () {
+ var carouselContainerElement = new Element('div').addClass('carouselContainer').injectInside(this.galleryElement);
+ this.carouselContainer = new Fx.Styles(carouselContainerElement, {transition: Fx.Transitions.expoOut});
+ this.carouselContainer.normalHeight = carouselContainerElement.offsetHeight;
+ this.carouselContainer.set({'opacity': this.options.carouselMinimizedOpacity, 'top': (this.options.carouselMinimizedHeight - this.carouselContainer.normalHeight)});
+
+ this.carouselBtn = new Element('a').addClass('carouselBtn').setProperties({
+ title: this.options.textShowCarousel\r
+ }).setHTML(this.options.textShowCarousel).injectInside(carouselContainerElement);
+
+ this.carouselBtn.addEvent(
+ 'click',
+ function () {
+ this.carouselContainer.clearTimer();
+ this.toggleCarousel();
+ }.bind(this)
+ );
+ this.carouselActive = false;
+
+ var carouselElement = new Element('div').addClass('carousel').injectInside(carouselContainerElement);
+ this.carousel = new Fx.Styles(carouselElement);
+
+ this.carouselLabel = new Element('p').addClass('label').injectInside(this.carousel.element);
+ this.carouselWrapper = new Element('div').addClass('carouselWrapper').injectInside(this.carousel.element);
+ this.carouselInner = new Element('div').addClass('carouselInner').injectInside(this.carouselWrapper);
+
+ this.carouselWrapper.scroller = new Scroller(this.carouselWrapper, {
+ area: 100,
+ velocity: 0.2
+ })
+
+ this.carouselWrapper.elementScroller = new Fx.Scroll(this.carouselWrapper, {
+ duration: 400,
+ onStart: this.carouselWrapper.scroller.stop.bind(this.carouselWrapper.scroller),
+ onComplete: this.carouselWrapper.scroller.start.bind(this.carouselWrapper.scroller)
+ });
+
+ this.constructThumbnails();
+
+ this.carouselInner.style.width = ((this.maxIter * (this.options.thumbWidth + this.options.thumbSpacing)) - this.options.thumbSpacing + this.options.thumbWidth) + "px";
+ },
+ toggleCarousel: function() {
+ if (this.carouselActive)
+ this.hideCarousel();
+ else
+ this.showCarousel();\r
+ },
+ showCarousel: function () {
+ this.fireEvent('onShowCarousel');
+ this.carouselContainer.custom({
+ 'opacity': this.options.carouselMaximizedOpacity,
+ 'top': 0
+ }).addEvent('onComplete', function() { this.carouselActive = true; this.carouselWrapper.scroller.start(); }.bind(this));
+ },
+ hideCarousel: function () {
+ this.fireEvent('onHideCarousel');
+ this.carouselContainer.custom({
+ 'opacity': this.options.carouselMinimizedOpacity,
+ 'top': (this.options.carouselMinimizedHeight - this.carouselContainer.normalHeight)
+ }).addEvent('onComplete', function() { this.carouselActive = false; this.carouselWrapper.scroller.stop(); }.bind(this));
+ },
+ constructThumbnails: function () {
+ element = this.carouselInner;
+ for(i=0;i<this.galleryData.length;i++)
+ {
+ var currentImg = new Fx.Style(new Element ('div').addClass("thumbnail").setStyles({
+ backgroundImage: "url('" + this.galleryData[i].thumbnail + "')",
+ backgroundPosition: "center center",
+ backgroundRepeat: 'no-repeat',
+ marginLeft: this.options.thumbSpacing + "px",
+ width: this.options.thumbWidth + "px",
+ height: this.options.thumbHeight + "px"
+ }).injectInside(element), "opacity", {duration: 200}).set(0.2);
+ currentImg.element.addEvents({
+ 'mouseover': function (myself) {
+ myself.clearTimer();
+ myself.custom(0.99);
+ $(this.carouselLabel).setHTML('<span class="number">' + (myself.relatedImage.number + 1) + "/" + this.maxIter + ":</span> " + myself.relatedImage.title);
+ }.pass(currentImg, this),
+ 'mouseout': function (myself) {
+ myself.clearTimer();
+ myself.custom(0.2);
+ }.pass(currentImg, this),
+ 'click': function (myself) {
+ this.goTo(myself.relatedImage.number);
+ }.pass(currentImg, this)\r
+ });
+
+ currentImg.relatedImage = this.galleryData[i];
+ this.thumbnailElements[parseInt(i)] = currentImg;
+ }
+ },
+ clearThumbnailsHighlights: function()
+ {
+ for(i=0;i<this.galleryData.length;i++)
+ {
+ this.thumbnailElements[i].clearTimer();
+ this.thumbnailElements[i].custom(0.2);
+ }
+ },
+ centerCarouselOn: function(num) {
+ var carouselElement = this.thumbnailElements[num];
+ var position = carouselElement.element.offsetLeft + (carouselElement.element.offsetWidth / 2);
+ var carouselWidth = this.carouselWrapper.offsetWidth;
+ var carouselInnerWidth = this.carouselInner.offsetWidth;
+ var diffWidth = carouselWidth / 2;
+ var scrollPos = position-diffWidth;
+ this.carouselWrapper.elementScroller.scrollTo(scrollPos,0);
+ },
+ initInfoSlideshow: function() {
+ /*if (this.slideInfoZone.element)
+ this.slideInfoZone.element.remove();*/
+ this.slideInfoZone = new Fx.Styles(new Element('div').addClass('slideInfoZone').injectInside($(this.galleryElement))).set({'opacity':0});
+ var slideInfoZoneTitle = new Element('h2').injectInside(this.slideInfoZone.element);
+ var slideInfoZoneDescription = new Element('p').injectInside(this.slideInfoZone.element);
+ this.slideInfoZone.normalHeight = this.slideInfoZone.element.offsetHeight;
+ this.slideInfoZone.element.setStyle('opacity',0);
+ },
+ changeInfoSlideShow: function()
+ {
+ this.hideInfoSlideShow.delay(10, this);
+ this.showInfoSlideShow.delay(500, this);
+ },
+ showInfoSlideShow: function() {
+ this.fireEvent('onShowInfopane');
+ this.slideInfoZone.clearTimer();
+ element = this.slideInfoZone.element;
+ element.getElement('h2').setHTML(this.galleryData[this.currentIter].title);
+ element.getElement('p').setHTML(this.galleryData[this.currentIter].description);
+ this.slideInfoZone.custom({'opacity': [0, this.options.slideInfoZoneOpacity], 'height': [0, this.slideInfoZone.normalHeight]});
+ if (this.options.showCarousel)
+ this.slideInfoZone.chain(this.centerCarouselOn.pass(this.currentIter, this));
+ return this.slideInfoZone;
+ },
+ hideInfoSlideShow: function() {
+ this.fireEvent('onHideInfopane');
+ this.slideInfoZone.clearTimer();
+ this.slideInfoZone.custom({'opacity': 0, 'height': 0});
+ return this.slideInfoZone;
+ },
+ makeLink: function(num) {
+ this.currentLink.setProperties({
+ href: this.galleryData[num].link,
+ title: this.galleryData[num].linkTitle
+ })
+ if (!((this.options.embedLinks) && (!this.options.showArrows) && (!this.options.showCarousel)))
+ this.currentLink.setStyle('display', 'block');
+ },
+ showDescription: function(num) {
+ var descObj = document.getElementById('DescriptionDiv');
+ if (descObj)
+ descObj.setHTML(this.galleryData[num].outsideDescription);
+ },
+ clearLink: function() {
+ this.currentLink.setProperties({href: '', title: ''});
+ if (!((this.options.embedLinks) && (!this.options.showArrows) && (!this.options.showCarousel)))
+ this.currentLink.setStyle('display', 'none');
+ }
+});
+gallery.implement(new Events);
+gallery.implement(new Options);
+
+/* All code copyright 2006 Jonathan Schemoul */
--- /dev/null
+//MooTools, My Object Oriented Javascript Tools. Copyright (c) 2006 Valerio Proietti, <http://mad4milk.net>, MIT Style License.
+eval(function(p,a,c,k,e,d){e=function(c){return(c<a?'':e(parseInt(c/a)))+((c=c%a)>35?String.fromCharCode(c+29):c.toString(36))};if(!''.replace(/^/,String)){while(c--)d[e(c)]=k[c]||e(c);k=[function(e){return d[e]}];e=function(){return'\\w+'};c=1};while(c--)if(k[c])p=p.replace(new RegExp('\\b'+e(c)+'\\b','g'),k[c]);return p}('k 11=f(1S){k 4s=f(){j(9.1e&&Y[0]!=\'7h\')h 9.1e.2m(9,Y);Q h 9};I(k n W 9)4s[n]=9[n];4s.U=1S;h 4s};11.1G=f(){};11.U={N:f(1S){k 4r=M 9(\'7h\');k 7g=f(2s,2f){j(!2s.2m||!2f.2m)h T;h f(){9.1t=2s;h 2f.2m(9,Y)}};I(k n W 1S){k 2s=4r[n];k 2f=1S[n];j(2s&&2s!=2f)2f=7g(2s,2f)||2f;4r[n]=2f}h M 11(4r)},1T:f(1S){I(k n W 1S)9.U[n]=1S[n]}};1H.N=f(){k R=Y;R=(R[1])?[R[0],R[1]]:[9,R[0]];I(k n W R[1])R[0][n]=R[1][n];h R[0]};1H.5p=f(){I(k i=0;i<Y.14;i++)Y[i].N=11.U.1T};M 1H.5p(59,1r,5e,76,11);j(5r 2I==\'3z\'){k 2I=11.1G;2I.U={}}f $q(u){j(u===1K||u===3z)h T;k q=5r u;j(q==\'5o\'){j(u 4m 2I)h\'r\';j(u 4m 1r)h\'1R\';j(u.9Y){2c(u.6x){1c 1:h\'r\';1c 3:h u.9X.15(\'\\\\S\')?\'9W\':\'4f\'}}}h q};f $2B(u){h!!(u||u===0)};f $9V(u,7f){h($q(u))?u:7f};f $7e(3o,1B){h G.9U(G.7e()*(1B-3o+1)+3o)};f $3Q(1f){9T(1f);9S(1f);h 1K};j(12.9R)12.3w=12[12.9Q?\'9P\':\'53\']=1g;Q j(L.6J&&!L.9O&&!9N.9M)12.3W=1g;Q j(L.9L!=1K)12.5m=1g;1r.U.4q=1r.U.4q||f(O,J){I(k i=0;i<9.14;i++)O.1i(J,9[i],i,9)};1r.U.4X=1r.U.4X||f(O,J){k 5u=[];I(k i=0;i<9.14;i++)5u[i]=O.1i(J,9[i],i,9);h 5u};1r.U.7d=1r.U.7d||f(O,J){I(k i=0;i<9.14;i++){j(!O.1i(J,9[i],i,9))h T}h 1g};1r.U.7c=1r.U.7c||f(O,J){I(k i=0;i<9.14;i++){j(O.1i(J,9[i],i,9))h 1g}h T};1r.U.4g=1r.U.4g||f(3a,F){F=F||0;j(F<0)F=G.1B(0,9.14+F);34(F<9.14){j(9[F]===3a)h F;F++}h-1};1r.N({1o:1r.U.4q,54:f(){k 36=[];I(k i=0;i<9.14;i++)36[i]=9[i];h 36},3Z:f(3a){k i=0;34(i<9.14){j(9[i]==3a)9.47(i,1);Q i++}h 9},15:f(3a,F){h 9.4g(3a,F)!=-1},N:f(36){I(k i=0;i<36.14;i++)9.18(36[i]);h 9},9K:f(1u){k u={},14=G.3o(9.14,1u.14);I(k i=0;i<14;i++)u[1u[i]]=9[i];h u}});f $A(1R){h 1r.U.54.1i(1R)};f $1o(7b,O,J){h 1r.U.4q.1i(7b,O,J)};5e.N({15:f(7a,79){h M 9J(7a,79).15(9)},2C:f(){h 5s(9)},74:f(){h 3t(9)},5n:f(){h 9.35(/-\\D/g,f(28){h 28.5t(1).78()})},6O:f(){h 9.35(/\\w[A-Z]/g,f(28){h(28.5t(0)+\'-\'+28.5t(1).3G())})},9I:f(){h 9.3G().35(/\\b[a-z]/g,f(28){h 28.78()})},77:f(){h 9.35(/^\\s+|\\s+$/g,\'\')},45:f(){h 9.35(/\\s{2,}/g,\' \').77()},3I:f(1R){k 1l=9.28(/\\d{1,3}/g);h(1l)?1l.3I(1R):T},3s:f(1R){k 2J=9.28(\'^#?(\\\\w{1,2})(\\\\w{1,2})(\\\\w{1,2})$\');h(2J)?2J.3s(1R):T}});1r.N({3I:f(1R){j(9.14<3)h T;j(9[3]&&9[3]==0)h\'9H\';k 2J=[];I(k i=0;i<3;i++){k 4p=(9[i]-0).9G(16);2J.18(4p.14==1?\'0\'+4p:4p)}h 1R?2J:\'#\'+2J.3r(\'\')},3s:f(1R){j(9.14!=4)h T;k 1l=[];I(k i=1;i<4;i++){j(9[i].14==1)9[i]+=9[i];1l.18(5s(9[i],16))}h 1R?1l:\'1l(\'+1l.3r(\',\')+\')\'}});76.N({2C:f(){h 5s(9)},74:f(){h 3t(9)}});59.N({2e:f(m){k O=9;m=1H.N({\'J\':O,\'o\':T,\'Y\':1K,\'2d\':T,\'2k\':T,\'4o\':T},m||{});j(m.Y!=1K&&5r m.Y!=\'3z\'&&!(m.Y 4m 1r))m.Y=[m.Y];h f(o){k R=m.Y||Y;j(m.o){o=(m.o===1g)?o||12.o:M m.o(o);R=[o].9F(R)}k 2t=f(){h O.2m(m.J,R)};j(m.2d)h 9E(2t,m.2d);j(m.2k)h 9D(2t,m.2k);j(m.4o){6g{k 5q=2t()}6f(73){5q=73}9C{h 5q}}Q h 2t()}},9B:f(R,J){h 9.2e({\'Y\':R,\'J\':J})},4o:f(R,J){h 9.2e({\'Y\':R,\'J\':J,\'4o\':1g})()},J:f(J,R){h 9.2e({\'J\':J,\'Y\':R})},9A:f(J,R){h 9.2e({\'J\':J,\'o\':1g,\'Y\':R})},2d:f(4n,J,R){h 9.2e({\'2d\':4n,\'J\':J,\'Y\':R})()},2k:f(4n,J,R){h 9.2e({\'2k\':4n,\'J\':J,\'Y\':R})()}});k 1b=M 11({1e:f(l){j($q(l)==\'4j\')l=L.6H(l);h $(l)}});f $(l){j(!l)h T;j(l.72||[12,L].15(l))h l;j($q(l)==\'4j\')l=L.44(l);j($q(l)!=\'r\')h T;j([\'5o\',\'9z\'].15(l.41.3G())||l.N)h l;l.72=1g;31.6z(l);l.N=1H.N;j(!(l 4m 2I))l.N(1b.U);h l};k 1N=M 11({});M 1H.5p(1N);L.2G=L.56;f $$(){j(!Y)h T;j(Y.14==1){j(!Y[0])h T;j(Y[0].71)h Y[0]}k 1w=[];$1o(Y,f(1v){2c($q(1v)){1c\'r\':1w.18($(1v));1P;1c\'4j\':1v=L.2G(1v);6F:j(1v.14){$1o(1v,f(l){j($(l))1w.18(l)})}}});1w.71=1g;h 1H.N(1w,M 1N)};1N.3T=f(n){h f(){k R=Y;k 3J=[];k 1w=1g;$1o(9,f(l){k 2t=l[n].2m(l,R);j($q(2t)!=\'r\')1w=T;3J.18(2t)});j(1w)3J=$$(3J);h 3J}};1b.N=f(1S){I(k n W 1S){2I.U[n]=1S[n];1b.U[n]=1S[n];1N.U[n]=1N.3T(n)}};1b.N({4l:f(l,70){l=$(l)||M 1b(l);2c(70){1c"6Y":$(l.26).6Z(9,l);1P;1c"6X":j(!l.5k())$(l.26).4k(9);Q $(l.26).6Z(9,l.5k());1P;1c"6W":l.4k(9)}h 9},9y:f(l){h 9.4l(l,\'6Y\')},5K:f(l){h 9.4l(l,\'6X\')},9x:f(l){h 9.4l(l,\'6W\')},5J:f(l){9.4k($(l)||M 1b(l));h 9},3Z:f(){9.26.9w(9);h 9},9v:f(6V){k l=9.9u(6V!==T);h $(l)},6G:f(l){l=$(l)||M 1b(l);9.26.9t(l,9);h l},9s:f(33){j(12.3w){2c(9.3C()){1c\'1h\':9.9r.6S=33;h 9;1c\'52\':9.4d(\'33\',33);h 9}}9.4k(L.9q(33));h 9},3A:f(1d){h 9.1d.15(\'(?:^|\\\\s+)\'+1d+\'(?:\\\\s+|$)\')},6T:f(1d){j(!9.3A(1d))9.1d=(9.1d+\' \'+1d).45();h 9},6U:f(1d){j(9.3A(1d))9.1d=9.1d.35(1d,\'\').45();h 9},9p:f(1d){h 9.3A(1d)?9.6U(1d):9.6T(1d)},1F:f(n,K){j(n==\'1Y\')9.6R(3t(K));Q 9.1h[n.5n()]=(K.18)?K.3I():K;h 9},6I:f(1L){2c($q(1L)){1c\'5o\':I(k n W 1L)9.1F(n,1L[n]);1P;1c\'4j\':j(12.3w)9.6S=1L;Q 9.6E(\'1h\',1L)}h 9},6R:f(1Y){j(1Y==0){j(9.1h.4i!="3S")9.1h.4i="3S"}Q{j(9.1h.4i!="6Q")9.1h.4i="6Q"}j(!9.4h||!9.4h.9o)9.1h.9n=1;j(12.3w)9.1h.3D="3x(1Y="+1Y*3g+")";9.1h.1Y=9.1Y=1Y;h 9},1W:f(n){n=n.5n();k 1h=9.1h[n]||T;j(!$2B(1h)){j(n==\'1Y\')h $2B(9.1Y)?9.1Y:1;j([\'2n\',\'9m\'].15(n)){h[9.1W(n+\'-2w\')||0,9.1W(n+\'-5a\')||0,9.1W(n+\'-6B\')||0,9.1W(n+\'-2i\')||0].3r(\' \')}j(L.6P)1h=L.6P.9l(9,1K).9k(n.6O());Q j(9.4h)1h=9.4h[n]}h(1h&&n.15(\'1A\',\'i\')&&1h.15(\'1l\'))?1h.3I():1h},1a:f(q,O){9.V=9.V||{};9.V[q]=9.V[q]||{\'1u\':[],\'1z\':[]};j(!9.V[q].1u.15(O)){9.V[q].1u.18(O);j(9.6N){9.6N((q==\'2M\'&&12.5m)?\'5f\':q,O,T)}Q{O=O.J(9);9.9j(\'58\'+q,O);9.V[q].1z.18(O)}}h 9},9i:f(1L){j(1L){I(k q W 1L)9.1a(q,1L[q])}h 9},1E:f(q,O){j(9.V&&9.V[q]){k 1D=9.V[q].1u.4g(O);j(1D==-1)h 9;k 1O=9.V[q].1u.47(1D,1)[0];j(9.6M){9.6M((q==\'2M\'&&12.5m)?\'5f\':q,1O,T)}Q{9.9h(\'58\'+q,9.V[q].1z.47(1D,1)[0])}}h 9},5h:f(q){j(9.V){j(q){j(9.V[q]){9.V[q].1u.1o(f(O){9.1E(q,O)},9);9.V[q]=1K}}Q{I(k 6L W 9.V)9.5h(6L);9.V=1K}}h 9},1x:f(q,R){j(9.V&&9.V[q]){R=R||[];j($q(R)!=\'1R\')R=[R];9.V[q].1u.1o(f(O){O.2m(9,R)},9)}},5j:f(5l){k l=9[5l+\'6K\'];34($q(l)==\'4f\')l=l[5l+\'6K\'];h $(l)},9g:f(){h 9.5j(\'2s\')},5k:f(){h 9.5j(\'9f\')},9e:f(){k l=9.9d;34($q(l)==\'4f\')l=l.9c;h $(l)},9b:f(){k l=9.9a;34($q(l)==\'4f\')l=l.99;h $(l)},98:f(){h $(9.26)},97:f(){h $$(9.6J)},4d:f(n,K){2c(n){1c\'6C\':9.1d=K;1P;1c\'1h\':9.6I(K);1P;1c\'24\':j(12.53){k l=$(L.6H(\'<\'+9.3C()+\' 24="\'+K+\'" />\'));$1o(9.96,f(4e){j(4e.24!=\'24\')l.4d(4e.24,4e.K)});j(9.26)9.6G(l);h l}6F:9.6E(n,K)}h 9},95:f(1L){I(k n W 1L)9.4d(n,1L[n]);h 9},94:f(6D){9.93=6D;h 9},92:f(n){h(n==\'6C\')?9.1d:9.6k(n)},3C:f(){h 9.41.3G()},2O:f(){k l=9,4c=0,4b=0;91{4c+=l.4c||0;4b+=l.4b||0;l=l.90}34(l);h{\'x\':4c,\'y\':4b}},2a:f(x,y){9.3U=x;9.3V=y},3P:f(){h{\'1V\':{\'x\':9.3U,\'y\':9.3V},\'2A\':{\'x\':9.2x,\'y\':9.2v},\'3O\':{\'x\':9.68,\'y\':9.69}}},4D:f(){h 9.2O().y},4F:f(){h 9.2O().x},8Z:f(){k 5i=9.2O();k u={\'3j\':9.2x,\'3i\':9.2v,\'2i\':5i.x,\'2w\':5i.y};u.5a=u.2i+u.3j;u.6B=u.2w+u.3i;h u},2F:f(){2c(9.3C()){1c\'2U\':j(9.6A!=-1)h 9.m[9.6A].K;1P;1c\'8Y\':j(!(9.8X&&[\'8W\',\'8V\'].15(9.q))&&![\'3S\',\'33\',\'8U\'].15(9.q))1P;1c\'8T\':h 9.K}h T}});k 8S=12;12.1a=L.1a=1b.U.1a;12.1E=L.1E=1b.U.1E;k 31={1w:[],6z:f(r){31.1w.18(r)},5g:f(){12.1E(\'6y\',31.5g);31.1w.1o(f(l){l.5h();I(k p W 1b.U)2I[p]=12[p]=L[p]=l[p]=1K;l.N=1K})}};12.1a(\'6y\',31.5g);k 3F=M 11({1e:f(o){9.o=o||12.o;9.q=9.o.q;9.3H=9.o.3H||9.o.8R;j(9.3H.6x==3)9.3H=9.3H.26;9.8Q=9.o.8P;9.8O=9.o.8N;9.8M=9.o.8L;9.8K=9.o.8J;j([\'5f\',\'2M\'].15(9.q)){9.3f=9.o.6w?(9.o.6w/ (12.51 ? -6v : 6v)) : -(9.o.8I || 0) /3}Q j(9.q.15(\'1O\')){9.5d=9.o.6r||9.o.8H;I(k 24 W 3F.1u){j(3F.1u[24]==9.5d)k 6u=24}9.1O=6u||5e.8G(9.5d).3G()}Q j(9.q.15(\'2l\')||9.q==\'8F\'){9.1y={\'x\':9.o.5c||9.o.6t+L.2r.3U,\'y\':9.o.5b||9.o.6s+L.2r.3V};9.5y={\'x\':9.o.5c?9.o.5c-12.66:9.o.6t,\'y\':9.o.5b?9.o.5b-12.67:9.o.6s};9.8E=(9.o.6r==3)||(9.o.8D==2);2c(9.q){1c\'8C\':9.4a=9.o.4a||9.o.8B;1P;1c\'8A\':9.4a=9.o.4a||9.o.5L}}},1s:f(){9.49();9.48();h 9},49:f(){j(9.o.49)9.o.49();Q 9.o.8z=1g;h 9},48:f(){j(9.o.48)9.o.48();Q 9.o.8y=T;h 9}});3F.1u={\'8x\':13,\'8w\':38,\'8v\':40,\'2i\':37,\'5a\':39,\'8u\':27,\'8t\':32,\'8s\':8,\'8r\':46};59.N({2y:f(J,R){h 9.2e({\'J\':J,\'Y\':R,\'o\':3F})}});k 5S=M 11({8q:f(O){9.2H=9.2H||[];9.2H.18(O);h 9},5Z:f(){j(9.2H&&9.2H.14)9.2H.47(0,1)[0].2d(10,9)},8p:f(){9.2H=[]}});k 3c=M 11({1a:f(q,O){j(O!=11.1G){9.V=9.V||{};9.V[q]=9.V[q]||[];j(!9.V[q].15(O))9.V[q].18(O)}h 9},1x:f(q,R,2d){j(9.V&&9.V[q]){9.V[q].1o(f(O){O.2e({\'J\':9,\'2d\':2d,\'Y\':R})()},9)}h 9},1E:f(q,O){j(9.V&&9.V[q])9.V[q].3Z(O);h 9}});k 3b=M 11({2N:f(6q,m){9.m=1H.N(6q,m);j(9.1a){I(k 3E W 9.m){j(($q(9.m[3E])==\'f\')&&3E.15(\'^58[A-Z]\'))9.1a(3E,9.m[3E])}}h 9}});f $E(1v,3D){h($(3D)||L).42(1v)};f $8o(1v,3D){h($(3D)||L).2G(1v)};1b.N({3B:f(1v){k 1Q=[];1v.45().4Y(\' \').1o(f(43,i){k 1q=43.28(\'^(\\\\w*|\\\\*)(?:#([\\\\6p-]+)|\\\\.([\\\\6p-]+))?(?:\\\\[["\\\']?(\\\\w+)["\\\']?(?:([\\\\*\\\\^\\\\$]?=)["\\\']?(\\\\w*)["\\\']?)?\\\\])?$\');j(!1q)h;1q[1]=1q[1]||\'*\';j(i==0){j(1q[2]){k l=9.44(1q[2]);j(!l||((1q[1]!=\'*\')&&(1b.U.3C.1i(l)!=1q[1])))h;1Q=[l]}Q{1Q=$A(9.56(1q[1]))}}Q{1Q=1N.U.6m.1i(1Q,1q[1]);j(1q[2])1Q=1N.U.6o.1i(1Q,1q[2])}j(1q[3])1Q=1N.U.6n.1i(1Q,1q[3]);j(1q[4])1Q=1N.U.6l.1i(1Q,1q[4],1q[6],1q[5])},9);h $$(1Q)},44:f(2Z){k l=L.44(2Z);j(!l)h T;I(k 1t=l.26;1t!=9;1t=1t.26){j(!1t)h T}h l},42:f(1v){h 9.2G(1v)[0]},2G:f(1v){k 57=[];1v.4Y(\',\').1o(f(43){57.N(9.3B(43))},9);h $$(57)}});L.N=1H.N;L.N({8n:f(1d){h L.3B(\'.\'+1d)},42:1b.U.42,3B:1b.U.3B,2G:1b.U.2G});1N.N({6o:f(2Z,8m){k 1p=[];9.1o(f(l){j(l.2Z==2Z)1p.18(l)});h 1p},6n:f(1d){k 1p=[];9.1o(f(l){j(1b.U.3A.1i(l,1d))1p.18(l)});h 1p},6m:f(41){k 1p=[];9.1o(f(l){1p.N(l.56(41))});h 1p},6l:f(24,K,55){k 1p=[];9.1o(f(l){k 30=l.6k(24);j(!30)h 1p;j(!55)h 1p.18(l);2c(55){1c\'*=\':j(30.15(K))1p.18(l);1P;1c\'=\':j(30==K)1p.18(l);1P;1c\'^=\':j(30.15(\'^\'+K))1p.18(l);1P;1c\'$=\':j(30.15(K+\'$\'))1p.18(l)}h 1p});h 1p}});k 6j=M 11({14:0,1e:f(u){9.u={};I(k n W u){9.u[n]=u[n];9.14++}},8l:f(1O){h 9.u[1O]},1U:f(1O,K){j(K==1K)h T;j(9.u[1O]==3z)9.14++;9.u[1O]=K;h 9},3Z:f(1O){j(9.u[1O]==3z)h T;k u={};9.14--;I(k n W 9.u){j(n!=1O)u[n]=9.u[n]}9.u=u;h 9},1o:f(O,J){I(k n W 9.u)O.1i(J||9,n,9.u[n])},N:f(u){9.1e(1H.N(9.u,u));h 9},1G:f(){h(9.14==0)},1u:f(){k 1u=[];I(k n W 9.u)1u.18(n);h 1u},1z:f(){k 1z=[];I(k n W 9.u)1z.18(9.u[n]);h 1z}});f $H(u){h M 6j(u)};k 2q=M 11({1e:f(1A){j(1A.6i&&1A.6h)h 1A;k 1l=(1A.18)?1A:1A.3s(1g);h 1H.N(1l,2q.U)},6i:f(){k 3y=$A(Y);k 3x=50;j($q(3y[3y.14-1])==\'5N\')3x=3y.8k();k 1l=9.54();3y.1o(f(1A){1A=M 2q(1A);I(k i=0;i<3;i++)1l[i]=G.3e((1l[i]/ 3g * (3g - 3x)) + (1A[i] /3g*3x))});h M 2q(1l)},6h:f(){k 1l=[];I(k i=0;i<3;i++)1l.18(8j-9[i]);h M 2q(1l)}});f $C(1A){h M 2q(1A)};12.N=1H.N;12.N({8i:f(){j(9.53)6g{L.8h("8g",T,1g)}6f(e){}},1a:f(q,O){j(q==\'3u\'){j(9.3Y)O();Q j(!9.V||!9.V.3u){k 3v=f(){j(9.3Y)h;9.3Y=1g;j(9.1f)9.1f=$3Q(9.1f);1b.U.1x.1i(9,\'3u\');9.V.3u=1K}.J(9);j(L.3X&&9.3W){9.1f=f(){j([\'3Y\',\'6d\'].15(L.3X))3v()}.2k(50)}Q j(L.3X&&9.3w){L.8f("<52 2Z=6e 8e 8d=8c:8b(0)><\\/52>");$(\'6e\').8a=f(){j(9.3X==\'6d\')3v()}}Q{9.1a("89",3v);L.1a("88",3v)}}}1b.U.1a.1i(9,q,O);h 9},87:f(6c){h 9.1a(\'3u\',6c)}});12.N({63:f(){j(9.3W||9.51)h 9.86;Q h L.2r.6b||L.4N.6b},62:f(){j(9.3W||9.51)h 9.85;h L.2r.6a||L.4N.6a},60:f(){h L.2r.69},61:f(){h L.2r.68},64:f(){h 9.67||L.2r.3V},65:f(){h 9.66||L.2r.3U},3P:f(){h{\'1V\':{\'x\':9.65(),\'y\':9.64()},\'2A\':{\'x\':9.63(),\'y\':9.62()},\'3O\':{\'x\':9.61(),\'y\':9.60()}}},2O:f(){h{\'x\':0,\'y\':0}}});k X={};X.1C=M 11({2j:f(){h{2K:11.1G,2g:11.1G,5T:11.1G,5Y:X.2Q.4U,4Z:84,1J:\'4I\',2T:1g,5U:50}},1e:f(m){9.r=9.r||1K;9.2N(9.2j(),m);j(9.m.1e)9.m.1e.1i(9)},19:f(){k 2Y=M 5W().5V();j(2Y<9.2Y+9.m.4Z){9.5X=2Y-9.2Y;9.2E();9.2o()}Q{9.1s(1g);9.P=9.B;9.2o();9.1x(\'2g\',9.r,10);9.5Z()}},1U:f(B){9.P=B;9.2o();h 9},2E:f(){9.P=9.2D(9.F,9.B)},2D:f(F,B){h 9.m.5Y(9.5X,F,(B-F),9.m.4Z)},1m:f(F,B){j(!9.m.2T)9.1s();Q j(9.1f)h 9;9.F=F;9.B=B;9.2Y=M 5W().5V();9.1f=9.19.2k(G.3e(83/9.m.5U),9);9.1x(\'2K\',9.r);h 9},1s:f(2h){j(!9.1f)h 9;9.1f=$3Q(9.1f);j(!2h)9.1x(\'5T\',9.r);h 9},82:f(F,B){h 9.1m(F,B)},81:f(2h){h 9.1s(2h)}});X.1C.1T(M 5S);X.1C.1T(M 3c);X.1C.1T(M 3b);X.2Q={5F:f(t,b,c,d){h c*t/d+b},4U:f(t,b,c,d){h-c/2*(G.4T(G.1X*t/d)-1)+b}};X.23={2U:f(n,B){j(n.15(\'1A\',\'i\'))h 9.2q;j(B.15&&B.15(\' \'))h 9.3T;h 9.5R},1M:f(l,n,2X){j(!2X.18)2X=[2X];k F=2X[0],B=2X[1];j(!B&&B!=0){B=F;F=l.1W(n)}k 17=9.2U(n,B);h{F:17.1M(F),B:17.1M(B),17:17}}};X.23.5R={1M:f(K){h 3t(K)},2V:f(F,B,2W){h 2W.2D(F,B)},2F:f(K,1J){h K+1J}};X.23.3T={1M:f(K){h K.18?K:K.4Y(\' \').4X(f(v){h 3t(v)})},2V:f(F,B,2W){k P=[];I(k i=0;i<F.14;i++)P[i]=2W.2D(F[i],B[i]);h P},2F:f(K,1J){h K.3r(1J+\' \')+1J}};X.23.2q={1M:f(K){h K.18?K:K.3s(1g)},2V:f(F,B,2W){k P=[];I(k i=0;i<F.14;i++)P[i]=G.3e(2W.2D(F[i],B[i]));h P},2F:f(K){h\'1l(\'+K.3r(\',\')+\')\'}};X.5Q=X.1C.N({1e:f(l,n,m){9.r=$(l);9.n=n;9.1t(m)},5I:f(){h 9.1U(0)},2E:f(){9.P=9.17.2V(9.F,9.B,9)},1U:f(B){9.17=X.23.2U(9.n,B);h 9.1t(9.17.1M(B))},1m:f(F,B){j(9.1f&&9.m.2T)h 9;k 1n=X.23.1M(9.r,9.n,[F,B]);9.17=1n.17;h 9.1t(1n.F,1n.B)},2o:f(){9.r.1F(9.n,9.17.2F(9.P,9.m.1J))}});1b.N({80:f(n,m){h M X.5Q(9,n,m)}});X.5P=X.1C.N({1e:f(l,m){9.r=$(l);9.1t(m)},2E:f(){I(k p W 9.F)9.P[p]=9.17[p].2V(9.F[p],9.B[p],9)},1U:f(B){k 1n={};9.17={};I(k p W B){9.17[p]=X.23.2U(p,B[p]);1n[p]=9.17[p].1M(B[p])}h 9.1t(1n)},1m:f(u){j(9.1f&&9.m.2T)h 9;9.P={};9.17={};k F={},B={};I(k p W u){k 1n=X.23.1M(9.r,p,u[p]);F[p]=1n.F;B[p]=1n.B;9.17[p]=1n.17}h 9.1t(F,B)},2o:f(){I(k p W 9.P)9.r.1F(p,9.17[p].2F(9.P[p],9.m.1J))}});1b.N({7Z:f(m){h M X.5P(9,m)}});X.1N=X.1C.N({1e:f(1w,m){9.1w=$$(1w);9.1t(m)},2E:f(){I(k i W 9.F){k 3q=9.F[i],2p=9.B[i],2b=9.17[i],3p=9.P[i]={};I(k p W 3q)3p[p]=2b[p].2V(3q[p],2p[p],9)}},1U:f(B){k 1n={};9.17={};I(k i W B){k 2p=B[i],2b=9.17[i]={},5O=1n[i]={};I(k p W 2p){2b[p]=X.23.2U(p,2p[p]);5O[p]=2b[p].1M(2p[p])}}h 9.1t(1n)},1m:f(u){j(9.1f&&9.m.2T)h 9;9.P={};9.17={};k F={},B={};I(k i W u){k 4W=u[i],3q=F[i]={},2p=B[i]={},2b=9.17[i]={};I(k p W 4W){k 1n=X.23.1M(9.1w[i],p,4W[p]);3q[p]=1n.F;2p[p]=1n.B;2b[p]=1n.17}}h 9.1t(F,B)},2o:f(){I(k i W 9.P){k 3p=9.P[i],2b=9.17[i];I(k p W 3p)9.1w[i].1F(p,2b[p].2F(3p[p],9.m.1J))}}});X.7Y=X.1C.N({1e:f(r,m){9.P=[];9.r=$(r);9.1a(\'2K\',f(){9.r.1a(\'2M\',9.1s.J(9,T))}.J(9));9.1E(\'2g\',f(){9.r.1E(\'2M\',9.1s.J(9,T))}.J(9));9.1t(m)},2E:f(){I(k i=0;i<2;i++)9.P[i]=9.2D(9.F[i],9.B[i])},2a:f(x,y){j(9.1f&&9.m.2T)h 9;k l=9.r.3P();k 1z={\'x\':x,\'y\':y};I(k z W l.2A){k 1B=l.3O[z]-l.2A[z];j($2B(1z[z]))1z[z]=($q(1z[z])==\'5N\')?G.1B(G.3o(1z[z],1B),0):1B;Q 1z[z]=l.1V[z]}h 9.1m([l.1V.x,l.1V.y],[1z.x,1z.y])},7X:f(){h 9.2a(T,0)},7W:f(){h 9.2a(T,\'5M\')},7V:f(){h 9.2a(0,T)},7U:f(){h 9.2a(\'5M\',T)},5L:f(l){h 9.2a($(l).4F(),$(l).4D())},2o:f(){9.r.2a(9.P[0],9.P[1])}});X.7T=X.1C.N({1e:f(l,m){9.r=$(l).1F(\'2n\',0);9.2R=M 1b(\'7S\').5K(9.r).1F(\'7R\',\'3S\').5J(9.r);9.2N({\'1k\':\'4E\'},m);9.P=[];9.1t(9.m)},2E:f(){I(k i=0;i<2;i++)9.P[i]=9.2D(9.F[i],9.B[i])},4E:f(){9.2n=\'2w\';9.4V=\'3i\';9.2S=9.r.2v;h[9.r.1W(\'2n-2w\').2C(),9.2R.1W(\'3i\').2C()]},4G:f(){9.2n=\'2i\';9.4V=\'3j\';9.2S=9.r.2x;h[9.r.1W(\'2n-2i\').2C(),9.2R.1W(\'3j\').2C()]},5H:f(1k){h 9.1m(9[1k||9.m.1k](),[0,9.2S])},5G:f(1k){h 9.1m(9[1k||9.m.1k](),[-9.2S,0])},5I:f(1k){9[1k||9.m.1k]();h 9.1U([-9.2S,0])},7Q:f(1k){9[1k||9.m.1k]();h 9.1U([0,9.2S])},7P:f(1k){j(9.2R.2v==0||9.2R.2x==0)h 9.5H(1k);Q h 9.5G(1k)},2o:f(){9.r.1F(\'2n-\'+9.2n,9.P[0]+9.m.1J);9.2R.1F(9.4V,9.P[1]+9.m.1J)}});X.2Q={5F:f(t,b,c,d){h c*t/d+b},7O:f(t,b,c,d){h c*(t/=d)*t+b},7N:f(t,b,c,d){h-c*(t/=d)*(t-2)+b},7M:f(t,b,c,d){j((t/=d/2)<1)h c/2*t*t+b;h-c/2*((--t)*(t-2)-1)+b},7L:f(t,b,c,d){h c*(t/=d)*t*t+b},7K:f(t,b,c,d){h c*((t=t/d-1)*t*t+1)+b},7J:f(t,b,c,d){j((t/=d/2)<1)h c/2*t*t*t+b;h c/2*((t-=2)*t*t+2)+b},7I:f(t,b,c,d){h c*(t/=d)*t*t*t+b},7H:f(t,b,c,d){h-c*((t=t/d-1)*t*t*t-1)+b},7G:f(t,b,c,d){j((t/=d/2)<1)h c/2*t*t*t*t+b;h-c/2*((t-=2)*t*t*t-2)+b},7F:f(t,b,c,d){h c*(t/=d)*t*t*t*t+b},7E:f(t,b,c,d){h c*((t=t/d-1)*t*t*t*t+1)+b},7D:f(t,b,c,d){j((t/=d/2)<1)h c/2*t*t*t*t*t+b;h c/2*((t-=2)*t*t*t*t+2)+b},7C:f(t,b,c,d){h-c*G.4T(t/d*(G.1X/2))+c+b},7B:f(t,b,c,d){h c*G.3n(t/d*(G.1X/2))+b},4U:f(t,b,c,d){h-c/2*(G.4T(G.1X*t/d)-1)+b},7A:f(t,b,c,d){h(t==0)?b:c*G.22(2,10*(t/d-1))+b},7z:f(t,b,c,d){h(t==d)?b+c:c*(-G.22(2,-10*t/d)+1)+b},7y:f(t,b,c,d){j(t==0)h b;j(t==d)h b+c;j((t/=d/2)<1)h c/2*G.22(2,10*(t-1))+b;h c/2*(-G.22(2,-10*--t)+2)+b},7x:f(t,b,c,d){h-c*(G.3m(1-(t/=d)*t)-1)+b},7w:f(t,b,c,d){h c*G.3m(1-(t=t/d-1)*t)+b},7v:f(t,b,c,d){j((t/=d/2)<1)h-c/2*(G.3m(1-t*t)-1)+b;h c/2*(G.3m(1-(t-=2)*t)+1)+b},7u:f(t,b,c,d,a,p){j(t==0)h b;j((t/=d)==1)h b+c;j(!p)p=d*.3;j(!a)a=1;j(a<G.4S(c)){a=c;k s=p/4}Q k s=p/(2*G.1X)*G.4R(c/a);h-(a*G.22(2,10*(t-=1))*G.3n((t*d-s)*(2*G.1X)/p))+b},7t:f(t,b,c,d,a,p){j(t==0)h b;j((t/=d)==1)h b+c;j(!p)p=d*.3;j(!a)a=1;j(a<G.4S(c)){a=c;k s=p/4}Q k s=p/(2*G.1X)*G.4R(c/a);h a*G.22(2,-10*t)*G.3n((t*d-s)*(2*G.1X)/p)+c+b},7s:f(t,b,c,d,a,p){j(t==0)h b;j((t/=d/2)==2)h b+c;j(!p)p=d*(.3*1.5);j(!a)a=1;j(a<G.4S(c)){a=c;k s=p/4}Q k s=p/(2*G.1X)*G.4R(c/a);j(t<1)h-.5*(a*G.22(2,10*(t-=1))*G.3n((t*d-s)*(2*G.1X)/p))+b;h a*G.22(2,-10*(t-=1))*G.3n((t*d-s)*(2*G.1X)/p)*.5+c+b},7r:f(t,b,c,d,s){j(!s)s=1.4Q;h c*(t/=d)*t*((s+1)*t-s)+b},7q:f(t,b,c,d,s){j(!s)s=1.4Q;h c*((t=t/d-1)*t*((s+1)*t+s)+1)+b},7p:f(t,b,c,d,s){j(!s)s=1.4Q;j((t/=d/2)<1)h c/2*(t*t*(((s*=(1.5E))+1)*t-s))+b;h c/2*((t-=2)*t*(((s*=(1.5E))+1)*t+s)+2)+b},5D:f(t,b,c,d){h c-X.2Q.4P(d-t,0,c,d)+b},4P:f(t,b,c,d){j((t/=d)<(1/2.75)){h c*(7.3R*t*t)+b}Q j(t<(2/2.75)){h c*(7.3R*(t-=(1.5/2.75))*t+.75)+b}Q j(t<(2.5/2.75)){h c*(7.3R*(t-=(2.25/2.75))*t+.7o)+b}Q{h c*(7.3R*(t-=(2.7n/2.75))*t+.7m)+b}},7l:f(t,b,c,d){j(t<d/2)h X.2Q.5D(t*2,0,c,d)*.5+b;h X.2Q.4P(t*2-d,0,c,d)*.5+c*.5+b}};k 2L={};2L.1C=M 11({2j:f(){h{3k:T,1J:\'4I\',2K:11.1G,2g:11.1G,5B:11.1G,4A:11.1G,1j:T,2u:{x:\'2i\',y:\'2w\'},3N:6}},1e:f(l,m){9.2N(9.2j(),m);9.r=$(l);9.3k=$(9.m.3k)||9.r;9.2l={\'P\':{},\'1D\':{}};9.K={\'1m\':{},\'P\':{}};9.1I={\'1m\':9.1m.2y(9)};9.3k.1a(\'4H\',9.1I.1m);j(9.m.1e)9.m.1e.1i(9)},1m:f(o){9.2l.1m=o.1y;k 1j=9.m.1j;9.1j={\'x\':[],\'y\':[]};I(k z W 9.m.2u){9.K.P[z]=9.r.1W(9.m.2u[z]).2C();9.2l.1D[z]=o.1y[z]-9.K.P[z];j(1j&&1j[z]){I(k i=0;i<2;i++){j($2B(1j[z][i]))9.1j[z][i]=1j[z][i].2m?1j[z][i].1i(9):1j[z][i]}}}9.1I.29=9.29.2y(9);9.1I.3l=9.3l.2y(9);9.1I.1s=9.1s.J(9);L.1a(\'2P\',9.m.3N?9.1I.3l:9.1I.29);L.1a(\'5A\',9.1I.1s);9.1x(\'2K\',9.r);o.1s()},3l:f(o){k 5C=G.3e(G.3m(G.22(o.1y.x-9.2l.1m.x,2)+G.22(o.1y.y-9.2l.1m.y,2)));j(5C>9.m.3N){L.1E(\'2P\',9.1I.3l);L.1a(\'2P\',9.1I.29);9.29(o);9.1x(\'5B\',9.r)}o.1s()},29:f(o){9.4O=T;9.2l.P=o.1y;I(k z W 9.m.2u){9.K.P[z]=o.1y[z]-9.2l.1D[z];j(9.1j[z]){j($2B(9.1j[z][1])&&(9.K.P[z]>9.1j[z][1])){9.K.P[z]=9.1j[z][1];9.4O=1g}Q j($2B(9.1j[z][0])&&(9.K.P[z]<9.1j[z][0])){9.K.P[z]=9.1j[z][0];9.4O=1g}}9.r.1F(9.m.2u[z],9.K.P[z]+9.m.1J)}9.1x(\'4A\',9.r);o.1s()},7k:f(){9.3k.1E(\'4H\',9.1I.1m)},1s:f(){L.1E(\'2P\',9.1I.29);L.1E(\'5A\',9.1I.1s);9.1x(\'2g\',9.r)}});2L.1C.1T(M 3c);2L.1C.1T(M 3b);1b.N({7j:f(m){h M 2L.1C(9,1H.N(m||{},{2u:{x:\'3j\',y:\'3i\'}}))}});k 4J=M 11({2j:f(){h{3h:20,4K:1,3K:f(x,y){9.r.2a(x,y)}}},1e:f(r,m){9.2N(9.2j(),m);9.r=$(r);9.4M=([12,L].15(r))?$(L.4N):9.r},1m:f(){9.4L=9.5z.2y(9);9.4M.1a(\'2P\',9.4L)},1s:f(){9.4M.1E(\'2P\',9.4L);9.1f=$3Q(9.1f)},5z:f(o){9.1y=(9.r==12)?o.5y:o.1y;j(!9.1f)9.1f=9.1V.2k(50,9)},1V:f(){k l=9.r.3P();k 1D=9.r.2O();k 2z={\'x\':0,\'y\':0};I(k z W 9.1y){j(9.1y[z]<(9.m.3h+1D[z])&&l.1V[z]!=0)2z[z]=(9.1y[z]-9.m.3h-1D[z])*9.m.4K;Q j(9.1y[z]+9.m.3h>(l.2A[z]+1D[z])&&l.1V[z]+l.2A[z]!=l.3O[z])2z[z]=(9.1y[z]-l.2A[z]+9.m.3h-1D[z])*9.m.4K}j(2z.y||2z.x)9.1x(\'3K\',[l.1V.x+2z.x,l.1V.y+2z.y])}});4J.1T(M 3c);4J.1T(M 3b);k 4t=M 11({2j:f(){h{3K:11.1G,2g:11.1G,4x:f(1D){9.21.1F(9.p,1D+\'4I\')},3d:3g,1k:\'4G\',3f:T}},1e:f(l,21,m){9.r=$(l);9.21=$(21);9.2N(9.2j(),m);9.4w=-1;9.4v=-1;9.19=-1;9.r.1a(\'4H\',9.5w.2y(9));j(9.m.3f)9.r.1a(\'2M\',9.5x.2y(9));j(9.m.1k==\'4G\'){9.z=\'x\';9.p=\'2i\';9.1B=9.r.2x-9.21.2x;9.4y=9.21.2x/2;9.4z=9.r.4F.J(9.r)}Q j(9.m.1k==\'4E\'){9.z=\'y\';9.p=\'2w\';9.1B=9.r.2v-9.21.2v;9.4y=9.21.2v/2;9.4z=9.r.4D.J(9.r)}9.21.1F(\'1Z\',\'7i\').1F(9.p,0);k 4B={},4C={};4C[9.z]=[0,9.1B];4B[9.z]=9.p;9.29=M 2L.1C(9.21,{1j:4C,3N:0,2u:4B,2K:f(){9.3M()}.J(9),4A:f(){9.3M()}.J(9),2g:f(){9.3M();9.2h()}.J(9)});j(9.m.1e)9.m.1e.1i(9)},1U:f(19){j(19>9.m.3d)19=9.m.3d;Q j(19<0)19=0;9.19=19;9.3L();9.2h();9.1x(\'4x\',9.5v(9.19)+\'\');h 9},5x:f(o){j(o.3f<0)9.1U(9.19+1);Q j(o.3f>0)9.1U(9.19-1);o.1s()},5w:f(o){k 1Z=o.1y[9.z]-9.4z()-9.4y;j(1Z>9.1B)1Z=9.1B;Q j(1Z<0)1Z=0;9.19=9.4u(1Z);9.3L();9.2h();9.1x(\'4x\',1Z+\'\')},3M:f(){9.19=9.4u(9.29.K.P[9.z]);9.3L()},3L:f(){j(9.4w!=9.19){9.4w=9.19;9.1x(\'3K\',9.19)}},2h:f(){j(9.4v!==9.19){9.4v=9.19;9.1x(\'2g\',9.19+\'\')}},4u:f(1Z){h G.3e(1Z/9.1B*9.m.3d)},5v:f(19){h(9.1B)*19/9.m.3d}});4t.1T(M 3c);4t.1T(M 3b);',62,619,'|||||||||this||||||function||return||if|var|el|options|property|event||type|element|||obj|||||||to||||from|Math||for|bind|value|document|new|extend|fn|now|else|args||false|prototype|events|in|Fx|arguments|||Class|window||length|test||css|push|step|addEvent|Element|case|className|initialize|timer|true|style|call|limit|mode|rgb|start|parsed|each|found|param|Array|stop|parent|keys|selector|elements|fireEvent|page|values|color|max|Base|pos|removeEvent|setStyle|empty|Object|bound|unit|null|source|parse|Elements|key|break|filters|array|properties|implement|set|scroll|getStyle|PI|opacity|position||knob|pow|CSS|name||parentNode||match|drag|scrollTo|iCss|switch|delay|create|current|onComplete|end|left|getOptions|periodical|mouse|apply|margin|increase|iTo|Color|documentElement|previous|returns|modifiers|offsetHeight|top|offsetWidth|bindWithEvent|change|size|chk|toInt|compute|setNow|getValue|getElementsBySelector|chains|HTMLElement|hex|onStart|Drag|mousewheel|setOptions|getOffsets|mousemove|Transitions|wrapper|offset|wait|select|getNow|fx|fromTo|time|id|att|Garbage||text|while|replace|newArray||||item|Options|Events|steps|round|wheel|100|area|height|width|handle|checkAndDrag|sqrt|sin|min|iNow|iFrom|join|hexToRgb|parseFloat|domready|domReady|ie|alpha|colors|undefined|hasClass|getElements|getTag|filter|option|Event|toLowerCase|target|rgbToHex|items|onChange|checkStep|draggedKnob|snap|scrollSize|getSize|clear|5625|hidden|Multi|scrollLeft|scrollTop|khtml|readyState|loaded|remove||tagName|getElement|sel|getElementById|clean||splice|preventDefault|stopPropagation|relatedTarget|offsetTop|offsetLeft|setProperty|attribute|whitespace|indexOf|currentStyle|visibility|string|appendChild|inject|instanceof|ms|attempt|bit|forEach|pr0t0typ3|klass|Slider|toStep|previousEnd|previousChange|onTick|half|getPos|onDrag|modSlide|limSlide|getTop|vertical|getLeft|horizontal|mousedown|px|Scroller|velocity|coord|mousemover|body|out|bounceOut|70158|asin|abs|cos|sineInOut|layout|iProps|map|split|duration||opera|script|ie6|copy|operator|getElementsByTagName|els|on|Function|right|pageY|pageX|code|String|DOMMouseScroll|trash|removeEvents|offs|getBrother|getNext|what|gecko|camelCase|object|Native|result|typeof|parseInt|charAt|results|toPosition|clickedElement|scrolledElement|client|getCoords|mouseup|onSnap|distance|bounceIn|525|linear|slideOut|slideIn|hide|adopt|injectAfter|toElement|full|number|iParsed|Styles|Style|Single|Chain|onCancel|fps|getTime|Date|cTime|transition|callChain|getScrollHeight|getScrollWidth|getHeight|getWidth|getScrollTop|getScrollLeft|pageXOffset|pageYOffset|scrollWidth|scrollHeight|clientHeight|clientWidth|init|complete|ie_ready|catch|try|invert|mix|Hash|getAttribute|filterByAttribute|filterByTagName|filterByClassName|filterById|w_|defaults|which|clientY|clientX|special|120|wheelDelta|nodeType|unload|collect|selectedIndex|bottom|class|html|setAttribute|default|replaceWith|createElement|setStyles|childNodes|Sibling|evType|removeEventListener|addEventListener|hyphenate|defaultView|visible|setOpacity|cssText|addClass|removeClass|contents|inside|after|before|insertBefore|where|_elements_extended_|_element_extended_|err|toFloat||Number|trim|toUpperCase|params|regex|iterable|some|every|random|picked|parentize|noinit|relative|makeResizable|detach|bounceInOut|984375|625|9375|backInOut|backOut|backIn|elasticInOut|elasticOut|elasticIn|circInOut|circOut|circIn|expoInOut|expoOut|expoIn|sineOut|sineIn|quintInOut|quintOut|quintIn|quartInOut|quartOut|quartIn|cubicInOut|cubicOut|cubicIn|quadInOut|quadOut|quadIn|toggle|show|overflow|div|Slide|toRight|toLeft|toBottom|toTop|Scroll|effects|effect|clearTimer|custom|1000|500|innerHeight|innerWidth|onDomReady|DOMContentLoaded|load|onreadystatechange|void|javascript|src|defer|write|BackgroundImageCache|execCommand|disableImageCache|255|pop|get|tag|getElementsByClassName|ES|clearChain|chain|delete|backspace|space|esc|down|up|enter|returnValue|cancelBubble|mouseout|fromElement|mouseover|button|rightClick|click|fromCharCode|keyCode|detail|metaKey|meta|altKey|alt|ctrlKey|control|shiftKey|shift|srcElement|Window|textarea|password|radio|checkbox|checked|input|getPosition|offsetParent|do|getProperty|innerHTML|setHTML|setProperties|attributes|getChildren|getParent|previousSibling|lastChild|getLast|nextSibling|firstChild|getFirst|next|getPrevious|detachEvent|addEvents|attachEvent|getPropertyValue|getComputedStyle|padding|zoom|hasLayout|toggleClass|createTextNode|styleSheet|appendText|replaceChild|cloneNode|clone|removeChild|injectInside|injectBefore|embed|bindAsEventListener|pass|finally|setInterval|setTimeout|concat|toString|transparent|capitalize|RegExp|associate|getBoxObjectFor|taintEnabled|navigator|all|ie7|XMLHttpRequest|ActiveXObject|clearInterval|clearTimeout|floor|pick|textnode|nodeValue|nodeName'.split('|'),0,{}))
--- /dev/null
+/*
+Script: Moo.js
+ My Object Oriented javascript.
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+
+Credits:
+ - Class is slightly based on Base.js <http://dean.edwards.name/weblog/2006/03/base/> (c) 2006 Dean Edwards, License <http://creativecommons.org/licenses/LGPL/2.1/>
+ - Some functions are based on those found in prototype.js <http://prototype.conio.net/> (c) 2005 Sam Stephenson sam [at] conio [dot] net, MIT-style license
+ - Documentation by Aaron Newton (aaron.newton [at] cnet [dot] com) and Valerio Proietti.
+*/
+
+/*
+Class: Class
+ The base class object of the <http://mootools.net> framework.
+
+Arguments:
+ properties - the collection of properties that apply to the class. Creates a new class, its initialize method will fire upon class instantiation.
+
+Example:
+ (start code)
+ var Cat = new Class({
+ initialize: function(name){
+ this.name = name;
+ }
+ });
+ var myCat = new Cat('Micia');
+ alert myCat.name; //alerts 'Micia'
+ (end)
+*/
+
+var Class = function(properties){
+ var klass = function(){
+ if (this.initialize && arguments[0] != 'noinit') return this.initialize.apply(this, arguments);
+ else return this;
+ };
+ for (var property in this) klass[property] = this[property];
+ klass.prototype = properties;
+ return klass;
+};
+
+/*
+Property: empty
+ Returns an empty function
+*/
+
+Class.empty = function(){};
+
+Class.prototype = {
+
+ /*
+ Property: extend
+ Returns the copy of the Class extended with the passed in properties.
+
+ Arguments:
+ properties - the properties to add to the base class in this new Class.
+
+ Example:
+ (start code)
+ var Animal = new Class({
+ initialize: function(age){
+ this.age = age;
+ }
+ });
+ var Cat = Animal.extend({
+ initialize: function(name, age){
+ this.parent(age); //will call the previous initialize;
+ this.name = name;
+ }
+ });
+ var myCat = new Cat('Micia', 20);
+ alert myCat.name; //alerts 'Micia'
+ alert myCat.age; //alerts 20
+ (end)
+ */
+
+ extend: function(properties){
+ var pr0t0typ3 = new this('noinit');
+
+ var parentize = function(previous, current){
+ if (!previous.apply || !current.apply) return false;
+ return function(){
+ this.parent = previous;
+ return current.apply(this, arguments);
+ };
+ };
+
+ for (var property in properties){
+ var previous = pr0t0typ3[property];
+ var current = properties[property];
+ if (previous && previous != current) current = parentize(previous, current) || current;
+ pr0t0typ3[property] = current;
+ }
+ return new Class(pr0t0typ3);
+ },
+
+ /*
+ Property: implement
+ Implements the passed in properties to the base Class prototypes, altering the base class, unlike <Class.extend>.
+
+ Arguments:
+ properties - the properties to add to the base class.
+
+ Example:
+ (start code)
+ var Animal = new Class({
+ initialize: function(age){
+ this.age = age;
+ }
+ });
+ Animal.implement({
+ setName: function(name){
+ this.name = name
+ }
+ });
+ var myAnimal = new Animal(20);
+ myAnimal.setName('Micia');
+ alert(myAnimal.name); //alerts 'Micia'
+ (end)
+ */
+
+ implement: function(properties){
+ for (var property in properties) this.prototype[property] = properties[property];
+ }
+
+};
+
+/* Section: Object related Functions */
+
+/*
+Function: Object.extend
+ Copies all the properties from the second passed object to the first passed Object.
+ If you do myWhatever.extend = Object.extend the first parameter will become myWhatever, and your extend function will only need one parameter.
+
+Example:
+ (start code)
+ var firstOb = {
+ 'name': 'John',
+ 'lastName': 'Doe'
+ };
+ var secondOb = {
+ 'age': '20',
+ 'sex': 'male',
+ 'lastName': 'Dorian'
+ };
+ Object.extend(firstOb, secondOb);
+ //firstOb will become:
+ {
+ 'name': 'John',
+ 'lastName': 'Dorian',
+ 'age': '20',
+ 'sex': 'male'
+ };
+ (end)
+
+Returns:
+ The first object, extended.
+*/
+
+Object.extend = function(){
+ var args = arguments;
+ args = (args[1]) ? [args[0], args[1]] : [this, args[0]];
+ for (var property in args[1]) args[0][property] = args[1][property];
+ return args[0];
+};
+
+/*
+Function: Object.Native
+ Will add a .extend method to the objects passed as a parameter, equivalent to <Class.implement>
+
+Arguments:
+ a number of classes/native javascript objects
+
+*/
+
+Object.Native = function(){
+ for (var i = 0; i < arguments.length; i++) arguments[i].extend = Class.prototype.implement;
+};
+
+new Object.Native(Function, Array, String, Number, Class);
+
+/*
+Script: Utility.js
+ Contains Utility functions
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+//htmlelement mapping
+
+if (typeof HTMLElement == 'undefined'){
+ var HTMLElement = Class.empty;
+ HTMLElement.prototype = {};
+}
+
+/*
+Function: $type
+ Returns the type of object that matches the element passed in.
+
+Arguments:
+ obj - the object to inspect.
+
+Example:
+ >var myString = 'hello';
+ >$type(myString); //returns "string"
+
+Returns:
+ 'element' - if obj is a DOM element node
+ 'textnode' - if obj is a DOM text node
+ 'whitespace' - if obj is a DOM whitespace node
+ 'array' - if obj is an array
+ 'object' - if obj is an object
+ 'string' - if obj is a string
+ 'number' - if obj is a number
+ 'boolean' - if obj is a boolean
+ 'function' - if obj is a function
+ false - (boolean) if the object is not defined or none of the above.
+*/
+
+function $type(obj){
+ if (obj === null || obj === undefined) return false;
+ var type = typeof obj;
+ if (type == 'object'){
+ if (obj instanceof HTMLElement) return 'element';
+ if (obj instanceof Array) return 'array';
+ if (obj.nodeName){
+ switch (obj.nodeType){
+ case 1: return 'element';
+ case 3: return obj.nodeValue.test('\\S') ? 'textnode' : 'whitespace';
+ }
+ }
+ }
+ return type;
+};
+
+/*
+Function: $chk
+ Returns true if the passed in value/object exists or is 0, otherwise returns false.
+ Useful to accept zeroes.
+*/
+
+function $chk(obj){
+ return !!(obj || obj === 0);
+};
+
+/*
+Function: $pick
+ Returns the first object if defined, otherwise returns the second.
+*/
+
+function $pick(obj, picked){
+ return ($type(obj)) ? obj : picked;
+};
+
+/*
+Function: $random
+ Returns a random integer number between the two passed in values.
+
+Arguments:
+ min - integer, the minimum value (inclusive).
+ max - integer, the maximum value (inclusive).
+
+Returns:
+ a random integer between min and max.
+*/
+
+function $random(min, max){
+ return Math.floor(Math.random() * (max - min + 1) + min);
+};
+
+/*
+Function: $clear
+ clears a timeout or an Interval.
+
+Returns:
+ null
+
+Arguments:
+ timer - the setInterval or setTimeout to clear.
+
+Example:
+ >var myTimer = myFunction.delay(5000); //wait 5 seconds and execute my function.
+ >myTimer = $clear(myTimer); //nevermind
+
+See also:
+ <Function.delay>, <Function.periodical>
+*/
+
+function $clear(timer){
+ clearTimeout(timer);
+ clearInterval(timer);
+ return null;
+};
+
+/* Section: Browser Detection */
+
+/*
+Properties:
+ window.ie - will be set to true if the current browser is internet explorer (any).
+ window.ie6 - will be set to true if the current browser is internet explorer 6.
+ window.ie7 - will be set to true if the current browser is internet explorer 7.
+ window.khtml - will be set to true if the current browser is Safari/Konqueror.
+ window.gecko - will be set to true if the current browser is Mozilla/Gecko.
+*/
+
+if (window.ActiveXObject) window.ie = window[window.XMLHttpRequest ? 'ie7' : 'ie6'] = true;
+else if (document.childNodes && !document.all && !navigator.taintEnabled) window.khtml = true;
+else if (document.getBoxObjectFor != null) window.gecko = true;
+
+/*
+Script: Array.js
+ Contains Array prototypes and the function <$A>;
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Array
+ A collection of The Array Object prototype methods.
+*/
+
+//emulated methods
+
+/*
+Property: forEach
+ Iterates through an array; This method is only available for browsers without native *forEach* support.
+ For more info see <http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Reference:Global_Objects:Array:forEach>
+*/
+
+Array.prototype.forEach = Array.prototype.forEach || function(fn, bind){
+ for (var i = 0; i < this.length; i++) fn.call(bind, this[i], i, this);
+};
+
+/*
+Property: map
+ This method is provided only for browsers without native *map* support.
+ For more info see <http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Reference:Global_Objects:Array:map>
+*/
+
+Array.prototype.map = Array.prototype.map || function(fn, bind){
+ var results = [];
+ for (var i = 0; i < this.length; i++) results[i] = fn.call(bind, this[i], i, this);
+ return results;
+};
+
+/*
+Property: every
+ This method is provided only for browsers without native *every* support.
+ For more info see <http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Reference:Global_Objects:Array:every>
+*/
+
+Array.prototype.every = Array.prototype.every || function(fn, bind){
+ for (var i = 0; i < this.length; i++){
+ if (!fn.call(bind, this[i], i, this)) return false;
+ }
+ return true;
+};
+
+/*
+Property: some
+ This method is provided only for browsers without native *some* support.
+ For more info see <http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Reference:Global_Objects:Array:some>
+*/
+
+Array.prototype.some = Array.prototype.some || function(fn, bind){
+ for (var i = 0; i < this.length; i++){
+ if (fn.call(bind, this[i], i, this)) return true;
+ }
+ return false;
+};
+
+/*
+Property: indexOf
+ This method is provided only for browsers without native *indexOf* support.
+ For more info see <http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Reference:Global_Objects:Array:indexOf>
+*/
+
+Array.prototype.indexOf = Array.prototype.indexOf || function(item, from){
+ from = from || 0;
+ if (from < 0) from = Math.max(0, this.length + from);
+ while (from < this.length){
+ if(this[from] === item) return from;
+ from++;
+ }
+ return -1;
+};
+
+//custom methods
+
+Array.extend({
+
+ /*
+ Property: each
+ Same as <Array.forEach>.
+
+ Arguments:
+ fn - the function to execute with each item in the array
+ bind - optional, the object that the "this" of the function will refer to.
+
+ Example:
+ >var Animals = ['Cat', 'Dog', 'Coala'];
+ >Animals.forEach(function(animal){
+ > document.write(animal)
+ >});
+ */
+
+ each: Array.prototype.forEach,
+
+ /*
+ Property: copy
+ Copy the array and returns it.
+
+ Returns:
+ an Array
+
+ Example:
+ >var letters = ["a","b","c"];
+ >var copy = ["a","b","c"].copy();
+ */
+
+ copy: function(){
+ var newArray = [];
+ for (var i = 0; i < this.length; i++) newArray[i] = this[i];
+ return newArray;
+ },
+
+ /*
+ Property: remove
+ Removes all occurrences of an item from the array.
+
+ Arguments:
+ item - the item to remove
+
+ Returns:
+ the Array with all occurrences of the item removed.
+
+ Example:
+ >["1","2","3","2"].remove("2") // ["1","3"];
+ */
+
+ remove: function(item){
+ var i = 0;
+ while (i < this.length){
+ if (this[i] == item) this.splice(i, 1);
+ else i++;
+ }
+ return this;
+ },
+
+ /*
+ Property: test
+ Tests an array for the presence of an item.
+
+ Arguments:
+ item - the item to search for in the array.
+ from - optional, the index at which to begin the search, default is 0. If negative, it is taken as the offset from the end of the array.
+
+ Returns:
+ true - the item was found
+ false - it wasn't
+
+ Example:
+ >["a","b","c"].test("a"); // true
+ >["a","b","c"].test("d"); // false
+ */
+
+ test: function(item, from){
+ return this.indexOf(item, from) != -1;
+ },
+
+ /*
+ Property: extend
+ Extends an array with another
+
+ Arguments:
+ newArray - the array to extend ours with
+
+ Example:
+ >var Animals = ['Cat', 'Dog', 'Coala'];
+ >Animals.extend(['Lizard']);
+ >//Animals is now: ['Cat', 'Dog', 'Coala', 'Lizard'];
+ */
+
+ extend: function(newArray){
+ for (var i = 0; i < newArray.length; i++) this.push(newArray[i]);
+ return this;
+ },
+
+ /*
+ Property: associate
+ Creates an object with key-value pairs based on the array of keywords passed in
+ and the current content of the array.
+
+ Arguments:
+ keys - the array of keywords.
+
+ Example:
+ (start code)
+ var Animals = ['Cat', 'Dog', 'Coala', 'Lizard'];
+ var Speech = ['Miao', 'Bau', 'Fruuu', 'Mute'];
+ var Speeches = Animals.associate(speech);
+ //Speeches['Miao'] is now Cat.
+ //Speeches['Bau'] is now Dog.
+ //...
+ (end)
+ */
+
+ associate: function(keys){
+ var obj = {}, length = Math.min(this.length, keys.length);
+ for (var i = 0; i < length; i++) obj[keys[i]] = this[i];
+ return obj;
+ }
+
+});
+
+/* Section: Utility Functions */
+
+/*
+Function: $A()
+ Same as <Array.copy>, but as function.
+ Useful to apply Array prototypes to iterable objects, as a collection of DOM elements or the arguments object.
+
+Example:
+ (start code)
+ function myFunction(){
+ $A(arguments).each(argument, function(){
+ alert(argument);
+ });
+ };
+ //the above will alert all the arguments passed to the function myFunction.
+ (end)
+*/
+
+function $A(array){
+ return Array.prototype.copy.call(array);
+};
+
+/*
+Function: $each
+ use to iterate through iterables that are not regular arrays, such as builtin getElementsByTagName calls, or arguments of a function.
+
+Arguments:
+ iterable - an iterable element.
+ function - function to apply to the iterable.
+ bind - optional, the 'this' of the function will refer to this object.
+*/
+
+function $each(iterable, fn, bind){
+ return Array.prototype.forEach.call(iterable, fn, bind);
+};
+
+/*
+Script: String.js
+ Contains String prototypes and Number prototypes.
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: String
+ A collection of The String Object prototype methods.
+*/
+
+String.extend({
+
+ /*
+ Property: test
+ Tests a string with a regular expression.
+
+ Arguments:
+ regex - the regular expression you want to match the string with
+ params - optional, any parameters you want to pass to the regex ('g' has no effect)
+
+ Returns:
+ true if a match for the regular expression is found in the string, false if not.
+ See <http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Reference:Objects:RegExp:test>
+
+ Example:
+ >"I like cookies".test("cookie"); // returns true
+ >"I like cookies".test("COOKIE", "i") // ignore case, returns true
+ >"I like cookies".test("cake"); // returns false
+ */
+
+ test: function(regex, params){
+ return new RegExp(regex, params).test(this);
+ },
+
+ /*
+ Property: toInt
+ parses a string to an integer.
+
+ Returns:
+ either an int or "NaN" if the string is not a number.
+
+ Example:
+ >var value = "10px".toInt(); // value is 10
+ */
+
+ toInt: function(){
+ return parseInt(this);
+ },
+
+ toFloat: function(){
+ return parseFloat(this);
+ },
+
+ /*
+ Property: camelCase
+ Converts a hiphenated string to a camelcase string.
+
+ Example:
+ >"I-like-cookies".camelCase(); //"ILikeCookies"
+
+ Returns:
+ the camel cased string
+ */
+
+ camelCase: function(){
+ return this.replace(/-\D/g, function(match){
+ return match.charAt(1).toUpperCase();
+ });
+ },
+
+ /*
+ Property: hyphenate
+ Converts a camelCased string to a hyphen-ated string.
+
+ Example:
+ >"ILikeCookies".hyphenate(); //"I-like-cookies"
+ */
+
+ hyphenate: function(){
+ return this.replace(/\w[A-Z]/g, function(match){
+ return (match.charAt(0)+'-'+match.charAt(1).toLowerCase());
+ });
+ },
+
+ /*
+ Property: capitalize
+ Converts the first letter in each word of a string to Uppercase.
+
+ Example:
+ >"i like cookies".capitalize(); //"I Like Cookies"
+
+ Returns:
+ the capitalized string
+ */
+
+ capitalize: function(){
+ return this.toLowerCase().replace(/\b[a-z]/g, function(match){
+ return match.toUpperCase();
+ });
+ },
+
+ /*
+ Property: trim
+ Trims the leading and trailing spaces off a string.
+
+ Example:
+ >" i like cookies ".trim() //"i like cookies"
+
+ Returns:
+ the trimmed string
+ */
+
+ trim: function(){
+ return this.replace(/^\s+|\s+$/g, '');
+ },
+
+ /*
+ Property: clean
+ trims (<String.trim>) a string AND removes all the double spaces in a string.
+
+ Returns:
+ the cleaned string
+
+ Example:
+ >" i like cookies \n\n".clean() //"i like cookies"
+ */
+
+ clean: function(){
+ return this.replace(/\s{2,}/g, ' ').trim();
+ },
+
+ /*
+ Property: rgbToHex
+ Converts an RGB value to hexidecimal. The string must be in the format of "rgb(255, 255, 255)" or "rgba(255, 255, 255, 1)";
+
+ Arguments:
+ array - boolean value, defaults to false. Use true if you want the array ['FF', '33', '00'] as output instead of #FF3300
+
+ Returns:
+ hex string or array. returns transparent if the fourth value of rgba in input string is 0,
+
+ Example:
+ >"rgb(17,34,51)".rgbToHex(); //"#112233"
+ >"rgba(17,34,51,0)".rgbToHex(); //"transparent"
+ >"rgb(17,34,51)".rgbToHex(true); //[11,22,33]
+ */
+
+ rgbToHex: function(array){
+ var rgb = this.match(/\d{1,3}/g);
+ return (rgb) ? rgb.rgbToHex(array) : false;
+ },
+
+ /*
+ Property: hexToRgb
+ Converts a hexidecimal color value to RGB. Input string must be the hex color value (with or without the hash). Also accepts triplets ('333');
+
+ Arguments:
+ array - boolean value, defaults to false. Use true if you want the array ['255', '255', '255'] as output instead of "rgb(255,255,255)";
+
+ Returns:
+ rgb string or array.
+
+ Example:
+ >"#112233".hexToRgb(); //"rgb(17,34,51)"
+ >"#112233".hexToRgb(true); //[17,34,51]
+ */
+
+ hexToRgb: function(array){
+ var hex = this.match('^#?(\\w{1,2})(\\w{1,2})(\\w{1,2})$');
+ return (hex) ? hex.hexToRgb(array) : false;
+ }
+
+});
+
+Array.extend({
+
+ rgbToHex: function(array){
+ if (this.length < 3) return false;
+ if (this[3] && this[3] == 0) return 'transparent';
+ var hex = [];
+ for (var i = 0; i < 3; i++){
+ var bit = (this[i]-0).toString(16);
+ hex.push(bit.length == 1 ? '0'+bit : bit);
+ }
+ return array ? hex : '#'+hex.join('');
+ },
+
+ hexToRgb: function(array){
+ if (this.length != 4) return false;
+ var rgb = [];
+ for (var i = 1; i < 4; i++){
+ if (this[i].length == 1) this[i] += this[i];
+ rgb.push(parseInt(this[i], 16));
+ }
+ return array ? rgb : 'rgb('+rgb.join(',')+')';
+ }
+
+});
+
+/*
+Class: Number
+ contains the internal method toInt.
+*/
+
+Number.extend({
+
+ /*
+ Property: toInt
+ Returns this number; useful because toInt must work on both Strings and Numbers.
+ */
+
+ toInt: function(){
+ return parseInt(this);
+ },
+
+ toFloat: function(){
+ return parseFloat(this);
+ }
+
+});
+
+/*
+Script: Function.js
+ Contains Function prototypes and utility functions .
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+
+Credits:
+ - Some functions are inspired by those found in prototype.js <http://prototype.conio.net/> (c) 2005 Sam Stephenson sam [at] conio [dot] net, MIT-style license
+*/
+
+/*
+Class: Function
+ A collection of The Function Object prototype methods.
+*/
+
+Function.extend({
+
+ create: function(options){
+ var fn = this;
+ options = Object.extend({
+ 'bind': fn,
+ 'event': false,
+ 'arguments': null,
+ 'delay': false,
+ 'periodical': false,
+ 'attempt': false
+ }, options || {});
+ if (options.arguments != null && typeof options.arguments != 'undefined' && !(options.arguments instanceof Array))
+ options.arguments = [options.arguments];
+ return function(event){
+ var args = options.arguments || arguments;
+ if (options.event){
+ event = (options.event === true) ? event || window.event : new options.event(event);
+ args = [event].concat(args);
+ }
+ var returns = function(){
+ return fn.apply(options.bind, args);
+ };
+ if (options.delay) return setTimeout(returns, options.delay);
+ if (options.periodical) return setInterval(returns, options.periodical);
+ if (options.attempt){
+ try {
+ var result = returns();
+ } catch(err){
+ result = err;
+ } finally {
+ return result;
+ }
+ } else return returns();
+ };
+ },
+
+ /*
+ Property: pass
+ Shortcut to create closures with arguments and bind.
+
+ Returns:
+ a function.
+
+ Arguments:
+ args - the arguments passed. must be an array if arguments > 1
+ bind - optional, the object that the "this" of the function will refer to.
+
+ Example:
+ >myFunction.pass([arg1, arg2], myElement);
+ */
+
+ pass: function(args, bind){
+ return this.create({'arguments': args, 'bind': bind});
+ },
+
+ /*
+ Property: attempt
+ Tries to execute the function, returns either the function results or the error.
+
+ Arguments:
+ args - the arguments passed. must be an array if arguments > 1
+ bind - optional, the object that the "this" of the function will refer to.
+
+ Example:
+ >myFunction.attempt([arg1, arg2], myElement);
+ */
+
+ attempt: function(args, bind){
+ return this.create({'arguments': args, 'bind': bind, 'attempt': true})();
+ },
+
+ /*
+ Property: bind
+ method to easily create closures with "this" altered.
+
+ Arguments:
+ bind - optional, the object that the "this" of the function will refer to.
+ args - optional, the arguments passed. must be an array if arguments > 1
+
+ Returns:
+ a function.
+
+ Example:
+ >function myFunction(){
+ > this.setStyle('color', 'red');
+ > // note that 'this' here refers to myFunction, not an element
+ > // we'll need to bind this function to the element we want to alter
+ >};
+ >var myBoundFunction = myFunction.bind(myElement);
+ >myBoundFunction(); // this will make the element myElement red.
+ */
+
+ bind: function(bind, args){
+ return this.create({'bind': bind, 'arguments': args});
+ },
+
+ /*
+ Property: bindAsEventListener
+ cross browser method to pass event firer
+
+ Arguments:
+ bind - optional, the object that the "this" of the function will refer to.
+ args - optional, the arguments passed. must be an array if arguments > 1
+
+ Returns:
+ a function with the parameter bind as its "this" and as a pre-passed argument event or window.event, depending on the browser.
+
+ Example:
+ >function myFunction(event){
+ > alert(event.clientx) //returns the coordinates of the mouse..
+ >};
+ >myElement.onclick = myFunction.bindAsEventListener(myElement);
+ */
+
+ bindAsEventListener: function(bind, args){
+ return this.create({'bind': bind, 'event': true, 'arguments': args});
+ },
+
+ /*
+ Property: delay
+ Delays the execution of a function by a specified duration.
+
+ Arguments:
+ ms - the duration to wait in milliseconds
+ bind - optional, the object that the "this" of the function will refer to.
+ args - optional, the arguments passed. must be an array if arguments > 1
+
+ Example:
+ >myFunction.delay(50, myElement) //wait 50 milliseconds, then call myFunction and bind myElement to it
+ >(function(){alert('one second later...')}).delay(1000); //wait a second and alert
+ */
+
+ delay: function(ms, bind, args){
+ return this.create({'delay': ms, 'bind': bind, 'arguments': args})();
+ },
+
+ /*
+ Property: periodical
+ Executes a function in the specified intervals of time
+
+ Arguments:
+ ms - the duration of the intervals between executions.
+ bind - optional, the object that the "this" of the function will refer to.
+ args - optional, the arguments passed. must be an array if arguments > 1
+ */
+
+ periodical: function(ms, bind, args){
+ return this.create({'periodical': ms, 'bind': bind, 'arguments': args})();
+ }
+
+});
+
+/*
+Script: Element.js
+ Contains useful Element prototypes, to be used with the dollar function <$>.
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+
+Credits:
+ - Some functions are inspired by those found in prototype.js <http://prototype.conio.net/> (c) 2005 Sam Stephenson sam [at] conio [dot] net, MIT-style license
+*/
+
+/*
+Class: Element
+ Custom class to allow all of its methods to be used with any DOM element via the dollar function <$>.
+*/
+
+var Element = new Class({
+
+ /*
+ Property: initialize
+ Creates a new element of the type passed in.
+
+ Arguments:
+ el - the tag name for the element you wish to create.
+
+ Example:
+ >var div = new Element('div');
+ */
+
+ initialize: function(el){
+ if ($type(el) == 'string') el = document.createElement(el);
+ return $(el);
+ }
+
+});
+
+/*
+Function: $()
+ returns the element passed in with all the Element prototypes applied.
+
+Arguments:
+ el - a reference to an actual element or a string representing the id of an element
+
+Example:
+ >$('myElement') // gets a DOM element by id with all the Element prototypes applied.
+ >var div = document.getElementById('myElement');
+ >$(div) //returns an Element also with all the mootools extentions applied.
+
+ You'll use this when you aren't sure if a variable is an actual element or an id, as
+ well as just shorthand for document.getElementById().
+
+Returns:
+ a DOM element or false (if no id was found).
+
+Note:
+ you need to call $ on an element only once to get all the prototypes.
+ But its no harm to call it multiple times, as it will detect if it has been already extended.
+*/
+
+function $(el){
+ if (!el) return false;
+ if (el._element_extended_ || [window, document].test(el)) return el;
+ if ($type(el) == 'string') el = document.getElementById(el);
+ if ($type(el) != 'element') return false;
+ if (['object', 'embed'].test(el.tagName.toLowerCase()) || el.extend) return el;
+ el._element_extended_ = true;
+ Garbage.collect(el);
+ el.extend = Object.extend;
+ if (!(el instanceof HTMLElement)) el.extend(Element.prototype);
+ return el;
+};
+
+//elements class
+
+var Elements = new Class({});
+
+new Object.Native(Elements);
+
+document.getElementsBySelector = document.getElementsByTagName;
+
+/*
+Function: $$()
+ Selects, and extends DOM elements.
+
+Arguments:
+ HTMLCollection(document.getElementsByTagName, element.childNodes), an array of elements, a string.
+
+Note:
+ if you loaded <Dom.js>, $$ will also accept CSS Selectors.
+
+Example:
+ >$$('a') //an array of all anchor tags on the page
+ >$$('a', 'b') //an array of all anchor and bold tags on the page
+ >$$('#myElement') //array containing only the element with id = myElement. (only with <Dom.js>)
+ >$$('#myElement a.myClass') //an array of all anchor tags with the class "myClass" within the DOM element with id "myElement" (only with <Dom.js>)
+
+Returns:
+ array - array of all the dom elements matched
+*/
+
+function $$(){
+ if (!arguments) return false;
+ if (arguments.length == 1){
+ if (!arguments[0]) return false;
+ if (arguments[0]._elements_extended_) return arguments[0];
+ }
+ var elements = [];
+ $each(arguments, function(selector){
+ switch ($type(selector)){
+ case 'element': elements.push($(selector)); break;
+ case 'string': selector = document.getElementsBySelector(selector);
+ default:
+ if (selector.length){
+ $each(selector, function(el){
+ if ($(el)) elements.push(el);
+ });
+ }
+ }
+ });
+ elements._elements_extended_ = true;
+ return Object.extend(elements, new Elements);
+};
+
+Elements.Multi = function(property){
+ return function(){
+ var args = arguments;
+ var items = [];
+ var elements = true;
+ $each(this, function(el){
+ var returns = el[property].apply(el, args);
+ if ($type(returns) != 'element') elements = false;
+ items.push(returns);
+ });
+ if (elements) items = $$(items);
+ return items;
+ };
+};
+
+Element.extend = function(properties){
+ for (var property in properties){
+ HTMLElement.prototype[property] = properties[property];
+ Element.prototype[property] = properties[property];
+ Elements.prototype[property] = Elements.Multi(property);
+ }
+};
+
+Element.extend({
+
+ inject: function(el, where){
+ el = $(el) || new Element(el);
+ switch (where){
+ case "before": $(el.parentNode).insertBefore(this, el); break;
+ case "after":
+ if (!el.getNext()) $(el.parentNode).appendChild(this);
+ else $(el.parentNode).insertBefore(this, el.getNext());
+ break;
+ case "inside": el.appendChild(this);
+ }
+ return this;
+ },
+
+ /*
+ Property: injectBefore
+ Inserts the Element before the passed element.
+
+ Parameteres:
+ el - a string representing the element to be injected in (myElementId, or div), or an element reference.
+ If you pass div or another tag, the element will be created.
+
+ Example:
+ >html:
+ ><div id="myElement"></div>
+ ><div id="mySecondElement"></div>
+ >js:
+ >$('mySecondElement').injectBefore('myElement');
+ >resulting html:
+ ><div id="mySecondElement"></div>
+ ><div id="myElement"></div>
+
+ */
+
+ injectBefore: function(el){
+ return this.inject(el, 'before');
+ },
+
+ /*
+ Property: injectAfter
+ Same as <Element.injectBefore>, but inserts the element after.
+ */
+
+ injectAfter: function(el){
+ return this.inject(el, 'after');
+ },
+
+ /*
+ Property: injectInside
+ Same as <Element.injectBefore>, but inserts the element inside.
+ */
+
+ injectInside: function(el){
+ return this.inject(el, 'inside');
+ },
+
+ /*
+ Property: adopt
+ Inserts the passed element inside the Element. Works as <Element.injectInside> but in reverse.
+
+ Parameteres:
+ el - a string representing the element to be injected in (myElementId, or div), or an element reference.
+ If you pass div or another tag, the element will be created.
+ */
+
+ adopt: function(el){
+ this.appendChild($(el) || new Element(el));
+ return this;
+ },
+
+ /*
+ Property: remove
+ Removes the Element from the DOM.
+
+ Example:
+ >$('myElement').remove() //bye bye
+ */
+
+ remove: function(){
+ this.parentNode.removeChild(this);
+ return this;
+ },
+
+ /*
+ Property: clone
+ Clones the Element and returns the cloned one.
+
+ Returns:
+ the cloned element
+
+ Example:
+ >var clone = $('myElement').clone().injectAfter('myElement');
+ >//clones the Element and append the clone after the Element.
+ */
+
+ clone: function(contents){
+ var el = this.cloneNode(contents !== false);
+ return $(el);
+ },
+
+ /*
+ Property: replaceWith
+ Replaces the Element with an element passed.
+
+ Parameteres:
+ el - a string representing the element to be injected in (myElementId, or div), or an element reference.
+ If you pass div or another tag, the element will be created.
+
+ Returns:
+ the passed in element
+
+ Example:
+ >$('myOldElement').replaceWith($('myNewElement')); //$('myOldElement') is gone, and $('myNewElement') is in its place.
+ */
+
+ replaceWith: function(el){
+ el = $(el) || new Element(el);
+ this.parentNode.replaceChild(el, this);
+ return el;
+ },
+
+ /*
+ Property: appendText
+ Appends text node to a DOM element.
+
+ Arguments:
+ text - the text to append.
+
+ Example:
+ ><div id="myElement">hey</div>
+ >$('myElement').appendText(' howdy'); //myElement innerHTML is now "hey howdy"
+ */
+
+ appendText: function(text){
+ if (window.ie){
+ switch(this.getTag()){
+ case 'style': this.styleSheet.cssText = text; return this;
+ case 'script': this.setProperty('text', text); return this;
+ }
+ }
+ this.appendChild(document.createTextNode(text));
+ return this;
+ },
+
+ /*
+ Property: hasClass
+ Tests the Element to see if it has the passed in className.
+
+ Returns:
+ true - the Element has the class
+ false - it doesn't
+
+ Arguments:
+ className - the class name to test.
+
+ Example:
+ ><div id="myElement" class="testClass"></div>
+ >$('myElement').hasClass('testClass'); //returns true
+ */
+
+ hasClass: function(className){
+ return this.className.test('(?:^|\\s+)' + className + '(?:\\s+|$)');
+ },
+
+ /*
+ Property: addClass
+ Adds the passed in class to the Element, if the element doesnt already have it.
+
+ Arguments:
+ className - the class name to add
+
+ Example:
+ ><div id="myElement" class="testClass"></div>
+ >$('myElement').addClass('newClass'); //<div id="myElement" class="testClass newClass"></div>
+ */
+
+ addClass: function(className){
+ if (!this.hasClass(className)) this.className = (this.className+' '+className).clean();
+ return this;
+ },
+
+ /*
+ Property: removeClass
+ works like <Element.addClass>, but removes the class from the element.
+ */
+
+ removeClass: function(className){
+ if (this.hasClass(className)) this.className = this.className.replace(className, '').clean();
+ return this;
+ },
+
+ /*
+ Property: toggleClass
+ Adds or removes the passed in class name to the element, depending on if it's present or not.
+
+ Arguments:
+ className - the class to add or remove
+
+ Example:
+ ><div id="myElement" class="myClass"></div>
+ >$('myElement').toggleClass('myClass');
+ ><div id="myElement" class=""></div>
+ >$('myElement').toggleClass('myClass');
+ ><div id="myElement" class="myClass"></div>
+ */
+
+ toggleClass: function(className){
+ return this.hasClass(className) ? this.removeClass(className) : this.addClass(className);
+ },
+
+ /*
+ Property: setStyle
+ Sets a css property to the Element.
+
+ Arguments:
+ property - the property to set
+ value - the value to which to set it
+
+ Example:
+ >$('myElement').setStyle('width', '300px'); //the width is now 300px
+ */
+
+ setStyle: function(property, value){
+ if (property == 'opacity') this.setOpacity(parseFloat(value));
+ else this.style[property.camelCase()] = (value.push) ? value.rgbToHex() : value;
+ return this;
+ },
+
+ /*
+ Property: setStyles
+ Applies a collection of styles to the Element.
+
+ Arguments:
+ source - an object or string containing all the styles to apply
+
+ Examples:
+ >$('myElement').setStyles({
+ > border: '1px solid #000',
+ > width: '300px',
+ > height: '400px'
+ >});
+
+ OR
+
+ >$('myElement').setStyle('border: 1px solid #000; width: 300px; height: 400px;');
+ */
+
+ setStyles: function(source){
+ switch ($type(source)){
+ case 'object':
+ for (var property in source) this.setStyle(property, source[property]);
+ break;
+ case 'string':
+ if (window.ie) this.cssText = source;
+ else this.setAttribute('style', source);
+ }
+ return this;
+ },
+
+ /*
+ Property: setOpacity
+ Sets the opacity of the Element, and sets also visibility == "hidden" if opacity == 0, and visibility = "visible" if opacity == 1.
+
+ Arguments:
+ opacity - Accepts numbers from 0 to 1.
+
+ Example:
+ >$('myElement').setOpacity(0.5) //make it 50% transparent
+ */
+
+ setOpacity: function(opacity){
+ if (opacity == 0){
+ if(this.style.visibility != "hidden") this.style.visibility = "hidden";
+ } else {
+ if(this.style.visibility != "visible") this.style.visibility = "visible";
+ }
+ if (!this.currentStyle || !this.currentStyle.hasLayout) this.style.zoom = 1;
+ if (window.ie) this.style.filter = "alpha(opacity=" + opacity*100 + ")";
+ this.style.opacity = this.opacity = opacity;
+ return this;
+ },
+
+ /*
+ Property: getStyle
+ Returns the style of the Element given the property passed in.
+
+ Arguments:
+ property - the css style property you want to retrieve
+
+ Example:
+ >$('myElement').getStyle('width'); //returns "400px"
+ >//but you can also use
+ >$('myElement').getStyle('width').toInt(); //returns "400"
+
+ Returns:
+ the style as a string
+ */
+
+ getStyle: function(property){
+ property = property.camelCase();
+ var style = this.style[property] || false;
+ if (!$chk(style)){
+ if (property == 'opacity') return $chk(this.opacity) ? this.opacity : 1;
+ if (['margin', 'padding'].test(property)){
+ return [this.getStyle(property+'-top') || 0, this.getStyle(property+'-right') || 0,
+ this.getStyle(property+'-bottom') || 0, this.getStyle(property+'-left') || 0].join(' ');
+ }
+ if (document.defaultView) style = document.defaultView.getComputedStyle(this, null).getPropertyValue(property.hyphenate());
+ else if (this.currentStyle) style = this.currentStyle[property];
+ }
+ return (style && property.test('color', 'i') && style.test('rgb')) ? style.rgbToHex() : style;
+ },
+
+ /*
+ Property: addEvent
+ Attaches an event listener to a DOM element.
+
+ Arguments:
+ type - the event to monitor ('click', 'load', etc) without the prefix 'on'.
+ fn - the function to execute
+
+ Example:
+ >$('myElement').addEvent('click', function(){alert('clicked!')});
+ */
+
+ addEvent: function(type, fn){
+ this.events = this.events || {};
+ this.events[type] = this.events[type] || {'keys': [], 'values': []};
+ if (!this.events[type].keys.test(fn)){
+ this.events[type].keys.push(fn);
+ if (this.addEventListener){
+ this.addEventListener((type == 'mousewheel' && window.gecko) ? 'DOMMouseScroll' : type, fn, false);
+ } else {
+ fn = fn.bind(this);
+ this.attachEvent('on'+type, fn);
+ this.events[type].values.push(fn);
+ }
+ }
+ return this;
+ },
+
+ addEvents: function(source){
+ if (source){
+ for (var type in source) this.addEvent(type, source[type]);
+ }
+ return this;
+ },
+
+ /*
+ Property: removeEvent
+ Works as Element.addEvent, but instead removes the previously added event listener.
+ */
+
+ removeEvent: function(type, fn){
+ if (this.events && this.events[type]){
+ var pos = this.events[type].keys.indexOf(fn);
+ if (pos == -1) return this;
+ var key = this.events[type].keys.splice(pos,1)[0];
+ if (this.removeEventListener){
+ this.removeEventListener((type == 'mousewheel' && window.gecko) ? 'DOMMouseScroll' : type, key, false);
+ } else {
+ this.detachEvent('on'+type, this.events[type].values.splice(pos,1)[0]);
+ }
+ }
+ return this;
+ },
+
+ /*
+ Property: removeEvents
+ removes all events of a certain type from an element. if no argument is passed in, removes all events.
+ */
+
+ removeEvents: function(type){
+ if (this.events){
+ if (type){
+ if (this.events[type]){
+ this.events[type].keys.each(function(fn){
+ this.removeEvent(type, fn);
+ }, this);
+ this.events[type] = null;
+ }
+ } else {
+ for (var evType in this.events) this.removeEvents(evType);
+ this.events = null;
+ }
+ }
+ return this;
+ },
+
+ /*
+ Property: fireEvent
+ executes all events of the specified type present in the element.
+ */
+
+ fireEvent: function(type, args){
+ if (this.events && this.events[type]){
+ args = args || [];
+ if ($type(args) != 'array') args = [args];
+ this.events[type].keys.each(function(fn){
+ fn.apply(this, args);
+ }, this);
+ }
+ },
+
+ getBrother: function(what){
+ var el = this[what+'Sibling'];
+ while ($type(el) == 'whitespace') el = el[what+'Sibling'];
+ return $(el);
+ },
+
+ /*
+ Property: getPrevious
+ Returns the previousSibling of the Element, excluding text nodes.
+
+ Example:
+ >$('myElement').getPrevious(); //get the previous DOM element from myElement
+
+ Returns:
+ the sibling element or undefined if none found.
+ */
+
+ getPrevious: function(){
+ return this.getBrother('previous');
+ },
+
+ /*
+ Property: getNext
+ Works as Element.getPrevious, but tries to find the nextSibling.
+ */
+
+ getNext: function(){
+ return this.getBrother('next');
+ },
+
+ /*
+ Property: getFirst
+ Works as <Element.getPrevious>, but tries to find the firstChild.
+ */
+
+ getFirst: function(){
+ var el = this.firstChild;
+ while ($type(el) == 'whitespace') el = el.nextSibling;
+ return $(el);
+ },
+
+ /*
+ Property: getLast
+ Works as <Element.getPrevious>, but tries to find the lastChild.
+ */
+
+ getLast: function(){
+ var el = this.lastChild;
+ while ($type(el) == 'whitespace') el = el.previousSibling;
+ return $(el);
+ },
+
+ /*
+ Property: getParent
+ returns the $(element.parentNode)
+ */
+
+ getParent: function(){
+ return $(this.parentNode);
+ },
+
+ /*
+ Property: getChildren
+ returns all the $(element.childNodes), excluding text nodes. Returns as <Elements>.
+ */
+
+ getChildren: function(){
+ return $$(this.childNodes);
+ },
+
+ /*
+ Property: setProperty
+ Sets an attribute for the Element.
+
+ Arguments:
+ property - the property to assign the value passed in
+ value - the value to assign to the property passed in
+
+ Example:
+ >$('myImage').setProperty('src', 'whatever.gif'); //myImage now points to whatever.gif for its source
+ */
+
+ setProperty: function(property, value){
+ switch (property){
+ case 'class': this.className = value; break;
+ case 'style': this.setStyles(value); break;
+ case 'name': if (window.ie6){
+ var el = $(document.createElement('<'+this.getTag()+' name="'+value+'" />'));
+ $each(this.attributes, function(attribute){
+ if (attribute.name != 'name') el.setProperty(attribute.name, attribute.value);
+ });
+ if (this.parentNode) this.replaceWith(el);
+ return el;
+ }
+ default: this.setAttribute(property, value);
+ }
+ return this;
+ },
+
+ /*
+ Property: setProperties
+ Sets numerous attributes for the Element.
+
+ Arguments:
+ source - an object with key/value pairs.
+
+ Example:
+ >$('myElement').setProperties({
+ > src: 'whatever.gif',
+ > alt: 'whatever dude'
+ >});
+ ><img src="whatever.gif" alt="whatever dude">
+ */
+
+ setProperties: function(source){
+ for (var property in source) this.setProperty(property, source[property]);
+ return this;
+ },
+
+ /*
+ Property: setHTML
+ Sets the innerHTML of the Element.
+
+ Arguments:
+ html - the new innerHTML for the element.
+
+ Example:
+ >$('myElement').setHTML(newHTML) //the innerHTML of myElement is now = newHTML
+ */
+
+ setHTML: function(html){
+ this.innerHTML = html;
+ return this;
+ },
+
+ /*
+ Property: getProperty
+ Gets the an attribute of the Element.
+
+ Arguments:
+ property - the attribute to retrieve
+
+ Example:
+ >$('myImage').getProperty('src') // returns whatever.gif
+
+ Returns:
+ the value, or an empty string
+ */
+
+ getProperty: function(property){
+ return (property == 'class') ? this.className : this.getAttribute(property);
+ },
+
+ /*
+ Property: getTag
+ Returns the tagName of the element in lower case.
+
+ Example:
+ >$('myImage').getTag() // returns 'img'
+
+ Returns:
+ The tag name in lower case
+ */
+
+ getTag: function(){
+ return this.tagName.toLowerCase();
+ },
+
+ getOffsets: function(){
+ var el = this, offsetLeft = 0, offsetTop = 0;
+ do {
+ offsetLeft += el.offsetLeft || 0;
+ offsetTop += el.offsetTop || 0;
+ el = el.offsetParent;
+ } while (el);
+ return {'x': offsetLeft, 'y': offsetTop};
+ },
+
+ /*
+ Property: scrollTo
+ scrolls the element to the specified coordinated (if the element has an overflow)
+
+ Arguments:
+ x - the x coordinate
+ y - the y coordinate
+
+ Example:
+ >$('myElement').scrollTo(0, 100)
+ */
+
+ scrollTo: function(x, y){
+ this.scrollLeft = x;
+ this.scrollTop = y;
+ },
+
+ /*
+ Property: getSize
+ return an Object representing the size/scroll values of the element.
+
+ Example:
+ (start code)
+ $('myElement').getSize();
+ (end)
+
+ Returns:
+ (start code)
+ {
+ 'scroll': {'x': 100, 'y': 100},
+ 'size': {'x': 200, 'y': 400},
+ 'scrollSize': {'x': 300, 'y': 500}
+ }
+ (end)
+ */
+
+ getSize: function(){
+ return {
+ 'scroll': {'x': this.scrollLeft, 'y': this.scrollTop},
+ 'size': {'x': this.offsetWidth, 'y': this.offsetHeight},
+ 'scrollSize': {'x': this.scrollWidth, 'y': this.scrollHeight}
+ };
+ },
+
+ /*
+ Property: getTop
+ Returns the distance from the top of the window to the Element.
+ */
+
+ getTop: function(){
+ return this.getOffsets().y;
+ },
+
+ /*
+ Property: getLeft
+ Returns the distance from the left of the window to the Element.
+ */
+
+ getLeft: function(){
+ return this.getOffsets().x;
+ },
+
+ /*
+ Property: getPosition
+ Returns an object with width, height, left, right, top, and bottom, representing the values of the Element
+
+ Example:
+ (start code)
+ var myValues = $('myElement').getPosition();
+ (end)
+
+ Returns:
+ (start code)
+ {
+ width: 200,
+ height: 300,
+ left: 100,
+ top: 50,
+ right: 300,
+ bottom: 350
+ }
+ (end)
+ */
+
+ getPosition: function(){
+ var offs = this.getOffsets();
+ var obj = {
+ 'width': this.offsetWidth,
+ 'height': this.offsetHeight,
+ 'left': offs.x,
+ 'top': offs.y
+ };
+ obj.right = obj.left + obj.width;
+ obj.bottom = obj.top + obj.height;
+ return obj;
+ },
+
+ /*
+ Property: getValue
+ Returns the value of the Element, if its tag is textarea, select or input. no multiple select support.
+ */
+
+ getValue: function(){
+ switch (this.getTag()){
+ case 'select': if (this.selectedIndex != -1) return this.options[this.selectedIndex].value; break;
+ case 'input': if (!(this.checked && ['checkbox', 'radio'].test(this.type)) && !['hidden', 'text', 'password'].test(this.type)) break;
+ case 'textarea': return this.value;
+ }
+ return false;
+ }
+
+});
+
+var Window = window;
+
+window.addEvent = document.addEvent = Element.prototype.addEvent;
+window.removeEvent = document.removeEvent = Element.prototype.removeEvent;
+
+var Garbage = {
+
+ elements: [],
+
+ collect: function(element){
+ Garbage.elements.push(element);
+ },
+
+ trash: function(){
+ window.removeEvent('unload', Garbage.trash);
+ Garbage.elements.each(function(el){
+ el.removeEvents();
+ for (var p in Element.prototype) HTMLElement[p] = window[p] = document[p] = el[p] = null;
+ el.extend = null;
+ });
+ }
+
+};
+
+window.addEvent('unload', Garbage.trash);
+
+/*
+Script: Event.js
+ Event class
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>, Michael Jackson, <http://ajaxon.com/michael>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Event
+ Cross browser methods to manage events.
+
+Arguments:
+ event - the event
+
+Properties:
+ shift - true if the user pressed the shift
+ control - true if the user pressed the control
+ alt - true if the user pressed the alt
+ meta - true if the user pressed the meta key
+ code - the keycode of the key pressed
+ page.x - the x position of the mouse, relative to the full window
+ page.y - the y position of the mouse, relative to the full window
+ client.x - the x position of the mouse, relative to the viewport
+ client.y - the y position of the mouse, relative to the viewport
+ key - the key pressed as a lowercase string. key also returns 'enter', 'up', 'down', 'left', 'right', 'space', 'backspace', 'delete', 'esc'. Handy for these special keys.
+ target - the event target
+ relatedTarget - the event related target
+
+Example:
+ (start code)
+ $('myLink').onkeydown = function(event){
+ var event = new Event(event);
+ //event is now the Event class.
+ alert(event.key); //returns the lowercase letter pressed
+ alert(event.shift); //returns true if the key pressed is shift
+ if (event.key == 's' && event.control) alert('document saved');
+ };
+ (end)
+*/
+
+var Event = new Class({
+
+ initialize: function(event){
+ this.event = event || window.event;
+ this.type = this.event.type;
+ this.target = this.event.target || this.event.srcElement;
+ if (this.target.nodeType == 3) this.target = this.target.parentNode; // Safari
+ this.shift = this.event.shiftKey;
+ this.control = this.event.ctrlKey;
+ this.alt = this.event.altKey;
+ this.meta = this.event.metaKey;
+ if (['DOMMouseScroll', 'mousewheel'].test(this.type)){
+ this.wheel = this.event.wheelDelta ? (this.event.wheelDelta / (window.opera ? -120 : 120)) : -(this.event.detail || 0) / 3;
+ } else if (this.type.test('key')){
+ this.code = this.event.which || this.event.keyCode;
+ for (var name in Event.keys){
+ if (Event.keys[name] == this.code) var special = name;
+ }
+ this.key = special || String.fromCharCode(this.code).toLowerCase();
+
+ } else if (this.type.test('mouse') || this.type == 'click'){
+ this.page = {
+ 'x': this.event.pageX || this.event.clientX + document.documentElement.scrollLeft,
+ 'y': this.event.pageY || this.event.clientY + document.documentElement.scrollTop
+ };
+ this.client = {
+ 'x': this.event.pageX ? this.event.pageX - window.pageXOffset : this.event.clientX,
+ 'y': this.event.pageY ? this.event.pageY - window.pageYOffset : this.event.clientY
+ };
+ this.rightClick = (this.event.which == 3) || (this.event.button == 2);
+ switch (this.type){
+ case 'mouseover': this.relatedTarget = this.event.relatedTarget || this.event.fromElement; break;
+ case 'mouseout': this.relatedTarget = this.event.relatedTarget || this.event.toElement;
+ }
+ }
+ },
+
+ /*
+ Property: stop
+ cross browser method to stop an event
+ */
+
+ stop: function() {
+ this.stopPropagation();
+ this.preventDefault();
+ return this;
+ },
+
+ /*
+ Property: stopPropagation
+ cross browser method to stop the propagation of an event
+ */
+
+ stopPropagation: function(){
+ if (this.event.stopPropagation) this.event.stopPropagation();
+ else this.event.cancelBubble = true;
+ return this;
+ },
+
+ /*
+ Property: preventDefault
+ cross browser method to prevent the default action of the event
+ */
+
+ preventDefault: function(){
+ if (this.event.preventDefault) this.event.preventDefault();
+ else this.event.returnValue = false;
+ return this;
+ }
+
+});
+
+Event.keys = {
+ 'enter': 13,
+ 'up': 38,
+ 'down': 40,
+ 'left': 37,
+ 'right': 39,
+ 'esc': 27,
+ 'space': 32,
+ 'backspace': 8,
+ 'delete': 46
+};
+
+Function.extend({
+
+ /*
+ Property: bindWithEvent
+ automatically passes mootools Event Class.
+
+ Arguments:
+ bind - optional, the object that the "this" of the function will refer to.
+
+ Returns:
+ a function with the parameter bind as its "this" and as a pre-passed argument event or window.event, depending on the browser.
+
+ Example:
+ >function myFunction(event){
+ > alert(event.clientx) //returns the coordinates of the mouse..
+ >};
+ >myElement.onclick = myFunction.bindWithEvent(myElement);
+ */
+
+ bindWithEvent: function(bind, args){
+ return this.create({'bind': bind, 'arguments': args, 'event': Event});
+ }
+
+});
+
+
+/*
+Script: Common.js
+ Contains common implementations for custom classes. In Mootools is implemented in <Ajax> and <Fx>.
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Chain
+ An "Utility" Class. Its methods can be implemented with <Class.implement> into any <Class>.
+ Currently implemented in <Fx> and <Ajax>. In <Fx> for example, is used to execute a list of function, one after another, once the effect is completed.
+ The functions will not be fired all togheter, but one every completion, to create custom complex animations.
+
+Example:
+ (start code)
+ var myFx = new Fx.Style('element', 'opacity');
+
+ myFx.start(1,0).chain(function(){
+ myFx.start(0,1);
+ }).chain(function(){
+ myFx.start(1,0);
+ }).chain(function(){
+ myFx.start(0,1);
+ });
+ //the element will appear and disappear three times
+ (end)
+*/
+
+var Chain = new Class({
+
+ /*
+ Property: chain
+ adds a function to the Chain instance stack.
+
+ Arguments:
+ fn - the function to append.
+ */
+
+ chain: function(fn){
+ this.chains = this.chains || [];
+ this.chains.push(fn);
+ return this;
+ },
+
+ /*
+ Property: callChain
+ Executes the first function of the Chain instance stack, then removes it. The first function will then become the second.
+ */
+
+ callChain: function(){
+ if (this.chains && this.chains.length) this.chains.splice(0, 1)[0].delay(10, this);
+ },
+
+ /*
+ Property: clearChain
+ Clears the stack of a Chain instance.
+ */
+
+ clearChain: function(){
+ this.chains = [];
+ }
+
+});
+
+/*
+Class: Events
+ An "Utility" Class. Its methods can be implemented with <Class.implement> into any <Class>.
+ In <Fx> Class, for example, is used to give the possibility add any number of functions to the Effects events, like onComplete, onStart, onCancel
+
+Example:
+ (start code)
+ var myFx = new Fx.Style('element', 'opacity').addEvent('onComplete', function(){
+ alert('the effect is completed');
+ }).addEvent('onComplete', function(){
+ alert('I told you the effect is completed');
+ });
+
+ myFx.start(0,1);
+ //upon completion it will display the 2 alerts, in order.
+ (end)
+*/
+
+var Events = new Class({
+
+ /*
+ Property: addEvent
+ adds an event to the stack of events of the Class instance.
+ */
+
+ addEvent: function(type, fn){
+ if (fn != Class.empty){
+ this.events = this.events || {};
+ this.events[type] = this.events[type] || [];
+ if (!this.events[type].test(fn)) this.events[type].push(fn);
+ }
+ return this;
+ },
+
+ /*
+ Property: fireEvent
+ fires all events of the specified type in the Class instance.
+ */
+
+ fireEvent: function(type, args, delay){
+ if (this.events && this.events[type]){
+ this.events[type].each(function(fn){
+ fn.create({'bind': this, 'delay': delay, 'arguments': args})();
+ }, this);
+ }
+ return this;
+ },
+
+ /*
+ Property: removeEvent
+ removes an event from the stack of events of the Class instance.
+ */
+
+ removeEvent: function(type, fn){
+ if (this.events && this.events[type]) this.events[type].remove(fn);
+ return this;
+ }
+
+});
+
+/*
+Class: Options
+ An "Utility" Class. Its methods can be implemented with <Class.implement> into any <Class>.
+ Used to automate the options settings, also adding Class <Events> when the option begins with on.
+*/
+
+var Options = new Class({
+
+ /*
+ Property: setOptions
+ sets this.options
+
+ Arguments:
+ defaults - the default set of options
+ options - the user entered options. can be empty too.
+
+ Note:
+ if your Class has <Events> implemented, every option beginning with on, followed by a capital letter (onComplete) becomes an Class instance event.
+ */
+
+ setOptions: function(defaults, options){
+ this.options = Object.extend(defaults, options);
+ if (this.addEvent){
+ for (var option in this.options){
+ if (($type(this.options[option]) == 'function') && option.test('^on[A-Z]')) this.addEvent(option, this.options[option]);
+ }
+ }
+ return this;
+ }
+
+});
+
+/*
+Script: Dom.js
+ Css Query related function and <Element> extensions
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/* Section: Utility Functions */
+
+/*
+Function: $E
+ Selects a single (i.e. the first found) Element based on the selector passed in and an optional filter element.
+
+Arguments:
+ selector - the css selector to match
+ filter - optional; a DOM element to limit the scope of the selector match; defaults to document.
+
+Example:
+ >$E('a', 'myElement') //find the first anchor tag inside the DOM element with id 'myElement'
+
+Returns:
+ a DOM element - the first element that matches the selector
+*/
+
+function $E(selector, filter){
+ return ($(filter) || document).getElement(selector);
+};
+
+/*
+Function: $ES
+ Returns a collection of Elements that match the selector passed in limited to the scope of the optional filter.
+ See Also: <Element.getElements> for an alternate syntax.
+
+Returns:
+ an array of dom elements that match the selector within the filter
+
+Arguments:
+ selector - css selector to match
+ filter - optional; a DOM element to limit the scope of the selector match; defaults to document.
+
+Examples:
+ >$ES("a") //gets all the anchor tags; synonymous with $$("a")
+ >$ES('a','myElement') //get all the anchor tags within $('myElement')
+*/
+
+function $ES(selector, filter){
+ return ($(filter) || document).getElementsBySelector(selector);
+};
+
+/*
+Class: Element
+ Custom class to allow all of its methods to be used with any DOM element via the dollar function <$>.
+*/
+
+Element.extend({
+
+ /*
+ Property: getElements
+ Gets all the elements within an element that match the given (single) selector.
+
+ Arguments:
+ selector - the css selector to match
+
+ Example:
+ >$('myElement').getElements('a'); // get all anchors within myElement
+
+ Credits:
+ Say thanks to Christophe Beyls <http://digitalia.be> for the new regular expression that rules getElements, a big step forward in terms of speed.
+ */
+
+ getElements: function(selector){
+ var filters = [];
+ selector.clean().split(' ').each(function(sel, i){
+ var param = sel.match('^(\\w*|\\*)(?:#([\\w_-]+)|\\.([\\w_-]+))?(?:\\[["\']?(\\w+)["\']?(?:([\\*\\^\\$]?=)["\']?(\\w*)["\']?)?\\])?$');
+ //PARAM ARRAY: 0 = full string: 1 = tag; 2 = id; 3 = class; 4 = attribute; 5 = operator; 6 = value;
+ if (!param) return;
+ param[1] = param[1] || '*';
+ if (i == 0){
+ if (param[2]){
+ var el = this.getElementById(param[2]);
+ if (!el || ((param[1] != '*') && (Element.prototype.getTag.call(el) != param[1]))) return;
+ filters = [el];
+ } else {
+ filters = $A(this.getElementsByTagName(param[1]));
+ }
+ } else {
+ filters = Elements.prototype.filterByTagName.call(filters, param[1]);
+ if (param[2]) filters = Elements.prototype.filterById.call(filters, param[2]);
+ }
+ if (param[3]) filters = Elements.prototype.filterByClassName.call(filters, param[3]);
+ if (param[4]) filters = Elements.prototype.filterByAttribute.call(filters, param[4], param[6], param[5]);
+ }, this);
+ return $$(filters);
+ },
+
+ /*
+ Property: getElementById
+ Targets an element with the specified id found inside the Element. Does not overwrite document.getElementById.
+
+ Arguments:
+ id - the id of the element to find.
+ */
+
+ getElementById: function(id){
+ var el = document.getElementById(id);
+ if (!el) return false;
+ for (var parent = el.parentNode; parent != this; parent = parent.parentNode){
+ if (!parent) return false;
+ }
+ return el;
+ },
+
+ /*
+ Property: getElement
+ Same as <Element.getElements>, but returns only the first. Alternate syntax for <$E>, where filter is the Element.
+ */
+
+ getElement: function(selector){
+ return this.getElementsBySelector(selector)[0];
+ },
+
+ /*
+ Property: getElementsBySelector
+ Same as <Element.getElements>, but allows for comma separated selectors, as in css. Alternate syntax for <$$>, where filter is the Element.
+
+ */
+
+ getElementsBySelector: function(selector){
+ var els = [];
+ selector.split(',').each(function(sel){
+ els.extend(this.getElements(sel));
+ }, this);
+ return $$(els);
+ }
+
+});
+
+document.extend = Object.extend;
+
+/* Section: document related functions */
+
+document.extend({
+ /*
+ Function: document.getElementsByClassName
+ Returns all the elements that match a specific class name.
+ Here for compatibility purposes. can also be written: document.getElements('.className'), or $$('.className')
+ */
+
+ getElementsByClassName: function(className){
+ return document.getElements('.'+className);
+ },
+ getElement: Element.prototype.getElement,
+ getElements: Element.prototype.getElements,
+ getElementsBySelector: Element.prototype.getElementsBySelector
+
+});
+
+/*
+Class: Elements
+ Methods for dom queries arrays, as <$$>.
+*/
+
+Elements.extend({
+
+ //internal methods
+
+ filterById: function(id, tag){
+ var found = [];
+ this.each(function(el){
+ if (el.id == id) found.push(el);
+ });
+ return found;
+ },
+
+ filterByClassName: function(className){
+ var found = [];
+ this.each(function(el){
+ if (Element.prototype.hasClass.call(el, className)) found.push(el);
+ });
+ return found;
+ },
+
+ filterByTagName: function(tagName){
+ var found = [];
+ this.each(function(el){
+ found.extend(el.getElementsByTagName(tagName));
+ });
+ return found;
+ },
+
+ filterByAttribute: function(name, value, operator){
+ var found = [];
+ this.each(function(el){
+ var att = el.getAttribute(name);
+ if (!att) return found;
+ if (!operator) return found.push(el);
+
+ switch (operator){
+ case '*=': if (att.test(value)) found.push(el); break;
+ case '=': if (att == value) found.push(el); break;
+ case '^=': if (att.test('^'+value)) found.push(el); break;
+ case '$=': if (att.test(value+'$')) found.push(el);
+ }
+ return found;
+ });
+ return found;
+ }
+
+});
+
+/*
+Script: Hash.js
+ Contains the class Hash.
+
+Author:
+ Christophe Beyls <http://digitalia.be>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Hash
+ It wraps an object that it uses internally as a map. The user must use put(), get(), and remove() to add/change, retrieve and remove values, it must not access the internal object directly. With this implementation, null values are not allowed.
+
+Example:
+ (start code)
+ var hash = new Hash({a: 'hi', b: 'world', c: 'howdy'});
+ hash.remove('b'); // b is removed.
+ hash.set('c', 'hello');
+ hash.get('c'); // returns 'hello'
+ hash.length // returns 2 (a and b)
+ (end)
+*/
+
+var Hash = new Class({
+
+ length: 0,
+
+ initialize: function(obj) {
+ this.obj = {};
+ for (var property in obj) {
+ this.obj[property] = obj[property];
+ this.length++;
+ }
+ },
+
+ get: function(key) {
+ return this.obj[key];
+ },
+
+ set: function(key, value) {
+ if (value == null) return false;
+ if (this.obj[key] == undefined) this.length++;
+ this.obj[key] = value;
+ return this;
+ },
+
+ remove: function(key) {
+ if (this.obj[key] == undefined) return false;
+ var obj = {};
+ this.length--;
+ for (var property in this.obj){
+ if (property != key) obj[property] = this.obj[property];
+ }
+ this.obj = obj;
+ return this;
+ },
+
+ each: function(fn, bind) {
+ for (var property in this.obj) fn.call(bind || this, property, this.obj[property]);
+ },
+
+ extend: function(obj){
+ this.initialize(Object.extend(this.obj, obj));
+ return this;
+ },
+
+ empty: function() {
+ return (this.length == 0);
+ },
+
+ keys: function() {
+ var keys = [];
+ for (var property in this.obj) keys.push(property);
+ return keys;
+ },
+
+ values: function() {
+ var values = [];
+ for (var property in this.obj) values.push(this.obj[property]);
+ return values;
+ }
+
+});
+
+/*
+Function: $H
+ Shortcut to create an Hash from an Object.
+*/
+
+function $H(obj) {
+ return new Hash(obj);
+};
+
+/*
+Script: Color.js
+ Contains the Color class.
+
+Author:
+ Michael Jackson <http://ajaxon.com/michael>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Color
+ Creates a new Color Object, which is an array with some color specific methods.
+
+Example:
+ (start code)
+ var black = new Color('#000');
+ var purple = new Color([255,0,255]);
+ // mix black with white and purple, each time at 10% of the new color
+ var darkpurple = black.mix('#fff', purple, 10);
+ $('myDiv').setStyle('background-color', darkpurple);
+ (end)
+*/
+
+var Color = new Class({
+
+ initialize: function(color){
+ if (color.mix && color.invert) return color;
+ var rgb = (color.push) ? color : color.hexToRgb(true);
+ return Object.extend(rgb, Color.prototype);
+ },
+
+ mix: function(){
+ var colors = $A(arguments);
+ var alpha = 50;
+ if ($type(colors[colors.length-1]) == 'number') alpha = colors.pop();
+ var rgb = this.copy();
+ colors.each(function(color){
+ color = new Color(color);
+ for (var i = 0; i < 3; i++) rgb[i] = Math.round((rgb[i] / 100 * (100 - alpha)) + (color[i] / 100 * alpha));
+ });
+ return new Color(rgb);
+ },
+
+ invert: function(){
+ var rgb = [];
+ for (var i = 0; i < 3; i++) rgb.push(255 - this[i]);
+ return new Color(rgb);
+ }
+
+});
+
+function $C(color){
+ return new Color(color);
+};
+
+/*
+Script: Window.Base.js
+ Contains Window.onDomReady and Window.disableImageCache
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Window
+ Cross browser methods to get the window size, onDomReady method.
+*/
+
+window.extend = Object.extend;
+
+window.extend({
+
+ /*
+ Function: window.disableImageCache
+ Disables background image chache for internex explorer, to prevent flickering.
+ To be called if you have effects with background images, and they flicker.
+
+ Example:
+ Window.disableImageCache();
+ */
+
+ disableImageCache: function(){
+ if (this.ie6) try {document.execCommand("BackgroundImageCache", false, true);} catch (e){};
+ },
+
+ addEvent: function(type, fn){
+ if (type == 'domready'){
+ if (this.loaded) fn();
+ else if (!this.events || !this.events.domready){
+ var domReady = function(){
+ if (this.loaded) return;
+ this.loaded = true;
+ if (this.timer) this.timer = $clear(this.timer);
+ Element.prototype.fireEvent.call(this, 'domready');
+ this.events.domready = null;
+ }.bind(this);
+ if (document.readyState && this.khtml){ //safari and konqueror
+ this.timer = function(){
+ if (['loaded','complete'].test(document.readyState)) domReady();
+ }.periodical(50);
+ }
+ else if (document.readyState && this.ie){ //ie
+ document.write("<script id=ie_ready defer src=javascript:void(0)><\/script>");
+ $('ie_ready').onreadystatechange = function(){
+ if (this.readyState == 'complete') domReady();
+ };
+ } else { //others
+ this.addEvent("load", domReady);
+ document.addEvent("DOMContentLoaded", domReady);
+ }
+ }
+ }
+ Element.prototype.addEvent.call(this, type, fn);
+ return this;
+ },
+
+ /*
+ Function: window.onDomReady
+ Executes the passed in function when the DOM is ready (when the document tree has loaded, not waiting for images).
+ Same as window.addEvent('domready', init);
+
+ Credits:
+ (c) Dean Edwards/Matthias Miller/John Resig, remastered for mootools. Later touched up by Christophe Beyls <http://digitalia.be>.
+
+ Arguments:
+ init - the function to execute when the DOM is ready
+
+ Example:
+ > window.addEvent('domready', function(){alert('the dom is ready')});
+ */
+
+ onDomReady: function(init){
+ return this.addEvent('domready', init);
+ }
+
+});
+
+/*
+Script: Window.Size.js
+ Window cross-browser dimensions methods.
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: window
+ Cross browser methods to get the window size, onDomReady method.
+*/
+
+window.extend({
+
+ /*
+ Property: getWidth
+ Returns an integer representing the width of the browser.
+ */
+
+ getWidth: function(){
+ if (this.khtml || this.opera) return this.innerWidth;
+ else return document.documentElement.clientWidth || document.body.clientWidth;
+ },
+
+ /*
+ Property: getHeight
+ Returns an integer representing the height of the browser.
+ */
+
+ getHeight: function(){
+ if (this.khtml || this.opera) return this.innerHeight;
+ return document.documentElement.clientHeight || document.body.clientHeight;
+ },
+
+ /*
+ Property: getScrollHeight
+ Returns an integer representing the scrollHeight of the window.
+
+ See Also:
+ <http://developer.mozilla.org/en/docs/DOM:element.scrollHeight>
+ */
+
+ getScrollHeight: function(){
+ return document.documentElement.scrollHeight;
+ },
+
+ /*
+ Property: getScrollWidth
+ Returns an integer representing the scrollWidth of the window.
+
+ See Also:
+ <http://developer.mozilla.org/en/docs/DOM:element.scrollWidth>
+ */
+
+ getScrollWidth: function(){
+ return document.documentElement.scrollWidth;
+ },
+
+ /*
+ Property: getScrollTop
+ Returns an integer representing the scrollTop of the window (the number of pixels the window has scrolled from the top).
+
+ See Also:
+ <http://developer.mozilla.org/en/docs/DOM:element.scrollTop>
+ */
+
+ getScrollTop: function(){
+ return this.pageYOffset || document.documentElement.scrollTop;
+ },
+
+ /*
+ Property: getScrollLeft
+ Returns an integer representing the scrollLeft of the window (the number of pixels the window has scrolled from the left).
+
+ See Also:
+ <http://developer.mozilla.org/en/docs/DOM:element.scrollLeft>
+ */
+
+ getScrollLeft: function(){
+ return this.pageXOffset || document.documentElement.scrollLeft;
+ },
+
+ /*
+ Property: getSize
+ Same as <Element.getSize>
+ */
+
+ getSize: function(){
+ return {
+ 'scroll': {'x': this.getScrollLeft(), 'y': this.getScrollTop()},
+ 'size': {'x': this.getWidth(), 'y': this.getHeight()},
+ 'scrollSize': {'x': this.getScrollWidth(), 'y': this.getScrollHeight()}
+ };
+ },
+
+ //ignore
+ getOffsets: function(){return {'x': 0, 'y': 0}}
+
+});
+
+/*
+Script: Fx.Base.js
+ Contains <Fx.Base> and two Transitions.
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+var Fx = {};
+
+/*
+Class: Fx.Base
+ Base class for the Mootools Effects (Moo.Fx) library.
+
+Options:
+ onStart - the function to execute as the effect begins; nothing (<Class.empty>) by default.
+ onComplete - the function to execute after the effect has processed; nothing (<Class.empty>) by default.
+ transition - the equation to use for the effect see <Fx.Transitions>; default is <Fx.Transitions.sineInOut>
+ duration - the duration of the effect in ms; 500 is the default.
+ unit - the unit is 'px' by default (other values include things like 'em' for fonts or '%').
+ wait - boolean: to wait or not to wait for a current transition to end before running another of the same instance. defaults to true.
+ fps - the frames per second for the transition; default is 30
+*/
+
+Fx.Base = new Class({
+
+ getOptions: function(){
+ return {
+ onStart: Class.empty,
+ onComplete: Class.empty,
+ onCancel: Class.empty,
+ transition: Fx.Transitions.sineInOut,
+ duration: 500,
+ unit: 'px',
+ wait: true,
+ fps: 50
+ };
+ },
+
+ initialize: function(options){
+ this.element = this.element || null;
+ this.setOptions(this.getOptions(), options);
+ if (this.options.initialize) this.options.initialize.call(this);
+ },
+
+ step: function(){
+ var time = new Date().getTime();
+ if (time < this.time + this.options.duration){
+ this.cTime = time - this.time;
+ this.setNow();
+ this.increase();
+ } else {
+ this.stop(true);
+ this.now = this.to;
+ this.increase();
+ this.fireEvent('onComplete', this.element, 10);
+ this.callChain();
+ }
+ },
+
+ /*
+ Property: set
+ Immediately sets the value with no transition.
+
+ Arguments:
+ to - the point to jump to
+
+ Example:
+ >var myFx = new Fx.Style('myElement', 'opacity').set(0); //will make it immediately transparent
+ */
+
+ set: function(to){
+ this.now = to;
+ this.increase();
+ return this;
+ },
+
+ setNow: function(){
+ this.now = this.compute(this.from, this.to);
+ },
+
+ compute: function(from, to){
+ return this.options.transition(this.cTime, from, (to - from), this.options.duration);
+ },
+
+ /*
+ Property: start
+ Executes an effect from one position to the other.
+
+ Arguments:
+ from - integer: staring value
+ to - integer: the ending value
+
+ Examples:
+ >var myFx = new Fx.Style('myElement', 'opacity').start(0,1); //display a transition from transparent to opaque.
+ */
+
+ start: function(from, to){
+ if (!this.options.wait) this.stop();
+ else if (this.timer) return this;
+ this.from = from;
+ this.to = to;
+ this.time = new Date().getTime();
+ this.timer = this.step.periodical(Math.round(1000/this.options.fps), this);
+ this.fireEvent('onStart', this.element);
+ return this;
+ },
+
+ /*
+ Property: stop
+ Stops the transition.
+ */
+
+ stop: function(end){
+ if (!this.timer) return this;
+ this.timer = $clear(this.timer);
+ if (!end) this.fireEvent('onCancel', this.element);
+ return this;
+ },
+
+ //compat
+ custom: function(from, to){return this.start(from, to)},
+ clearTimer: function(end){return this.stop(end)}
+
+});
+
+Fx.Base.implement(new Chain);
+Fx.Base.implement(new Events);
+Fx.Base.implement(new Options);
+
+/*
+Class: Fx.Transitions
+ A collection of transition equations for use with the <Fx> Class.
+
+See Also:
+ <Fxtransitions.js> for a whole bunch of transitions.
+
+Credits:
+ Easing Equations, (c) 2003 Robert Penner (http://www.robertpenner.com/easing/), Open Source BSD License.
+*/
+
+Fx.Transitions = {
+
+ /* Property: linear */
+ linear: function(t, b, c, d){
+ return c*t/d + b;
+ },
+
+ /* Property: sineInOut */
+ sineInOut: function(t, b, c, d){
+ return -c/2 * (Math.cos(Math.PI*t/d) - 1) + b;
+ }
+
+};
+
+/*
+Script: Fx.CSS.js
+ Css parsing class for effects. Required by <Fx.Style>, <Fx.Styles>, <Fx.Elements>. No documentation needed, as its used internally.
+
+Author:
+ Christophe Beyls, <http://www.digitalia.be>,
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+Fx.CSS = {
+
+ select: function(property, to){
+ if (property.test('color', 'i')) return this.Color;
+ if (to.test && to.test(' ')) return this.Multi;
+ return this.Single;
+ },
+
+ parse: function(el, property, fromTo){
+ if (!fromTo.push) fromTo = [fromTo];
+ var from = fromTo[0], to = fromTo[1];
+ if (!to && to != 0){
+ to = from;
+ from = el.getStyle(property);
+ }
+ var css = this.select(property, to);
+ return {from: css.parse(from), to: css.parse(to), css: css};
+ }
+
+};
+
+Fx.CSS.Single = {
+
+ parse: function(value){
+ return parseFloat(value);
+ },
+
+ getNow: function(from, to, fx){
+ return fx.compute(from, to);
+ },
+
+ getValue: function(value, unit){
+ return value+unit;
+ }
+
+};
+
+Fx.CSS.Multi = {
+
+ parse: function(value){
+ return value.push ? value : value.split(' ').map(function(v){
+ return parseFloat(v);
+ });
+ },
+
+ getNow: function(from, to, fx){
+ var now = [];
+ for (var i = 0; i < from.length; i++) now[i] = fx.compute(from[i], to[i]);
+ return now;
+ },
+
+ getValue: function(value, unit){
+ return value.join(unit+' ')+unit;
+ }
+
+};
+
+Fx.CSS.Color = {
+
+ parse: function(value){
+ return value.push ? value : value.hexToRgb(true);
+ },
+
+ getNow: function(from, to, fx){
+ var now = [];
+ for (var i = 0; i < from.length; i++) now[i] = Math.round(fx.compute(from[i], to[i]));
+ return now;
+ },
+
+ getValue: function(value){
+ return 'rgb('+value.join(',')+')';
+ }
+
+};
+
+/*
+Script: Fx.Style.js
+ Contains <Fx.Style>
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Fx.Style
+ The Style effect; Extends <Fx.Base>, inherits all its properties. Used to transition any css property from one value to another. Includes colors.
+ Colors must be in hex format.
+
+Arguments:
+ el - the $(element) to apply the style transition to
+ property - the property to transition
+ options - the Fx.Base options (see: <Fx.Base>)
+
+Example:
+ >var marginChange = new Fx.Style('myElement', 'margin-top', {duration:500});
+ >marginChange.start(10, 100);
+*/
+
+Fx.Style = Fx.Base.extend({
+
+ initialize: function(el, property, options){
+ this.element = $(el);
+ this.property = property;
+ this.parent(options);
+ },
+
+ /*
+ Property: hide
+ Same as <Fx.Base.set>(0)
+ */
+
+ hide: function(){
+ return this.set(0);
+ },
+
+ setNow: function(){
+ this.now = this.css.getNow(this.from, this.to, this);
+ },
+
+ set: function(to){
+ this.css = Fx.CSS.select(this.property, to);
+ return this.parent(this.css.parse(to));
+ },
+
+ /*
+ Property: start
+ displays the transition to the value/values passed in
+
+ Example:
+ (start code)
+ var var marginChange = new Fx.Style('myElement', 'margin-top', {duration:500});
+ marginChange.start(10); //tries to read current margin top value and goes from current to 10
+ (end)
+ */
+
+ start: function(from, to){
+ if (this.timer && this.options.wait) return this;
+ var parsed = Fx.CSS.parse(this.element, this.property, [from, to]);
+ this.css = parsed.css;
+ return this.parent(parsed.from, parsed.to);
+ },
+
+ increase: function(){
+ this.element.setStyle(this.property, this.css.getValue(this.now, this.options.unit));
+ }
+
+});
+
+/*
+Class: Element
+ Custom class to allow all of its methods to be used with any DOM element via the dollar function <$>.
+*/
+
+Element.extend({
+
+ /*
+ Property: effect
+ Applies an <Fx.Style> to the Element; This a shortcut for <Fx.Style>.
+
+ Example:
+ >var myEffect = $('myElement').effect('height', {duration: 1000, transition: Fx.Transitions.linear});
+ >myEffect.start(10, 100);
+ */
+
+ effect: function(property, options){
+ return new Fx.Style(this, property, options);
+ }
+
+});
+
+/*
+Script: Fx.Styles.js
+ Contains <Fx.Styles>
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Fx.Styles
+ Allows you to animate multiple css properties at once; Extends <Fx.Base>, inherits all its properties. Includes colors.
+ Colors must be in hex format.
+
+Arguments:
+ el - the $(element) to apply the styles transition to
+ options - the fx options (see: <Fx.Base>)
+
+Example:
+ (start code)
+ var myEffects = new Fx.Styles('myElement', {duration: 1000, transition: Fx.Transitions.linear});
+
+ //height from 10 to 100 and width from 900 to 300
+ myEffects.start({
+ 'height': [10, 100],
+ 'width': [900, 300]
+ });
+
+ //or height from current height to 100 and width from current width to 300
+ myEffects.start({
+ 'height': 100,
+ 'width': 300
+ });
+ (end)
+*/
+
+Fx.Styles = Fx.Base.extend({
+
+ initialize: function(el, options){
+ this.element = $(el);
+ this.parent(options);
+ },
+
+ setNow: function(){
+ for (var p in this.from) this.now[p] = this.css[p].getNow(this.from[p], this.to[p], this);
+ },
+
+ set: function(to){
+ var parsed = {};
+ this.css = {};
+ for (var p in to){
+ this.css[p] = Fx.CSS.select(p, to[p]);
+ parsed[p] = this.css[p].parse(to[p]);
+ }
+ return this.parent(parsed);
+ },
+
+ /*
+ Property: start
+ The function you'll actually use to execute a transition.
+
+ Arguments:
+ an object
+
+ Example:
+ see <Fx.Styles>
+ */
+
+ start: function(obj){
+ if (this.timer && this.options.wait) return this;
+ this.now = {};
+ this.css = {};
+ var from = {}, to = {};
+ for (var p in obj){
+ var parsed = Fx.CSS.parse(this.element, p, obj[p]);
+ from[p] = parsed.from;
+ to[p] = parsed.to;
+ this.css[p] = parsed.css;
+ }
+ return this.parent(from, to);
+ },
+
+ increase: function(){
+ for (var p in this.now) this.element.setStyle(p, this.css[p].getValue(this.now[p], this.options.unit));
+ }
+
+});
+
+/*
+Class: Element
+ Custom class to allow all of its methods to be used with any DOM element via the dollar function <$>.
+*/
+
+Element.extend({
+
+ /*
+ Property: effects
+ Applies an <Fx.Styles> to the Element; This a shortcut for <Fx.Styles>.
+
+ Example:
+ >var myEffects = $(myElement).effects({duration: 1000, transition: Fx.Transitions.sineInOut});
+ >myEffects.start({'height': [10, 100], 'width': [900, 300]});
+ */
+
+ effects: function(options){
+ return new Fx.Styles(this, options);
+ }
+
+});
+
+/*
+Script: Fx.Elements.js
+ Contains <Fx.Elements>
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Fx.Elements
+ Fx.Elements allows you to apply any number of styles transitions to a selection of elements. Includes colors (must be in hex format).
+
+Arguments:
+ elements - a collection of elements the effects will be applied to.
+ options - same as <Fx.Base> options.
+*/
+
+Fx.Elements = Fx.Base.extend({
+
+ initialize: function(elements, options){
+ this.elements = $$(elements);
+ this.parent(options);
+ },
+
+ setNow: function(){
+ for (var i in this.from){
+ var iFrom = this.from[i], iTo = this.to[i], iCss = this.css[i], iNow = this.now[i] = {};
+ for (var p in iFrom) iNow[p] = iCss[p].getNow(iFrom[p], iTo[p], this);
+ }
+ },
+
+ set: function(to){
+ var parsed = {};
+ this.css = {};
+ for (var i in to){
+ var iTo = to[i], iCss = this.css[i] = {}, iParsed = parsed[i] = {};
+ for (var p in iTo){
+ iCss[p] = Fx.CSS.select(p, iTo[p]);
+ iParsed[p] = iCss[p].parse(iTo[p]);
+ }
+ }
+ return this.parent(parsed);
+ },
+
+ /*
+ Property: start
+ Applies the passed in style transitions to each object named (see example). Each item in the collection is refered to as a numerical string ("1" for instance). The first item is "0", the second "1", etc.
+
+ Example:
+ (start code)
+ var myElementsEffects = new Fx.Elements($$('a'));
+ myElementsEffects.start({
+ '0': { //let's change the first element's opacity and width
+ 'opacity': [0,1],
+ 'width': [100,200]
+ },
+ '1': { //and the second one's opacity
+ 'opacity': [0.2, 0.5]
+ }
+ });
+ (end)
+ */
+
+ start: function(obj){
+ if (this.timer && this.options.wait) return this;
+ this.now = {};
+ this.css = {};
+ var from = {}, to = {};
+ for (var i in obj){
+ var iProps = obj[i], iFrom = from[i] = {}, iTo = to[i] = {}, iCss = this.css[i] = {};
+ for (var p in iProps){
+ var parsed = Fx.CSS.parse(this.elements[i], p, iProps[p]);
+ iFrom[p] = parsed.from;
+ iTo[p] = parsed.to;
+ iCss[p] = parsed.css;
+ }
+ }
+ return this.parent(from, to);
+ },
+
+ increase: function(){
+ for (var i in this.now){
+ var iNow = this.now[i], iCss = this.css[i];
+ for (var p in iNow) this.elements[i].setStyle(p, iCss[p].getValue(iNow[p], this.options.unit));
+ }
+ }
+
+});
+
+/*
+Script: Fx.Scroll.js
+ Contains <Fx.Scroll>
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Fx.Scroll
+ Scroll any element with an overflow, including the window element.
+
+Arguments:
+ element - the element to scroll
+ options - same as <Fx.Base> options.
+*/
+
+Fx.Scroll = Fx.Base.extend({
+
+ initialize: function(element, options){
+ this.now = [];
+ this.element = $(element);
+ this.addEvent('onStart', function(){
+ this.element.addEvent('mousewheel', this.stop.bind(this, false));
+ }.bind(this));
+ this.removeEvent('onComplete', function(){
+ this.element.removeEvent('mousewheel', this.stop.bind(this, false));
+ }.bind(this));
+ this.parent(options);
+ },
+
+ setNow: function(){
+ for (var i = 0; i < 2; i++) this.now[i] = this.compute(this.from[i], this.to[i]);
+ },
+
+ /*
+ Property: scrollTo
+ Scrolls the chosen element to the x/y coordinates.
+
+ Arguments:
+ x - the x coordinate to scroll the element to
+ y - the y coordinate to scroll the element to
+ */
+
+ scrollTo: function(x, y){
+ if (this.timer && this.options.wait) return this;
+ var el = this.element.getSize();
+ var values = {'x': x, 'y': y};
+ for (var z in el.size){
+ var max = el.scrollSize[z] - el.size[z];
+ if ($chk(values[z])) values[z] = ($type(values[z]) == 'number') ? Math.max(Math.min(values[z], max), 0) : max;
+ else values[z] = el.scroll[z];
+ }
+ return this.start([el.scroll.x, el.scroll.y], [values.x, values.y]);
+ },
+
+ /*
+ Property: toTop
+ Scrolls the chosen element to its maximum top.
+ */
+
+ toTop: function(){
+ return this.scrollTo(false, 0);
+ },
+
+ /*
+ Property: toBottom
+ Scrolls the chosen element to its maximum bottom.
+ */
+
+ toBottom: function(){
+ return this.scrollTo(false, 'full');
+ },
+
+ /*
+ Property: toLeft
+ Scrolls the chosen element to its maximum left.
+ */
+
+ toLeft: function(){
+ return this.scrollTo(0, false);
+ },
+
+ /*
+ Property: toRight
+ Scrolls the chosen element to its maximum right.
+ */
+
+ toRight: function(){
+ return this.scrollTo('full', false);
+ },
+
+ /*
+ Property: toElement
+ Scrolls the specified element to the position the passed in element is found. Only usable if the chosen element is == window.
+
+ Arguments:
+ el - the $(element) to scroll the window to
+ */
+
+ toElement: function(el){
+ return this.scrollTo($(el).getLeft(), $(el).getTop());
+ },
+
+ increase: function(){
+ this.element.scrollTo(this.now[0], this.now[1]);
+ }
+
+});
+
+/*
+Script: Fx.Slide.js
+ Contains <Fx.Slide>
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Fx.Slide
+ The slide effect; slides an element in horizontally or vertically, the contents will fold inside. Extends <Fx.Base>, inherits all its properties.
+
+Note:
+ This effect works on any block element, but the element *cannot be positioned*; no margins or absolute positions. To position the element, put it inside another element (a wrapper div, for instance) and position that instead.
+
+Options:
+ mode - set it to vertical or horizontal. Defaults to vertical.
+ and all the <Fx.Base> options
+
+Example:
+ (start code)
+ var mySlider = new Fx.Slide('myElement', {duration: 500});
+ mySlider.toggle() //toggle the slider up and down.
+ (end)
+*/
+
+Fx.Slide = Fx.Base.extend({
+
+ initialize: function(el, options){
+ this.element = $(el).setStyle('margin', 0);
+ this.wrapper = new Element('div').injectAfter(this.element).setStyle('overflow', 'hidden').adopt(this.element);
+ this.setOptions({'mode': 'vertical'}, options);
+ this.now = [];
+ this.parent(this.options);
+ },
+
+ setNow: function(){
+ for (var i = 0; i < 2; i++) this.now[i] = this.compute(this.from[i], this.to[i]);
+ },
+
+ vertical: function(){
+ this.margin = 'top';
+ this.layout = 'height';
+ this.offset = this.element.offsetHeight;
+ return [this.element.getStyle('margin-top').toInt(), this.wrapper.getStyle('height').toInt()];
+ },
+
+ horizontal: function(){
+ this.margin = 'left';
+ this.layout = 'width';
+ this.offset = this.element.offsetWidth;
+ return [this.element.getStyle('margin-left').toInt(), this.wrapper.getStyle('width').toInt()];
+ },
+
+ /*
+ Property: slideIn
+ slides the elements in view horizontally or vertically, depending on the mode parameter or options.mode.
+ */
+
+ slideIn: function(mode){
+ return this.start(this[mode || this.options.mode](), [0, this.offset]);
+ },
+
+ /*
+ Property: slideOut
+ slides the elements out of the view horizontally or vertically, depending on the mode parameter or options.mode.
+ */
+
+ slideOut: function(mode){
+ return this.start(this[mode || this.options.mode](), [-this.offset, 0]);
+ },
+
+ /*
+ Property: hide
+ Hides the element without a transition.
+ */
+
+ hide: function(mode){
+ this[mode || this.options.mode]();
+ return this.set([-this.offset, 0]);
+ },
+
+ /*
+ Property: show
+ Shows the element without a transition.
+ */
+
+ show: function(mode){
+ this[mode || this.options.mode]();
+ return this.set([0, this.offset]);
+ },
+
+ /*
+ Property: toggle
+ Slides in or Out the element, depending on its state
+ */
+
+ toggle: function(mode){
+ if (this.wrapper.offsetHeight == 0 || this.wrapper.offsetWidth == 0) return this.slideIn(mode);
+ else return this.slideOut(mode);
+ },
+
+ increase: function(){
+ this.element.setStyle('margin-'+this.margin, this.now[0]+this.options.unit);
+ this.wrapper.setStyle(this.layout, this.now[1]+this.options.unit);
+ }
+
+});
+
+/*
+Script: Fx.Transitions.js
+ Cool transitions, to be used with all the effects.
+
+Author:
+ Robert Penner, <http://www.robertpenner.com/easing/>, modified to be used with mootools.
+
+License:
+ Easing Equations v1.5, (c) 2003 Robert Penner, all rights reserved. Open Source BSD License.
+*/
+
+/*
+Class: Fx.Transitions
+ A collection of tweaning transitions for use with the <Fx.Base> classes.
+*/
+
+Fx.Transitions = {
+
+ /* Property: linear */
+ linear: function(t, b, c, d){
+ return c*t/d + b;
+ },
+
+ /* Property: quadIn */
+ quadIn: function(t, b, c, d){
+ return c*(t/=d)*t + b;
+ },
+
+ /* Property: quatOut */
+ quadOut: function(t, b, c, d){
+ return -c *(t/=d)*(t-2) + b;
+ },
+
+ /* Property: quadInOut */
+ quadInOut: function(t, b, c, d){
+ if ((t/=d/2) < 1) return c/2*t*t + b;
+ return -c/2 * ((--t)*(t-2) - 1) + b;
+ },
+
+ /* Property: cubicIn */
+ cubicIn: function(t, b, c, d){
+ return c*(t/=d)*t*t + b;
+ },
+
+ /* Property: cubicOut */
+ cubicOut: function(t, b, c, d){
+ return c*((t=t/d-1)*t*t + 1) + b;
+ },
+
+ /* Property: cubicInOut */
+ cubicInOut: function(t, b, c, d){
+ if ((t/=d/2) < 1) return c/2*t*t*t + b;
+ return c/2*((t-=2)*t*t + 2) + b;
+ },
+
+ /* Property: quartIn */
+ quartIn: function(t, b, c, d){
+ return c*(t/=d)*t*t*t + b;
+ },
+
+ /* Property: quartOut */
+ quartOut: function(t, b, c, d){
+ return -c * ((t=t/d-1)*t*t*t - 1) + b;
+ },
+
+ /* Property: quartInOut */
+ quartInOut: function(t, b, c, d){
+ if ((t/=d/2) < 1) return c/2*t*t*t*t + b;
+ return -c/2 * ((t-=2)*t*t*t - 2) + b;
+ },
+
+ /* Property: quintIn */
+ quintIn: function(t, b, c, d){
+ return c*(t/=d)*t*t*t*t + b;
+ },
+
+ /* Property: quintOut */
+ quintOut: function(t, b, c, d){
+ return c*((t=t/d-1)*t*t*t*t + 1) + b;
+ },
+
+ /* Property: quintInOut */
+ quintInOut: function(t, b, c, d){
+ if ((t/=d/2) < 1) return c/2*t*t*t*t*t + b;
+ return c/2*((t-=2)*t*t*t*t + 2) + b;
+ },
+
+ /* Property: sineIn */
+ sineIn: function(t, b, c, d){
+ return -c * Math.cos(t/d * (Math.PI/2)) + c + b;
+ },
+
+ /* Property: sineOut */
+ sineOut: function(t, b, c, d){
+ return c * Math.sin(t/d * (Math.PI/2)) + b;
+ },
+
+ /* Property: sineInOut */
+ sineInOut: function(t, b, c, d){
+ return -c/2 * (Math.cos(Math.PI*t/d) - 1) + b;
+ },
+
+ /* Property: expoIn */
+ expoIn: function(t, b, c, d){
+ return (t==0) ? b : c * Math.pow(2, 10 * (t/d - 1)) + b;
+ },
+
+ /* Property: expoOut */
+ expoOut: function(t, b, c, d){
+ return (t==d) ? b+c : c * (-Math.pow(2, -10 * t/d) + 1) + b;
+ },
+
+ /* Property: expoInOut */
+ expoInOut: function(t, b, c, d){
+ if (t==0) return b;
+ if (t==d) return b+c;
+ if ((t/=d/2) < 1) return c/2 * Math.pow(2, 10 * (t - 1)) + b;
+ return c/2 * (-Math.pow(2, -10 * --t) + 2) + b;
+ },
+
+ /* Property: circIn */
+ circIn: function(t, b, c, d){
+ return -c * (Math.sqrt(1 - (t/=d)*t) - 1) + b;
+ },
+
+ /* Property: circOut */
+ circOut: function(t, b, c, d){
+ return c * Math.sqrt(1 - (t=t/d-1)*t) + b;
+ },
+
+ /* Property: circInOut */
+ circInOut: function(t, b, c, d){
+ if ((t/=d/2) < 1) return -c/2 * (Math.sqrt(1 - t*t) - 1) + b;
+ return c/2 * (Math.sqrt(1 - (t-=2)*t) + 1) + b;
+ },
+
+ /* Property: elasticIn */
+ elasticIn: function(t, b, c, d, a, p){
+ if (t==0) return b; if ((t/=d)==1) return b+c; if (!p) p=d*.3; if (!a) a = 1;
+ if (a < Math.abs(c)){ a=c; var s=p/4; }
+ else var s = p/(2*Math.PI) * Math.asin(c/a);
+ return -(a*Math.pow(2,10*(t-=1)) * Math.sin( (t*d-s)*(2*Math.PI)/p )) + b;
+ },
+
+ /* Property: elasticOut */
+ elasticOut: function(t, b, c, d, a, p){
+ if (t==0) return b; if ((t/=d)==1) return b+c; if (!p) p=d*.3; if (!a) a = 1;
+ if (a < Math.abs(c)){ a=c; var s=p/4; }
+ else var s = p/(2*Math.PI) * Math.asin(c/a);
+ return a*Math.pow(2,-10*t) * Math.sin( (t*d-s)*(2*Math.PI)/p ) + c + b;
+ },
+
+ /* Property: elasticInOut */
+ elasticInOut: function(t, b, c, d, a, p){
+ if (t==0) return b; if ((t/=d/2)==2) return b+c; if (!p) p=d*(.3*1.5); if (!a) a = 1;
+ if (a < Math.abs(c)){ a=c; var s=p/4; }
+ else var s = p/(2*Math.PI) * Math.asin(c/a);
+ if (t < 1) return -.5*(a*Math.pow(2,10*(t-=1)) * Math.sin( (t*d-s)*(2*Math.PI)/p )) + b;
+ return a*Math.pow(2,-10*(t-=1)) * Math.sin( (t*d-s)*(2*Math.PI)/p )*.5 + c + b;
+ },
+
+ /* Property: backIn */
+ backIn: function(t, b, c, d, s){
+ if (!s) s = 1.70158;
+ return c*(t/=d)*t*((s+1)*t - s) + b;
+ },
+
+ /* Property: backOut */
+ backOut: function(t, b, c, d, s){
+ if (!s) s = 1.70158;
+ return c*((t=t/d-1)*t*((s+1)*t + s) + 1) + b;
+ },
+
+ /* Property: backInOut */
+ backInOut: function(t, b, c, d, s){
+ if (!s) s = 1.70158;
+ if ((t/=d/2) < 1) return c/2*(t*t*(((s*=(1.525))+1)*t - s)) + b;
+ return c/2*((t-=2)*t*(((s*=(1.525))+1)*t + s) + 2) + b;
+ },
+
+ /* Property: bounceIn */
+ bounceIn: function(t, b, c, d){
+ return c - Fx.Transitions.bounceOut (d-t, 0, c, d) + b;
+ },
+
+ /* Property: bounceOut */
+ bounceOut: function(t, b, c, d){
+ if ((t/=d) < (1/2.75)){
+ return c*(7.5625*t*t) + b;
+ } else if (t < (2/2.75)){
+ return c*(7.5625*(t-=(1.5/2.75))*t + .75) + b;
+ } else if (t < (2.5/2.75)){
+ return c*(7.5625*(t-=(2.25/2.75))*t + .9375) + b;
+ } else {
+ return c*(7.5625*(t-=(2.625/2.75))*t + .984375) + b;
+ }
+ },
+
+ /* Property: bounceInOut */
+ bounceInOut: function(t, b, c, d){
+ if (t < d/2) return Fx.Transitions.bounceIn(t*2, 0, c, d) * .5 + b;
+ return Fx.Transitions.bounceOut(t*2-d, 0, c, d) * .5 + c*.5 + b;
+ }
+
+};
+
+/*
+Script: Drag.Base.js
+ Contains <Drag.Base>, <Element.makeResizable>
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+var Drag = {};
+
+/*
+Class: Drag.Base
+ Modify two css properties of an element based on the position of the mouse.
+
+Arguments:
+ el - the $(element) to apply the transformations to.
+ options - optional. The options object.
+
+Options:
+ handle - the $(element) to act as the handle for the draggable element. defaults to the $(element) itself.
+ modifiers - an object. see Modifiers Below.
+ onStart - optional, function to execute when the user starts to drag (on mousedown);
+ onComplete - optional, function to execute when the user completes the drag.
+ onDrag - optional, function to execute at every step of the drag
+ limit - an object, see Limit below.
+ snap - optional, the distance you have to drag before the element starts to respond to the drag. defaults to false
+
+ modifiers:
+ x - string, the style you want to modify when the mouse moves in an horizontal direction. defaults to 'left'
+ y - string, the style you want to modify when the mouse moves in a vertical direction. defaults to 'top'
+
+ limit:
+ x - array with start and end limit relative to modifiers.x
+ y - array with start and end limit relative to modifiers.y
+*/
+
+Drag.Base = new Class({
+
+ getOptions: function(){
+ return {
+ handle: false,
+ unit: 'px',
+ onStart: Class.empty,
+ onComplete: Class.empty,
+ onSnap: Class.empty,
+ onDrag: Class.empty,
+ limit: false,
+ modifiers: {x: 'left', y: 'top'},
+ snap: 6
+ };
+ },
+
+ initialize: function(el, options){
+ this.setOptions(this.getOptions(), options);
+ this.element = $(el);
+ this.handle = $(this.options.handle) || this.element;
+ this.mouse = {'now': {}, 'pos': {}};
+ this.value = {'start': {}, 'now': {}};
+ this.bound = {'start': this.start.bindWithEvent(this)};
+ this.handle.addEvent('mousedown', this.bound.start);
+ if (this.options.initialize) this.options.initialize.call(this);
+ },
+
+ start: function(event){
+ this.mouse.start = event.page;
+ var limit = this.options.limit;
+ this.limit = {'x': [], 'y': []};
+ for (var z in this.options.modifiers){
+ this.value.now[z] = this.element.getStyle(this.options.modifiers[z]).toInt();
+ this.mouse.pos[z] = event.page[z] - this.value.now[z];
+ if (limit && limit[z]){
+ for (var i = 0; i < 2; i++){
+ if ($chk(limit[z][i])) this.limit[z][i] = limit[z][i].apply ? limit[z][i].call(this) : limit[z][i];
+ }
+ }
+ }
+ this.bound.drag = this.drag.bindWithEvent(this);
+ this.bound.checkAndDrag = this.checkAndDrag.bindWithEvent(this);
+ this.bound.stop = this.stop.bind(this);
+ document.addEvent('mousemove', this.options.snap ? this.bound.checkAndDrag : this.bound.drag);
+ document.addEvent('mouseup', this.bound.stop);
+ this.fireEvent('onStart', this.element);
+ event.stop();
+ },
+
+ checkAndDrag: function(event){
+ var distance = Math.round(Math.sqrt(Math.pow(event.page.x - this.mouse.start.x, 2) + Math.pow(event.page.y - this.mouse.start.y, 2)));
+ if (distance > this.options.snap){
+ document.removeEvent('mousemove', this.bound.checkAndDrag);
+ document.addEvent('mousemove', this.bound.drag);
+ this.drag(event);
+ this.fireEvent('onSnap', this.element);
+ }
+ event.stop();
+ },
+
+ drag: function(event){
+ this.out = false;
+ this.mouse.now = event.page;
+ for (var z in this.options.modifiers){
+ this.value.now[z] = event.page[z] - this.mouse.pos[z];
+ if (this.limit[z]){
+ if ($chk(this.limit[z][1]) && (this.value.now[z] > this.limit[z][1])){
+ this.value.now[z] = this.limit[z][1];
+ this.out = true;
+ } else if ($chk(this.limit[z][0]) && (this.value.now[z] < this.limit[z][0])){
+ this.value.now[z] = this.limit[z][0];
+ this.out = true;
+ }
+ }
+ this.element.setStyle(this.options.modifiers[z], this.value.now[z] + this.options.unit);
+ }
+ this.fireEvent('onDrag', this.element);
+ event.stop();
+ },
+
+ detach: function(){
+ this.handle.removeEvent('mousedown', this.bound.start);
+ },
+
+ stop: function(){
+ document.removeEvent('mousemove', this.bound.drag);
+ document.removeEvent('mouseup', this.bound.stop);
+ this.fireEvent('onComplete', this.element);
+ }
+
+});
+
+Drag.Base.implement(new Events);
+Drag.Base.implement(new Options);
+
+/*
+Class: Element
+ Custom class to allow all of its methods to be used with any DOM element via the dollar function <$>.
+*/
+
+Element.extend({
+
+ /*
+ Property: makeResizable
+ Makes an element resizable (by dragging) with the supplied options.
+
+ Arguments:
+ options - see <Drag.Base> for acceptable options.
+ */
+
+ makeResizable: function(options){
+ return new Drag.Base(this, Object.extend(options || {}, {modifiers: {x: 'width', y: 'height'}}));
+ }
+
+});
+
+/*
+Script: Scroller.js
+ Contains the <Scroller>.
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Scroller
+ The Scroller is a class to scroll any element with an overflow (including the window) when the mouse cursor reaches certain buondaries of that element.
+ You must call its start method to start listening to mouse movements.
+
+Arguments:
+ element - required, the element to scroll.
+ options - optional, see options below, and <Fx.Base> options.
+
+Options:
+ area - integer, the necessary boundaries to make the element scroll.
+ velocity - integer, velocity ratio, the modifier for the window scrolling speed.
+ onChange - optionally, when the mouse reaches some boundaries, you can choose to alter some other values, instead of the scrolling offsets.
+ Automatically passes as parameters x and y values.
+*/
+
+var Scroller = new Class({
+
+ getOptions: function(){
+ return {
+ area: 20,
+ velocity: 1,
+ onChange: function(x, y){
+ this.element.scrollTo(x, y);
+ }
+ };
+ },
+
+ initialize: function(element, options){
+ this.setOptions(this.getOptions(), options);
+ this.element = $(element);
+ this.mousemover = ([window, document].test(element)) ? $(document.body) : this.element;
+ },
+
+ /*
+ Property: start
+ The scroller starts listening to mouse movements.
+ */
+
+ start: function(){
+ this.coord = this.getCoords.bindWithEvent(this);
+ this.mousemover.addEvent('mousemove', this.coord);
+ },
+
+ /*
+ Property: stop
+ The scroller stops listening to mouse movements.
+ */
+
+ stop: function(){
+ this.mousemover.removeEvent('mousemove', this.coord);
+ this.timer = $clear(this.timer);
+ },
+
+ getCoords: function(event){
+ this.page = (this.element == window) ? event.client : event.page;
+ if (!this.timer) this.timer = this.scroll.periodical(50, this);
+ },
+
+ scroll: function(){
+ var el = this.element.getSize();
+ var pos = this.element.getOffsets();
+
+ var change = {'x': 0, 'y': 0};
+ for (var z in this.page){
+ if (this.page[z] < (this.options.area + pos[z]) && el.scroll[z] != 0)
+ change[z] = (this.page[z] - this.options.area - pos[z]) * this.options.velocity;
+ else if (this.page[z] + this.options.area > (el.size[z] + pos[z]) && el.scroll[z] + el.size[z] != el.scrollSize[z])
+ change[z] = (this.page[z] - el.size[z] + this.options.area - pos[z]) * this.options.velocity;
+ }
+ if (change.y || change.x) this.fireEvent('onChange', [el.scroll.x + change.x, el.scroll.y + change.y]);
+ }
+
+});
+
+Scroller.implement(new Events);
+Scroller.implement(new Options);
+
+/*
+Script: Slider.js
+ Contains <Slider>
+
+Author:
+ Valerio Proietti, <http://mad4milk.net>
+
+License:
+ MIT-style license.
+*/
+
+/*
+Class: Slider
+ Creates a slider with two elements: a knob and a container. Returns the values.
+
+Arguments:
+ element - the knob container
+ knob - the handle
+ options - see Options below
+
+Options:
+ onChange - a function to fire when the value changes.
+ onComplete - a function to fire when you're done dragging.
+ onTick - optionally, you can alter the onTick behavior, for example displaying an effect of the knob moving to the desired position.
+ Passes as parameter the new position.
+ steps - the number of steps for your slider.
+ mode - either 'horizontal' or 'vertical'. defaults to horizontal.
+ wheel - experimental! Also use the mouse wheel to control the slider. defaults to false.
+*/
+
+var Slider = new Class({
+
+ getOptions: function(){
+ return {
+ onChange: Class.empty,
+ onComplete: Class.empty,
+ onTick: function(pos){
+ this.knob.setStyle(this.p, pos+'px');
+ },
+ steps: 100,
+ mode: 'horizontal',
+ wheel: false
+ };
+ },
+
+ initialize: function(el, knob, options){
+ this.element = $(el);
+ this.knob = $(knob);
+ this.setOptions(this.getOptions(), options);
+
+ this.previousChange = -1;
+ this.previousEnd = -1;
+ this.step = -1;
+
+ this.element.addEvent('mousedown', this.clickedElement.bindWithEvent(this));
+
+ if (this.options.wheel) this.element.addEvent('mousewheel', this.scrolledElement.bindWithEvent(this));
+
+ if (this.options.mode == 'horizontal'){
+ this.z = 'x'; this.p = 'left';
+ this.max = this.element.offsetWidth-this.knob.offsetWidth;
+ this.half = this.knob.offsetWidth/2;
+ this.getPos = this.element.getLeft.bind(this.element);
+ } else if (this.options.mode == 'vertical'){
+ this.z = 'y'; this.p = 'top';
+ this.max = this.element.offsetHeight-this.knob.offsetHeight;
+ this.half = this.knob.offsetHeight/2;
+ this.getPos = this.element.getTop.bind(this.element);
+ }
+
+ this.knob.setStyle('position', 'relative').setStyle(this.p, 0);
+
+ var modSlide = {}, limSlide = {};
+
+ limSlide[this.z] = [0, this.max];
+ modSlide[this.z] = this.p;
+
+ this.drag = new Drag.Base(this.knob, {
+ limit: limSlide,
+ snap: 0,
+ modifiers: modSlide,
+ onStart: function(){
+ this.draggedKnob();
+ }.bind(this),
+ onDrag: function(){
+ this.draggedKnob();
+ }.bind(this),
+ onComplete: function(){
+ this.draggedKnob();
+ this.end();
+ }.bind(this)
+ });
+ if (this.options.initialize) this.options.initialize.call(this);
+ },
+
+ /*
+ Property: set
+ The slider will get the step you pass.
+
+ Arguments:
+ step - one integer
+ */
+
+ set: function(step){
+ if (step > this.options.steps) step = this.options.steps;
+ else if (step < 0) step = 0;
+ this.step = step;
+ this.checkStep();
+ this.end();
+ this.fireEvent('onTick', this.toPosition(this.step)+'');
+ return this;
+ },
+
+ scrolledElement: function(event){
+ if (event.wheel < 0) this.set(this.step + 1);
+ else if (event.wheel > 0) this.set(this.step - 1);
+ event.stop();
+ },
+
+ clickedElement: function(event){
+ var position = event.page[this.z] - this.getPos() - this.half;
+ if (position > this.max) position = this.max;
+ else if (position < 0) position = 0;
+ this.step = this.toStep(position);
+ this.checkStep();
+ this.end();
+ this.fireEvent('onTick', position+'');
+ },
+
+ draggedKnob: function(){
+ this.step = this.toStep(this.drag.value.now[this.z]);
+ this.checkStep();
+ },
+
+ checkStep: function(){
+ if (this.previousChange != this.step){
+ this.previousChange = this.step;
+ this.fireEvent('onChange', this.step);
+ }
+ },
+
+ end: function(){
+ if (this.previousEnd !== this.step){
+ this.previousEnd = this.step;
+ this.fireEvent('onComplete', this.step+'');
+ }
+ },
+
+ toStep: function(position){
+ return Math.round(position/this.max*this.options.steps);
+ },
+
+ toPosition: function(step){
+ return (this.max)*step/this.options.steps;
+ }
+
+});
+
+Slider.implement(new Events);
+Slider.implement(new Options);
\ No newline at end of file
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>News and Notes about nXhtml</title>
+ <link href="wd/grapes/nxhtml-grapes.css" rel="StyleSheet" type="text/css" />
+ <style type="text/css">
+#nxhtml-home a {
+ /* Image */
+ display: block;
+ background: transparent url("img/getitbuttons.png") 0 0 no-repeat;
+ overflow: hidden;
+ width: 200px;
+ xheight: 35px;
+ /* Text placement and size, etc */
+ text-align: center;
+ padding-top: 11px;
+ font-size: 12px;
+ padding-bottom: 9px;
+ text-decoration: none;
+ white-space: nowrap;
+ margin: 0;
+ border: none;
+}
+#nxhtml-home a:hover {
+ background-position: 0 -35px;
+ color: yellow;
+}
+.bugfix {
+ background-color: #ffd700;
+}
+
+</style>
+ </head>
+ <body>
+ <div id="container">
+
+ <div id="rgtcol">
+ <p id="nxhtml-home"><a href='nxhtml.html'>To nXhtml main page</a></p>
+
+ <h1>News and Notes about nXhtml</h1>
+
+ <dl>
+
+ <dt id="state-of-the-art" style="margin-top:1em;
+ background-color: #66cd5c;
+ background-color: #96cd5c;
+ padding: 0.5em;
+ ">The State of the Art</dt>
+ <dd style="background-color: #f9e529; padding: 0.5em">
+ <p>
+ I believe now that MuMaMo (the multi major mode support)
+ is fairly stable. It is now possible to have chunks in
+ chunks and it is reasonably fast.
+ </p>
+ <p>
+ The major mode than once gave the name to this package
+ for web devoloping, nxhtml-mode, has long been stable.
+ There are a lot of other minor things in this package.
+ Of course everything is not perfect. Bug report and
+ taking part in the development is very welcome. Go to
+ the project page on Launchpad if you want to join!
+ </p>
+ <p>
+ If you want to know how it works, install and test. It
+ will not harm, everything is autoloaded so it will not
+ slow down your Emacs - eh, a tiny little bit perhaps if
+ you really use it, but then you will also get the
+ benefits of it.
+ </p>
+ <p>
+ If you want to know current bug status go to Launchpad!
+ </p>
+ </dd>
+
+ <dt id="hadron-bugs" style="margin-top:1em;">Thanks for testing!</dt>
+ <dd>
+ <p>
+ I want to thanks the testers and bug reporters (who have
+ been many now), especially to my first testers Hadron
+ Quark and Eric Lilja, for helping me by testing and
+ pointing out bugs and weaknesses, most of them related
+ to editing of PHP.
+ </p>
+ <p>
+ Without testers all kind of problems I just can't
+ imagine myself would still be there in nXhtml. For
+ example Hadron told me once that he got the error
+ <i>(wrong-type-argument stringp nil)</i>. Eh, I replied, are
+ you sure. Yes he was. I tried the same file as him. No
+ error.
+ </p>
+ <p>
+ The error happened during fontification so the error
+ message above was all we had. A real black box for
+ me. Or perhaps black magic? After much confusion and
+ some hard work we finally found out what it was and I
+ implemented a better way to catch such errors. If Hadron
+ would have given up the problem would still have been
+ there. Some problems are just impossible to solve
+ without good cooperation. So, again, thanks Hadron.
+ </p>
+ <p>
+ BTW, I will perhaps add some even better way to Emacs to
+ catch these errors so other can benefit from our
+ insights too, but that requires some time and effort
+ which I can't afford right now.
+ </p>
+ <p>
+ If is now a bit more easy to take care of errors since
+ there is a good bug database for nXhtml at Launchpad.
+ </p>
+ </dd>
+
+ <dt id="underline-bug" style="margin-top:1em;">Long Red Underlines</dt>
+ <dd>
+ <p>
+ Because of a bug in Emacs 22.1 you can sometimes (at the
+ end of a line) get long red lines instead of just a
+ single underlined character. Many users (me included)
+ find this quite a bit disturbing. I have therefore added
+ a command to quickly hide/show the underlines. This is
+ on <em>C-c C-w</em> (nxhtml-toggle-visible-warnings, key
+ binding changed to <em>C-c _</em> in later versions of
+ nXhtml).
+ </p>
+ <p>
+ This is particular useful for example in the case where
+ you edit a PHP file and are bound to get a lot of XHTML
+ validation errors.
+ </p>
+ </dd>
+
+ <dt id="php-attribute-values" style="margin-top:1em;">Attribute values computed by PHP</dt>
+ <dd>
+ <p>
+ If you want to have attribute values computed by PHP
+ here is a way how to structure that to avoid breaking
+ completion and validation in the XHTML part unnessecary:
+ </p>
+ <p style="margin-left:2em">
+ <img src="images/linux.png" title="<?php foo("bar");?>"/>
+ </p>
+ <p>
+ Unfortunately that still breaks XHTML validation since
+ < is not allowed in strings. In the long run I
+ believe the XML validator has to be broken up so that it
+ avoids parsing the string here (in PHP files).
+ </p>
+ <p>
+ For now I have implemented a workaround.
+ If you are using constructs like those above then turn on <em>mumamo-alt-php-tags-mode</em>.
+ This will temporarily replace the above with
+ </p>
+ <p style="margin-left:2em">
+ <img src="images/linux.png" title="(?php foo("bar");?)"/>
+ </p>
+ <p>
+ However on the screen you will still see the original
+ string and when writing to file the correct characters
+ will be used.
+ </p>
+ </dd>
+
+ <dt id="pi-note" style="margin-top:1em;">A note for PHP and its cousins</dt>
+ <dd>
+ <p>
+ The rules for a process instruction in XML, like <?php
+ ... ?> says that the text can contain any text except
+ <em>?></em>. So if you want to output that string
+ from PHP then break it up so it does not look as ?> in
+ the source file.
+ </p>
+ <p>
+ It might be good to break up the beginning part of the
+ process instructions too. And please note that to use
+ XHTML validation or completion you should avoid using
+ < in strings, since it is not allowed there.
+ </p>
+ </dd>
+
+ <dt id="mmm-compat" style="margin-top:1em;">Why the chunks are not compatible with mmm</dt>
+ <dd>
+ <p>
+ Some people have asked why the way to specify chunks in
+ mumamo-mode is not compatible with the old mmm-mode. The
+ answer is that I was not sure that the way used in
+ mmm-mode for specifying the chunks was flexible enough.
+ </p>
+ <p>
+ Some people have also wondered why MuMaMo does not find
+ chunks just as simple as multi-mode does. The answer is
+ it did from the beginning. However that way (looking
+ around current point) is not stable enough. Multi major
+ modes are a bit different in this respect than normal
+ major modes. More things can go wrong when you are
+ guessing.
+ </p>
+ </dd>
+
+ </dl>
+
+ <h1 id="change-history">nXhtml Changes</h1>
+
+ <div>
+ <a href="#v0.89">v0.89</a>
+ <a href="#v0.90">v0.90</a>
+ <a href="#v0.91">v0.91</a>
+ <a href="#v0.92">v0.92</a>
+ <a href="#v0.93">v0.93</a>
+ <a href="#v0.94">v0.94</a>
+ <a href="#v0.95">v0.95</a>
+ <a href="#v0.96">v0.96</a>
+ <a href="#v0.97">v0.97</a>
+ <a href="#v0.98">v0.98</a>
+ <a href="#v0.99">v0.99</a>
+ <a href="#v1.00">v1.00</a>
+ <a href="#v1.01">v1.01</a>
+ <a href="#v1.02">v1.02</a>
+ <a href="#v1.03">v1.03</a>
+ <a href="#v1.04">v1.04</a>
+ <a href="#v1.10">v1.10</a>
+ <a href="#v1.11">v1.11</a>
+ <a href="#v1.12">v1.12</a>
+ <a href="#v1.13">v1.13</a>
+ <a href="#v1.14">v1.14</a>
+ <a href="#v1.15">v1.15</a>
+ <a href="#v1.16">v1.16</a>
+ <a href="#v1.17">v1.17</a>
+ <a href="#v1.18">v1.18</a>
+ <a href="#v1.19">v1.19</a>
+ <a href="#v1.20">v1.20</a>
+ <a href="#v1.21">v1.21</a>
+ <a href="#v1.22">v1.22</a>
+ <a href="#v1.23">v1.23</a>
+ <a href="#v1.24">v1.24</a>
+ <a href="#v1.25">v1.25</a>
+ <a href="#v1.26">v1.26</a>
+ <a href="#v1.27">v1.27</a>
+ <a href="#v1.28">v1.28</a>
+ <a href="#v1.29">v1.29</a>
+ <a href="#v1.30">v1.30</a>
+ <a href="#v1.31">v1.31</a>
+ <a href="#v1.32">v1.32</a>
+ <a href="#v1.33">v1.33</a>
+ <a href="#v1.34">v1.34</a>
+ <a href="#v1.35">v1.35</a>
+ <a href="#v1.36">v1.36</a>
+ <a href="#v1.37">v1.37</a>
+ <a href="#v1.38">v1.38</a>
+ <a href="#v1.39">v1.39</a>
+ <a href="#v1.40">v1.40</a>
+ <a href="#v1.41">v1.41</a>
+ <a href="#v1.42">v1.42</a>
+ <a href="#v1.43">v1.43</a>
+ <a href="#v1.44">v1.44</a>
+ <a href="#v1.45">v1.45</a>
+ <a href="#v1.46">v1.46</a>
+ <a href="#v1.47">v1.47</a>
+ <a href="#v1.48">v1.48</a>
+ <a href="#v1.49">v1.49</a>
+ <a href="#v1.50">v1.50</a>
+ <a href="#v1.51">v1.51</a>
+ <a href="#v1.52">v1.52</a>
+ <a href="#v1.53">v1.53</a>
+ <a href="#v1.54">v1.54</a>
+ <a href="#v1.55">v1.56</a>
+ <a href="#v1.56">v1.56</a>
+ <a href="#v1.57">v1.57</a>
+ <a href="#v1.58">v1.58</a>
+ <a href="#v1.59">v1.59</a>
+ <a href="#v1.60">v1.60</a>
+ <a href="#v1.61">v1.61</a>
+ <a href="#v1.62">v1.62</a>
+ <a href="#v1.63">v1.63</a>
+ <a href="#v1.64">v1.64</a>
+ <a href="#v1.65">v1.65</a>
+ <a href="#v1.66">v1.66</a>
+ <a href="#v1.67">v1.67</a>
+ <a href="#v1.68">v1.68</a>
+ <a href="#v1.69">v1.69</a>
+ <a href="#v1.70">v1.70</a>
+ <a href="#v1.71">v1.71</a>
+ <a href="#v1.72">v1.72</a>
+ <a href="#v1.73">v1.73</a>
+ <a href="#v1.74">v1.74</a>
+ <a href="#v1.75">v1.75</a>
+ <a href="#v1.76">v1.76</a>
+ <a href="#v1.77">v1.77</a>
+ <a href="#v1.78">v1.78</a>
+ <a href="#v1.79">v1.79</a>
+ <a href="#v1.80">v1.80</a>
+ <a href="#v1.81">v1.81</a>
+ <a href="#v1.82">v1.82</a>
+ <a href="#v1.83">v1.83</a>
+ <a href="#v1.84">v1.84</a>
+ <a href="#v1.85">v1.85</a>
+ <a href="#v1.86">v1.86</a>
+ <a href="#v1.87">v1.87</a>
+ <a href="#v1.88">v1.88</a>
+ <a href="#v1.89">v1.89</a>
+ <a href="#v1.90">v1.90</a>
+ <a href="#v1.91">v1.91</a>
+ <a href="#v1.92">v1.92</a>
+ <a href="#v1.93">v1.93</a>
+ <a href="#v1.94">v1.94</a>
+ <a href="#v1.95">v1.95</a>
+ <a href="#v1.96">v1.96</a>
+ <a href="#v1.97">v1.97</a>
+ <a href="#v1.98">v1.98</a>
+ <a href="#v1.99">v1.99</a>
+ <a href="#v2.00">v2.00</a>
+ <a href="#v2.01">v2.01</a>
+ <a href="#v2.02">v2.02</a>
+ <a href="#v2.03">v2.03</a>
+ <a href="#v2.04">v2.04</a>
+ <a href="#v2.05">v2.05</a>
+ <a href="#v2.06">v2.06</a>
+ <a href="#v2.07">v2.07</a>
+ <a href="#v2.08">v2.08</a>
+ </div>
+
+ <dl>
+ <dt id="v0.89">0.89</dt>
+ <dd>
+ <ul>
+ <li>
+ Corrected autostart for nXhtml when not used together with EmacsW32.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.90">0.90</dt>
+ <dd>
+ <ul>
+ <li>
+ Improved display of XML path.
+ </li>
+ <li>
+ Discontinued xmple-mode.
+ </li>
+ <li>
+ New major modes nxhtml-part-mode/nxml-part-mode replaces
+ minor mode xmlpe-mode. (While moving the code to
+ nxhtml-part.el I also fixed a bug in Xmple minor mode that
+ made Emacs take 99% of the CPU.)
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.91">0.91</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed some calls to perl which prevented uploading of
+ a site of you did not have perl in the same location
+ as me.
+ </li>
+ <li>
+ Glued together things so that editing PHP files works
+ as I intended. (This means that Emacs switches between
+ php-mode and nxhtml-part-mode automatically when
+ moving point. And that you can use completion.)
+ </li>
+ <li>
+ Starting working on the documentation for nXhtml.
+ New layout to the documentation files.
+ Examples with images.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.92">0.92</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixes to make the switching between php and xhtml
+ style editing work better.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.93">0.93</dt>
+ <dd>
+ <ul>
+ <li>
+ Better error handling when switching to editing
+ embedded JavaScript and CSS.
+ </li>
+ <li>
+ Removed PHP spec from embedded switching since they
+ interfered with the automatic switching between php
+ and xhtml.
+ </li>
+ <li>
+ Gives an error message if web host is not defined in
+ site when trying to use View Uploaded File and
+ cousins.
+ </li>
+ <li>
+ Gives a ready message when finished uploading a single
+ file.
+ </li>
+ <li>
+ When using Mode Switching at <? ... ?> mode
+ switching could occur in wrong buffer. Fixed together
+ with some other buffer problems.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.94">0.94</dt>
+ <dd>
+ <ul>
+ <li>
+ Add http://www.w3.org/ to the help sites for CSS.
+ </li>
+ <li>
+ Included a CSS mode.
+ </li>
+ <li>
+ Added a menu entry for bug reporting.
+ </li>
+ <li>
+ Renamed menu bar entry from XHTML to nXhtml for clarity.
+ (But nXml menu bar entry is still called XML.)
+ </li>
+ <li>
+ Added work around for globalized minor modes in the
+ cases of MLinks, XML Path and mode switching at <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.95">0.95</dt>
+ <dd>
+ <ul>
+ <li>
+ Added workaround for the problem with the first
+ keyboard key after automatically switching of mode at
+ <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.96">0.96</dt>
+ <dd>
+ <ul>
+ <li>
+ Added support for multiple major modes with mumamo.el.
+ </li>
+ <li>
+ More conventient handling of links. They can now be
+ opened in the same window, 'other window' or in a new
+ frame.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.97">0.97</dt>
+ <dd>
+ <ul>
+ <li>
+ Schema was not setup after starting new page so
+ completion did not work. Fixed.
+ </li>
+ <li>
+ Added http://xhtml.com/ to help sites for XHTML.
+ </li>
+ <li>
+ Added the concept of <em>fictive XML validation
+ headers</em>. These are just text parsed by the nXml
+ validation parser to get a start state before starting
+ parsing a buffer. This allows the use of the nXml
+ completion in buffers where there are no XML header.
+ Such a header is often lacking for example in PHP code
+ since the XHTML header is often generated dynamically.
+ </li>
+ <li>
+ Because of the change above <em>nxhtml-part-mode</em>
+ is no longer needed and is therefore declared
+ obsolete.
+ </li>
+ <li>
+ Corrected a bug in mlinks.el that prevented opening an
+ HTML link in a other window or a new frame.
+ </li>
+ <li>
+ Added support for JSP, eRuby and some support for perl
+ in mumamo.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.98">0.98</dt>
+ <dd>
+ <ul>
+ <li>
+ Mumamo was not found when nXhtml was installed with
+ just the zip file. Corrected. (nXhtml is also
+ installed when you install EmacsW32.)
+ </li>
+ <li>
+ Enhancement to mumamo error handling when a bad mode
+ specifier for an embedded mode is found.
+ </li>
+ <li>
+ Introduced a bug for empty XHTML documents in
+ 0.97. Corrected.
+ </li>
+ <li>
+ Corrected a bug for chunks 1 character long.
+ </li>
+ <li>
+ There is what I consider is a bug in Emacs 22.1 in the
+ handling of global minor mode that are not distributed
+ with Emacs. If they are turned on by customization,
+ but loaded after Emacs have loaded the customizations
+ (usually in .emacs) then they are not turned on
+ correctly. Added work-around for this.
+ </li>
+ <li>
+ <em>Fictive XHTML Validation Header</em>:
+ <ul>
+ <li>
+ <em>Fictive XHTML Validation Header</em> state was not saved when moving between chunks. Fixed.
+ </li>
+ <li>
+ Tried to make the concept of <em>Fictive XHTML Validation Header</em>
+ more clear. Added this visually to the buffer.
+ </li>
+ <li>
+ <em>Fictive XHTML Validation Headers</em> can now be turned on
+ automatically based on file name.
+ </li>
+ </ul>
+ </li>
+ <li>
+ <em>nXhtml menu:</em>
+ <ul>
+ <li>
+ Reorganized the nXhtml menu.
+ </li>
+ <li>
+ Added <em>customization</em> groups for help libraries to nXhtml.
+ </li>
+ <li>
+ Added an entry for customization of nXhtml to the menus.
+ </li>
+ <li>
+ Added <em>Tidy</em> to the menus again.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Corrected bug in <em>XML Path</em> (nxml-where) for single tags.
+ Other small fixes to nxhtml-where.
+ </li>
+ <li>
+ Documentation enhancements.
+ Added <em>The Quick Guide</em>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.99">0.99</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed a serious bug in the cooperation between nxhtml-mode and mumamo-mode.
+ </li>
+ <li>
+ Turn on mumamo-mode by file name (mumamo-global-mode).
+ </li>
+ <li>
+ Fictive XHTML Validation Header:
+ <ul>
+ <li>
+ The Fictive XHTML Validation Header state were not saved when changing major mode in MuMaMo. Corrected.
+ </li>
+ <li>
+ Added more alternatives to the Fictive XHTML Validation Header list.
+ This should make it easier to use completion with for example PHP.
+ </li>
+ <li>
+ Added default value for the Fictive XHTML Validation Header.
+ </li>
+ <li>
+ Tried to make the use of Fictive XHTML Validation Header more automatic and therefore useful.
+ Also tried to make it play better with setting schema file.
+ (There is no need normally to set schema file by hand.)
+ </li>
+ <li>
+ To turn this on by default customize nxhtml-global-validation-header-mode.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Possible to hide validation warnings without turning
+ on validation (which would make completion in the
+ XHTML part impossible).
+ </li>
+ <li>
+ Some fixes to php-mode:
+ <ul>
+ <li>Using the character # for comments now works for most cases.</li>
+ <li>Now uses the fontification faces in a more standard way which calms down the look.</li>
+ <li>Initialization bug fixes.</li>
+ <li>Renamed php-mode-user-hook to php-mode-hook to follow standard.</li>
+ </ul>
+ </li>
+ <li>
+ Indentation fixes:
+ <ul>
+ <li>
+ Various corrections to indentation in mumamo.
+ </li>
+ <li>
+ Added the possibility to use TAB to indent regions
+ (indent-region-mode).
+ </li>
+ <li>
+ Warn about bad indentation in mixed PHP/HTML code
+ when using php-mode only.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fontification now fontifies all text first in main
+ major mode and thereafter applies submodes. (This
+ avoids some problems with around a submode chunk.)
+ </li>
+ <li>
+ Reorganized the nXhtml menu:
+ <ul>
+ <li>
+ There is now a minor mode for the nXhtml
+ menu. This makes it possible to easier use common
+ features when in buffers not in nxhtml-mode.
+ </li>
+ <li>
+ The nXhtml menu does not disappear when moving
+ into a chunk where the major mode is not
+ nxhtml-mode. The changes also makes it easy to
+ access uploading functions functions etc from
+ other modes than nxhtml-mode since the
+ <em>nXhtml</em> may also be shown in them.
+ </li>
+ <li>
+ The nXhtml menu can be turned on globally by default.
+ Customize nxhtml-menu-mode for that.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.00">1.00</dt>
+ <dd>
+ <ul>
+ <li>
+ Reached version number 1.00 - which you maybe believe
+ means the bugs should be gone? Sorry, it is just that
+ I ran out of version numbers. However it looks like
+ much fewer bugs at least.
+ </li>
+ <li>
+ Fixed problems mostly related to global turn on of different features in nXhtml.
+ </li>
+ <li>
+ Small fixes to indentation.
+ <ul>
+ <li>
+ nxhtml-mode could get confused by php tags.
+ </li>
+ <li>
+ nxhtml-mode did not indent <!DOCTYPE in a sensible way.
+ </li>
+ <li>
+ Electric keys now works in embedded php when using mumamo-mode.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Tidy was very misbehaving since the output buffer was
+ not erased between different files. But I have got no
+ bug reports on this.
+ </li>
+ <li>
+ Fixed a bug in validation that should up when using muamo-mode.
+ </li>
+ <li>
+ Fixed bug in <script ...> and <style ...> chunk dividing.
+ </li>
+ <li>
+ Added support for OpenLaszlo.
+ </li>
+ <li>
+ Corrections to mlinks-mode (visible mostly as links in
+ XHTML buffers):
+ <ul>
+ <li>
+ Links disappeared when a new file was
+ opened. Corrected.
+ </li>
+ <li>
+ Links were not correctly updated at changes in the
+ buffer when mumamo-mode was used. Fixed.
+ </li>
+ </ul>
+ </li>
+ <li>
+ The welcome message for nXhtml could be shown too
+ early sometimes when loading, before nXhtml actually
+ knew if it should be shown or not. Tried to fix it.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.01">1.01</dt>
+ <dd>
+ <ul>
+ <li>
+ Reported wrong version number for nXhtml in the menus. Fixed.
+ </li>
+ <li>
+ <em>If you use the zip file to install nXhtml please
+ notice that it has now a top level nxml.</em> Sorry for not
+ having zipped it like that before!
+ </li>
+ <li>
+ The url links in <em>Welcome to nXhtml</em> was a bit
+ incorrect and did not work on all OS:es. Fixed.
+ </li>
+ <li>
+ Added customization of popup completion to the 'nxhtml
+ customization group so they are easier to find.
+ </li>
+ <li>
+ MuMaMo
+ <ul>
+ <li>
+ Struggled a bit with the load sequences of the elisp
+ libraries used by nXhtml when using MuMaMo.
+ </li>
+ <li>
+ Tried to get the global turn on of mumam-mode to work
+ in all cases.
+ </li>
+ <li>
+ The screen was blinking when changing overlays after
+ changes in the buffer. Tried to fix this.
+ </li>
+ <li>
+ Minor fixes do syntax highlighting, like taking care of single ':s.
+ </li>
+ <li>
+ Fixes to the support for JSP and eRuby.
+ </li>
+ <li>
+ Made the support for perl here documents a bit better.
+ Large perl documents are however still quite slow when
+ using mumamo-mode. I do not know the reason yet.
+ </li>
+ <li>
+ Refontification could miss some parts when buffer
+ changes caused chunk division changes. Complex,
+ tried to fix it, but I am a bit unsure that it
+ always works.
+ </li>
+ <li>
+ Cleaned up mumamo.el a bit.
+ </li>
+ <li>
+ Rewrote mumamo-test.el and functions called from it in
+ mumamo.el a bit to make tracebacks from errors more
+ useful. Changed keybindings in mumamo-test.el from
+ global to a minor mode <em>mumamo-test-mode</em>.
+ Renamed mumamo-notest.el to mumamo-test.el. Added it
+ to the zipped distribution of nXhtml.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fixed a bug related to links and buffer changes.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.02">1.02</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed a refontification bug that occured after changes.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.03">1.03</dt>
+ <dd>
+ <ul>
+ <li>
+ Added the possibility to call GIMP.
+ </li>
+ <li>
+ Reworked the messages for fontification errors to try
+ to catch an error that shows up sometimes. Tried to
+ avoid disturbing normal use in spite of that error.
+ </li>
+ <li>
+ Reverted to using a short delay before switching major
+ mode when moving between buffers.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.04">1.04</dt>
+ <dd id="v1.04-dd">
+ <ul>
+ <li>
+ Enhanced the documentation for nXhtml. Starting from
+ <i>C-h f nxhtml-mode</i> it should now be easier to
+ get an overview.
+ </li>
+ <li>
+ Bug fixes etc:
+ <ul id="v1.04-bugs">
+ <li>
+ Completion on an empty page gave a faulty frameset page. Fixed.
+ </li>
+ <li>
+ Insert end tag did not work with a fictive
+ validation header. Fixed.
+ </li>
+ <li>
+ Insert end tag when all preceding tags where
+ closed gave a strange error message. Fixed.
+ </li>
+ <li>
+ Changed some key bindings to comply with
+ <i>(info "(elisp) Key Binding Conventions")</i>
+ </li>
+ <li>
+ Completion in empty buffers with a completion
+ header did not work. Fixed.
+ </li>
+ <li id="mumamo-bugs">
+ Multiple major modes:
+ <ul>
+ <li>
+ Fixed a bug that prevented mumamo-global-mode from
+ beeing turned on in a file opened in
+ fundamental-mode.
+ </li>
+ <li>
+ Better error tracing for some functions,
+ including the call of major mode functions.
+ </li>
+ <li>
+ Position was garbled when a ;-char was inserted in php-mode chunk. Fixed.
+ </li>
+ <li>
+ A bad check for if mlinks-mode where available was fixed.
+ </li>
+ <li>
+ Some bugs concerning turning off mumamo-mode was fixed.
+ </li>
+ <li>
+ Fixed a bug in <i>perl here doc</i> chunks. Suddenly the
+ problem with slowness when using mumamo-mode in
+ perl buffers seems gone. (Note quite sure, but I
+ can't see any problems now.)
+ </li>
+ <li>
+ Fixed a bug in mumamo-mode when current buffer was
+ switched before the major mode had been set from
+ the current chunk.
+ </li>
+ <li>
+ Fixed a long standing bug in php fontification of
+ strings and comments.
+ </li>
+ <li>
+ Fixed a bug where <i>sgml-xml-mode</i> was not defined.
+ </li>
+ <li>
+ Fixed a bug related to get-text-property which
+ gives an error when buffer is narrowed.
+ </li>
+ <li>
+ Tried to refontify things outside of a narrowed part. Fixed.
+ </li>
+ <li>
+ Too little where refontified after changes. I hope I have fixed this.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fictive XHTML Validation Header:
+ <ul id="v1.04-fic-bugs">
+ <li>
+ View File did not work correctly when a fictive
+ XHTML validation header was used. Corrected.
+ </li>
+ <li>
+ Fictive XHTML validation headers are no longer
+ turned on by default in any buffers.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Indentation:
+ <ul>
+ <li>
+ Tried to fix a problem when using
+ newline-and-indent. When this was in a mode
+ derived from C the indentation sometimes became 0.
+ </li>
+ <li>
+ Speeded up the indentation of regions a bit when
+ using <i>mumamo-mode</i>.
+ </li>
+ <li>
+ Indentation: TAB now only indents a region if it
+ is visibly marked (see transient-mark-mode and
+ cua-mode).
+ </li>
+ <li>
+ Simplified the indentation code.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fixed a problem where string fontification got out
+ of phase so that wrong parts of buffer could be
+ fontified as a string.
+ </li>
+ <li>
+ Added a workaround for <a
+ href="#php-attribute-values">Attribute values
+ computed by PHP</a>
+ </li>
+ <li>
+ Added .nosearch to subdirectories with no elisp files.
+ </li>
+ <li>
+ Fixed incorrect checks for mlinks-mode in menu building.
+ </li>
+ <li>
+ File extensions where used in a case sensitive way
+ in some places. Fixed.
+ </li>
+ <li>
+ appmenu: Worked only in html files. Fixed.
+ </li>
+ <li>
+ html-site: Fixed the error <em>Error
+ (html-site-current): Can't find site:
+ your-site-name</em>.
+ </li>
+ <li>
+ Fixed a problem with longlines-mode in the support
+ for Firefox add-on It's All Text. (Note however
+ that there are some bugs in longlines-mode
+ itself.) Rewrote the support to be more
+ general. It is now in the file as-external.el, see
+ this file.
+ </li>
+ <li>
+ Fixed an encoding problem in
+ <i>tidy-buffer</i>. Output from tidy was not read
+ using the same coding system as tidy was using.
+ </li>
+ <li>
+ Fixed some problems with face definitions, possibly bugs (not sure).
+ </li>
+ <li>
+ Made the fontification faster when using mumamo-mode.
+ (It is still slower than single mode fontification of course.)
+ </li>
+ <li>
+ nxml-where.el: Made it aware of mumamo.el.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Menu changes:
+ <ul>
+ <li>
+ Completion menu: Renamed to <i>Completion and
+ Validation</i> menu and reorganized a little bit to
+ make it more clear.
+ </li>
+ <li>
+ Renamed <i>view</i> to <i>browse</i> since this is
+ the normal emacs name for showing files in a web
+ browser. Also made corresponding changes to
+ function names. Put back the possibility to view
+ only the region in a web browser.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Uploading:
+ <ul>
+ <li>
+ Added remote dired to the menus.
+ </li>
+ <li>
+ Fixed problems with file names starting with ~.
+ </li>
+ <li>
+ Fixed more problems with file names with spaces.
+ </li>
+ </ul>
+ </li>
+ <li>
+ nxml-where:
+ <ul>
+ <li>
+ nxml-where now uses a timeout for more smooth performance.
+ </li>
+ <li>
+ nxml-where can now recognizes both id and name attribute.
+ </li>
+ <li>
+ Hyphens are now accepted in tag names.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Ruby
+ <ul>
+ <li>
+ Multiple major mode turned on by default for .rhtml files when this mode is global.
+ </li>
+ <li>
+ Multiple major mode is no longer turned on when rub-mode is turned on.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added support for switching major mode dependent on if
+ Emacs was called as an external editor. This makes it
+ possible for example to switch to relevant major and
+ minor modes when Firefox add-on It's All Text.
+ </li>
+ <li>
+ Added the possibility to easily view the output of scripts on the server (if they require no parameters).
+ You can now do that from the nXhtml menu.
+ Previously only html files on the server could be viewed that way.
+ Image files can also be viewed this way.
+ </li>
+ <li>
+ Filling:
+ <ul>
+ <li>
+ Added functions for unfilling.
+ </li>
+ <li>
+ Added keybindings and menu entries for longlines-mode, fill-paragraph and unfill-paragraph.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Quoting:
+ Added HTML quoting of & and < in text areas. Bound to C-c C-q.
+ </li>
+ <li>
+ Images:
+ <ul>
+ <li>
+ Added image-mode to those that are encompassed by nxhtml-global-minor-mode so that images can be uploaded more easily.
+ </li>
+ <li>
+ Added <em>edit with GIMP</em> and <em>upload</em> to the popup menu for links.
+ This avoids the need to load the linked files in Emacs first.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added <em>nxml-untag-element</em>.
+ </li>
+ <li>
+ Added a modified version of wikipedia-mode.el. Seems likely to be useful if you are doing web editing.
+ </li>
+ <li>
+ Added html-imenu.el
+ </li>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Removed the lighter <i>"MuMaMo"</i> for
+ mumamo-mode. Instead the active major mode now has
+ <b>"/m"</b> appended to mode-name (that is what you see
+ in the mode line).
+ </li>
+ <li>
+ The normal way to turn on <i>mumamo-mode</i> has
+ changed. There are now functions that you can use
+ in <i>auto-mode-alist</i> to directly set up the
+ buffer for mumamo-mode. The available functions
+ are in the
+ variable <i>mumamo-defined-turn-on-functions</i>.
+ <p>
+ You are not supposed to call mumamo-mode
+ yourself any more and mumamo-global-mode is
+ gone. So is also mumamo-chunk-family-by-mode and
+ mumamo-filenames-list. The functionality those
+ gave are all replaced by the new functions for
+ turning on mumamo mode.
+ </p>
+ </li>
+ <li>
+ Added support for buffer local values in
+ hooks. This is necessary for example to support
+ minor modes that are meant to be buffer local but
+ not major mode specific. Instructions for authors
+ of this kind of minor modes are in the file
+ mumamo.el.
+ </li>
+ <li>
+ Added support for Django.
+ </li>
+ <li>
+ Added support for Embperl.
+ </li>
+ <li>
+ Added support for PHP Smarty. The <i>{literal}
+ ... {/literal}</i> construct is not supported.
+ This mean that you can not use <style ..> or <script ..>.
+ </li>
+ <li>
+ Added support for imenu for the main major mode.
+ Turned on this by default in nxhtml-mode.
+ </li>
+ <li>
+ Made the temporary replacement of the
+ attr="<?php ... ?>" a bit better. They are
+ now more visible and also still mumamo chunks
+ during the temporary replacement.
+ </li>
+ <li>
+ Added support for <i>flymake-mode</i>.
+ Maybe add support for checking chunks?
+ </li>
+ <li>
+ Printing: Added htmlfontify.el and
+ hfyview.el. These makes if possible to print a
+ buffer fontified with <i>mumamo-mode</i> on in
+ colors (through your web browser). There is an
+ example of the capabilities of htmlfontify <a
+ href="htmlfontify-example.html">here</a> (made
+ with a little function in hfyview.el).
+ </li>
+ </ul>
+ </li>
+ <li>
+ PHP:
+ <ul>
+ <li>
+ Did a first merge with Aaron Hawleys fixes for php-mode.el.
+ </li>
+ </ul>
+ </li>
+ <li>
+ CSS: Upgraded to Stefan's latest css-mode.el.
+ </li>
+ <li>
+ Fictive XHTML Validation Headers: Changed the way they
+ are turned on. They may now be turned on when
+ mumamo-mode is turned on.
+ </li>
+ <li>
+ Some users want to use their own patched version of nXml. Next version of Emacs will come with nXml. Therefore, the loading routine for nXhtml now checks if nXml is is already loaded. Thanks to Eric Lilja for testing this. Eric also made me aware of that if nXhtml was placed in the site-lisp directory tree then things did not work as I expected. I think I have corrected that by placing a <i>.nosearch</i> file at the top of the nxml tree in nXhtml.
+ </li>
+ <li>
+ Restructured the directories. Moved some files out of
+ the <i>nxhtml</i> subdir. Some of them went into the
+ <i>util</i> subdir (those are written by me) and some
+ to the new subdir <i>related</i> (those that are
+ inherited from others, maybe changed by me - most
+ often to work with mumamo-mode).
+ </li>
+ <li>
+ Changed all licenses to be GNU GPL.
+ </li>
+ <li>
+ Additions to tidy support: It is now possible to use
+ the tidy support to tidy the XHTML part of php etc.
+ (Thanks to Hadron for this suggestion.)
+ </li>
+ <li>
+ Added <i>winsize.el</i> which allows interactive resizing of
+ windows. Also added <i>winsav.el</i> which adds the
+ capability to rotate window configurations and also to
+ save window configuration to file.
+ </li>
+ <li>
+ Made nXhtml work with CVS Emacs 23.0.50.1.
+ </li>
+ <li>
+ Added freemind.el to the parcel. After all FreeMind
+ supports web publishing too so why not have the Emacs
+ support here ...
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.10">1.10</dt>
+ <dd id="v1.10-dd">
+ Just jumped the version number for the new release of
+ nXhtml. There are really significant changes in this
+ release, not only minor bug fixes.
+ </dd>
+ <dt id="v1.11">1.11</dt>
+ <dd id="v1.11-dd">
+ Minor bug fixes to completion. Added fictive validation
+ header to completion alternatives when buffer is empty and
+ mumamo is used.
+ </dd>
+ <dt id="v1.12">1.12</dt>
+ <dd id="v1.12-dd">
+ <ul>
+ <li>
+ Fixed a bug in image link insertion in nxhtml-mode, thanks Niels Giesen!
+ </li>
+ <li>
+ Restructured, reordered and documented mumamo.el. It is now two
+ separate files, mumamo.el and mumamo-fun.el.
+ </li>
+ <li>
+ Added move by chunk to the nXhtml menu.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.13">1.13</dt>
+ <dd id="v1.13-dd">
+ <ul>
+ <li>
+ Better handling of the case when no validation header
+ is needed and the user tries to turn it on.
+ </li>
+ <li>
+ Added .phtml as php file.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.14">1.14</dt>
+ <dd id="v1.14-dd">
+ <ul>
+ <li>
+ Completion of links in XHTML was broken. Fixed, thanks
+ to Niels Giesen.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.15">1.15</dt>
+ <dd id="v1.15-dd">
+ <ul>
+ <li>
+ Added `mumamo-map' keymap.
+ </li>
+ <li>
+ Added a keymap to all multi major modes.
+ </li>
+ <li>
+ Some more refinement to fictive validation headers.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.16">1.16</dt>
+ <dd id="v1.16-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Changes to indentation:
+ <ul>
+ <li>
+ Removed indent-region-mode since that
+ functionality is now in indent-for-tab-command in
+ Emacs 22.
+ </li>
+ <li>
+ Removed some code that checked if indentation was 0.
+ </li>
+ <li>
+ Added indent-for-tab-command to mumamo-map.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Reordering and renaming:
+ <ul>
+ <li>
+ Reordered and move some functions in mumamo.el et al.
+ Added new file nxhtml-mumamo.el.
+ </li>
+ <li>
+ Renamed <i>define-mumamo-turn-on</i> to
+ <i>define-mumamo-multi-major-mode</i>.
+ </li>
+ <li>
+ Removed the ending <i>-turn-on</i> from the
+ functions defined by the macro above.
+ </li>
+ <li>
+ Introduced <i>multi major mode</i> as a name for
+ the functions defined by the macro above. Those
+ works in many respects like major mode functions,
+ but they support multiple major modes in a buffer.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added support for noweb as multiple major mode.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.17">1.17</dt>
+ <dd id="v1.17-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Added support for flyspell.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Bug fixes to the version of find-recursive.el that
+ ships with nXhtml. Thanks to Cezar Halmagean.
+ </li>
+ <li>
+ Added tabkey2.el which tries to make it easy to use
+ the Tab key for completion. (You must load it and turn
+ on tabkey2-mode to use it.)
+ </li>
+ <li>
+ Folding:
+ <ul>
+ <li>
+ Added <i>nxhtml-heading-element-name-regexp</i> as
+ default for nxml style folding.
+ </li>
+ <li>
+ Some changes to fold-dwim.el.
+ </li>
+ </ul>
+ </li>
+ <li>
+ AppMenu:
+ <ul>
+ <li>
+ Simplified: Removed the possibility to
+ automatically show minor and major mode menus.
+ There is now only one list, <i>appmenu-alist</i>.
+ </li>
+ <li>
+ Added menu item <i>At Current Point</i> for
+ bindings found in character and overlay keymaps at
+ point. Those you always forget.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Physical line:
+ <ul>
+ <li>
+ Added physical-line.el to nXhtml.
+ </li>
+ <li>
+ Added new functions to move to beginning and end
+ of line to ourcomments-util.el that supports
+ physical-line.el.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.18">1.18</dt>
+ <dd id="v1.18-dd">
+ <ul>
+ <li>
+ Better Tab completion in tabkey2.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.19">1.19</dt>
+ <dd id="v1.19-dd">
+ <ul>
+ <li>
+ Even better Tab completion in tabkey2.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.20">1.20</dt>
+ <dd id="v1.20-dd">
+ <ul>
+ <li>
+ Once again even better Tab completion in tabkey2.el.
+ </li>
+ <li>
+ Fixed bug in hiding of validation errors (they could
+ disappear totally).
+ </li>
+ <li>
+ Cleaned up menus in nXhtml.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.21">1.21</dt>
+ <dd id="v1.21-dd">
+ <ul>
+ <li>
+ Added a bit support for dired (upload, browse, browse
+ remote).
+ </li>
+ <li>
+ Fixed some strange menu problems (i hope).
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.22">1.22</dt>
+ <dd id="v1.22-dd">
+ <ul>
+ <li>
+ Bug fix.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.23">1.23</dt>
+ <dd id="v1.23-dd">
+ <ul>
+ <li>
+ Bug fix.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.24">1.24</dt>
+ <dd id="v1.24-dd">
+ <ul>
+ <li>
+ Tried again to make hexcolor-mode more readable.
+ </li>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Added support for <i>hi-lock-mode</i>. At present
+ it might however be very puzzling. The hilight
+ added by hi-lock-mode may be hidden by the
+ overlays used by mumamo. Tip: you can always use
+ the face <span
+ style="font-size:1.5em;">hi-black-hb</span>.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.25">1.25</dt>
+ <dd id="v1.25-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Handle hi-lock-mode in a more general way
+ using <i>font-lock-mode-hook</i>.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.26">1.26</dt>
+ <dd id="v1.26-dd">
+ <ul>
+ <li>
+ nxhtml-mode:
+ <ul>
+ <li>
+ Removed the indent line patch for nxml-mode.
+ </li>
+ <li>
+ Better test for empty page during completion.
+ </li>
+ </ul>
+ </li>
+ <li>
+ tabkey2-mode:
+ <ul>
+ <li>
+ A lot of improvements.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.27">1.27</dt>
+ <dd id="v1.27-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Worked with bugs in mumamo.el that was due to bad
+ handling of syntax-ppss et el. Looks like most of
+ them are fixed.
+ </li>
+ <li>
+ Fixed documentation and reordered code in mumamo.el and mumamo-fun.el.
+ </li>
+ <li>
+ Changed javascript.el indentation to make it work with
+ mumamo.el.
+ </li>
+ <li>
+ Introduced the function <i>mumamo-make-variable-buffer-permanent</i> as an aid for minor mode authors.
+ </li>
+ <li>
+ Fixed quite a few indentation bugs.
+ There was one bug that could make Emacs loop after indentation.
+ </li>
+ </ul>
+ </li>
+ <li>
+ nxml-where, mlinks
+ <ul>
+ <li>
+ Fixed bugs with left over idle timers when buffer
+ had been killed (nxml-where.el, mlinks.el).
+ </li>
+ </ul>
+ </li>
+ <li>
+ html-site
+ <ul>
+ <li>
+ Fixed a bug in html-site when comparing file
+ names. File names where not made unique before
+ comparision.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Tabkey2
+ <ul>
+ <li>
+ Fixed tabkey2 bugs.
+ </li>
+ </ul>
+ </li>
+ <li>
+ freemind.el
+ <ul>
+ <li>
+ Fixed a problem in freemind-to-org-mode that
+ caused the error "wrong-type-argument string: nil"
+ in string-match("\\(?:^--org-mode: WHOLE FILE$\\)"
+ nil).
+ </li>
+ </ul>
+ </li>
+ <li>
+ Made nXhtml menu available in sub-chunks.
+ </li>
+ <li>
+ Included a slightly changed version of Steve Yegge's js2.el + js2-fl-mode.el from 2008-04-24 with support for jit-lock-mode. This support has some flaws and maybe js2 is not ready for use, I am not sure. However if you want to use this instead of Karl Landströms javascript-mode then please customize <i>mumamo-major-modes</i>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.28">1.28</dt>
+ <dd id="v1.28-dd">
+ <ul>
+ <li>
+ New version with mostly minor bug fixes from 1.27.
+ Unfortunately I put out 1.27 a bit too early.
+ Please upgrade.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.29">1.29</dt>
+ <dd id="v1.29-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Fixed a bug causing emacs to loop when <?>
+ was encountered in an html style buffer.
+ </li>
+ <li>
+ Fixed some problems with <? and ?> in
+ strings in html style buffers.
+ </li>
+ <li>
+ Tried to avoid chunk dividers in strings and comments. (There are still some bugs there.)
+ </li>
+ <li>
+ Fixed an error that prevented byte compiling nxhtml-mumamo.el.
+ (Thanks Christoph Conrad.)
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.30">1.30</dt>
+ <dd id="v1.30-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Added support to handle specific rng
+ schemacs. With the help of this Genshi and MJT
+ templating languages are now handled.
+ </li>
+ <li>
+ Let the rng schema file name survive mumamo major
+ mode changes.
+ </li>
+ <li>
+ Added support for to let nxml-mode skip chunks it
+ can not parse. (This requires a patch to
+ rng-valid.el too which is not included, but which
+ I hope can go into Emacs soon.)
+ </li>
+ <li>
+ Chunk dividers can now be a part on their own. (Ie
+ there will be no parsing or syntax highlighting of
+ them by the chunk major mode. This is optional and
+ specified for each chunk types.)
+ </li>
+ <li>
+ Added support for Genshi and MJT. These multi
+ major modes support completion and error checking
+ in the XML/XHTML part according to their DTD
+ (which has some additions to the XHTML DTD).
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.31">1.31</dt>
+ <dd id="v1.31-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Fixed a bug that caused multi major modes to loop sometimes.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.32">1.32</dt>
+ <dd id="v1.32-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Fixed a bug in syntax-ppss advice.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.33">1.33</dt>
+ <dd id="v1.33-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Fixed another bug in syntax-ppss advice.
+ </li>
+ <li>
+ Added support for <i>fill-forward-paragraph-function</i>.
+ </li>
+ <li>
+ Made <i>longlines-mode</i> survive major mode changes in mumamo buffers.
+ </li>
+ <li>
+ Fixed a bug that made Emacs loop when it found
+ <??> in for example nxhtml-mumamo.
+ </li>
+ <li>
+ Made it usable with Emacs 22 again.
+ </li>
+ <li>
+ Moved some changes from rng-valid.el to
+ mumamo.el. This makes it possible to let nxml-mode
+ (and derivates) jump over parts when parsing the
+ buffer even if not using the patched version of
+ Emacs+EmacsW32.
+ </li>
+ </ul>
+ </li>
+ <li>
+ nxhtml:
+ <ul>
+ <li>
+ Added command to add CSS rollover images.
+ </li>
+ </ul>
+ </li>
+ <li>
+ mlinks:
+ <ul>
+ <li>
+ Tried to fix the error <i>invalid-read-syntax "]
+ in a list"</i> when loading <i>mlinks.el</i>
+ reported by some Asian users.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.34">1.34</dt>
+ <dd id="v1.34-dd">
+ <ul>
+ <li>
+ <span style="font-size: 1.2em; color: red ()"
+ >Changed top directory name from nxml to nxhtml</span>
+ <p>
+ This will of course case some problems if you do not
+ notice it when you upgrade nXhtml. If you are using
+ EmacsW32 and upgrade nXhtml you should change the
+ file <i>emacsw32.el</i>.
+ </p>
+ <p>
+ The reason for this change is that nXml will soon
+ normally not be part of nXhtml so keeping the old
+ top directory name would be confusing.
+ </p>
+ </li>
+ <li>
+ Added a test suite. See the file <i>nxml/tests/test-Q.el</i>.
+ </li>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Fixed indentation when the whole line is a sub chunk.
+ </li>
+ <li>
+ Tried a bit more to stop nxml from parsing non-xml
+ mode chunks. Because of this php support was
+ changed a bit (for the better I hope).
+ </li>
+ </ul>
+ </li>
+ <li>
+ GIMP:
+ <ul>
+ <li>
+ Registry value location for GIMP had changed.
+ </li>
+ </ul>
+ </li>
+ <li>
+ nXhtml:
+ <ul>
+ <li>
+ Added support for <a href="http://hyperstruct.net/projects/mozlab">MozLab</a>. If you install MozLab in Firefox then you can directly use it from javascript mode without any additional setup.
+ </li>
+ <li>
+ Added <a href="http://www.oak.homeunix.org/~marcel/blog/articles/2008/07/18/nested-imenu-for-php">php-imenu.el</a>.
+ </li>
+ <li>
+ Fixed a bug where I inadvertently
+ added <i>../../lisp</i> to load-path.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.35">1.35</dt>
+ <dd id="v1.35-dd">
+ <ul>
+ <li>
+ Fixed a small bug in sex-mode.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.36">1.36</dt>
+ <dd id="v1.36-dd">
+ <ul>
+ <li>
+ Added the function <i>emacs-Q-nxhtml</i> for easier
+ testing. It does the equivalent of <i>emacs -Q --load
+ PATH-TO/nxhtml/autostart.el</i>.
+ </li>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Forgot to return php-mode in php short tags. Fixed.
+ </li>
+ <li>
+ Borders where not correctly calculated with php short tags. Fixed.
+ </li>
+ <li>
+ Subchunks not parseable by nxml-mode where marked as parseable. Fixed.
+ </li>
+ <li>
+ Debug messages from mumamo where not silenced.
+ </li>
+ <li>
+ Forgot font-lock-syntactic-keywords. This showed up in
+ bad fontification for strings sometimes. Fixed.
+ </li>
+ <li>
+ To fontify keywords font-lock-syntactically-fontified
+ must be set in each chunk. Fixed.
+ </li>
+ <li>
+ Find a way to at least temporarily work around the
+ problem with the last "e; char in
+ syntax="e;..."e; that could be seen in
+ large XHTML files, for example this file. The
+ drawback with the work around is that it bypasses
+ the cache for syntax-ppss, but this happens only
+ in multi major mode buffers and I notice no
+ performance problems here.
+ </li>
+ <li>
+ Fixed a number of problems with the defadvice for the syntax functions.
+ (I am afraid there are more left.)
+ </li>
+ <li>
+ Took a new grab on the indentation problems.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.37">1.37</dt>
+ <dd id="v1.37-dd">
+ <ul>
+ <li>
+ The command <i>emacs-Q-nxhtml</i> and cousins did not
+ work on all platform. Tried to fix it.
+ </li>
+ <li>
+ Got a report that editing Django was to slow. Tried to fix this.
+ </li>
+ <li>
+ Added a test to the unit test suite that test
+ scrolling and jumping.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.38">1.38</dt>
+ <dd id="v1.38-dd">
+ <ul>
+ <li>
+ Added a workaround that removes validation error marking in non-xhtml chunks.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.39">1.39</dt>
+ <dd id="v1.39-dd">
+ <ul>
+ <li>
+ Multi major modes where not allowed in defcustoms
+ nxhtml-magic-mode-alist and
+ nxhtml-auto-mode-alist. Fixed.
+ </li>
+ <li>
+ Added tests for the use of the lists above.
+ </li>
+ <li>
+ Fixed some bugs that could make a buffer became
+ modified due to mumamo fontification actions.
+ </li>
+ <li>
+ The rnc files for mjt and genshi had include path that
+ did not work if you where using the nxml-mode that
+ comes with nXhtml. Fixed. (Thanks for pointing this
+ out, Bryan.)
+ </li>
+ <li>
+ Now trying to keep the launchpad bazaar repository in
+ sync.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.40">1.40</dt>
+ <dd id="v1.40-dd">
+ <ul>
+ <li>
+ tabkey2-mode
+ <ul>
+ <li>
+ Some small changes: support for eshell
+ and better information about completion commands
+ alternative key bindings.
+ </li>
+ </ul>
+ </li>
+ <li>
+ php-mode
+ <ul>
+ <li>
+ It turned out that my patched php-mode asked in
+ every buffer to turn on mumamo. Changed it to
+ once for every Emacs invocation instead.
+ </li>
+ <li>
+ In addition to this it did not turn on mumamo
+ multi major support if the user wanted it ;-)
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.41">1.41</dt>
+ <dd id="v1.41-dd">
+ <ul>
+ <li>
+ There was an error that prevented loading of nXhtml
+ with Emacs 22. (This was before opening any file.)
+ </li>
+ <li>
+ Fixed a problem in startup order for ido-mode and nXhtml.
+ (This could lead to that ido-mode was reset from 'both to 'buffer.)
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.42">1.42</dt>
+ <dd id="v1.42-dd">
+ <ul>
+ <li>
+ Fixed a bug concerning style="e;..."e; and similar constructs.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.43">1.43</dt>
+ <dd id="v1.43-dd">
+ <ul>
+ <li>
+ Added file ffip.el for finding files in projects.
+ </li>
+ <li>
+ Added command <i>html-site-find-file</i>.
+ </li>
+ <li>
+ Added aliases for all multi major modes.
+ The alias looks like <i>mumamo-alias-MULTI_MAJOR_MODE</i>.
+ Their purpose is to make it easier to find a multi major mode.
+ </li>
+ <li>
+ Fixed bug <a href="https://bugs.launchpad.net/nxhtml/+bug/258169">https://bugs.launchpad.net/nxhtml/+bug/258169</a>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.44">1.44</dt>
+ <dd id="v1.44-dd">
+ <ul>
+ <li>
+ Fixed an error in chunk dividing.
+ </li>
+ <li>
+ Fixed bug <a href="https://bugs.launchpad.net/nxhtml/+bug/258097">https://bugs.launchpad.net/nxhtml/+bug/258097</a>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.45">1.45</dt>
+ <dd id="v1.45-dd">
+ <ul>
+ <li>
+ Fixed bug reporting instructions to point to Launchpad.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.46">1.46</dt>
+ <dd id="v1.46-dd">
+ <ul>
+ <li>
+ Cleaned up and fixed bugs in the help routines.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.47">1.47</dt>
+ <dd id="v1.47-dd">
+ <ul>
+ <li>
+ Made tabkey2-mode aware of this-command.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.48">1.48</dt>
+ <dd id="v1.48-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Added jde-mode as first choice if major mode file spec is java-mode.
+ </li>
+ <li>
+ Fixed a bug concerning buffer local variables saving.
+ </li>
+ <li>
+ Fixed a bug that occured when autoloading major mode failed.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.49">1.49</dt>
+ <dd id="v1.49-dd">
+ <ul>
+ <li>
+ Added a CEDET loader which can fetch CVS version of CEDET.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.50">1.50</dt>
+ <dd id="v1.50-dd">
+ <ul>
+ <li>
+ Added a Rinari loader which can fetch SVN version of Rinari and ruby-mode.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.51">1.51</dt>
+ <dd id="v1.51-dd">
+ <ul>
+ <li>
+ Fixed a regression bug in MuMaMo. If a major mode was
+ not defined Emacs could hang badly.
+ </li>
+ <li>
+ Added an ECB loader which can fetch CVS version of ECB.
+ </li>
+ <li>
+ Enhancements to the routines for fetching and setting
+ up CEDET, ECT and Rinari.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.52">1.52</dt>
+ <dd id="v1.52-dd">
+ <ul>
+ <li>
+ Added a tool to give major modes priority when
+ choosing a major mode for a buffer.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.53">1.53</dt>
+ <dd id="v1.53-dd">
+ <ul>
+ <li>
+ Quick fix for left-over which made it impossible to
+ edit php files in version 1.52. If you are using
+ version 1.52 you may for the moment just add (require
+ 'fmode) to your .emacs after loading nXhtml.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.54">1.54</dt>
+ <dd id="v1.54-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Added better error handling for problems such as
+ those that occured in version 1.52 with php-mode.
+ </li>
+ <li>
+ There was a bug when changing from a mumamo multi
+ major mode.
+ </li>
+ <li>
+ Tried to fix <a href="https://answers.launchpad.net/nxhtml/+question/43320">question 43320</a>.
+ </li>
+ </ul>
+ </li>
+ <li>
+ php-mode:
+ <ul>
+ <li>
+ Made the indentation check up to date with current
+ MuMaMo.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.55">1.55</dt>
+ <dd id="v1.55-dd">
+ <ul>
+ <li>
+ Tried to fix https://answers.launchpad.net/nxhtml/+question/43320 again.
+ </li>
+ <li>
+ Better test of when to end tabkey2-mode completion function state.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.56">1.56</dt>
+ <dd id="v1.56-dd">
+ <ul>
+ <li>
+ Allowed both single and double quotes in mlinks for html files.
+ </li>
+ <li>
+ Added initial support for Mako template language.
+ (There is no support for the tags yet, like in
+ Genshi. Additions are welcome!)
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.57">1.57</dt>
+ <dd id="v1.57-dd">
+ <ul>
+ <li>
+ Fixed another part of question 43320 (see above) regarding php indentation.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.58">1.58</dt>
+ <dd id="v1.58-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ The change of major mode when moving between
+ chunks could occur in the wrong buffer because I
+ had misunderstood how with-selected-window
+ works. Fixed.
+ </li>
+ <li>
+ Added ${...} python chunks to Mako (ie mako-html-mumamo).
+ </li>
+ <li>
+ Added mako-nxhtml-mumamo.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Appmenu:
+ <ul>
+ <li>
+ Fixed problem with point keymap.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Php:
+ <ul>
+ <li>
+ Fixed <a href="https://answers.launchpad.net/nxhtml/+question/44504">https://answers.launchpad.net/nxhtml/+question/44504</a>.
+ </li>
+ <li>
+ Fixed a typo regarding indentation check.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Tabkey2:
+ <ul>
+ <li>
+ Better support for YASnippet.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.59">1.59</dt>
+ <dd id="v1.59-dd">
+ <ul>
+ <li>
+ Fixed a bug that was revealed by the better support for YASnippet.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.60">1.60</dt>
+ <dd id="v1.60-dd">
+ <ul>
+ <li>
+ Bug fixes:
+ <ul>
+ <li>
+ Fix some bugs in Tidy XHTML support.
+ </li>
+ <li>
+ Also Some small improvements to Tidy GUI.
+ </li>
+ <li>
+ Added a test case for bug
+ https://bugs.launchpad.net/nxhtml/+bug/271497 (which I
+ can't reproduce).
+ </li>
+ <li>
+ Bug fixes to ffip.el
+ </li>
+ <li>
+ Added fix for <a href="http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?bug=1013"
+ >Emacs bug 1013</a>.
+ </li>
+ <li>
+ Fixed some minor bugs in as-external.el.
+ </li>
+ <li>
+ New handling of minor modes (buffer local variables).
+ I hope this should fix the problem reported in
+ <a href="https://bugs.launchpad.net/bugs/272526">nXhtml bug 272526: Imenu on menubar doesn't work after switching modes</a>.
+ </li>
+ <li>
+ Fixed a bug that could make buffer marked as modified
+ during fontification.
+ </li>
+ <li>
+ Changed <i>php-mode</i> binding for TAB to follow Emacs normal standard.
+ </li>
+ <li>
+ Fixed a bug that sometimes caused rng-validate-mode to be
+ turned on in wrong buffer when setting xhtml fictive
+ validation header.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Finished a replacement for the usual help command on
+ [f1 ?c]. This will in addition to the command show the
+ keymap. To use it add
+ <i>(global-set-key [f1 ?c] 'find-keymap-binding-key)</i> to your .emacs.
+ </li>
+ <li>
+ Let tabkey2-mode first look for [tab] and then [?\t].
+ </li>
+ <li>
+ Added an <a href="http://ourcomments.org/Emacs/nXhtml/tut/tutorials.html"
+ >nXhtml tutorial page</a> with video tutorials.
+ </li>
+ <li>
+ After question
+ <a href="https://answers.launchpad.net/nxhtml/+question/45721"
+ >nXhtml question 45721</a>
+ there was a short discussion on Emacs Devel where I
+ was convinced to change the name convention for multi
+ major modes. They are now supposed to end
+ in <i>-mumamo-mode</i> (instead of the old <i>-mumamo</i>).
+ </li>
+ <li>
+ Added <i>ourcomments-ediff-files</i> to start ediff
+ from a shell with Emacs Client.
+ </li>
+ <li>
+ Took a look at autoloading. nXhtml now uses
+ autoloading in many more cases and loads much faster.
+ </li>
+ <li>
+ Added new general functions for search and replace:
+ <i>grep-query-replace</i>, <i>ldir-query-replace</i> and
+ <i>rdir-query-replace</i>. Also added similar
+ functions to search and replace in a site (they are in
+ the nXhtml menu).
+ </li>
+ <li>
+ Added <i>better-fringes-mode</i> for my personal preferences
+ for fringe symbols ...
+ </li>
+ <li>
+ Enhancement for (X)HTML editing:
+ <ul>
+ <li>
+ Added a minimal one-line display version of fictive
+ validation headers and made it the default.
+ </li>
+ <li>
+ Some enhancements to <i>nxml-where-mode</i>.
+ </li>
+ <li>
+ Display of images inline. Can be used in different major modes/files.
+ </li>
+ <li>
+ Added the minor mode <i>wrap-to-fill-column-mode</i> and
+ replaced longlines-mode in the Tools menu with this.
+ </li>
+ <li>
+ Added the minor mode <i>html-write-mode</i> that can hide
+ some simple tags and just show the inner html with a
+ user defined face. This is meant to make it easier to
+ write html files.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.61">1.61</dt>
+ <dd id="v1.61-dd">
+ <ul>
+ <li>
+ Bug fixes in html-write-mode and as-external.el.
+ </li>
+ <li>
+ Removed left over autoloads (maybe there was a problem with ruby-mode, not sure).
+ </li>
+ <li>
+ Fixed bug <a href="https://bugs.launchpad.net/nxhtml/+bug/290364">290364</a>,
+ see below about MuMaMo important changes.
+ </li>
+ <li>Fixed bug <a href="https://bugs.launchpad.net/nxhtml/+bug/272526">272526</a>.</li>
+ <li>Fixed bug <a href="https://bugs.launchpad.net/nxhtml/+bug/292393">292393</a>.</li>
+ <li>Fixed bug <a href="https://bugs.launchpad.net/nxhtml/+bug/300946">300946</a>.</li>
+ <li>Fixed bug <a href="https://bugs.launchpad.net/nxhtml/+bug/304569">304569</a>.</li>
+ <li>
+ Added some support for editing gmail messages in
+ as-external.el (to be used with It's All Text for
+ Firefox).
+ </li>
+ <li>
+ Some changes to face handling in Emacs had made htmlfontify.el fail.
+ Some changes in CSS handling in Firefox and IE made hfyview.el fail even more.
+ Tried to fix this.
+ </li>
+ <li>
+ Updated vline.el
+ </li>
+ <li>
+ Aaron Hawley merged in some changes he made to php-mode.el. Thanks Aaron!
+ Now nXhtml uses a slightly modified version of php-mode 1.5.0 is used
+ </li>
+ <li>
+ <b>MuMaMo important changes</b>
+ <p>
+ Unfortunately the chunk dividing routines in
+ mumamo.el can loop, see bug 290364 above. The
+ reason is that I tried to find chunks at current
+ point in a buffer without looking through the buffer
+ from the beginning. Fontification works this way in
+ Emacs. It is a heuristic that sometimes fails
+ however, but the consequences are merely just local
+ errors in fontification.
+ </p>
+ <p>
+ Chunk dividing must be more stable since it has a
+ global impact on the files fontification. It
+ therefore have to be done from the beginning of the
+ buffer - just like a parser reading the file will
+ do.
+ </p>
+ <p>
+ I have done first part of this rewrite and I hope
+ chunk dividing can not loop any more. Chunk dividing
+ is now always done from the beginning. However the
+ routines actually finding the chunks still looks
+ both upwards and downwards. I will try to remove
+ this unnecessary complexity later.
+ </p>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.62">1.62</dt>
+ <dd id="v1.62-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Fixed bugs in chunk creation that caused args out
+ of range at buffer end.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Autoloading caused wrong libraries to load (for
+ example javascript from mozdev). Fixed.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.63">1.63</dt>
+ <dd id="v1.63-dd">
+ <ul>
+ <li>
+ Removed find-recursive.el since there is no use for it
+ any more and it interferes with emacs-rails. (It was
+ initally a bug fixs for emacs-rails.)
+ </li>
+ <li>
+ Fixed bugs in <i>html-write-mode</i>.
+ </li>
+ <li>
+ Used the new routines for finding chunks also during
+ xml validation and syntax-ppss.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.64">1.64</dt>
+ <dd id="v1.64-dd">
+ <ul>
+ <li>
+ MuMaMo: nxml was not turned off properly when
+ switching from a multi major mode that used nxml-mode
+ or nxhtml-mode. Fixed. This was especially troublesome
+ for Emacs 22 users where multi major modes based on
+ nxhtml-mode does not always work.
+ </li>
+ <li>
+ Majmodpri.el: Added a defcustom to give multi major
+ modes based on nxhtm-mode or nxml-mode lower
+ priority. This is on by default in Emacs 22.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.65">1.65</dt>
+ <dd id="v1.65-dd">
+ <ul>
+ <li>Fixed a bug in nxml-where.el.</li>
+ <li>
+ Fixed a minor bug in majmodpri.el. It did not work if
+ magic-mode-alist contained anonymous functions.
+ (Thanks from Niels Giesen.)
+ </li>
+ <li>
+ Fixed a bug in pause.el and added some mindfulness to it.
+ </li>
+ <li>
+ Adjusted <i>ourcomments-move-beginning-of-line</i> (and dito
+ for end) to the new <i>line-move-visual</i> in Emacs 23.
+ Moved physical-line.el to <i>old</i> subdir since it is now
+ obsolete.
+ </li>
+ <li>
+ Made it possible to byte compile nXhtml.
+ <p>
+ To do that use
+ <i>M-x nxhtmlmaint-start-byte-compilation</i>.
+ </p>
+ <p>
+ A lot of code changes to make byte compilation
+ possible without a lot of warnings. Most changes
+ where just moving code around, but some where bug
+ fixes.
+ </p>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.66">1.66</dt>
+ <dd id="v1.66-dd">
+ <ul>
+ <li>
+ Further work on byte compiling.
+ </li>
+ <li>
+ Tried to fix some problem with defadvice in
+ ourcomments-util.el.
+ </li>
+ <li>
+ Tried to finish the command <i>M-x search-form</i>.
+ </li>
+ <li>
+ When no chunk is found (border case) then set the
+ major mode to the main major mode for the current
+ multi major mode.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.67">1.67</dt>
+ <dd id="v1.67-dd">
+ <ul>
+ <li>
+ Removed css.el since it is in Emacs 22.2 and later.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.68">1.68</dt>
+ <dd id="v1.68-dd">
+ <ul>
+ <li>
+ Fixed bugs related to byte compilation. This should
+ now work for both Emacs 22 and 23. Also added a menu
+ entry for byte compilation.
+ </li>
+ <li>
+ Removed nXml from the distribution to make it
+ smaller. nXml comes with Emacs 23 (not yet released of
+ course). For Emacs 22 users see EmacsWiki about where
+ to get nXml.
+ <p>
+ Adding nXml to Emacs 22 startup should be done by
+ using the file <i>nxhtml/autostart22.el</i>.
+ </p>
+ <p>
+ NOTE 1: if you want to use <i>nxhtml-mode</i> in
+ multi major modes in Emacs 22 (not recommended) you
+ must also customize <i>majmodpri-no-nxml</i>.
+ </p>
+ <p>
+ NOTE 2: The major mode <i>nxhtml-mode</i> as a
+ major-mode works however very well also in Emacs 22.
+ </p>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.69">1.69</dt>
+ <dd id="v1.69-dd">
+ <ul>
+ <li>
+ Chunks were unnecessary deleted and recreated after a
+ change even if all changes where within one
+ chunk. This could make editing very slow. Fixed.
+ </li>
+ <li>
+ Search for rng-auto.el in path. (Emacs 22 only.)
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.70">1.70</dt>
+ <dd id="v1.70-dd">
+ <ul>
+ <li>
+ Validation could not be turned on in multi major
+ modes. Fixed.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.71">1.71</dt>
+ <dd id="v1.71-dd">
+ <ul>
+ <li>
+ Fixed the problem that showed up in the file
+ nxhtml/tests/in/kubica-freezing-i.html which could
+ make Emacs freeze.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.72">1.72</dt>
+ <dd id="v1.72-dd">
+ <ul>
+ <li>
+ Somehow I dropped this: Search for rng-auto.el in
+ path. (Emacs 22 only.) Don't ask me how. Fixed again.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.73">1.73</dt>
+ <dd id="v1.73-dd">
+ <ul>
+ <li>
+ Worked a bit more on byte compilation and elisp
+ libraries loading. If you byte compile nXhtml it will
+ now load very few modules by default. It loads more
+ modules if you don't.
+ </li>
+ <li>
+ Added chart.el, a small elisp library to create charts.
+ This works by calling google charts library.
+ Chart.el is a bit beta, eh alpha, but still useful I believe.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.74">1.74</dt>
+ <dd id="v1.74-dd">
+ <ul>
+ <li>
+ Found and fixed a bug in <em>fictive XML validation
+ headers</em>. This bug depended on the load order of
+ libraries.
+ </li>
+ <li>
+ Fixed a small bug in <i>nxml-where-mode</i>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.75">1.75</dt>
+ <dd id="v1.75-dd">
+ <ul>
+ <li>
+ Included css-color.el, css-palette.el and gpl.el from Niels Giesen.
+ (This replaces hexcolor.el which is no longer in nXhtml.)
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.76">1.76 -- Released 2009-02-26</dt>
+ <dd id="v1.76-dd">
+ <ul>
+ <li>
+ <span class="bugfix">Fixed a long standing bug in XML validation.</span> (I had
+ forgot to set the defadvice return value in defadvice
+ rng-set-initial-state in rngalt.el - I wonder why I
+ did not get any bug reports about this...)
+ </li>
+ <li>
+ <span class="bugfix">css-color.el: bug fix for mIxEd case color names.</span>
+ </li>
+ <li>
+ <span class="bugfix">freemind.el: bug fixes.</span>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.77">1.77 -- Never released!</dt>
+ <dd id="v1.77-dd">
+ <ul>
+ <li>
+ <span class="bugfix">Fixed numerous bugs</span>, please
+ see <a href="https://bugs.launchpad.net/nxhtml/">nXhtml bug tracker</a>
+ and dito <a href="https://answers.launchpad.net/nxhtml">question and answers</a>.
+ </li>
+ <li>
+ Added some missing autoloads.
+ </li>
+ <li>
+ <span class="bugfix">Tried to fix some smaller troubles with Viper when
+ changing chunk.</span>
+ </li>
+ <li>
+ <span class="bugfix">Menus for Tidy were broken. Fixed.</span>
+ </li>
+ <li>
+ Added a test that the <i>nxml-mode libraries included
+ in Emacs</i> are used and not the old ones. (If I
+ understand it correctly this might have been a problem
+ for Debian/Ubuntu Emacs 23 snap-shots users where the
+ old nxml-mode has been a left over from earlier
+ snap-shots where it was needed.)
+ </li>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Chunks are now always created from top to bottom.
+ This should make chunk creation more stable.
+ It also opens up for chunks in chunks in the future.
+ (The code still needs work...)
+ </li>
+ </ul>
+ </li>
+ <li>
+ majmodpri.el:
+ <ul>
+ <li>
+ To restore multi major modes in files loaded by
+ desktop-save-mode the new
+ function <i>majmodpri-apply</i> can be added
+ to <i>desktop-after-read-hook</i>.
+ </li>
+ <li>
+ New default for <i>majmodpri-sort-after-load</i>:
+ Sort after loading certain features/libraries that
+ are known to change <i>auto-mode-alist</i> and
+ apply to current buffer. This new default should
+ hopefully make major mode selection less
+ confusing.
+ </li>
+ </ul>
+ </li>
+ <li>
+ winsav.el:
+ <ul>
+ <li>
+ Added save and restore between Emacs sessions for frame configuration.
+ I am not sure how this works with special frames yet, but I have tested this with oneonone.el and it seems to work.
+ Dedicated windows should also work.
+ </li>
+ <li>
+ Added saving and restoring of named frame configurations.
+ </li>
+ </ul>
+ </li>
+ <li>
+ javascript.el:
+ <ul>
+ <li>
+ Updated to Karl's newest version (and added my additions).
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added library usb-setup.el that might help a bit with
+ using Emacs from an USB stick.
+ </li>
+ <li>
+ Updated smarty-mode.el to the latest version.
+ </li>
+ <li>
+ <img alt="Happy brain" src="img/fun-brain-2.png" width="131" height="119" />
+ Added an n-back game for your brain (and mine).
+ Just do <b>M-x n-back-game</b> to start it.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.78">1.78 -- Released 2009-05-28</dt>
+ <dd id="v1.78-dd">
+ <ul>
+ <li>
+ <span class="bugfix">nXhtml version 1.78 is the
+ release of the previous beta</span> (which had number
+ 1.77 and existed in many versions).
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.79">1.79</dt>
+ <dd id="v1.79-dd">
+ <ul>
+ <li>
+ Added a function to simplify adding for example font
+ lock keywords for major modes used in multi major
+ mode: <i>mumamo-refresh-multi-font-lock</i>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.80">1.80 -- Released 2009-06-02</dt>
+ <dd id="v1.80-dd">
+ <ul>
+ <li>
+ <span class="bugfix">Fixed a (rather serious) bug and cleaned up.</span>
+ </li>
+ <li>
+ Added mumamo regions. Mumamo regions are temporary
+ mumamo chunks that you set up by selecting a region
+ and telling you want that in a new major mode. To use
+ this feature look in the nXhtml menu under <i>Chunks -
+ Region Chunks</i>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.81">1.81 -- Released 2009-06-19</dt>
+ <dd id="v1.81-dd">
+ <ul>
+ <li>
+ Added the minor mode <i>mumamo-alt-php-tags-mode</i>
+ that lets you work more easily with <?php tags in
+ strings while you are still able to use XHTML
+ completion. (I added something looking rather similare
+ earlier, but removed it again because of difficulties
+ with undo. They are now fixed in Emacs and this should
+ be safe.)
+ </li>
+ <li>
+ Added support for hi-lock, but please be aware that
+ chunk overlays hides background marking that hi-lock
+ does... - so you must use marking that changes
+ foreground part of face.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.82">1.82 -- Released 2009-06-23</dt>
+ <dd id="v1.82-dd">
+ <ul>
+ <li>
+ <span class="bugfix">Find and fixed some bugs when
+ I tried to fix bug 388729.</span> Not sure I fixed that
+ bug though.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.83">1.83 -- Released 2009-06-24</dt>
+ <dd id="v1.83-dd">
+ <ul>
+ <li>
+ <span class="bugfix">Fontification disappeared for example in *grep* buffer. Fixed.</span>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.84">1.84 -- Released 2009-06-30</dt>
+ <dd id="v1.84-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ <span class="bugfix">Worked around bug in Emacs
+ 22.3 where c-after-change was left in
+ after-change-functions.</span> (This makes no
+ difference in Emacs 23.)
+ </li>
+ <li>
+ <span class="bugfix">Fixed a bug that occured
+ after deletion of whole chunks.</span>
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.85">1.85 -- Released 2009-07-04</dt>
+ <dd id="v1.85-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ <span class="bugfix">Corrected various mostly
+ minor bugs</span>, like indent-line-function which
+ where globally set to
+ mumamo-indent-line. Corrected.
+ </li>
+ <li>
+ <span class="bugfix">Forgot to finish the implementation of support for
+ font-lock-add-keywords. Done.</span>
+ </li>
+ <li>
+ Added some faces hi-mumamo-* to use with hi-lock,
+ but unfortunately they are not very
+ visible. Suggestions are welcome.
+ </li>
+ </ul>
+ </li>
+ <li>
+ CEDET and ECB:
+ <ul>
+ <li>
+ <span class="bugfix">Made the routines for fetching and installing CEDET and ECB
+ from the development sources work again.</span>
+ </li>
+ <li>
+ Added support for ECB in <i>winsav-save-mode</i>. Though I suspect it need some rework...
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added pointback.el, found on EmacsWiki. This is just
+ so missing in Emacs...
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.86">1.86 -- Released 2009-07-05</dt>
+ <dd id="v1.86-dd">
+ <ul>
+ <li>
+ Made the fetching and installing of CEDET and ECB a
+ bit better.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.87">1.87 -- Released 2009-07-08</dt>
+ <dd id="v1.87-dd">
+ <ul>
+ <li>
+ Some enhancements to winsav.el and menuacc.el.
+ </li>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Added heredoc for some modes. They are currently
+ kind of hidden since they are only available in
+ multiple major modes that offer just heredocs.
+ The implemented heredoc multi major modes are
+
+ sh-mumamo-heredoc-mode,
+ php-mumamo-heredoc-mode,
+ perl-mumamo-heredoc-mode,
+ cperl-mumamo-heredoc-mode,
+ python-mumamo-heredoc-mode and
+ ruby-mumamo-heredoc-mode.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.88">1.88 -- Never released, only betas</dt>
+ <dd id="v1.88-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ <span class="bugfix">
+ Background colors could not be removed by
+ setting <i>mumamo-background-coloring</i>.
+ Fixed, but please notice that this variable now
+ is a number.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">Support for chunks in chunks.</span>
+ </li>
+ <li>
+ <span class="bugfix">Removed string-match-p which does not exist in Emacs 22.</span>
+ </li>
+ <li>
+ <span class="bugfix">
+ mumamo-alt-php-tags-mode hardly survived major mode
+ changes. Rescued.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Added possibility to display chunk info in
+ window margins as an alternative/addon to
+ colored chunks.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Fixed a bug in n-back.el that prevented the game to be used on Emacs 22.
+ </span>
+ </li>
+ </ul>
+ </li>
+ <li>
+ Bug fixes and changes to udev for CEDET and ECB. (Udev
+ is a little utility to fetch and install dev sources.)
+ <ul>
+ <li>
+ <span class="bugfix">
+ Changed default directory for installing CEDET and
+ ECB to be under <i>~/.emacs.d/udev/</i>.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Several bug fixes for udev.
+ It should now work again (it did not if you compiled nXhtml).
+ </span>
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added support for <a href="http://www.emacswiki.org/emacs/CompanyMode">Company Mode</a> style completion. Temporary included a copy of Company Mode with bug fixes and changes needed for nXhtml and Viper. It also include a lot of other small features (which I hope can be included in Company Mode). On of these is integration with <a href="http://www.emacswiki.org/emacs/PredictiveMode">Predictive Mode</a>. (You have to get Predictive Mode yourself. If you want to install it on MS Windows I recommend using the latest version of Cygwin. A smaller change to the Makefile is required, there is one absolute path you probably want to remove.)
+ <p class="bugfix">
+ Note: I thought that I should make Company Mode the default completion style. However there are still some problem so I kept the old default completion style.
+ </p>
+ </li>
+ <li>
+ TabKey2:
+ <ul>
+ <li>
+ Added support for Company Mode.
+ </li>
+ <li>
+ Made completion only occur at word ends.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added support for <a href="http://www.emacswiki.org/emacs/Anything">anything style completion</a> in XHTML completion.
+ </li>
+ <li>
+ Added support in inlimg-mode to show images in org-mode. (Also made inlimg-mode use font lock which makes it more reliable.)
+ </li>
+ <li>
+ Included espresso-mode (with some possible bug fixes). Not yet the default for Javascript.
+ </li>
+ <li>
+ <p class="bugfix">
+ Added simple functions for mirroring html files in
+ Firefox as typing. This works - at least for small
+ files. There is also support for automatic update
+ of Firefox when saving CSS files.
+ </p>
+ <p>
+ This is a simple framework for communicating with
+ MozRepl which enqueues requests, waiting for
+ response prompt before sending next requests.
+ <span class="bugfix">Maybe this can be used to make
+ some more efficient routines than those I have
+ written here. Any takers?</span>
+ </p>
+ <p>
+ For larger files (like this one) this version is
+ rather slow since it always changes the whole DOM.
+ </p>
+ </li>
+ <li>
+ <span class="bugfix">
+ Rewrote <i>nxml-where-mode</i> to be more efficient and
+ fixed some minor bugs. It can now also be used with
+ MozRepl to track position in file.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Made <i>winsav-save-mode</i> remember maximized state and forget about empty non-file buffers.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Added workaround for <a href="http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?bug=4015">Emacs bug 4015 on w32</a>.
+ </span>
+ </li>
+ <li>
+ Added <i>ourcomments-M-x-menu-mode</i> which <a
+ href="http://lists.gnu.org/archive/html/emacs-devel/2009-07/msg01025.html">adds menu commands to M-x history</a>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.89">1.89 -- Released 2009-08-04</dt>
+ <dd id="v1.89-dd">
+ <ul>
+ <li>
+ The release version of all the fixes in beta 1.88.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.90">1.90 -- Released 2009-08-04</dt>
+ <dd id="v1.90-dd">
+ <ul>
+ <li>
+ <span class="bugfix">
+ Made wrap-to-fill-column-mode cooperate a bit with
+ mumamo-margin-info-mode.
+ </span>
+ </li>
+ <li>
+ Made an inventory of utilities in nXhtml and made some
+ of them more visible in the menus.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.91">1.91 -- Released 2009-08-04</dt>
+ <dd id="v1.91-dd">
+ <ul>
+ <li>
+ <span class="bugfix">
+ Mumamo bug fix for bug reported on Emacs wiki today. Inline scripts end tag could not be in column one if previous line had a // style js comment.
+ </span>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.92">1.92 -- Released 2009-08-04</dt>
+ <dd id="v1.92-dd">
+ <ul>
+ <li>
+ <span class="bugfix">
+ An Emacs bug that sometimes prevent changing local keymap in a timer hit us. Made a workaround.
+ </span>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.93">1.93 -- Released 2009-08-04</dt>
+ <dd id="v1.93-dd">
+ <ul>
+ <li>
+ <span class="bugfix">
+ Minor bug in menus gave major problem. Fixed - I hope.
+ </span>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.94">1.94 -- Never released, only betas</dt>
+ <dd id="v1.94-dd">
+ <ul>
+ <li>
+ MuMaMo
+ <ul>
+ <li>
+ <span class="bugfix">
+ Hopefully MuMaMo is now fully transfered to the new way of finding the major mode chunks. Chunks in chunks should now work (except for lurking bugs of course...). Tried to fix indentation.
+ </span>
+ </li>
+ </ul>
+ </li>
+ <li>
+ <span class="bugfix">
+ <i>wrap-to-fill-column-mode</i> calculated window width wrongly so that the displayed wrapping was not consistent with what fill-paragraph would give. Corrected together with some other bugs in it.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Fixed an indentation bug in php-mode I introduced when I fixed another indentation bug for heredoc endings.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ A bug in <i>ourcomments-M-x-menu-mode</i> made Emacs client fail. Fixed.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ The version of company-mode include in nXhtml has some changes. It turns out that these probably gives some problems with company-mode support for etags. The version of company-mode in nXhtml is therefore not autoloaded any more.
+ </span>
+ </li>
+ <li>
+ Improved external editing of web mail.
+ </li>
+ <li>
+ Removed <i>js2-mode</i> (and my attempts to make it work with mumamo) since it is now part of Emacs devel sources. Since js2-mode does not use font-lock its integration with mumamo have to wait until it does that.
+ </li>
+ <li>
+ Reworked <b>folding</b> a bit so it is more useful.
+ There is a new minor mode, <i>foldit-mode</i>, that shows better markers for folding. There is a new entry in the <i>nXhtml / Tools</i> menu for folding. <i>fold-dwim-toggle</i> now alwo toggles images and <i>html-write-mode</i> things. In html it first checks for headers then does tag block style visibility toggling.
+ </li>
+ <li>
+ Updated <i>vline.el</i>.
+ </li>
+ <li>
+ Removed fmode.el since it is not needed any more when majmodpri.el does the job.
+ </li>
+ <li>
+ Removed routines to fetch/load CEDET since CEDET is now part of devel sources of Emacs.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.95">1.95</dt>
+ <dd id="v1.95-dd">
+ <ul>
+ <li>
+ First release after all 1.94 betas.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.96">1.96</dt>
+ <dd id="v1.96-dd">
+ <ul>
+ <li>
+ <span class="bugfix">
+ Problem creating autoload file in latest dev version of Emacs. Fixed.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Fixed typo in wrap-to-fill.el.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Autoloaded <i>buffer-narrowed-p</i>.
+ </span>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.97">1.97</dt>
+ <dd id="v1.97-dd">
+ <ul>
+ <li>
+ <span class="bugfix">
+ Problem with customize-option because widgets where not loaded. Rearranged code to bit to fix this.
+ </span>
+ </li>
+ <li>
+ Added support for Groovy from
+ <a href="http://tiagocury.blogspot.com/2009/10/gsp-groovy-server-pages-support-for.html">Tiago Cury</a>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.98">1.98</dt>
+ <dd id="v1.98-dd">
+ <ul>
+ <li>
+ <span class="bugfix">
+ Added support for PHP nowdocs.
+ </span>
+ </li>
+ <li>
+ Freemind.el: Added support for <i>org-odd-levels-only</i>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.99">1.99</dt>
+ <dd id="v1.99-dd">
+ <ul>
+ <li>
+ Converted line endings from CRLF to LF.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v2.00">2.00</dt>
+ <dd id="v2.00-dd">
+ <p>
+ 2.00 does not stand for something very exciting, it is just a consecutive number. But - I do believe this is a rather mature version of nXhtml.
+ </p>
+ <ul>
+ <li>
+ MuMaMo
+ <ul>
+ <li>
+ <span class="bugfix">
+ Fixed some indentation bugs.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Added multi major mode local sub chunk dividing inheriting.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Made MuMaMo avoid closing org-mode nodes
+ </span>
+ when moving between sub chunks in org files.
+ </li>
+ <li>
+ <span class="bugfix">
+ Introduced per main major local variables.
+ </span>
+ First use is for buffer-invisibility-spec. This can only be set in the main major mode now. (Or rather, it will be reset to what was last set in main major mode when you move between chunks.) This is the most reasonable way I believe, since it may otherwise change when moving between chunks and the new chunk's major mode is called.
+ </li>
+ <li>
+ Added support for Mason.
+ </li>
+ </ul>
+ </li>
+ <li>
+ <span class="bugfix">Renamed gimp.el to gimpedit.el</span> and made it open GIMP on other platforms than w32 too. (Symbols in the files are renamed too.) Skipped compatibility with old GIMP versions.
+ </li>
+ <li>
+ <span class="bugfix">Renamed freemind.el to org-freemind.el</span> so that it can be included among the org files.
+ Also added support for #+BEGIN_HTML when exporting to freemind.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v2.01">2.01</dt>
+ <dd id="v2.01-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ <span class="bugfix">
+ Major mode was not always switched when moving fast between chunks. Fixed.
+ </span>
+ </li>
+ <li>
+ Made desktop recognize multi major modes.
+ </li>
+ </ul>
+ </li>
+ <li>
+ <span class="bugfix">
+ org-freemind.el was broken. Sorry.
+ </span>
+ </li>
+ <li>
+ Fixed a bug in wrap-to-fill-column-mode.
+ </li>
+ <li>
+ Enhanced support for smarty template language.
+ </li>
+ <li>
+ Mlinks mode used one timer per buffer. Converted to one global timer => much faster. (This actually slowed down Emacs screen update before.)
+ </li>
+ </ul>
+ </dd>
+ <dt id="v2.02">2.02</dt>
+ <dd id="v2.02-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ <span class="bugfix">
+ Support for #+BEGIN_SRC ... #+END_SRC etc in org-mode.
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Bug fix for the case <script ...>//<!-- -->
+ </span>
+ </li>
+ <li>
+ <span class="bugfix">
+ Fixed support for ASP again.
+ </span>
+ </li>
+ <li>
+ Added support for XSL with embedded CSS and Javascript, see <i>xsl-nxml-mumamo-mode</i>.
+ </li>
+ <li>
+ Added support for SSJS (Server Side Javascript)
+ </li>
+ <li>
+ Changed to using nxhtml-mode for indentation when chunk major is htm-mode. Added <i>mumamo-indent-major-to-use</i> to control this.
+ </li>
+ <li>
+ Turned off nxml-mode validation during indentation of regions.
+ </li>
+ <li>
+ Updated htmlfontify.el.
+ </li>
+ <li>
+ Included <a href="http://www.emacswiki.org/emacs/ZenCoding">zencoding-mode.el</a>.
+ </li>
+ <li>
+ Finally got around to implement a <b>C-a</b> that just selects a widget field in a Custom buffer, not the whole buffer. See <i>rebind-keys-mode</i>.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added wrap-to-fill-column-global-mode.
+ </li>
+ <li>
+ Removed org-freemind.el (formerly freemind.el) since it is now part of Emacs CVS repository and you can get it there.
+ </li>
+ <li>
+ <span class="bugfix">
+ Added flymake support for CSS and javascript with detailed instructions of how to install needed support.
+ </span>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v2.03">2.03</dt>
+ <dd id="v2.03-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ <span class="bugfix">
+ Made the new JavaScript mode that is included in Emacs work within chunks.
+ </span>
+ </li>
+ </ul>
+ </li>
+ <li>
+ Removed the JavaScript modes that were distributed with nXhtml. If you are not using CVS Emacs please get js.el from there.
+ </li>
+ <li>
+ <span class="bugfix">
+ Made <i>majmodpri-no-nxml</i> work a bit better.
+ </span>
+ </li>
+ <li>
+ Put <i>rebind-keys-mode</i> on the menu so it can be found.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v2.04">2.04</dt>
+ <dd id="v2.04-dd">
+ <ul>
+ <li>
+ <span class="bugfix">
+ Added web install and update of nXhtml.
+ </span>
+ You can find this in the nXhtml menu.
+ If you do not have this in your nXhtml yet, or have not installed nXhtml please see the instructions on EmacsWiki.
+ </li>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ <span class="bugfix">
+ Fixed some problems with temporary chunks.
+ </span>
+ </li>
+ <li>
+ Added support for html chunks in markdown files with new multi major mode <i>markdown-html-mumamo-mode</i>.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v2.05">2.05</dt>
+ <dd id="v2.05-dd">
+ <ul>
+ <li>
+ <span class="bugfix">
+ Fixed a problem in flymake-css.el with loading newst-backend.el (which provides the wrong feature).
+ </span>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v2.06">2.06 - never released</dt>
+ <dd id="v2.06-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Skipped fontification during indentation. (This was troublesome since major mode may have to be changed during indentation.)
+ </li>
+ <li>
+ Included iss-mode and iss-mumamo-mode for editing of Inno Setup scripts.
+ </li>
+ <li>
+ <span class="bugfix">
+ Comments in eRuby <%# .. %> did not work. Fixed.
+ </span>
+ </li>
+ </ul>
+ </li>
+ <li>
+ Included better support for Java in flymake. It will can now recognize makefiles, ant and single java files and try to DTRT.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v2.07">2.07 - never released</dt>
+ <dd id="v2.07-dd">
+ <p>
+ This version was never released, but was available as beta for testing (and use). During this beta I tried to finish the rewriting of the rewriting of the chunk dividing routines. (Those needed simplification. Initially I believed that chunks with different major could be created starting from anywhere in the file. This was complex and indeed a bad idea since the chunk dividing markers depends on the content of the file from the top.)
+ </p>
+ <p>
+ A lot of bugs where fixed during this and new things were added. Some things were removed. But there is no good logg of this anywhere because I did not have time to update that. Sorry. But if you are interested you can have a look at the bug database at Launchpad.
+ </p>
+ </dd>
+ <dt id="v2.08">2.08 - released 2010-04-25</dt>
+ <dd id="v2.08-dd">
+ <p>
+ This is the first released version since version 2.05 (which was released in Dec 2009).
+ </p>
+ <p>
+ One noticeable thing is that the menus were restructered to make it easier to find things. You can find some of the new things there. Most of the rest are internal changes and bug fixes.
+ </p>
+ </dd>
+ </dl>
+ </div>
+
+ <hr class="footer"/>
+ <p class="footer">
+ <span id="latest">Copyright © <!-- this year -->2009<!-- end this year --> OurComments.org</span>
+ </p>
+ </div>
+ </body>
+</html>
--- /dev/null
+@import url(td_oc.css);\r
+\r
+hr {\r
+ margin-top: 4em;\r
+}\r
+body {\r
+ margin-top: 0.5em;\r
+ background-color: #ffe4b5;\r
+ background-color: #ffffdf;\r
+ margin-left: 5%;\r
+ margin-right: 5%;\r
+}\r
+body, td {\r
+ font-size: 0.9em;\r
+ font-family: Arial, sans-serif;\r
+}\r
+h1, h2, h3 {\r
+ color: #556b2f;\r
+}\r
+em {\r
+ color: maroon;\r
+ font-style: normal;\r
+}\r
+\r
+a {\r
+ color: maroon;\r
+}\r
+a.nonexistent {\r
+ font-weight: bold;\r
+ background-color: #F8F8F8;\r
+ color: #FF2222;\r
+}\r
+\r
+a.nonexistent:visited {\r
+ background-color: #F8F8F8;\r
+ color: #FF2222;\r
+}\r
+\r
+a.dl {\r
+ font-weight: 400;\r
+ background-color: #e0ff6e\r
+}\r
+\r
+strong { font-weight: bold; }\r
+\r
+ul { list-style-type: disc }\r
+\r
+dl.contents { margin-top: 0; }\r
+dt.contents { margin-bottom: 0; }\r
+\r
+\r
+p.verse {\r
+ white-space: pre;\r
+ margin-left: 5%;\r
+}\r
+\r
+pre {\r
+ white-space: pre;\r
+ /* monospace does not work in Firefox 0.9.2 font-family: monospace; */\r
+ margin-left: 0em;\r
+ margin-bottom: 0em;\r
+}\r
+\r
+dl.bolddt dt { font-weight: bold; }\r
+\r
+dt {\r
+ font-weight: bold;\r
+}\r
+dd {\r
+ margin-bottom: 0.7em;\r
+}\r
+hr {\r
+ width: 100%;\r
+}\r
+hr.divider {\r
+ height: 0.7em;\r
+ background-color: maroon;\r
+ width: 67%;\r
+}\r
+#FEAT li {\r
+ margin-bottom: 0.7em;\r
+}\r
+\r
+#PAGETOC {\r
+ float: left;\r
+ background-color: #df7;\r
+ background-color: #edef87;\r
+ margin-right: 2em;\r
+ margin-bottom: 2em;\r
+ margin-top: 0em;\r
+ -moz-border-radius: 1em;\r
+}\r
+#PAGETOC td {\r
+ padding: 0.8em;\r
+ padding-right: 1.1em;\r
+ //font-size: 0.8em; /* For IE only */\r
+}\r
+#PAGETOC strong {\r
+ color: #6b8e23;\r
+ display: block;\r
+ margin-bottom: 0.5em;\r
+}\r
+#PAGETOC ul li a {\r
+ color: maroon;\r
+}\r
+#PAGETOC a:hover { background-color: yellow; }\r
+#PAGETOC ul {\r
+ list-style-type: none;\r
+ margin:0;\r
+ padding-left: 1.5em;\r
+}\r
+#PAGETOC ul li {\r
+ font-weight: bold;\r
+}\r
+#PAGETOC ul li ul { }\r
+#PAGETOC ul li ul li { font-weight: normal;}\r
+#PAGETOC .liul {\r
+ //display:inline; /* For IE only */\r
+}\r
+#emacswikibar {\r
+ background-color:#ef4;\r
+ background-color: #edef87;\r
+ text-align:center;\r
+ margin-top:0em;\r
+ padding:0.4em;\r
+}\r
+#imgwikiguide {\r
+ background-color:#cef;\r
+ padding:2em;\r
+ -moz-border-radius: 2em;\r
+}\r
+\r
+#download a {\r
+ border: groove;\r
+ font-size: 1.5em;\r
+ padding: 0.6em;\r
+ background-color: #556b2f;\r
+ color: #ce6;\r
+ -moz-border-radius: 1em;\r
+}\r
+#download a:hover {\r
+ color: #BF0;\r
+ background-color: black;\r
+ text-decoration: underline;\r
+}\r
+#emacsw32dl {\r
+ width:20em;\r
+ border-style:solid;\r
+ border-color:#556b2f;\r
+ padding:0.7em;\r
+ -moz-border-radius: 1em;\r
+}\r
+\r
+#my-elisp {\r
+ background-color: #fff;\r
+ padding: 2em;\r
+ border-style: solid;\r
+ -moz-border-radius: 1em;\r
+}\r
+#my-elisp dl {\r
+ margin-left: 2em;\r
+}\r
+\r
+#keybnotationdiv {\r
+ border-width:1px;\r
+ border-style:solid;\r
+ border-color:#556b2f;\r
+ padding:0.7em;\r
+ padding-left:1.5em;\r
+ -moz-border-radius: 1em;\r
+}\r
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>nXhtml - an Emacs mode for Web Development</title>
+ <link href="wd/grapes/nxhtml-grapes.css" rel="StyleSheet" type="text/css" />
+ <style type="text/css">
+ #special {
+ background-color: red;
+ }
+ </style>
+<style type="text/css">
+
+
+#getit {
+ max-width: 800px;
+}
+
+#getit span { display: none; }
+/* This seems to be impossible with CSS2 since the containing block
+ can not be floated. Why did they design it that way?
+#getit, #getit dl { display: block; }
+#getit a:hover span {
+ display: block;
+ position: absolute;
+ left: 200;
+ top: 0;
+}
+*/
+
+#getit a {
+ /* Image */
+ display: block;
+ background: transparent url("img/getitbuttons.png") 0 0 no-repeat;
+ overflow: hidden;
+ width: 200px;
+ /* Text placement and size, etc */
+ text-align: center;
+ padding-top: 11px;
+ font-size: 12px;
+ font-weight: 600;
+ padding-bottom: 9px;
+ text-decoration: none;
+ white-space: nowrap;
+ border: none;
+}
+#getit dt {
+ display: block;
+ padding: 0;
+ margin: 0;
+ float: left;
+ letter-spacing: 0;
+}
+#getit a:hover {
+ background-position: 0 -35px;
+ color: yellow;
+}
+
+#useit {
+ position: absolute;
+ top: 150px;
+ left: 100px;
+ width: 85px;
+ z-index: 100;
+ border: none;
+ font-size: 9px;
+}
+/* I can't get rid of the underline. Firefox bug or my bug? */
+#useit a { text-decoration: none; }
+#useit img {
+ text-decoration: none;
+ overflow: hidden;
+ border: solid 2px #990033;
+}
+div#useit { text-decoration: none; }
+#useit img:hover {
+ background: url("img/use-nXhtml-trans2.png") 0 0 no-repeat;
+}
+
+#quicklnk a {
+ color: #cd3700;
+ font-weight: bold;
+ font-size: 1.2em;
+}
+#quicklnk a:hover {
+ background-color: yellow;
+}
+
+</style>
+ </head>
+ <body>
+ <div id="useit">
+ <!-- title is for Firefox -->
+ <a href="http://ourcomments.org/Emacs/nXhtml/doc/nxhtml.html"
+ title="Get nXhtml for Emacs"
+ ><img alt="Get nXhtml for Emacs" src="img/use-nXhtml-trans2.png" width="78" height="29" /></a>
+ Above is a little banner you can put on your site if you want to.
+ </div>
+
+ <div id="container">
+ <div id="hdr">
+ <br />
+ <span style="color:#FF0;font-size:14px; font-weight: 600;"> <i> Enjoying editing web files!</i> </span>
+ <br />
+ </div>
+
+ <div id="lftcol">
+ <!-- Table of contents BEGIN -->
+ <!-- Table of contents min=2 max=3 -->
+ <table id="PAGETOC"><tr><td>
+ <span class="tochead">On THIS Page:</span>
+ <ul>
+ <li><a href="#summary">Introduction to nXhtml</a></li>
+ <li class="liul"><ul>
+ <li><a href="#featsum">Features</a></li>
+ <li><a href="#qg">The Quick Guide</a></li>
+ <li><a href="#toolset">What you may use more</a></li>
+ </ul></li>
+ <li><a href="#completion">Completion</a></li>
+ <li class="liul"><ul>
+ <li><a href="#complex-compl">More Helpful Completion</a></li>
+ <li><a href="#ask-compl">But How Do I Ask nXhtml for Alternatives?</a></li>
+ <li><a href="#region-compl">The Region and Completion</a></li>
+ <li><a href="#errors">And if I Do Not Follow the Advices?</a></li>
+ </ul></li>
+ <li><a href="#xmlpath">Where am I? - XML Path</a></li>
+ <li><a href="#sites">Why it is Useful that nXhtml has Sites</a></li>
+ <li><a href="#mlinks">Why the Links Look Like Links</a></li>
+ <li><a href="#tocs">Did You Notice the Table of Contents at the Top?</a></li>
+ <li><a href="#tidy">But I Can't Use this Cause my Files are HTML</a></li>
+ <li><a href="#php">And what about Multiple Modes like PHP?</a></li>
+ <li class="liul"><ul>
+ <li><a href="#dtd-needed">But I Have no DTD Links in my PHP Files?</a></li>
+ <li><a href="#multi-colors">Why Are Colors Different in Multiple Modes?</a></li>
+ <li><a href="#part2">More Multiple Modes</a></li>
+ <li><a href="#tips-multi">Tips When Using Multiple Modes</a></li>
+ </ul></li>
+ <li><a href="#file-assoc">File Associations within Emacs</a></li>
+ <li><a href="#bloggin">Not for Me, I Am Only Blogging</a></li>
+ <li><a href="#bloggin">And Other Goodies...</a></li>
+ </ul>
+ </td></tr></table>
+ <!-- END of Table of contents -->
+ </div>
+
+ <div id="getit">
+ <dl>
+ <dt>
+ <a href="http://ourcomments.org/Emacs/nXhtml/tut/tutorials.html" title="Tutorials">Tutorials</a>
+ </dt>
+ <dt>
+ <a href="https://answers.launchpad.net/nxhtml/+faqs" title="nXhtml FAQ">nXhtml FAQ</a>
+ </dt>
+ <dt>
+ <a href="nxhtml-changes.html">News about nXhtml
+ <span>Details</span></a>
+ </dt>
+ <dt>
+ <a href="http://www.emacswiki.org/cgi-bin/wiki/NxhtmlMode"
+ >nXhtml page at EmacsWiki</a>
+ </dt>
+ <dt>
+ <a id="download" href="http://ourcomments.org/cgi-bin/emacsw32-dl-latest.pl">Download nXhtml</a>
+ </dt>
+ <dt>
+ <a href="https://launchpad.net/nxhtml" title="Bazaar repository">nXhtml at Launchpad</a>
+ </dt>
+ </dl>
+ </div>
+
+ <div id="rgtcol">
+ <h1 id="mainheader">nXhtml - Emacs Utilities for Web Development</h1>
+
+ <h2 id="summary">Introduction to nXhtml</h2>
+ <p>
+ nXhtml is an addon to Emacs for editing XHTML, PHP and similar things. It is not
+ very well-known, but it looks like at least <a
+ href="http://drewyates.net/nxml-nxhmtl-emacs-mode-for-ruby-on-rails-rhtml">Drew
+ Yates</a> has found it useful:
+ </p>
+ <blockquote>
+ <p style="font-style:italic">
+ nXML mode and the subsequent nXHTML mode for emacs are godsends ...
+ </p>
+ </blockquote>
+ <p>
+ And that was before I fixed all the bugs ...
+ </p>
+
+ <h3 id="featsum">Features</h3>
+ <p>
+ One of the main parts of nXhtml is nxhtml-mode, a GNU <a
+ href="http://en.wikipedia.org/wiki/Emacs">Emacs</a> major
+ mode that builds on <a
+ href="http://www.thaiopensource.com/nxml-mode/">nxml-mode</a>.
+ It knows about XHTML syntax and can check this as
+ you type. It can also tell you what tags and attributes you
+ can use at a certain point and help you insert them.
+ </p>
+ <p>
+ That feature, which we call <a
+ href="#completion">completion</a>, is one of the main
+ features of this mode. Another important feature is the
+ ability to mix several languages in one buffer and get the
+ correct syntax highlighting and indentation for each of
+ them.
+ </p>
+ <p>
+ In nXhtml this is combined with other features to make it
+ more easy to edit web sites (mostly XHTML based but there is
+ support for things like PHP too). Here is a list of important features:
+ </p>
+ <ul id="sum-ul">
+ <li>
+ Completion and syntax checking for XHTML.
+ <ul>
+ <li> Some helpful extensions when completing certain tags (like the <a ...> tag for example).</li>
+ <li> When region is visible tag completion will surround the region with the start tag and end tag.</li>
+ </ul>
+ </li>
+ <li>
+ Multiple major modes, which means it can handle for example PHP, JSP, eRuby and Django while allowing XHTML completion.
+ (Notice however that not all major modes you may need for this comes with nXhtml.)
+ </li>
+ <li>
+ Link handling:
+ <ul>
+ <li> Easier insertion of tags with links.</li>
+ <li> Following links to edit or view.</li>
+ <li> Moving between links.</li>
+ <li> Moving files and automatically update affected links.</li>
+ <li> Copy link to id location and paste it back as a relative link.</li>
+ <li> Link checking in current site (local links only)</li>
+ </ul>
+ </li>
+ <li>
+ The concept of a site. This is used in many places. A
+ site is here a directory tree with additional properties, like
+ remote ftp and http addresses. A directory could belong to
+ many sites.
+ </li>
+ <li>
+ Make a remote copy of site:
+ <ul>
+ <li> Uploading of single files</li>
+ <li> Uploading of whole or part of site</li>
+ <li> Editing of remote files.</li>
+ <li> Ediff of local vs remote file.</li>
+ <li> Easy viewing of local and remote files in web browser.</li>
+ </ul>
+ </li>
+ <li>
+ Table of contents
+ <ul>
+ <li>Creating table of contents for a page.</li>
+ <li>Creating table of contents for a site.</li>
+ <li>
+ Merging of pages and table of contents for a site (see
+ example, notice that the table of content easily can be
+ navigated using the keyboard).
+ </li>
+ </ul>
+ </li>
+ <li> Support for folding.</li>
+ <li> Using <a href="http://www.w3.org/People/Raggett/tidy/">Tidy</a> to convert HTML to XHTML.</li>
+ <li> Help for XHTML tags and CSS attributes.</li>
+ <li> Edit a fragment of an XHTML file (for blogging for example).</li>
+ <li> ... and more of course ...</li>
+ <!-- <li> Adding a popup menu to [apps] to access these features.</li> -->
+ </ul>
+
+ <h3 id="qg">The Quick Guide</h3>
+ <p>
+ Below are some short notes to get you started using nXhtml.
+ (Maybe you should start by taking a look at the
+ <a href="http://ourcomments.org/Emacs/nXhtml/tut/tutorials.html" title="Tutorials">Tutorials</a>?)
+ </p>
+ <dl>
+ <dt>GNU Emacs 22 or later</dt>
+ <dd>
+ <p>
+ You need GNU Emacs 22 (which was released 2007-06-02) or later.
+ </p>
+ </dd>
+ <dt>Installation</dt>
+ <dd>
+ <ul>
+ <li>
+ Download nXhtml as a zip file <a href="http://ourcomments.org/cgi-bin/emacsw32-dl-latest.pl">here</a>
+ or download
+ <a href="http://ourcomments.org/Emacs/EmacsW32.html">EmacsW32</a>.
+ </li>
+ <li>
+ If you got nXhtml with <a
+ href="http://ourcomments.org/Emacs/EmacsW32.html">EmacsW32</a>
+ you should use the menus <em>Options - Customize
+ EmacsW32</em> and there just set <em>nxhtml-load</em>.
+ </li>
+ <li>
+ If you downloaded the zip file with nXhtml then unzip it anywhere and
+ then follow the instructions in
+ <em>nxhtml/README.txt</em>.
+ </li>
+ </ul>
+ <p>
+ After this files with extensions for example .html will open in nxhtml-mode.
+ </p>
+ <p>
+ To make nXhtml run faster you can also byte compile the files.
+ You do that with <i>M-x nxhtmlmaint-start-byte-compilation</i>.
+ </p>
+ </dd>
+
+ <dt id="nxhtml-menu">The nXhtml Menu</dt>
+ <dd>
+ <p>
+ To reach many of the features in nXhtml you can use the
+ <b>nXhtml menu</b>. If you do not see that when in a buffer
+ then you can always do <em>M-x nxhtml-minor-mode</em> which
+ will turn it on (or off) for that buffer.
+ </p>
+ <p>
+ But please notice also the <b>XML menu</b> which
+ contains the nXml menu! (Remember that nXhtml is based
+ on nXml.) When you are using nxhtml-mode this menu is
+ visible when you are in the XHTML parts of a buffer.
+ </p>
+ </dd>
+
+ <!-- <dt id="turn-on-some">Turn on Some Things</dt> -->
+ <!-- <dd> -->
+ <!-- <p> -->
+ <!-- There is a good chance that you want to turn on some -->
+ <!-- things that makes nXhtml work more automatic. They are -->
+ <!-- in the <a href="#nxhtml-menu">nXhtml menu</a> for -->
+ <!-- turning them on temporarily. Later, when you have -->
+ <!-- tested, you may want to turn them on permanently, which -->
+ <!-- you can do from the menus by choosing <em>nXhtml - -->
+ <!-- nXhtml Help and Setup - Quick Customize nXhtml</em>. -->
+ <!-- </p> -->
+ <!-- </dd> -->
+
+ <dt>XHTML Completion and Validation</dt>
+ <dd>
+ <p>
+ nXhtml knows a good deal about XHTML tags and attributes when you are using <em>nxhtml-mode</em>.
+ It can assist you in different ways:
+ </p>
+ <ul>
+ <li>
+ Completion
+ </li>
+ <li>
+ Validation
+ </li>
+ </ul>
+ <p>
+ <b>Completion</b> means that you ask Emacs to give you choices to complete what you are currently writing.
+ For example you may have written <b and want to know what tags beginning this way can actually be used at that place in the document.
+ You ask Emacs in nxhtml-mode this by calling the function nxml-complete.
+ This is normally bound to M-Tab.
+ </p>
+ <p>
+ On some systems, for example MS Windows with an
+ unpatched Emacs this is inconvenient and clashes with
+ Alt-Tab that the window manager uses. There is however a
+ little utility that comes with nXhtml that let you use
+ just Tab for completion, <i>tabkey2-mode</i>. Turn this on with
+ </p>
+ <p style="padding-left:2em;">
+ M-x tabkey2-mode
+ </p>
+ <p>
+ After this the first Tab press will still do
+ indentation, but the second can do completion.
+ </p>
+ <p>
+ <b>Validation</b> means checking that what you have
+ written in nxhtml-mode follows the XHTML specifications.
+ If it does not there will be a red underline at the
+ places where something is wrong. To see what is wrong
+ move to this (for example with C-c C-n). A message in
+ the minibuffer will tell you the error.
+ </p>
+ <p>
+ Notice that the modeline also tells if the document is
+ valid. Most of the times it will however say
+ <em>Invalid</em> maybe just because you are editing and have
+ not yet finished.
+ </p>
+ <p>
+ For files mixing XHTML with codes, like PHP, you can use
+ something I call <a href="#dtd-needed">Fictive XHTML
+ Validation Headers</a>. That allows you to use XHTML
+ completion even if those files does not have the XHTML
+ headers needed.
+ </p>
+ </dd>
+ <dt>Multiple Major Modes</dt>
+ <dd>
+ <p>
+ nXhtml can automatically divide the buffer into chunks
+ with relevant different major modes (i e languages, like
+ PHP, XHTML etc). This is useful for editing PHP,
+ JSP, eRuby, Django and similar. See <a href="#php">And
+ what about Multiple Modes like PHP?</a> for more information.
+ </p>
+ </dd>
+ <dt>Links</dt>
+ <dd>
+ <p>
+ The links you put in your XHTML documents actually works
+ like links with nxhtml-mode too. To follow a link you
+ can use <em>C-c RET RET</em>. (There are other
+ possibilities too, they all begin with <em>C-c RET</em>.)
+ </p>
+ </dd>
+ <dt>Sites and Uploading</dt>
+ <dd>
+ <p>
+ If you want to upload your XHTML files, image files etc
+ you can do that from within Emacs. There are entries
+ for this in the <a href="#nxhtml-menu">nXhtml menu</a>.
+ </p>
+ </dd>
+ <dt>Keyboard shortcuts (aka keybindings in Emacs)</dt>
+ <dd>
+ <p>
+ When you start to use a new program you often wonder
+ about which keybindings there are to use. If you have
+ not used Emacs before you may feel quite lost because
+ you have looked in all documentation and you have not
+ seen any list of keybindings.
+ </p>
+ <p>
+ Well, that is how it often is in Emacs. Get use to it ...
+ </p>
+ <p>
+ But do not panic. Because there is help, probably even
+ better than you are used to - in Emacs dynamic help
+ system. A help system that change if you for example add
+ a keybinding yourself. Try the command <i>C-h b</i> (or <i>F1
+ b</i>). This list all the keybindings (in their priority
+ order) that are active where you are in Emacs.
+ </p>
+ <p>
+ You can also try <i>C-h m</i> which gives information about
+ minor modes and the current major mode. There is
+ sometimes information about the keybindings there too.
+ </p>
+ </dd>
+ <dt>Some More You Can Do ...</dt>
+ <dd>
+ <p>
+ See <a href="#summary">Introduction</a> above.
+ Look into the <a href="#nxhtml-menu">nXhtml menu</a>.
+ And then of course learn some of all the things you can do using the power of Emacs.
+ </p>
+ </dd>
+ </dl>
+ <p>
+ </p>
+ <h3 id="toolset">What you may use more</h3>
+ <p>
+ If find it very conventient to combine nXhtml with Firefox
+ add-on Firebug. I think Firebug is very handy for finding CSS
+ problem.
+ </p>
+ <p>
+ <a href="http://www.spreadfirefox.com/node&id=0&t=306"><img border="0"
+ alt="Firefox 3" title="Firefox 3"
+ src="http://sfx-images.mozilla.org/affiliates/Buttons/firefox3/110x32_get_ffx.png"/></a>
+
+ <a href="http://www.getfirebug.com/?link=2" title="Firebug
+ is a free web development tool for
+ Firefox"><img src="http://www.getfirebug.com/images/firebug2.png"
+ border="0" alt="Firebug - Web Development Evolved"/></a>
+ </p>
+ <p>
+ And of course, another good resource is Russ Weakley's <a
+ href="http://css.maxdesign.com.au/">CSS-based tutorials</a>.
+ Russ co-chairs the <a
+ href="http://webstandardsgroup.org/">Web Standards Group</a>
+ and seems to know this well.
+ </p>
+ <p>
+ I am sure you know about it, but just in case, here is WDG's
+ <a href="http://htmlhelp.com/design/accessibility/">Guide to Accessibility</a>
+ and their
+ <a href="http://htmlhelp.com/design/accessibility/tips.html">Accessibility Tips</a>.
+ </p>
+
+ <h2 id="completion">Completion</h2>
+ <div align="right">
+ <img align="right"
+ src="img/popup-compl.png"
+ alt="Popup menu style completion"
+ title="Popup menu style completion"
+ style="border: thin dotted #00ff00;
+ margin-left: 2em;
+ margin-top: 0em;
+ margin-bottom: 1em;"
+ width="371" height="483" />
+ </div>
+ <p>
+ Completion in nXhtml Mode lets you ask Emacs <i>"What can I
+ type here?"</i>. The most important part, the content, can
+ Emacs not help you with yet. However when it comes to XHTML and
+ such things that you really want to get past as easy as
+ possible, then nXhtml mode can assist you.
+ </p>
+ <p>
+ Perhaps you wonder with <i>"With what?"</i> Well, completion
+ works like this: You position point in your XHML file where you
+ want to write. Now you ask nXhtml what XHTML code you can
+ write there. nXhtml may answer that it can't help you, that
+ happens in some cases.
+ </p>
+ <p>
+ But most often nXhtml can help you. It knows about tags and
+ where they fit, and it knows about tag attributes. When nXhtml
+ can helpt you it will give you choices you can select from. It
+ may display the choices in a popup menu like in the pictures to
+ the left, or it may use something like the picture below shows.
+ It is actually exactly the same question that is asked in these
+ two cases. You decide by <i>customizing</i> nXhtml mode in Emacs which
+ way it should display the choices. The way below is the
+ standard Emacs way to do display choices. It is fast once you know it, but
+ the popup menus are of course more familiar to computer users
+ today.
+ </p>
+ <img alt="Emacs style completion" src="img/emacs-style-completion.png" width="456" height="406"
+ />
+ <p>
+ That far nXhtml can take you because it knows the DTD for XHTML.
+ (You may wonder about different versions of XHTML, more about that later.)
+ </p>
+
+ <h3 id="complex-compl">More Helpful Completion</h3>
+ <p>
+ For certain attributes nXhtml knows their values because the DTD just allows certain values.
+ For some other attribute values for which nXhtml can know little
+ from the DTD alone, like links (src and href attributes) nXhtml
+ can also be helpful. If you want a link to a file, for example,
+ nXhtml lets you browse for the file and then inserts a relative
+ link to it. It can also look for anchors (ie <b>id</b> attributes).
+ </p>
+ <p>
+ In some cases nXhtml knows more about a tag.
+ From the DTD it knows that an <b><img></b> tag should have a <b>src</b> attribute with a value that points to an image.
+ Therefor it prompts you for the value of the src attribute.
+ It is the same with the <b>alt</b> attribute that is required.
+ It even gets the height and width of an image on file if it can and inserts the attributes in the <img> tag.
+ </p>
+ <p>
+ Well, it is better that you test (and perhaps give some feedback?).
+ </p>
+ <p>
+ Normally nXhtml does not care that much. It just tells you that
+ you when you have broken the DTD rules. If however you want
+ nXhtml to do less or more of this kind then you can change the
+ variable <b>nxhtml-complete-tag-do-also</b> - but that requires
+ that you knows Emacs lisp. If you do write something useful for
+ this, please tell me.
+ </p>
+
+ <h3 id="ask-compl">But How Do I Ask nXhtml for Alternatives?</h3>
+ <p>
+ Oh, I nearly forgot. Do you wonder how to ask nXhtml in Emacs for completion alternatives?
+ That is a nice question to answer.
+ You give a certain command to Emacs to ask for this.
+ That can be done by either:
+ </p>
+ <ul>
+ <li>Type <i>M-Tab</i></li>
+ <li>Do it from the <a href="#nxhtml-menu">nXhtml menu</a>: <i>nXhtml - Completion - Complete tag, attributes etc</i></li>
+ <li>Or more explicit with a command: <i>M-x nxml-complete</i></li>
+ </ul>
+ <p>
+ You can change <i>M-Tab</i> to whatever you want. What it
+ means? Ah, yes, it means <i>"hold down the Meta key and press
+ Tab"</i>. That is Emacs jargon and you have to know which key
+ is the Meta key of course. I actually use the left Windows key
+ on my keyboard for Meta. See <a
+ href="http://ourcomments.org/Emacs/EmacsW32.html">EmacsW32 home
+ page</a> for some information about this if you are on MS
+ Windows.
+ </p>
+
+ <h3 id="region-compl">The Region and Completion</h3>
+ <p>
+ This is a small but useful thing (and I added it because some people liked it, it
+ was not my own idea): If some text is selected (in Emacs jargon
+ "if region is active and hilighted") and you use completion to
+ insert a tag then the <em>region will be surrounded by that tag</em>.
+ If region is active like here:
+ </p>
+ <img alt="Region is selected" src="img/region-selected.png" width="584" height="50"
+ style="border: thin dotted #00ff00;
+ vertical-align: top;
+ margin-bottom: 1em;" />
+ <p>
+ And you then ask for completion:
+ </p>
+ <img alt="Ask for tag" src="img/region-selected-completion.png" width="584" height="393"
+ style="border: thin dotted #00ff00;
+ vertical-align: top;
+ margin-bottom: 1em;" />
+ <p>
+ The result will be that your choice (<em>em</em> here) will surround the region you had selected:
+ </p>
+ <img alt="After completion" src="img/region-selected-after.png" width="584" height="61"
+ style="border: thin dotted #00ff00;
+ vertical-align: top;
+ margin-bottom: 1em;" />
+ <p>
+ Eh? Ah, yes, you are right. I happened to choose the wrong picture for the result. Sorry.
+ </p>
+
+ <h3 id="errors">And if I Do Not Follow the Advices?</h3>
+ <p>
+ nXhtml gives you advices about how to handle the XHTML tags, but
+ it does not force you to follow them. You can write whatever
+ you want, but nXhtml anyway observes what you are doing and
+ checks the XHTML code. If you do not follow the DTD rules
+ nXhtml will silently warn you with a red underline, like here
+ (where I have written <i>image</i> instead of <i>img</i>):
+ </p>
+ <img alt="Validation error marking" src="img/validation-error.png" width="375" height="50"
+ style="border: thin dotted #00ff00;"
+ />
+ <p>
+ (Oh, geeh. Firefox took that before, but not now ...)
+ </p>
+
+ <h2 id="xmlpath" style="clear:both">Where am I? - XML Path</h2>
+
+ <p>
+ If you have for example <div> tags to separate things or long
+ list you may wonder in which of those you are. Nxml Mode can
+ show this. Look in the menus <i>XHTML - XML Path</i> to turn it
+ on. Here is what it looks like. There is header with the label <i>Path:</i> which here shows that we are in a list with id="sum-ul".
+ Note also the yellow color of the tag we are in. The whole path up to the top is colored this way.
+ </p>
+ <img alt="Showing XML Path" src="img/nxml-where.png" width="456" height="262" />
+ <p>
+ A little tip: I found this very useful when I looked at different CSS designs.
+ </p>
+
+ <h2 id="sites">Why it is Useful that nXhtml has Sites</h2>
+ <p>
+ I am writing this in nXhtml mode in Emacs. Just after I had
+ written a piece or added an image on my pc I update the web
+ pages on http://OurComments.org/. I do that very easily because
+ of the concept of a site.
+ </p>
+ <p>
+ A <b>site in nXhtml</b> is in its simplest form just a local directory tree.
+ And that is given a name.
+ In my case I have given it the name <i>nxhtml-doc</i> just to remember what it is about.
+ </p>
+ <p>
+ To that site I have also added information about uploading and
+ and the http address of the uploaded files. Now if I add an
+ image to the site on my pc all I have to do to upload it to the
+ web site is to open the image in Emacs (yes that is possible,
+ Emacs knows about the most common image formats) and then just from the menus choose
+ <i>Web Site - File Transfer - Upload Single File</i>.
+ That is all.
+ </p>
+ <p>
+ And then I can (from the XHTML file I am editing) use the
+ command <i>XHTML - File Transfer - View Uploaded File</i> to
+ check that the web page is ok.
+ </p>
+
+ <h2 id="mlinks">Why the Links Look Like Links</h2>
+ <p>
+ As soon as you open an XHTML file in nXhtml mode you will notice that the links you enter looks like links.
+ They are underlined and blue like in a web browser.
+ You may think that that is kind of nice, but why do they look like that?
+ </p>
+ <p>
+ It is just because they are links. You access them a little bit
+ different in a web browser, just so that it does not interfere
+ with editing. And because you may want to do different things
+ with them. Take a look at the picture below. I have positioned
+ point to a link and then pressed tha App key on my keyboard.
+ That pops up a menu where I can see what I can do with the link:
+ </p>
+ <img alt="Link with popup menu" src="img/links-appmenu.png" width="529" height="189"
+ style="border: thin dotted #00ff00;"
+ />
+ <p>
+ As you can see I can copy the link (maybe not that useful
+ often). I can open it - and that means edit the linked file in
+ Emacs. That is useful. And then I can view the linked file in a
+ web browser. Can be useful too.
+ </p>
+ <p>
+ And then I can move between the links.
+ </p>
+ <p>
+ All this is useful, at least for me. But there are some more
+ things, in the menus <i>XHTML - Links</i>. Check them out, you
+ may like them. They may save you time.
+ </p>
+
+ <h2 id="tocs">Did You Notice the Table of Contents at the Top?</h2>
+ <p>
+ Well, you should notice not because it exactly is the worlds
+ most pretty table of content. But because it is there. And I
+ did not write it. nXhtml mode wrote it for me.
+ </p>
+ <p>
+ How it works? Just put <b>id</b> attributes on your header tags
+ (h1-h6). Then position point where you want the table of
+ contents. Tell nXhtml mode to write it by using the menus
+ <i>XHTML - Table of Contents</i>.
+ </p>
+ <p>
+ When you want to change it just ask nXhtml mode to rewrite it.
+ </p>
+ <p>
+ And you can make it more pretty if you are good at CSS.
+ </p>
+
+ <h2 id="tidy">But I Can't Use this Cause my Files are HTML</h2>
+ <p>
+ That is a problem of course. You need to convert them to XHTML
+ because that is what the browsers and all other tools are best
+ at today.
+ </p>
+ <p>
+ But don't worry. Didn't I tell you that nXhtml knows about <a
+ href="http://tidy.sourceforge.net/">Tidy For XHTML</a>? (It
+ even comes together with nXhtml if you get it with EmacsW32.)
+ </p>
+ <p>
+ Tidy can convert your HTML files to XHTML.
+ Just open a file in nXhtml mode then use the <i>Tidy</i>
+ menu and choose what you want to do there.
+ </p>
+ <p>
+ If you do it file-by-file you can compare the "tidied" XHTML
+ version of the file and your old version side by side (using
+ Emacs Ediff command actually - an interactive way to compare).
+ You can also tidy a whole directory tree at once.
+ </p>
+
+ <h2 id="php">And what about Multiple Modes like PHP?</h2>
+ <p>
+ nXhtml mode can handle multiple modes in a buffer. The
+ benefits of nXml style completion can still be used. This
+ can even be done when there is no header in the file that
+ tells what DTD to use for the completion.
+ </p>
+ <p>
+ Mumamo, which is part of nXhtml, implements what it
+ calls <i>multi major modes</i> for handling multiple major
+ modes in a buffer. Instead of turning on a major mode for a
+ buffer you turn on a multi major mode and Mumamo will handle
+ the rest. Multi major modes has names like nxhtml-mumamo,
+ html-mumamo, django-nxhtml-mumamo etc.
+ </p>
+ <p>
+ When point is in a PHP part then the major mode is switched
+ to php-mode, with all that means. Here you can see how that
+ looks:
+ </p>
+ <img alt="In PHP part" src="img/php-in-nxhtml.png" width="448" height="294" />
+ <p>
+ If you move the point outside of those <?php ... ?> areas
+ then the mode is automatically switched to nxhtml-mode
+ instead. Now you can use the power of nxhtml-mode and
+ do for example completion, like here:
+ </p>
+ <img alt="In XHTML part" src="img/php-in-nxhtml-2.png" width="450" height="294" />
+ <p>
+ The switching is done with a short delay so that it does not
+ interfere with your normal editing. That's it. (But maybe
+ there should be a better php-mode? Does someone has any
+ better than the one that comes with nXhtml now?)
+ </p>
+
+ <h3 id="dtd-needed">But I Have no DTD Links in my PHP Files?</h3>
+ <p>
+ Ah, yes. Good question. You are right. nXhtml mode needs a
+ DTD to be able to help you with XHTML and completion. I
+ thought it was impossible for a normal human to get that
+ working.
+ </p>
+ <p>
+ But it turned out to be surpricingly simple and it works
+ quite nicely now. The first time you do completion of XHTML
+ code in a buffer where you do not have the needed XHTML
+ headers nXhtml mode will ask you for what it calls a
+ <em>fictive XHTML validation header</em>. After that completion
+ should work as usual. A fictive XHTML validation header in nXhtml
+ mode is something that is used in the background for
+ validation. It is not inserted in the buffer, but may be shown on the screen like this:
+ </p>
+ <img alt="fictive XHTML validation header" src="img/xml-validation-header.png" width="448" height="374" />
+ <p>
+ nXhtml does its best to guess what fictive XHTML Validation Header
+ the buffer needs, but if the default fictive XHTML validation header
+ does not fit you can customize the choices.
+ </p>
+ <p>
+ Note: Do not try to set the XML schema directly when the XHTML
+ headers are missing in the buffer. Use a fictive XHTML
+ validation header instead.
+ </p>
+
+ <h3 id="multi-colors">Why Are Colors Different in Multiple Modes?</h3>
+ <p>
+ It has been necessary to replace the nxml-mode style
+ fontification with the sgml-mode style. All other features
+ of nXml/nXhtml modes should still work however.
+ In all other cases the normal fontification colors are used.
+ </p>
+ <p>
+ Or perhaps you mean the background colors? These are just a
+ visual aid about the dividing into chunks with different
+ major modes and they can be turned off. Do <em>M-x
+ customize-group RET mumamo RET</em>.
+ </p>
+
+ <h3 id="part2">More Multiple Modes</h3>
+ <p>
+ nXhtml mode handles for example embedded style sheets the
+ same way as it handles PHP chunks:
+ </p>
+ <!--
+ <img alt="CSS embedded in XHTML" src="img/embedded-xhtml.png" width="448" height="294" />
+ -->
+ <img alt="CSS embedded in XHTML" src="img/style-in-nxhtml.png" width="448" height="278" />
+ <p>
+ Currently it can handle PHP, CSS, JavaScript, eRuby, JSP and
+ some other minor cases. If you can program in elisp it is
+ not a very big deal adding support for other embedded
+ languages. (I do not use all the languages above myself so
+ please give me feedback if there is something you think
+ could be done better.)
+ </p>
+ <p>
+ Please notice also that each major mode handles completion
+ in its own ways. The popup style completion is currently
+ only used by nXhtml mode, not the other major modes even if
+ they are on the same page.
+ </p>
+ <p>
+ The use of multi major modes is not constrained to nXhtml.
+ You can use that when editing other files too. To see what
+ multi major modes are currently defined in your Emacs
+ session see the
+ variable <i>mumamo-defined-turn-on-functions</i>.
+ </p>
+
+ <h3 id="tips-multi">Tips When Using Multiple Modes</h3>
+ <p>
+ The routines dividing into chunks with different major modes is not that very supersmart.
+ They do not know much about the languages of the major modes.
+ So if you write something like this:
+ </p>
+ <pre>
+ <?php
+ echo '<'?xml version="1.0" encoding="utf-8"?'>';
+ ?>
+ </pre>
+ <p>
+ it will get very, very confused. If you are not fond of that
+ you better write it like this instead:
+ </p>
+ <pre>
+ <?php
+ echo '<'; echo '?xml version="1.0" encoding="utf-8"?'; echo '>';
+ ?>
+ </pre>
+ <p>
+ For a similar problem <a href="nxhtml-changes.html#php-attribute-values">attribute values computed by PHP</a>.
+ </p>
+ <p>
+ When editing PHP sometimes the validation of the XHTML part
+ gets quite upset. You may even think that it is unuseful
+ (since trying to complete gives you nothing), but it is not.
+ Here is what you can do:
+ </p>
+ <ul>
+ <li>
+ Turn on <em>Fictive XHTML Validation Header</em> from
+ menus. (In <em>nXhtml - Completion</em>.) That will try
+ to guess a how to start validation. It shows a fictive
+ header at the top of the buffer to show you what is goind
+ on (nothing is inserted in the buffer).
+ </li>
+ <li>
+ If you do not think the red underlines you get are very
+ pretty then you can hide them. Use the menus again,
+ <em>Hide Validation Errors</em>.
+ </li>
+ </ul>
+ <p>
+ And maybe you do not think the background colors when using
+ Multiple Major Modes is very smart? Then just go ahead and
+ remove them. Customize.
+ <em>M-x customize-group RET mumamo RET</em>.
+ </p>
+
+ <h2 id="file-assoc">File Associations within Emacs</h2>
+ <p>
+ Some file associations are changed within Emacs to get
+ multiple modes to work without requiring the user to do
+ anything. Good for a new user I guess, but I understand
+ that old Emacs users may want more control over this. If
+ you are one of them then please look in
+ <em>nxhtml-autoload.el</em> which is where the associations
+ are made.
+ </p>
+
+ <h2 id="bloggin">Not for Me, I Am Only Blogging</h2>
+ <p>
+ Not for you?
+ Ah, wait a minute.
+ Blogging, that is exactly one of the things that I myself use this for.
+ </p>
+ <p>
+ When you blog you only write part of an XHTML page, so you
+ may think that all the nicities of nXhtml mode like
+ validation and completion does not work. They do. (If you
+ wonder how, then please read <a href="#dtd-needed">But I
+ Have No DTD Links In My PHP Files</a>. Though you do not
+ have to read this to start using nXhtml for writing blog
+ texts and comments.)
+ </p>
+ <p>
+ The setup for blogging is simple
+ </p>
+ <ol>
+ <li>
+ <a href="http://www.mozilla.com/en-US/firefox/">Firefox</a> - which you of course already use ...
+ </li>
+ <li>
+ The <a href="https://addons.mozilla.org/en-US/firefox/addon/4125">It's All Text</a> add-on to Firefox.
+ It should use Emacs client:
+ <p>
+ <img alt="It's All Text preferences" src="img/itsalltext-pref.png" width="371" height="352" />
+ </p>
+ </li>
+ <li>
+ And finally: Customize the little elisp library that comes with nXhtml:
+ <p style="padding-left:2em; font-size: 1em; font-weight: 600;">
+ M-x customize-group RET as-external RET
+ </p>
+ You just need to turn <i>as-external</i> on there.
+ </li>
+ </ol>
+ <p>
+ With this setup you just press F2 in any text area in
+ Firefox and then you got the text to edit in Emacs - using
+ nXhtml for completion etc. Finish and save with <b>C-x
+ #</b>.
+ </p>
+
+<!-- <img alt="Edit part of an XHTML file" src="img/edit-part.png" width="448" height="390" /> -->
+
+ <h2 id="bloggin">And Other Goodies...</h2>
+ <p>
+ There are a lot of other things in the package too, please
+ see the nXhtml menu in Emacs. You can for example find a
+ n-back-game (if you do not know what it is now, do not
+ worry, just try it and you will learn - and understand why I
+ put it there).
+ </p>
+ </div>
+
+ <hr align="left" class="footer" />
+ <p class="footer">
+ Copyright © 2008 OurComments.org
+ <br style="margin:0; padding:0; line-height: 0;" />
+ Design thanks to <a href="http://www.oswd.org/">OSWD</a>
+ <br />
+ </p>
+ </div>
+ </body>
+</html>
--- /dev/null
+/* Grapes, web template for business or for fun */\r
+/* By Dave Reeder, www.davereederdesign.com */\r
+\r
+body {margin: 0; padding: 0; background: #213205}\r
+\r
+* {margin: 0; padding: 0; border: 0; font-family: Arial, Helvetica, sans-serif}\r
+\r
+\r
+/*----------------------------------------------Basic styles------------------------------------------------*/\r
+\r
+h1, h2, h3, h4 {font-family: Georgia, Georgia, serif; margin: 15px 0 0 5px; color: #fff; font-weight: normal; text-decoration: none}\r
+h1 em, h2 em, h3 em, h4 em {font-family: Georgia, Georgia, serif; font-weight: normal} /* italic words in titles */\r
+\r
+h1 {position: absolute; right: 0px; top: 30px; font-size: 2.25em; letter-spacing: 0.1em; line-height: 1.00em; padding-right: 10px; border-right: 15px solid #fff}\r
+h1:first-letter {font-family: Georgia, Georgia, serif; font-size: 2.25em} /* styles the first letter of the main title to make it large */\r
+\r
+p#tagline {position: absolute; right: 0px; top: 125px; font-style: italic; color: #648D20; font-size: 0.90em} /* sits under main title */\r
+\r
+h2 {font-size: 1.30em; letter-spacing: 0.05em}\r
+\r
+p, ul, ol {margin: 10px 10px 0 7px; font-size: 0.70em; line-height: 1.60em; color: #000; letter-spacing: 0.05em}\r
+\r
+code {font-family: monospace; font-size: 1.20em; color: #E20000}\r
+\r
+p span {font-size: 1.50em; font-weight: bold} /* shouting words */\r
+\r
+a:link, a:visited {color: #792533; font-weight: bold; text-decoration: none; border-bottom: 1px solid #792533}\r
+a:hover, a:active {color: #fff; border-color: #fff}\r
+\r
+ul {list-style: inside square} /* general lists */\r
+\r
+acronym {font-weight: bold; border-bottom: 1px dashed #000; cursor: help}\r
+\r
+\r
+/*-----------------------------------------------Layout DIVS------------------------------------------------*/\r
+\r
+#container { /* keeps everything together */\r
+position: relative; \r
+margin: 0 auto; \r
+width: 620px; \r
+background: url(images/bkgrnd.gif) 0 0 repeat-y #CCCC33; /* Important image, do not remove */\r
+overflow: hidden\r
+}\r
+\r
+#hdr { /* div containing h1, nav and grapes image */\r
+float: left; \r
+width: 620px; \r
+height: 200px; \r
+background: url(images/grapes.jpg) 0 0 no-repeat #CCCC33 /* Image of Grapes */\r
+}\r
+\r
+#lftcol { /* left column */\r
+position: absolute;\r
+left: 0px;\r
+top: 200px;\r
+margin-left: 50px; /* leave this so that background image lines up with edge of this div */\r
+width: 200px; \r
+background: transparent;\r
+overflow: hidden\r
+}\r
+\r
+#rgtcol {float: right; width: 370px; padding-bottom: 30px; background: transparent; overflow: hidden} /* right column */\r
+\r
+#bttmbar {float: right; text-align: center; font-size: 0.70em; height: 4em; line-height: 4em; width: 570px; background: #CCCC33; border-top: 1px solid #D9D93C}\r
+\r
+#quote { /* Quote box in left column */\r
+ float: left;\r
+ margin: 10px 0 20px 10px;\r
+ padding: 10px 0;\r
+ width: 170px;\r
+ text-align: center;\r
+ background: url(images/quote.gif) no-repeat 0 0 \r
+}\r
+\r
+#quote p {color: #444; font-size: 0.80em; font-weight: bold; line-height: 2.00em} /* Quote box text */\r
+\r
+\r
+/*---------------------------------------------Main Navigation-----------------------------------------------*/\r
+\r
+ul#nav { /* navigation list */\r
+ margin: 53px 0 20px 0; /* the 53px is where the nav begins (margin top) */\r
+ padding: 0;\r
+ list-style: none inside\r
+}\r
+ \r
+ul#nav li {float: left; display: block}\r
+\r
+ul#nav li a {\r
+ width: 170px;\r
+ margin: 3px 0 0 0; /* a little top margin */\r
+ border: 0;\r
+ border-left: 10px solid #CCCC33;\r
+ padding: 10px 5px;\r
+ font-family: Georgia, Georgia, serif;\r
+ font-weight: normal;\r
+ text-decoration: none;\r
+ display: block;\r
+ color: #450F1F;\r
+ background: #D9D93C\r
+}\r
+\r
+ul#nav li a#current {border-color: #fff} /* current page, move id in the xhtml when creating a new page */\r
+\r
+ul#nav li a:hover {background: #9EA219; color: #fff}\r
+\r
+\r
+
\ No newline at end of file
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"\r
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">\r
+<html>\r
+<head>\r
+<title>Grapes</title>\r
+<link rel="stylesheet" type="text/css" href="grapes.css" />\r
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />\r
+<meta name="author" content="Your name here" />\r
+<meta name="Copyright" content="Copyright (c) Your copyright here 2005" />\r
+</head>\r
+<body>\r
+<div id="container">\r
+<div id="hdr">\r
+<h1>grapes</h1>\r
+<p id="tagline">fruit, wine & web design</p>\r
+</div>\r
+\r
+<div id="lftcol">\r
+ <ul id="nav">\r
+ <li><a href="" id="current">Introduction</a></li>\r
+ <li><a href="">Our Wines</a></li>\r
+ <li><a href="">Important Grapes</a></li>\r
+ <li><a href="">Contact Us</a></li>\r
+ <li><a href="">Links</a></li>\r
+ </ul>\r
+\r
+<div id="quote">\r
+<p><em>A great source for information...</em></p>\r
+</div>\r
+ \r
+<h3>More stuff</h3>\r
+ <ul>\r
+ <li><a href="http://validator.w3.org/check?uri=referer">Validate XHTML</a></li>\r
+ <li><a href="http://jigsaw.w3.org/css-validator/check/referer">Validate CSS</a></li>\r
+ <li><a href="http://www.davereederdesign.com/">Authors Website</a></li>\r
+ <li><a href="http://www.oswd.org/">OSWD</a></li> \r
+ </ul>\r
+\r
+</div>\r
+\r
+\r
+\r
+<div id="rgtcol">\r
+<h2>Introduction</h2>\r
+<p>Hello and welcome to my latest template called "Grapes". \r
+<br /> \r
+"Grapes" is an Open Source web template which means it can be used without the need to ask permission and you have full rights to use and adapt its images. For more of my work, please see my website which can be found <a href="http://www.davereederdesign.com/">here.</a>\r
+</p>\r
+<p>\r
+I wanted to create a fairly simple yet attractive template which can be used for food or wine related websites, although it can easily be adapted for other uses too. \r
+</p>\r
+\r
+\r
+<h2>But is it <em>easy</em> to Use?</h2>\r
+<p>"Grapes" should be quite easy to use as I have added plenty of comments and tried to make the <acronym title="Cascading Style Sheet">CSS</acronym> as neat and organised as possible. \r
+</p>\r
+<p>There are also plenty of styles for other tags, including:</p>\r
+\r
+<p><code>Text using the code tag, this is ideal for showing code on a page.</code></p>\r
+\r
+<p><acronym title="acronym text">acronym text</acronym></p>\r
+\r
+<p><strong>strong or bold text</strong></p>\r
+\r
+<p><em>em or italic text</em></p>\r
+\r
+<p>This is a paragraph of normal text that contains <span>span</span> tags with a class set to <span>special</span>. This means all the <span>big words</span> in this paragraph are words that are placed between opening and closing <span>span</span> tags. These span tags can be used to add meaning to a block of text or to <span>shout out</span> when needed.</p>\r
+</div>\r
+\r
+<div id="bttmbar">Copyright © Your Copyright Info</div>\r
+\r
+\r
+</div>\r
+\r
+</body>\r
+</html>
\ No newline at end of file
--- /dev/null
+/* Grapes, web template for business or for fun */
+/* By Dave Reeder, www.davereederdesign.com */
+
+body {margin: 0; padding: 0; background: #213205}
+
+/* * {margin: 0; padding: 0; border: 0; font-family: Arial, Helvetica, sans-serif} */
+* {font-family: Arial, Helvetica, sans-serif}
+
+/*----------------------------------------------Basic styles------------------------------------------------*/
+
+h1, h2, h3, h4 {font-family: Georgia, Georgia, serif; margin: 15px 0 0 5px; color: #fff; font-weight: normal; text-decoration: none}
+h1 em, h2 em, h3 em, h4 em {font-family: Georgia, Georgia, serif; font-weight: normal} /* italic words in titles */
+
+h1 {xposition: absolute; right: 0px; top: 30px; font-size: 2.25em; letter-spacing: 0.1em; line-height: 1.00em; padding-right: 10px; border-right: 15px solid #fff}
+h1:first-letter {font-family: Georgia, Georgia, serif; font-size: 2.25em} /* styles the first letter of the main title to make it large */
+
+p#tagline {position: absolute; right: 0px; top: 125px; font-style: italic; color: #648D20; font-size: 0.90em} /* sits under main title */
+
+h2 {font-size: 1.40em; letter-spacing: 0.05em}
+h3 {font-size: 1.00em; letter-spacing: 0.05em}
+
+p {
+/* margin: 10px 10px 0 7px; */
+}
+p, ul, ol {
+ font-size: 0.75em; xline-height: 1.60em; color: #000; letter-spacing: 0.05em
+}
+dt {font-size: 0.9em;}
+ul li ul {font-size: 1em;}
+ul li ul {
+ margin-bottom: 0;
+ margin-top: 0;
+}
+
+code {font-family: monospace; font-size: 1.20em; color: #E20000}
+
+/* p span {font-size: 1.50em; font-weight: bold} /\* shouting words *\/ */
+
+a:link, a:visited {
+ color: #792533;
+ /* font-weight: bold; */
+ /* I can see why a border-bottom was used, but I do not have time to
+ fix it now */
+ /* text-decoration: none; */
+ /* border-bottom: 1px solid #792533; */
+}
+a:hover, a:active {color: #fff; border-color: #fff}
+
+#getit a {
+ text-decoration: none;
+}
+#getit a:visited {
+ color: #792533;
+}
+#getit a:hover, #getit a:active {
+ color: red;
+}
+#nxhtml-home a:hover, #nxhtml-home a:active {
+ color: red;
+}
+#nxhtml-home {
+ margin-bottom:3em;
+ background-color:white;
+ padding: 0.5em;
+}
+
+nul {list-style: inside square} /* general lists */
+nul ul {list-style: inside circle} /* general lists */
+
+acronym {font-weight: bold; border-bottom: 1px dashed #000; cursor: help}
+
+p, li, dt, dd {
+ margin-right: 1em;
+}
+dt {
+ margin-top: 1em;
+ margin-bottom: 0.5em;
+}
+li ul li {
+ margin-right: 0;
+}
+table, td {
+ margin: 0;
+ padding: 0;
+ cell-padding: 0;
+ //font-size:0.9em;
+}
+
+li p {
+ font-size: 1em;
+}
+
+/*-----------------------------------------------Layout DIVS------------------------------------------------*/
+
+#xgetit {
+ font-size: 0.6em;
+ float: left;
+ width: 20em;
+ background: white;
+ text-decoration: none;
+ padding: 0.5em;
+ padding-left: 1em;
+ margin-left: 1em;
+ margin-top: 1em;
+}
+/* * { text-decoration: none; } */
+#container { /* keeps everything together */
+ position: absolute;
+ margin: 0 auto;
+ margin-top: 0;
+ /* width: 620px; */
+ margin-right: 17%;
+ background: url(images/bkgrnd.gif) 0 0 repeat-y #CCCC33; /* Important image, do not remove */
+ xoverflow: hidden;
+}
+
+#hdr { /* div containing h1, nav and grapes image */
+ float: left;
+ width: 260px;
+ height: 250px;
+ background: url(images/grapes.jpg) 0 0 no-repeat #CCCC33 /* Image of Grapes */
+}
+
+#xmainhdr {
+ xfloat: right;
+ width: 100px;
+ height: 100px;
+}
+
+#lftcol table li a {
+ /* text-decoration: none; */
+}
+#lftcol { /* left column */
+ /* position: absolute; */
+ float: right;
+ /* left: 0px; */
+ /* top: 200px; */
+ /* margin-left: 50px; /* leave this so that background image lines up with edge of this div */
+ margin-bottom: 50px; /* Quck fix for img menu */
+ margin-right: 1em;
+ background: transparent;
+}
+
+#rgtcol {
+ xfloat: left;
+ clear: both;
+ margin-left: 100px;
+ max-width: 600px;
+ padding-bottom: 30px; background: transparent; xoverflow: hidden; /* right column */
+}
+
+.footer {
+ float: left;
+ width: 19em;
+ clear: both;
+}
+hr.footer {
+ width: 19em;
+ float: left;
+ text-align: left;
+ margin-bottom: 0;
+ margin-left: 0;
+ padding-left: 0;
+}
+p.footer {
+ margin-left: 1em;
+ margin-right: 1em;
+ color: #564;
+ //font-size: 0.8em;
+ //padding: 0;
+ //margin-bottom: 1em;
+ //padding-bottom: 1em;
+}
+
+#bttmbar {float: right; text-align: center; font-size: 0.70em; height: 4em; line-height: 4em; width: 570px; background: #CCCC33; border-top: 1px solid #D9D93C}
+
+#quote { /* Quote box in left column */
+ float: left;
+ margin: 10px 0 20px 10px;
+ padding: 10px 0;
+ width: 170px;
+ text-align: center;
+ background: url(images/quote.gif) no-repeat 0 0
+}
+
+#quote p {color: #444; font-size: 0.80em; font-weight: bold; line-height: 2.00em} /* Quote box text */
+
+
+/*---------------------------------------------Main Navigation-----------------------------------------------*/
+
+ul#nav { /* navigation list */
+ margin: 53px 0 20px 0; /* the 53px is where the nav begins (margin top) */
+ padding: 0;
+ list-style: none inside
+}
+
+ul#nav li {float: left; display: block}
+
+ul#nav li a {
+ width: 170px;
+ margin: 3px 0 0 0; /* a little top margin */
+ border: 0;
+ border-left: 10px solid #CCCC33;
+ padding: 10px 5px;
+ font-family: Georgia, Georgia, serif;
+ font-weight: normal;
+ text-decoration: none;
+ display: block;
+ color: #450F1F;
+ background: #D9D93C
+}
+
+ul#nav li a#current {border-color: #fff} /* current page, move id in the xhtml when creating a new page */
+
+ul#nav li a:hover {background: #9EA219; color: #fff}
+
+#PAGETOC {
+ float: left;
+}
+#PAGETOC * {
+ font-size: 12px;
+}
+#PAGETOC ul {
+ margin: 0;
+ margin-top: 1em;
+ padding: 0;
+}
+#PAGETOC li {
+ font-size: 1em;
+ list-style-type: none;
+ margin: 0em;
+}
+#PAGETOC ul li ul {
+ padding-left: 1.5em;
+ margin: 0em;
+}
+#PAGETOC li, #PAGETOC li ul li {
+ font-weight: bold;
+ display: block;
+}
+#PAGETOC li ul li {
+ font-weight: 500;
+}
+
+#PAGETOC .tochead {
+ font-size: 10px;
+ background-color: #c0ff3e;
+ background-color: #9acd32;
+ background-color: #b3ee3a;
+ padding: 4px;
+}
+
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+ <title>Something</title>
+ <script type="text/javascript" src="js/smoothgallery/scripts/mootools.uncompressed.js"></script>
+ <script type="text/javascript" src="js/smoothgallery/scripts/jd.gallery.js"></script>
+ <link rel="stylesheet" href="js/smoothgallery/css/jd.gallery.css" type="text/css" media="screen" charset="utf-8" />
+ </head>
+ <body>
+ <h1>My 1st demo</h1>
+ <script type="text/javascript">
+ function startGallery() {
+ var myGallery = new gallery($('myGallery'), {
+ timed: true,
+ delay: 9000,
+ embedLinks: false,
+ showArrows: true,
+ showCarousel: false,
+ showInfopane: true,
+ });
+ }
+ window.onDomReady(startGallery);
+ </script>
+
+ <div class="content">
+ <div id="myGallery">
+ <div class="imageElement">
+ <h3>Popup completion</h3>
+ <p>
+ popup stlye completion
+ popup stlye completion
+ popup stlye completion
+ popup stlye completion
+ popup stlye completion
+ popup stlye completion
+ popup stlye completion
+ popup stlye completion
+ popup stlye completion
+ </p>
+ <img src="img/popup-compl.png" class="full" />
+ </div>
+ <div class="imageElement">
+ <h3>Emacs style completion</h3>
+ <p> emacs stlye completion </p>
+ <a href="#" title="open image" class="open"></a>
+ <img src="img/emacs-style-completion.png" class="full" />
+ <img src="ximages/brugges2006/1-mini.jpg" class="thumbnail" />
+ </div>
+ <div class="imageElement">
+ <h3>Edit part</h3>
+ <p> edit part </p>
+ <a href="#" title="open image" class="open"></a>
+ <img src="img/edit-part.png" class="full" />
+ <img src="ximages/brugges2006/1-mini.jpg" class="thumbnail" />
+ </div>
+ </div>
+ </body>
+ </html>
--- /dev/null
+;;; html-chklnk.el --- Check links in local HTML sites
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Wed Mar 15 14:46:17 2006
+(defconst html-chklnk:version "0.2") ;; Version:
+;; Last-Updated: Tue Apr 10 04:12:32 2007 (7200 +0200)
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (add-to-list 'load-path default-directory load-path))
+(eval-when-compile
+ (when (> emacs-major-version 22)
+ (let* ((load-path load-path)
+ (this-file (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+ (this-dir (file-name-directory this-file)))
+ (add-to-list 'load-path (expand-file-name "../../lisp" this-dir))
+ (require 'w32shell nil t))))
+
+
+(eval-when-compile (require 'html-site nil t))
+(require 'compile)
+
+;;;###autoload
+(defgroup html-chklnk nil
+ "Customization group for html-chklnk."
+ :group 'nxhtml)
+
+(defcustom html-chklnk-dir
+ (file-name-as-directory
+ (expand-file-name
+ "html-chklnk"
+ (file-name-directory
+ (if load-file-name load-file-name buffer-file-name))))
+
+ "Directory where the tools needed are located.
+"
+ :type 'directory
+ :group 'html-chklnk)
+
+(defun html-chklnk-check-site-links (start-file)
+ "Check local file web site links.
+Currently only internal links are checked."
+ (interactive
+ (progn
+ (html-site-current-ensure-site-defined)
+ (if (y-or-n-p "Start from a given file and check links from there? ")
+ (let* ((default-start (if (html-site-current-contains buffer-file-name)
+ buffer-file-name
+ (car (directory-files (html-site-current-site-dir)
+ nil
+ "\\.html?$"))))
+ (start-file
+ (read-file-name "Start checking from file: "
+ (html-site-current-site-dir)
+ nil
+ nil
+ default-start)))
+ (unless (html-site-dir-contains (html-site-current-site-dir) start-file)
+ (error "File %s is not in the site %s" start-file html-site-current))
+ (list start-file))
+ (list nil))))
+ (let* ((default-directory html-chklnk-dir)
+ (compile-cmd (concat "perl link_checker.pl "
+ "--site="
+ ;;(html-chklnk-convert-file-name
+ (html-site-current-site-dir)
+ ;;)
+ (if start-file
+ (concat " --start="
+ ;;(html-chklnk-convert-file-name
+ start-file
+ ;;)
+ )
+ "")))
+ (compilation-buffer-name-function
+ '(lambda (dummy) (concat "** Checking links in site "
+ html-site-current " **")))
+ (compilation-scroll-output t)
+ (compilation-error-regexp-alist-alist
+ '(
+ (html-chklnk
+ "^\\(.*\\)\\s-+at line \\([0-9]+\\):"
+ 1 ;; file
+ 2 ;; line
+ )))
+ (compilation-error-regexp-alist '(html-chklnk))
+ ;;(shell-file-name "cmd")
+ ;;(explicit-shell-file-name "cmd")
+ ;;(shell (concat exec-directory "cmdproxy.exe"))
+ ;;(old-w32shell nil)
+ )
+ ;; There are trouble with perl paths
+;; (when (featurep 'w32shell)
+;; (when w32shell-current-shell-path
+;; (setq old-w32shell w32shell-current-shell-path)
+;; (w32shell-set-shell "cmd")))
+ ;;(message "uses-cygwin=%s" uses-cygwin)(sit-for 8)
+
+ (if (fboundp 'w32shell-save-shell)
+ (w32shell-save-shell
+ "cmd"
+ (compile compile-cmd))
+ (compile compile-cmd))
+
+;; (when old-w32shell
+;; (cond ((string= old-w32shell w32shell-cygwin-bin)
+;; (w32shell-set-shell "cygwin"))
+;; ((string= old-w32shell w32shell-msys-bin)
+;; (w32shell-set-shell "msys"))))
+ ))
+
+(defun html-chklnk-convert-file-name (filename)
+ (let ((uses-cygwin (and (featurep 'w32shell)
+ (string= w32shell-current-shell-path
+ w32shell-cygwin-bin)))
+ (case-fold-search t)
+ )
+ (save-match-data
+ (if (and uses-cygwin
+ (string-match "^\\([a-z]\\):" filename))
+ (concat "/cygdrive/" (match-string 1 filename)
+ (substring filename 2))
+ filename))))
+
+
+
+
+(provide 'html-chklnk)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; html-chklnk.el ends here
--- /dev/null
+### File: LinkWalker.pm\r
+### Author: Lennart Borgman\r
+### All rights reserved\r
+\r
+##########################################################\r
+### UserAgent module\r
+##########################################################\r
+package LWP::WalkerUA;\r
+require LWP::UserAgent;\r
+@ISA = qw(LWP::UserAgent);\r
+\r
+### Mirror to another file (why???)\r
+sub mirror\r
+{\r
+ my($self, $url, $file, $mirr_tmp) = @_;\r
+ die "no mirr_tmp" unless defined $mirr_tmp;\r
+\r
+ LWP::Debug::trace('()');\r
+ my $request = new HTTP::Request('GET', $url);\r
+\r
+ if (-e $file) {\r
+ my($mtime) = (stat($file))[9];\r
+ if($mtime) {\r
+ $request->header('If-Modified-Since' =>\r
+ HTTP::Date::time2str($mtime));\r
+ }\r
+ }\r
+ my $tmpfile = "$file-$$";\r
+\r
+ my $response = $self->request($request, $tmpfile);\r
+ if ($response->is_success) {\r
+\r
+ my $file_length = (stat($tmpfile))[7];\r
+ my($content_length) = $response->header('Content-length');\r
+\r
+ if (defined $content_length and $file_length < $content_length) {\r
+ unlink($tmpfile);\r
+ die "Transfer truncated: " .\r
+ "only $file_length out of $content_length bytes received\n";\r
+ } elsif (defined $content_length and $file_length > $content_length) {\r
+ unlink($tmpfile);\r
+ die "Content-length mismatch: " .\r
+ "expected $content_length bytes, got $file_length\n";\r
+ } else {\r
+ # OK\r
+ if (-e $mirr_tmp) {\r
+ # Some dosish systems fail to rename if the target exists\r
+ chmod 0777, $mirr_tmp;\r
+ unlink $mirr_tmp;\r
+ }\r
+ rename($tmpfile, $mirr_tmp) or\r
+ die "Cannot rename '$tmpfile' to '$mirr_tmp': $!\n";\r
+\r
+ if (my $lm = $response->last_modified) {\r
+ # make sure the file has the same last modification time\r
+ utime $lm, $lm, $mirr_tmp;\r
+ }\r
+ }\r
+ } else {\r
+ unlink($tmpfile);\r
+ }\r
+ return $response;\r
+}\r
+\r
+\r
+##########################################################\r
+### Parser module\r
+##########################################################\r
+package HTML::WalkerParser;\r
+require HTML::ParserTagEnd;\r
+@ISA = qw(HTML::ParserTagEnd);\r
+use strict;\r
+use vars qw(%LINK_ELEMENT);\r
+\r
+# Elements that might contain links and the name of the link attribute\r
+%LINK_ELEMENT =\r
+(\r
+ body => 'background',\r
+ base => 'href',\r
+ a => 'href',\r
+ img => [qw(src lowsrc usemap)], # 'lowsrc' is a Netscape invention\r
+ form => 'action',\r
+ input => 'src',\r
+'link' => 'href', # need quoting since link is a perl builtin\r
+ frame => 'src',\r
+ applet => [qw(codebase code)],\r
+ area => 'href',\r
+ iframe => 'src', # Netscape 2.0 extention\r
+ embed => 'src', # used in Netscape 2.0 for Shockwave and things like that\r
+);\r
+\r
+my %LINKATTRIBS = (\r
+ "href" => 1,\r
+ "src" => 1,\r
+ "action" => 1,\r
+ "background" => 1,\r
+ "usemap" => 1,\r
+ "code" => 1,\r
+ "codebase" => 1,\r
+ "lowsrc" => 1,\r
+ );\r
+my %MAYBECONT = (\r
+ a => 'href',\r
+ area => 'href',\r
+ form => 'action',\r
+ frame => 'src',\r
+ iframe => 'src',\r
+ );\r
+\r
+sub maybecont($$) {\r
+ my $tag = shift;\r
+ my $att = shift;\r
+ return unless exists $MAYBECONT{$tag};\r
+ return ($MAYBECONT{$tag} eq $att);\r
+}\r
+\r
+sub new {\r
+ my($class, $parsed_fh) = @_;\r
+ my $self = $class->SUPER::new;\r
+ $self->{parsed_fh} = $parsed_fh;\r
+ $self;\r
+}\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+##########################################################\r
+### Walker module\r
+##########################################################\r
+package HTML::LinkWalker;\r
+use strict;\r
+\r
+use IO::File;\r
+use File::Copy qw();\r
+use File::Path qw();\r
+use PathSubs qw();\r
+use HTML::Entities;\r
+use FindBin qw();\r
+\r
+\r
+##########################################################\r
+### Globals\r
+##########################################################\r
+my $ua;\r
+my $m_ua_personality = "LinkWalker/0.9";\r
+my %m_is_outside;\r
+my %m_is_container;\r
+my $m_bOnlyCont;\r
+my @m_sLinkRoots;\r
+my $m_subReport;\r
+my $m_subAction;\r
+my $m_subMirrorAction;\r
+\r
+\r
+#############################\r
+### Collecting info\r
+#############################\r
+my %m_CheckedLinks;\r
+my %m_MissedLinks;\r
+\r
+sub tell_bad_link($$$$$) {\r
+ my $what = shift;\r
+ my $file = shift;\r
+ my $lnum = shift;\r
+ my $link = shift;\r
+ my $line = shift;\r
+ $file = "START" unless defined $file;\r
+ $lnum = "(start)" unless defined $lnum;\r
+ my $longMsg = "<<$what>>";\r
+ my $shortMsg = $what;\r
+ if (defined $link) {\r
+ my @lines = split("\\s+", $line);\r
+ my $disp_line = join("\n\t\t ", @lines);\r
+ $longMsg .= ",\n\t\tlink=$link\n\t\t$disp_line";\r
+ }\r
+ my @msg = ($shortMsg, $longMsg);\r
+ $m_CheckedLinks{$file}->{ERR}->{$lnum} = \@msg;\r
+ &$m_subReport("\t* Error * " . $what . "\n");\r
+} # tell_bad_link\r
+\r
+\r
+#############################\r
+### Helpers\r
+#############################\r
+\r
+sub get_contenttype($) {\r
+ my $response = shift;\r
+ my @rh = $response->header("Content-Type");\r
+ for my $r (@rh) {\r
+ my $c = $r;\r
+ if ((my $iPos = index($r, ";")) > -1) {\r
+ $c = substr($r, 0, $iPos);\r
+ }\r
+ return $c;\r
+ }\r
+}\r
+sub is_linked_contenttype($) {\r
+ my $response = shift;\r
+ return (get_contenttype($response) eq "text/html");\r
+}\r
+\r
+sub ending_is_container($) {\r
+ my $link_addr = shift;\r
+ $link_addr =~ s!#.*$!!;\r
+ $link_addr =~ s!\?.*$!!;\r
+ return (($link_addr =~ m!\.s?html?$!i) ? 1 : 0);\r
+}\r
+\r
+my $m_sMirrorRoot;\r
+my $m_bMirror = 1;\r
+\r
+sub mk_mirror_name($) {\r
+ my $orig_name = shift;\r
+ $orig_name =~ tr!\\!/!;\r
+ my $mirr_name = $orig_name;\r
+ my ($orig_host) = ($orig_name =~ m!(^https?://[^/]*)!i);\r
+ if (defined $orig_host) {\r
+ my $host = $orig_host;\r
+ $host =~ tr!:!_!;\r
+ $host =~ tr!/!_!;\r
+ $mirr_name =~ s!^$orig_host!$host!;\r
+ if (substr($mirr_name, -1) eq "/") { $mirr_name .= "default.html"; }\r
+ } else {\r
+ die "Can't find host in $orig_name\n";\r
+ }\r
+ my $mirr_full = sMirrorRoot() . $mirr_name;\r
+ if (!$m_bMirror) {\r
+ my $sExt = $mirr_name; $sExt =~ s!.*\.([^\.]*$)!$1!;\r
+ $mirr_full = sMirrorRoot() . "temp.$sExt";\r
+ }\r
+ my $mirr_fold = $mirr_full;\r
+ $mirr_fold =~ s![^/]*$!!;\r
+ File::Path::mkpath($mirr_fold, 0, 0777);\r
+ return $mirr_full;\r
+}\r
+\r
+#############################\r
+### Checks\r
+#############################\r
+sub is_outside($) {\r
+ my $uq_link_addr = shift;\r
+ if (!exists $m_is_outside{$uq_link_addr}) {\r
+ $m_is_outside{$uq_link_addr} = test_is_outside($uq_link_addr, \@m_sLinkRoots);\r
+ }\r
+ return $m_is_outside{$uq_link_addr};\r
+}\r
+sub set_is_container($$) {\r
+ my $uq_link_addr = shift;\r
+ return if exists $m_is_container{$uq_link_addr};\r
+ $m_is_container{$uq_link_addr} = shift;\r
+}\r
+sub is_outside_container($) {\r
+ my $uq_link_addr = shift;\r
+ if (exists $m_is_container{$uq_link_addr}) {\r
+ if ($m_is_container{$uq_link_addr}) {\r
+ return is_outside($uq_link_addr);\r
+ }\r
+ }\r
+}\r
+sub test_is_outside($$) {\r
+ my $uq_link_addr = shift;\r
+ my $link_roots = shift;\r
+ if (defined $link_roots) {\r
+ my $in_roots;\r
+ for my $link_root (@$link_roots) {\r
+ if (substr($uq_link_addr, 0, length($link_root)) eq $link_root) {\r
+ return 0;\r
+ }\r
+ }\r
+ return 1;\r
+ }\r
+} # is_outside\r
+\r
+\r
+\r
+##########################################################\r
+### Parsing\r
+##########################################################\r
+\r
+\r
+### Parser subs\r
+sub HTML::WalkerParser::declaration {\r
+ my($self, $decl) = @_;\r
+ return unless defined $self->{parsed_fh};\r
+ my $fh = $self->{parsed_fh};\r
+ print $fh "<!" . $decl . ">";\r
+}\r
+my $m_start_cb;\r
+sub HTML::WalkerParser::start {\r
+ my($self, $tag, $attr, $ended) = @_;\r
+ &$m_start_cb($tag, $attr);\r
+ return unless defined $self->{parsed_fh};\r
+ my $t = "<$tag";\r
+ for my $k (keys %$attr) {\r
+ my $encoded = encode_entities($$attr{$k});\r
+ $t .= qq( $k="$encoded");\r
+ }\r
+ if ($ended) {\r
+ $t .= " />";\r
+ } else {\r
+ $t .= ">";\r
+ }\r
+ my $fh = $self->{parsed_fh};\r
+ print $fh $t;\r
+}\r
+sub HTML::WalkerParser::end {\r
+ my ($self, $tag) = @_;\r
+ return unless defined $self->{parsed_fh};\r
+ my $fh = $self->{parsed_fh};\r
+ print $fh "</" . $tag . ">";\r
+}\r
+sub HTML::WalkerParser::text {\r
+ my ($self, $txt) = @_;\r
+ return unless defined $self->{parsed_fh};\r
+ my $fh = $self->{parsed_fh};\r
+ print $fh $txt;\r
+}\r
+sub HTML::WalkerParser::comment {\r
+ my($self, $comment) = @_;\r
+ return unless defined $self->{parsed_fh};\r
+ my $fh = $self->{parsed_fh};\r
+ print $fh "<!--" . $comment . "-->";\r
+}\r
+\r
+\r
+\r
+\r
+### Main parsing routine\r
+\r
+sub parse_file($$$$$$$$$) {\r
+ my ($file_name, $parsed_fh, $uq_link_addr, $link_roots,\r
+ $ref_links, $ref_anchs, $ref_lines, $ref_tagname, $ref_attname) = @_;\r
+ my $fh;\r
+ if (-d $file_name) {\r
+ $file_name = PathSubs::uniq_dir($file_name) . "default.html";\r
+ $uq_link_addr .= "/" unless substr($uq_link_addr, -1) eq "/";\r
+ $uq_link_addr .= "default.html";\r
+ &$m_subReport("dir => $file_name\n");\r
+ }\r
+ $fh = new IO::File($file_name);\r
+ die "Can't read $file_name: $!\n" unless defined $fh;\r
+ my $base_href;\r
+ my $n;\r
+ my $line;\r
+ my $uq_link_fold = $uq_link_addr; $uq_link_fold =~ s![^/]*$!!;\r
+\r
+ my $start_cb =\r
+ sub {\r
+ my ($tag, $attr_hash) = @_;\r
+ for my $k (keys %$attr_hash) {\r
+ if (($k eq "id") || ($k eq "name")) {\r
+ my $v = $$attr_hash{$k};\r
+ $$ref_anchs{$v} = $n;\r
+ $$ref_lines{$n} = $line;\r
+ } elsif (exists $LINKATTRIBS{$k}) {\r
+ my $v = $$attr_hash{$k};\r
+ next if $v =~ m!^javascript:!;\r
+ next if $v =~ m!^ftp://!;\r
+ next if $v =~ m!^mailto://!;\r
+ if ($tag eq "base") { $base_href = $v if $k eq "href"; next; }\r
+ my $v_abs; my $v_rel;\r
+ my $v_is_abs = PathSubs::is_abs_path($v);\r
+ if ($v_is_abs) {\r
+ $v_abs = $v;\r
+ $v_rel = PathSubs::mk_relative_link($uq_link_addr, $v_abs);\r
+ } else {\r
+ $v_rel = $v;\r
+ if (defined $base_href) {\r
+ $v_abs = PathSubs::mk_abs_link($base_href, $v);\r
+ } else {\r
+ if (substr($v_rel, 0, 1) ne "#") {\r
+ $v_abs = $uq_link_fold . $v_rel;\r
+ } else {\r
+ $v_abs = $uq_link_addr . $v_rel;\r
+ }\r
+ $v_abs = PathSubs::resolve_dotdot($v_abs);\r
+ }\r
+ }\r
+ next if exists $m_CheckedLinks{$v_abs};\r
+ if (is_outside($v_abs)) {\r
+ if (!$v_is_abs) {\r
+ if (ending_is_container($v_abs)) {\r
+ $m_CheckedLinks{$v_abs} = {};\r
+ tell_bad_link("Outside relative link ($v_rel)",\r
+ $uq_link_addr, $n, $v, $line);\r
+ }\r
+ }\r
+ ### Skip outside absolute links\r
+ ### Could be things like banners etc...\r
+ next;\r
+ }\r
+ $$ref_links{$v_rel} = $n;\r
+ $$ref_lines{$n} = $line;\r
+ if (substr($v_rel, 0, 1) ne "#") {\r
+ my $v_rel_name = $v_rel;\r
+ $v_rel_name =~ s!#.*$!!;\r
+ $v_rel_name =~ s!\?.*$!!;\r
+ $$ref_tagname{$v_rel_name} = $tag;\r
+ $$ref_attname{$v_rel_name} = $k;\r
+ }\r
+ if ($v_is_abs && ($v_rel ne $v)) { $$attr_hash{$k} = $v_rel; }\r
+ }\r
+ }\r
+ }; # $start_cb\r
+\r
+ $m_start_cb = $start_cb;\r
+ my $p = HTML::WalkerParser->new($parsed_fh);\r
+ while ($line = <$fh>) {\r
+ $n++;\r
+ $p->parse($line);\r
+ }\r
+ $fh->close();\r
+} # parse_file\r
+\r
+\r
+\r
+##########################################################\r
+### Do the walk...\r
+##########################################################\r
+sub walk_link($$;$$$$) {\r
+ die "$#_" unless ($#_ == 1 || $#_ == 5);\r
+ my $link_fold = shift;\r
+ my $link_file = shift;\r
+ my $parent_url = shift;\r
+ my $parent_lnum = shift;\r
+ my $parent_link = shift;\r
+ my $parent_line = shift;\r
+\r
+ my $link_addr = $link_fold . $link_file;\r
+ my $uq_link_addr;\r
+ my $is_file = ($link_addr !~ m!^https?://!i);\r
+ if ($is_file) {\r
+ $uq_link_addr = PathSubs::uniq_file($link_addr);\r
+ } else {\r
+ $uq_link_addr = PathSubs::resolve_dotdot($link_addr);\r
+ }\r
+ return if exists $m_CheckedLinks{$uq_link_addr};\r
+ return if exists $m_MissedLinks{$uq_link_addr};\r
+ $m_CheckedLinks{$uq_link_addr} = {};\r
+ my $link_is_container = ending_is_container($uq_link_addr);\r
+ if ($link_is_container) {\r
+ set_is_container($uq_link_addr, 1);\r
+ return if is_outside($uq_link_addr);\r
+ } else {\r
+ return if $m_bOnlyCont;\r
+ }\r
+ my $response;\r
+ my $contenttype;\r
+ my $bDoRewrite;\r
+ my $file_name;\r
+ if ($is_file) {\r
+ if (!-r $uq_link_addr) {\r
+ tell_bad_link("Can't read file ($uq_link_addr)",\r
+ $parent_url, $parent_lnum, $parent_link, $parent_line);\r
+ $m_MissedLinks{$uq_link_addr} = 1;\r
+ return;\r
+ }\r
+ $file_name = $uq_link_addr;\r
+ } else {\r
+ $file_name = mk_mirror_name($uq_link_addr);\r
+ if (!defined $ua) {\r
+ $ua = new LWP::UserAgent;\r
+ $ua->agent($m_ua_personality);\r
+ #$ua->delay(0.1);\r
+ }\r
+ if ($m_bMirror) {\r
+ $response = $ua->mirror($uq_link_addr, $file_name);\r
+ &$m_subMirrorAction($uq_link_addr, $file_name, $response);\r
+ } else {\r
+ my $request = new HTTP::Request('GET', $uq_link_addr);\r
+ $response = $ua->request($request, $file_name);\r
+ }\r
+ #dump_response($response); exit;\r
+ if ($response->code != 304) {\r
+ if (!$response->is_success) {\r
+ tell_bad_link($response->status_line . " ($uq_link_addr)",\r
+ $parent_url, $parent_lnum, $parent_link, $parent_line);\r
+ $m_MissedLinks{$uq_link_addr} = 1;\r
+ return;\r
+ }\r
+ $bDoRewrite = $m_bMirror;\r
+ $contenttype = get_contenttype($response);\r
+ $link_is_container = is_linked_contenttype($response);\r
+ }\r
+ if ($uq_link_addr ne $response->base) {\r
+ if ($m_bMirror) {\r
+ my $base_file = mk_mirror_name($response->base);\r
+ if (!File::Copy::copy($file_name, $base_file)) {\r
+ die "Can't copy($file_name, $base_file): $!\n";\r
+ }\r
+ if (my $lm = $response->last_modified) { utime $lm, $lm, $base_file; }\r
+ $file_name = $base_file;\r
+ }\r
+ $uq_link_addr = $response->base;\r
+ }\r
+ }\r
+ ### Test again, could be new info from net!\r
+ if ($link_is_container) {\r
+ set_is_container($uq_link_addr, 1);\r
+ return if is_outside($uq_link_addr);\r
+ } else {\r
+ return if $m_bOnlyCont;\r
+ return;\r
+ }\r
+ &$m_subReport("$uq_link_addr ...");\r
+\r
+ my %links;\r
+ my %anchs;\r
+ my %lines;\r
+ my %tagname;\r
+ my %attname;\r
+ my $parsed_fh;\r
+ my $parsed_file;\r
+ my $file_to_parse = $file_name;\r
+ if ($bDoRewrite) {\r
+ $parsed_file = $file_to_parse . "-p$$";\r
+ &$m_subReport(" <<GET");\r
+ $parsed_fh = new IO::File("> $parsed_file");\r
+ die "Can't create $parsed_file: $!\n" unless defined $parsed_fh;\r
+ print $parsed_fh "<!-- parsed version -->\n";\r
+ }\r
+ &$m_subReport("\n");\r
+ parse_file($file_to_parse, $parsed_fh, $uq_link_addr,\r
+ \@m_sLinkRoots,\r
+ \%links, \%anchs, \%lines, \%tagname, \%attname);\r
+ if (defined $parsed_fh) {\r
+ $parsed_fh->close();\r
+ if (-e $file_name) { unlink $file_name or die "Can't unlink $file_name: $!"; }\r
+ rename($parsed_file, $file_name) or die "Can't rename($parsed_file, $file_name): $!\n";\r
+ if (my $lm = $response->last_modified) { utime $lm, $lm, $file_name; }\r
+ }\r
+ ### Now we know...\r
+ if ($link_is_container) { return if is_outside($uq_link_addr); }\r
+\r
+ $m_CheckedLinks{$uq_link_addr}->{ANC} = \%anchs;\r
+ my $file_dir;\r
+ if ($is_file) {\r
+ $file_dir = $uq_link_addr;\r
+ $file_dir =~ s![^/]*$!!;\r
+ #chdir $file_dir;\r
+ }\r
+ my $container_folder = $uq_link_addr; $container_folder =~ s![^/]*$!!;\r
+ &$m_subAction($uq_link_addr, $file_name, $contenttype);\r
+ for my $link (sort keys %links) {\r
+ # Next line is for onclick lines in prepared docs\r
+ next if ($link eq "#");\r
+ my $lnum = $links{$link};\r
+ my $line = $lines{$lnum};\r
+ if ($link eq "") {\r
+ tell_bad_link("Empty link", $uq_link_addr, $lnum, $link, $line);\r
+ next;\r
+ }\r
+ if ($link =~ m!(.*)\?!) { $link = $1; }\r
+ my $anchor;\r
+ if ($link =~ m!(.*)#(.*)!) { $link = $1; $anchor = $2; }\r
+ if ($link eq "") {\r
+ if (!exists $anchs{$anchor}) {\r
+ tell_bad_link("Anchor not found ($anchor)", $uq_link_addr, $lnum, $link, $line);\r
+ }\r
+ next;\r
+ }\r
+ my $sub_fold;\r
+ my $sub_file;\r
+ my $uq_sublink; \r
+ if ($link =~ m!^https?://!i) {\r
+ $sub_fold = "";\r
+ $sub_file = $link;\r
+ $uq_sublink = $link;\r
+ } else {\r
+ $sub_file = $link;\r
+ if ($is_file) {\r
+ $sub_fold = $file_dir;\r
+ $uq_sublink = PathSubs::uniq_file($sub_fold . $sub_file);\r
+ } else {\r
+ $sub_fold = $container_folder;\r
+ $uq_sublink = $sub_fold . $sub_file;\r
+ }\r
+ }\r
+ next if (exists $m_CheckedLinks{$uq_sublink});\r
+ if (defined $anchor) {\r
+ $m_CheckedLinks{$uq_link_addr}->{EXTANC}->{$uq_sublink} =\r
+ { ANC=> $anchor, LINE=>$line, LNUM=>$lnum};\r
+ }\r
+ if ($m_bOnlyCont) {\r
+ die "link=$link\tattr=$tagname{$link}\n" unless exists $tagname{$link};\r
+ next unless maybecont($tagname{$link}, $attname{$link});\r
+ }\r
+ if (is_outside($uq_link_addr)) {\r
+ if (maybecont($tagname{$link}, $attname{$link}) ) {\r
+ next;\r
+ }\r
+ }\r
+ walk_link($sub_fold, $sub_file, $uq_link_addr, $lnum, $link, $line);\r
+ }\r
+} # walk_link\r
+\r
+\r
+\r
+\r
+############################################\r
+### Some more checks!\r
+############################################\r
+sub check_external_anchors() {\r
+ &$m_subReport("\nChecking external anchors...\n");\r
+ for my $f (sort keys %m_CheckedLinks) {\r
+ my $fnode = $m_CheckedLinks{$f};\r
+ if (exists ${$fnode}{"EXTANC"}) {\r
+ my $extanc_hash = ${$fnode}{"EXTANC"};\r
+ for my $fx (keys %$extanc_hash) {\r
+ next unless (exists $m_CheckedLinks{$fx});\r
+ my $ea_hash = ${$extanc_hash}{$fx};\r
+ my $ea = ${$ea_hash}{ANC};\r
+ my $fxnode = $m_CheckedLinks{$fx};\r
+ my $fx_anc_hash = ${$fxnode}{"ANC"};\r
+ if (!exists ${$fx_anc_hash}{$ea}) {\r
+ my $line = ${$ea_hash}{LINE};\r
+ my $lnum = ${$ea_hash}{LNUM};\r
+ &$m_subReport("From $f\n");\r
+ tell_bad_link("Ext anchor not found ($fx#$ea)",\r
+ $f, $lnum, "$fx#$ea", $line);\r
+ }\r
+ }\r
+ }\r
+ }\r
+} # check_external_anchors\r
+\r
+\r
+\r
+#############################\r
+### Reporting\r
+#############################\r
+sub report_errors($$) {\r
+ my $bSum = shift;\r
+ my $bDet = shift;\r
+ my $errors_reported;\r
+ my $errors_found;\r
+ for my $f (sort keys %m_CheckedLinks) {\r
+ my $fnode = $m_CheckedLinks{$f};\r
+ if (exists ${$fnode}{ERR}) {\r
+ $errors_found = 1;\r
+ last unless $bSum;\r
+ if (!defined $errors_reported) {\r
+ $errors_reported = 1;\r
+ &$m_subReport("\n\n*********** Summary ERRORS and WARNINGS **********\n");\r
+ }\r
+ &$m_subReport("$f\n");\r
+ my $err_hash = ${$fnode}{ERR};\r
+ for my $e (sort keys %$err_hash) {\r
+ my $refE = ${$err_hash}{$e};\r
+ &$m_subReport("\t" . ${$refE}[0] . "\n");\r
+ }\r
+ }\r
+ }\r
+ undef $errors_reported;\r
+ if ($bDet) {\r
+ for my $f (sort keys %m_CheckedLinks) {\r
+ my $fnode = $m_CheckedLinks{$f};\r
+ if (exists ${$fnode}{ERR}) {\r
+ if (!defined $errors_reported) {\r
+ $errors_reported = 1;\r
+ &$m_subReport("\n\n*********** Detailed ERRORS and WARNINGS **********\n");\r
+ }\r
+ &$m_subReport("$f\n");\r
+ my $err_hash = ${$fnode}{ERR};\r
+ for my $e (sort keys %$err_hash) {\r
+ my $refE = ${$err_hash}{$e};\r
+ &$m_subReport("\tat line $e: " . ${$refE}[1] . "\n");\r
+ }\r
+ }\r
+ }\r
+ }\r
+ if ($errors_found) {\r
+ die "\n*** There where errors ***\n";\r
+ } else {\r
+ &$m_subReport("No errors found\n");\r
+ }\r
+} # report_errors\r
+\r
+sub dump_response($) {\r
+ my $response = shift;\r
+ &$m_subReport( $response->code . " " . $response->message . "\n");\r
+ &$m_subReport( "****************************************\n");\r
+ #&$m_subReport( $response->request . "\n");\r
+ #&$m_subReport( "****************************************\n");\r
+ #&$m_subReport( $response->previous . "\n");\r
+ #&$m_subReport( "****************************************\n");\r
+ &$m_subReport( " i=" . $response->is_info .\r
+ ", s=" . $response->is_success .\r
+ ", r=" . $response->is_redirect .\r
+ ", e=" . $response->is_error . "\n");\r
+ &$m_subReport( "****************************************\n");\r
+ &$m_subReport( "content: " . $response->content . "\n");\r
+ &$m_subReport( "****************************************\n");\r
+ &$m_subReport( "base: " . $response->base . "\n");\r
+ &$m_subReport( "****************************************\n");\r
+ &$m_subReport( $response->as_string);\r
+ &$m_subReport( "****************************************\n");\r
+ &$m_subReport( $response->current_age . "\n");\r
+ &$m_subReport( "****************************************\n");\r
+ my @rh = $response->header("Content-Type");\r
+ for my $r (@rh) { &$m_subReport( "ct: $r\n"); }\r
+ &$m_subReport( "****************************************\n");\r
+} # dump_response\r
+\r
+\r
+#############################\r
+### Parameters\r
+#############################\r
+sub sMirrorRoot() {\r
+ my $val = shift;\r
+ $m_sMirrorRoot = PathSubs::get_temp_path() . "LinkWalker/" unless defined $m_sMirrorRoot;\r
+ my $old = $m_sMirrorRoot;\r
+ $m_sMirrorRoot = PathSubs::uniq_dir($val) if defined $val;\r
+ return $old;\r
+}\r
+sub bMirror(;$) {\r
+ my $val = shift;\r
+ my $old = $m_bMirror;\r
+ $m_bMirror = $val if defined $val;\r
+ $old;\r
+}\r
+\r
+sub subReporter(;$) {\r
+ my $val = shift;\r
+ my $old = $m_subReport;\r
+ $m_subReport = $val if defined $val;\r
+ $old\r
+}\r
+sub subAction(;$) {\r
+ my $val = shift;\r
+ my $old = $m_subAction;\r
+ $m_subAction = $val if defined $val;\r
+ $old\r
+}\r
+sub bOnlyCont(;$) {\r
+ my $val = shift;\r
+ my $old = $m_bOnlyCont;\r
+ $m_bOnlyCont = $val if defined $val;\r
+ $old\r
+}\r
+sub ua_personality(;$) {\r
+ my $val = shift;\r
+ my $old = $m_ua_personality;\r
+ $m_ua_personality = $val if defined $val;\r
+ $old\r
+}\r
+\r
+sub clear_roots() { @m_sLinkRoots = (); }\r
+sub get_roots() { return \@m_sLinkRoots; }\r
+sub add_root($) { push @m_sLinkRoots, shift; }\r
+sub add_files_root($) {\r
+ my $file = shift;\r
+ my $default_root;\r
+ my ($host) = ($file =~ m!(^https?://[^/]*)!i);\r
+ if (defined $host) {\r
+ $default_root = $file;\r
+ } else {\r
+ die "Can't find $file\n" unless -e $file;\r
+ $default_root = PathSubs::uniq_file($file);\r
+ }\r
+ $default_root =~ s![^/]*$!!;\r
+ add_root($default_root);\r
+}\r
+\r
+### Default actions\r
+sub default_sub {}\r
+$m_subReport = \&default_sub;\r
+$m_subAction = \&default_sub;\r
+$m_subMirrorAction = \&default_sub;\r
+\r
+1;\r
--- /dev/null
+package HTML::ParserTagEnd;\r
+\r
+# Author address: <gisle@aas.no>\r
+### Modified for <tag />, Lennart\r
+\r
+use strict;\r
+use HTML::Entities ();\r
+\r
+use vars qw($VERSION);\r
+$VERSION = "2.23"; # $Date: 1999/06/09 10:27:16 $\r
+\r
+\r
+sub new\r
+{\r
+ my $class = shift;\r
+ my $self = bless { '_buf' => '',\r
+ '_strict_comment' => 0,\r
+ }, $class;\r
+ $self;\r
+}\r
+\r
+\r
+# A little note about the observed Netscape behaviour:\r
+#\r
+# It parse <xmp> in the depreceated 'literal' mode, i.e. no tags are\r
+# recognized until a </xmp> is found.\r
+# \r
+# <listing> is parsed like <pre>, i.e. tags are recognized. <listing>\r
+# are presentend in smaller font than <pre>\r
+#\r
+# Netscape does not parse this comment correctly (it terminates the comment\r
+# too early):\r
+#\r
+# <! -- comment -- --> more comment -->\r
+#\r
+# Netscape ignores '<!--' and '-->' within the <SCRIPT> and <STYLE> tag.\r
+# This is used as a trick to make non-script-aware browsers ignore\r
+# the scripts.\r
+\r
+\r
+sub parse\r
+{\r
+ my $self = shift;\r
+ my $buf = \ $self->{'_buf'};\r
+ unless (defined $_[0]) {\r
+ # signals EOF (assume rest is plain text)\r
+ $self->text($$buf) if length $$buf;\r
+ $$buf = '';\r
+ return $self;\r
+ }\r
+ $$buf .= $_[0];\r
+ my $netscape_comment = !$self->{'_strict_comment'};\r
+\r
+ # Parse html text in $$buf. The strategy is to remove complete\r
+ # tokens from the beginning of $$buf until we can't deside whether\r
+ # it is a token or not, or the $$buf is empty.\r
+\r
+ TOKEN:\r
+ while (1) {\r
+\r
+ # First we try to pull off any plain text (anything before a "<" char)\r
+ if ($$buf =~ s|^([^<]+)||) {\r
+ if (length $$buf) {\r
+ $self->text($1);\r
+ } else {\r
+ my $text = $1;\r
+ # At the end of the buffer, we should not parse white space\r
+ # but leave it for parsing on the next round.\r
+ if ($text =~ s|(\s+)$||) {\r
+ $$buf = $1;\r
+ # Same treatment for chopped up entites and words.\r
+ # We must wait until we have it all.\r
+ } elsif ($text =~ s|(\s*\S+)$||) {\r
+ $$buf = $1;\r
+ };\r
+ $self->text($text) if length $text;\r
+ last TOKEN;\r
+ }\r
+\r
+ # Netscapes buggy comments are easy to handle\r
+ } elsif ($netscape_comment && $$buf =~ m|^<!\s*--|) {\r
+ if ($$buf =~ s|^<!\s*--(.*?)--\s*>||s) {\r
+ $self->comment($1);\r
+ } else {\r
+ last TOKEN; # must wait until we see the end of it\r
+ }\r
+\r
+ # Then, markup declarations (usually either <!DOCTYPE...> or a comment)\r
+ } elsif ($$buf =~ s|^(<!)||) {\r
+ my $eaten = $1;\r
+ my $text = '';\r
+ my @com = (); # keeps comments until we have seen the end\r
+ # Eat text and beginning of comment\r
+ while ($$buf =~ s|^(([^>]*?)--)||) {\r
+ $eaten .= $1;\r
+ $text .= $2;\r
+ # Look for end of comment\r
+ if ($$buf =~ s|^((.*?)--)||s) {\r
+ $eaten .= $1;\r
+ push(@com, $2);\r
+ } else {\r
+ # Need more data to get all comment text.\r
+ $$buf = $eaten . $$buf;\r
+ last TOKEN;\r
+ }\r
+ }\r
+ # Can we finish the tag\r
+ if ($$buf =~ s|^([^>]*)>||) {\r
+ $text .= $1;\r
+ $self->declaration($text) if $text =~ /\S/;\r
+ # then tell about all the comments we found\r
+ for (@com) { $self->comment($_); }\r
+ } else {\r
+ $$buf = $eaten . $$buf; # must start with it all next time\r
+ last TOKEN;\r
+ }\r
+\r
+ # Should we look for 'processing instructions' <? ...> ??\r
+ #} elsif ($$buf =~ s|<\?||) {\r
+ # ...\r
+\r
+ # Then, look for a end tag\r
+ } elsif ($$buf =~ s|^</||) {\r
+ # end tag\r
+ if ($$buf =~ s|^([a-zA-Z][a-zA-Z0-9\.\-]*)(\s*>)||) {\r
+ $self->end(lc($1), "</$1$2");\r
+ } elsif ($$buf =~ m|^[a-zA-Z]*[a-zA-Z0-9\.\-]*\s*$|) {\r
+ $$buf = "</" . $$buf; # need more data to be sure\r
+ last TOKEN;\r
+ } else {\r
+ # it is plain text after all\r
+ $self->text("</");\r
+ }\r
+\r
+ # Then, finally we look for a start tag\r
+ } elsif ($$buf =~ s|^(<([a-zA-Z]+)>)||) {\r
+ # special case plain start tags for slight speed-up (2.5%)\r
+ ### mod Lennart\r
+ $self->start(lc($2), {}, 0, [], $1);\r
+\r
+ } elsif ($$buf =~ s|^<||) {\r
+ # start tag\r
+ my $eaten = '<';\r
+\r
+ # This first thing we must find is a tag name. RFC1866 says:\r
+ # A name consists of a letter followed by letters,\r
+ # digits, periods, or hyphens. The length of a name is\r
+ # limited to 72 characters by the `NAMELEN' parameter in\r
+ # the SGML declaration for HTML, 9.5, "SGML Declaration\r
+ # for HTML". In a start-tag, the element name must\r
+ # immediately follow the tag open delimiter `<'.\r
+ if ($$buf =~ s|^(([a-zA-Z][a-zA-Z0-9\.\-]*)\s*)||) {\r
+ $eaten .= $1;\r
+ my $tag = lc $2;\r
+ my %attr;\r
+ my @attrseq;\r
+\r
+ # Then we would like to find some attributes\r
+ #\r
+ # Arrgh!! Since stupid Netscape violates RCF1866 by\r
+ # using "_" in attribute names (like "ADD_DATE") of\r
+ # their bookmarks.html, we allow this too.\r
+ while ($$buf =~ s|^(([a-zA-Z][a-zA-Z0-9\.\-_]*)\s*)||) {\r
+ $eaten .= $1;\r
+ my $attr = lc $2;\r
+ my $val;\r
+ # The attribute might take an optional value (first we\r
+ # check for an unquoted value)\r
+ if ($$buf =~ s|(^=\s*([^\"\'>\s][^>\s]*)\s*)||) {\r
+ $eaten .= $1;\r
+ $val = $2;\r
+ HTML::Entities::decode($val);\r
+ # or quoted by " or '\r
+ } elsif ($$buf =~ s|(^=\s*([\"\'])(.*?)\2\s*)||s) {\r
+ $eaten .= $1;\r
+ $val = $3;\r
+ HTML::Entities::decode($val);\r
+ # truncated just after the '=' or inside the attribute\r
+ } elsif ($$buf =~ m|^(=\s*)$| or\r
+ $$buf =~ m|^(=\s*[\"\'].*)|s) {\r
+ $$buf = "$eaten$1";\r
+ last TOKEN;\r
+ } else {\r
+ # assume attribute with implicit value\r
+ $val = $attr;\r
+ }\r
+ $attr{$attr} = $val;\r
+ push(@attrseq, $attr);\r
+ }\r
+\r
+ # At the end there should be a closing ">"\r
+### Modified for <tag />, Lennart\r
+ if ($$buf =~ s|^/>||) {\r
+ $self->start($tag, \%attr, 1, \@attrseq, "$eaten>");\r
+ } elsif ($$buf =~ s|^>||) {\r
+ #if ($$buf =~ s|^>||) {\r
+ $self->start($tag, \%attr, 0, \@attrseq, "$eaten>");\r
+ } elsif (length $$buf) {\r
+ # Not a conforming start tag, regard it as normal text\r
+ $self->text($eaten);\r
+ } else {\r
+ $$buf = $eaten; # need more data to know\r
+ last TOKEN;\r
+ }\r
+\r
+ } elsif (length $$buf) {\r
+ $self->text($eaten);\r
+ } else {\r
+ $$buf = $eaten . $$buf; # need more data to parse\r
+ last TOKEN;\r
+ }\r
+\r
+ } else {\r
+ #die if length($$buf); # This should never happen\r
+ last TOKEN; # The buffer should be empty now\r
+ }\r
+ }\r
+\r
+ $self;\r
+}\r
+\r
+\r
+sub eof\r
+{\r
+ shift->parse(undef);\r
+}\r
+\r
+\r
+sub parse_file\r
+{\r
+ my($self, $file) = @_;\r
+ no strict 'refs'; # so that a symbol ref as $file works\r
+ local(*F);\r
+ unless (ref($file) || $file =~ /^\*[\w:]+$/) {\r
+ # Assume $file is a filename\r
+ open(F, $file) || die "Can't open $file: $!";\r
+ $file = \*F;\r
+ }\r
+ my $chunk = '';\r
+ while(read($file, $chunk, 512)) {\r
+ $self->parse($chunk);\r
+ }\r
+ close($file);\r
+ $self->eof;\r
+}\r
+\r
+\r
+sub strict_comment\r
+{\r
+ my $self = shift;\r
+ my $old = $self->{'_strict_comment'};\r
+ $self->{'_strict_comment'} = shift if @_;\r
+ return $old;\r
+}\r
+\r
+\r
+sub netscape_buggy_comment # legacy\r
+{\r
+ my $self = shift;\r
+ my $old = !$self->strict_comment;\r
+ $self->strict_comment(!shift) if @_;\r
+ return $old;\r
+}\r
+\r
+\r
+sub text\r
+{\r
+ # my($self, $text) = @_;\r
+}\r
+\r
+sub declaration\r
+{\r
+ # my($self, $decl) = @_;\r
+}\r
+\r
+sub comment\r
+{\r
+ # my($self, $comment) = @_;\r
+}\r
+\r
+sub start\r
+{\r
+die "hie";\r
+ # my($self, $tag, $attr, $attrseq, $origtext) = @_;\r
+ # $attr is reference to a HASH, $attrseq is reference to an ARRAY\r
+}\r
+\r
+sub end\r
+{\r
+ # my($self, $tag, $origtext) = @_;\r
+}\r
+\r
+1;\r
+\r
+\r
+__END__\r
+\r
+\r
+=head1 NAME\r
+\r
+HTML::Parser - SGML parser class\r
+\r
+=head1 SYNOPSIS\r
+\r
+ require HTML::Parser;\r
+ $p = HTML::Parser->new; # should really a be subclass\r
+ $p->parse($chunk1);\r
+ $p->parse($chunk2);\r
+ #...\r
+ $p->eof; # signal end of document\r
+\r
+ # Parse directly from file\r
+ $p->parse_file("foo.html");\r
+ # or\r
+ open(F, "foo.html") || die;\r
+ $p->parse_file(\*F);\r
+\r
+=head1 DESCRIPTION\r
+\r
+The C<HTML::Parser> will tokenize an HTML document when the parse()\r
+method is called by invoking various callback methods. The document to\r
+be parsed can be supplied in arbitrary chunks.\r
+\r
+The external interface the an I<HTML::Parser> is:\r
+\r
+=over 4\r
+\r
+=item $p = HTML::Parser->new\r
+\r
+The object constructor takes no arguments.\r
+\r
+=item $p->parse( $string );\r
+\r
+Parse the $string as an HTML document. Can be called multiple times.\r
+The return value is a reference to the parser object.\r
+\r
+=item $p->eof\r
+\r
+Signals end of document. Call eof() to flush any remaining buffered\r
+text. The return value is a reference to the parser object.\r
+\r
+=item $p->parse_file( $file );\r
+\r
+This method can be called to parse text from a file. The argument can\r
+be a filename or an already opened file handle. The return value from\r
+parse_file() is a reference to the parser object.\r
+\r
+=item $p->strict_comment( [$bool] )\r
+\r
+By default we parse comments similar to how the popular browsers (like\r
+Netscape and MSIE) do it. This means that comments will always be\r
+terminated by the first occurrence of "-->". This is not correct\r
+according to the "official" HTML standards. The official behaviour\r
+can be enabled by calling the strict_comment() method with a TRUE\r
+argument.\r
+\r
+The return value from strict_comment() is the old attribute value.\r
+\r
+=back\r
+\r
+\r
+\r
+In order to make the parser do anything interesting, you must make a\r
+subclass where you override one or more of the following methods as\r
+appropriate:\r
+\r
+=over 4\r
+\r
+=item $self->declaration($decl)\r
+\r
+This method is called when a I<markup declaration> has been\r
+recognized. For typical HTML documents, the only declaration you are\r
+likely to find is <!DOCTYPE ...>. The initial "<!" and ending ">" is\r
+not part of the string passed as argument. Comments are removed and\r
+entities will B<not> be expanded.\r
+\r
+=item $self->start($tag, $attr, $attrseq, $origtext)\r
+\r
+This method is called when a complete start tag has been recognized.\r
+The first argument is the tag name (in lower case) and the second\r
+argument is a reference to a hash that contain all attributes found\r
+within the start tag. The attribute keys are converted to lower case.\r
+Entities found in the attribute values are already expanded. The\r
+third argument is a reference to an array with the lower case\r
+attribute keys in the original order. The fourth argument is the\r
+original HTML text.\r
+\r
+\r
+=item $self->end($tag, $origtext)\r
+\r
+This method is called when an end tag has been recognized. The\r
+first argument is the lower case tag name, the second the original\r
+HTML text of the tag.\r
+\r
+=item $self->text($text)\r
+\r
+This method is called when plain text in the document is recognized.\r
+The text is passed on unmodified and might contain multiple lines.\r
+Note that for efficiency reasons entities in the text are B<not>\r
+expanded. You should call HTML::Entities::decode($text) before you\r
+process the text any further.\r
+\r
+A sequence of text in the HTML document can be broken between several\r
+invocations of $self->text. The parser will make sure that it does\r
+not break a word or a sequence of spaces between two invocations of\r
+$self->text().\r
+\r
+=item $self->comment($comment)\r
+\r
+This method is called as comments are recognized. The leading and\r
+trailing "--" sequences have been stripped off the comment text.\r
+\r
+=back\r
+\r
+The default implementation of these methods do nothing, i.e., the\r
+tokens are just ignored.\r
+\r
+There is really nothing in the basic parser that is HTML specific, so\r
+it is likely that the parser can parse other kinds of SGML documents.\r
+SGML has many obscure features (not implemented by this module) that\r
+prevent us from renaming this module as C<SGML::Parser>.\r
+\r
+=head1 EFFICIENCY\r
+\r
+The parser is fairly inefficient if the chunks passed to $p->parse()\r
+are too big. The reason is probably that perl ends up with a lot of\r
+character copying when tokens are removed from the beginning of the\r
+strings. A chunk size of about 256-512 bytes was optimal in a test I\r
+made with some real world HTML documents. (The parser was about 3\r
+times slower with a chunk size of 20K).\r
+\r
+=head1 SEE ALSO\r
+\r
+L<HTML::Entities>, L<HTML::TokeParser>, L<HTML::Filter>,\r
+L<HTML::HeadParser>, L<HTML::LinkExtor>\r
+\r
+L<HTML::TreeBuilder> (part of the I<HTML-Tree> distribution)\r
+\r
+=head1 COPYRIGHT\r
+\r
+Copyright 1996-1999 Gisle Aas. All rights reserved.\r
+\r
+This library is free software; you can redistribute it and/or\r
+modify it under the same terms as Perl itself.\r
+\r
+=cut\r
+\r
+\r
--- /dev/null
+C:/TEMP/i2data\r
--- /dev/null
+# Copyright 2006 Lennart Borgman, http://OurComments.org/. All rights
+# reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; see the file COPYING. If not, write to the
+# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+# Boston, MA 02110-1301, USA.
+
+package PathSubs;
+
+#####################################################
+### This package contains general path handling
+### routines and some win32 specific dito.
+### The latter should ev be moved to a new module!
+#####################################################
+use strict;
+
+use File::Spec;
+
+### Absolute path names
+
+sub is_abs_path ($) {
+ my $path = shift;
+ return 0 if $path eq "";
+ return 1 if File::Spec->file_name_is_absolute($path);
+ #return 1 if substr($path, 1, 1) eq ":"; # MSWin32
+ #return 1 if substr($path, 0, 1) eq "/";
+ return 1 if $path =~ /^https?:/i;
+ return 1 if $path =~ /^file:/i;
+ return 1 if $path =~ /^javascript:/i;
+ return 1 if $path =~ /^mailto:/i;
+}
+sub is_abs_netpath($) {
+ my $path = shift;
+ return 1 if $path =~ /^https?:/i;
+ # New
+ return 1 if $path =~ /^ftp:/i;
+ return 1 if $path =~ /^mailto:/i;
+}
+
+
+sub uniq_file($) {
+ my $fname = shift;
+ $fname =~ s!^\s+|\s+$!!g;
+ return "" if ($fname eq "");
+ $fname = File::Spec->rel2abs($fname);
+ if (!File::Spec->file_name_is_absolute($fname)) {
+ die "File name is not absolute: $fname";
+ }
+ #print STDERR "uniq_file($fname)\n";
+ $fname =~ tr!\\!/!;
+ if (-e $fname) {
+ #print STDERR "exists $fname\n";
+ ### There is an error in 522, compensate for this!
+ #die substr($fname, -1);
+ if (substr($fname, -1) eq "/") { chop $fname; }
+ #print STDERR "exists $fname\n";
+ ### Translate ..
+ if (substr($fname, 1, 1) eq ":") {
+ my $ffname = Win32::GetFullPathName($fname);
+ ### Get case
+ my $lfname = Win32::GetLongPathName($ffname);
+ #print STDERR "lexists $lfname\n";
+ $fname = $lfname if ($lfname ne "");
+ }
+ } else {
+ #print STDERR "NOT exists $fname\n";
+ if (substr($fname, -1) eq "/") { chop $fname; }
+ my $head = "";
+ if (substr($fname, 0, 2) eq "//") {
+ $head = "//";
+ $fname = substr($fname, 2);
+ }
+ my @fname = split("/", $fname);
+ my $tail = pop @fname;
+ $fname = uniq_dir($head . join("/", @fname)) . $tail;
+ }
+ if (substr($fname, 1, 1) eq ":") {
+ $fname = uc(substr($fname, 0, 1)) . substr($fname, 1);
+ #print STDERR "fname $fname\n";
+ }
+ $fname =~ tr!\\!/!;
+ #print STDERR "fname ($fname)\n";
+ return $fname;
+}
+sub uniq_dir($) {
+ my $dir = shift;
+ my $uq_dir = uniq_file($dir);
+ if (substr($uq_dir, -1) ne "/") { $uq_dir .= "/"; }
+ return $uq_dir;
+}
+
+
+
+### Relative paths
+sub _get_link_root($) {
+ my $lnk = shift;
+ if ($lnk =~ m!^(/|ftp://[^/]*|https?://[^/]*|[a-z]:/)!i) {
+ return $1;
+ } else {
+ return "";
+ }
+}
+
+sub resolve_dotdot($) {
+ my $orig_url = shift;
+ my $root = _get_link_root($orig_url);
+ return $orig_url if length($root) == length($orig_url);
+ my $url = substr($orig_url, length($root));
+ if (substr($root, -1) eq "/") {
+ chop $root;
+ $url = "/$url";
+ }
+ #die "$root\n$url";
+ my $iPosSearch = 2;
+ #print "url=$url\n";
+ while ((my $iPos = index($url, "/../", $iPosSearch)) > -1) {
+ my $sLeft = substr($url, 0, $iPos);
+ if (substr($sLeft, -2) eq "..") {
+ $iPosSearch += 3;
+ next;
+ }
+ my $sRight = substr($url, $iPos+3);
+ #print "url=$url\n";
+ #print "iPos=$iPos\n";
+ #print "sLeft=$sLeft\n";
+ $sLeft =~ s!/[^/]*$!!;
+ #print "sLeft=$sLeft\n";
+ #print "sRight=$sRight\n";
+ $url = $sLeft . $sRight;
+ #print "\t***url=$url\n";
+ #print "url=$url\n";
+ }
+ if (index($url, "../") > -1) {
+ return $orig_url;
+ }
+ return $root . $url;
+}
+
+sub mk_relative_link($$;$) {
+ my $from = shift;
+ my $to = shift;
+ my $norm = shift;
+ if ($norm) {
+ $from = uniq_file($from);
+ $to = uniq_file($to);
+ }
+ if (-e $from) {
+ $from = uniq_file($from);
+ } else {
+ $from = resolve_dotdot($from);
+ }
+ if (-e $to) {
+ $to = uniq_file($to);
+ } else {
+ $to = resolve_dotdot($to);
+ }
+ my $root_from = _get_link_root($from);
+ my $root_to = _get_link_root($to );
+ if ($root_from ne $root_to) {
+ return $to;
+ }
+ my @from = split "/", $from;
+ my @to = split "/", $to;
+ while (@to) {
+ last if ($to[0] ne $from[0]);
+ shift @to;
+ shift @from;
+ }
+ if (@to == 1 && @from == 1) {
+ if (length($to[0]) > length($from[0])) {
+ if (substr($to[0], 0, length($from[0])+1) eq ($from[0] . "#")) {
+ return substr($to[0], length($from[0]));
+ }
+ }
+ }
+ my $rl;
+ for (1..$#from) { $rl .= "../"; }
+ $rl .= join("/", @to);
+
+ return $rl;
+}
+
+
+
+sub mk_absolute_link($$) {
+ my $from = shift;
+ my $rel_to = shift;
+ my $abs = $from;
+ $abs =~ s![^/]*$!!;
+ $abs .= $rel_to;
+ if (!is_abs_netpath($abs)) { $abs = uniq_file($abs); }
+ $abs;
+}
+
+
+1;
--- /dev/null
+#! perl
+
+# Copyright 2006, 2007 Lennart Borgman, http://OurComments.org/. All
+# rights reserved.
+#
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This file is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+
+use strict;
+use warnings;
+
+use IO::File;
+use File::Spec;
+use File::Find;
+
+sub check_file($);
+
+#############################
+### Collecting info
+#############################
+my $m_site_dir; # Site root directory (every file should be in this)
+my %m_CheckedFiles;
+my %m_FilesToCheck;
+my %m_MissedFiles;
+my $m_errors_found;
+
+sub tell_bad_link($$$$$) {
+ my $what = shift;
+ my $file = shift;
+ my $lnum = shift;
+ my $link = shift;
+ my $line = shift;
+ $line =~ s/^\s+|\s+$//g;
+ $m_CheckedFiles{$file}->{"ERR"}->{$lnum} = "$what\n Link: \"$link\"\n";
+ #$line";
+}
+
+#############################
+### Helpers
+#############################
+sub add_file_to_check($) {
+ $m_FilesToCheck{File::Spec->canonpath(shift)} = 1;
+}
+# sub full_uq_file($) {
+# my $file = shift;
+# my $full_file = $file;
+# if (! File::Spec->file_name_is_absolute($full_file)) {
+# #$full_file = Win32::GetFullPathName($file);
+# $full_file = File::Spec->rel2abs($full_file, $m_site_dir);
+# }
+# if (($^O eq "MSWin32") || ($^O eq "cygwin")) {
+# $full_file =~ tr!A-Z!a-z!;
+# }
+# #print "ull_uq_file: full_file=$file\n";
+# return $full_file;
+# }
+
+#############################
+### Checks
+#############################
+sub check_next_file() {
+ if (scalar(keys %m_FilesToCheck) > 0) {
+ my @FilesToCheck = sort keys %m_FilesToCheck;
+ my $next_file = $FilesToCheck[0];
+ delete $m_FilesToCheck{$next_file};
+ check_file($next_file);
+ }
+}
+sub not_a_local_file($) {
+ my $url = shift;
+ (
+ $url =~ m!^javascript:!
+ ||
+ $url =~ m!^mailto:!
+ ||
+ $url =~ m!^[a-z]+://!
+ );
+}
+
+sub check_file($) {
+ my $fname = shift;
+ if (! File::Spec->file_name_is_absolute($fname)) {
+ die "check_file: File is not abs: $fname";
+ }
+ my $only_name = (File::Spec->splitpath($fname))[2];
+ print "Checking $fname ... ";
+ sleep 0.5;
+ $m_CheckedFiles{$fname} = {};
+ my %links;
+ my %anchs;
+ my %lines;
+ my $fh = new IO::File($fname);
+ die "Can't read $fname: $!\n" unless defined $fh;
+ my $whole;
+ my $n;
+ my $found_errors = 0;
+ while (my $line = <$fh>) {
+ $n++;
+ chomp $line;
+ $whole = $line;
+ while ($whole =~ m!(?:\s|^)id="(.*?)"!g) {
+ $anchs{$1} = $n;
+ $lines{$n} = $line;
+ }
+ while ($whole =~ m!(?:\s|^)name="(.*?)"!g) {
+ $anchs{$1} = $n;
+ $lines{$n} = $line;
+ }
+ while ($whole =~ m!(?:\s|^)href="(.*?)"!g) {
+ my $l = $1;
+ next if not_a_local_file($l);
+ if ($l =~ m!^#!) {
+ $l = $only_name . $l;
+ }
+ $links{$l} = $n;
+ $lines{$n} = $line;
+ }
+ while ($whole =~ m!(?:\s|^)src="(.*?)"!g) {
+ my $l = $1; $l =~ tr!A-Z!a-z!;
+ $links{$l} = $n;
+ $lines{$n} = $line;
+ }
+ }
+ $fh->close();
+ $m_CheckedFiles{$fname}->{ANC} = \%anchs;
+ my ($fv, $fd, $ff) = File::Spec->splitpath($fname);
+ my $fdir = File::Spec->catpath($fv, $fd, "");
+ for my $link (sort keys %links) {
+ # Next line is for onclick lines
+ next if ($link eq "#");
+ my $lnum = $links{$link};
+ my $line = $lines{$lnum};
+ if ($link eq "") {
+ tell_bad_link("empty link", $fname, $lnum, $link, $line);
+ $found_errors = 1;
+ next;
+ }
+ if ($link =~ m!(.*)\?!) { $link = $1; }
+ my $anchor;
+ if ($link =~ m!(.*)#(.*)!) { $link = $1; $anchor = $2; }
+ if ($link eq "") {
+ if (!exists $anchs{$anchor}) {
+ tell_bad_link("bad internal anchor ref ($anchor)", $fname, $lnum, $link, $line);
+ $found_errors = 1;
+ }
+ next;
+ }
+ $link =~ m!([^\.]*)$!;
+ my $link_file_type = $1;
+ my $subfile = $link;
+ if (!File::Spec->file_name_is_absolute($subfile)) {
+ $subfile = File::Spec->catpath($fv, $fd, $link);
+ }
+ $subfile = File::Spec->canonpath($subfile);
+ die "Contained .." if $subfile =~ m/\.\./;
+ next if (exists $m_MissedFiles{$subfile});
+ if (! -r $subfile) {
+ tell_bad_link("Can't read linked file: $!", $fname, $lnum, $link, $line);
+ $found_errors = 1;
+ $m_MissedFiles{$subfile} = 1;
+ next;
+ }
+ next unless $link_file_type =~ m!^html?$!i;
+ if (defined $anchor) {
+ $m_CheckedFiles{$fname}->{EXTANC}->{$subfile} =
+ { ANC=> $anchor, LINE=>$line, LNUM=>$lnum};
+ }
+ next if (exists $m_CheckedFiles{$subfile});
+ #check_file($subfile);
+ my $rel_root = File::Spec->abs2rel($subfile, $m_site_dir);
+ if (substr($rel_root, 0, 2) eq "..") {
+ tell_bad_link("Reference to file outside site", $fname, $lnum, $link, $line);
+ $found_errors = 1;
+ } else {
+ #$m_FilesToCheck{$subfile} = 1;
+ add_file_to_check($subfile);
+ }
+ }
+ if ($found_errors) {
+ print "Errors found\n";
+ } else {
+ print "Ok\n";
+ }
+ sleep 0.5;
+ check_next_file();
+} # check_file
+
+
+sub check_external_anchors() {
+ for my $f (sort keys %m_CheckedFiles) {
+ my $fnode = $m_CheckedFiles{$f};
+ if (exists ${$fnode}{"EXTANC"}) {
+ my $extanc_hash = ${$fnode}{"EXTANC"};
+ for my $fx (keys %$extanc_hash) {
+ next unless (exists $m_CheckedFiles{$fx});
+ my $ea_hash = ${$extanc_hash}{$fx};
+ my $ea = ${$ea_hash}{ANC};
+ my $fxnode = $m_CheckedFiles{$fx};
+ my $fx_anc_hash = ${$fxnode}{"ANC"};
+ if (!exists ${$fx_anc_hash}{$ea}) {
+ my $line = ${$ea_hash}{LINE};
+ my $lnum = ${$ea_hash}{LNUM};
+ tell_bad_link("Hash not found", $f, $lnum, "$fx#$ea", $line);
+ }
+ }
+ }
+ }
+} # check_external_anchors
+
+
+
+#############################
+### Reporting
+#############################
+sub report_errors() {
+ for my $f (sort keys %m_CheckedFiles) {
+ my $fnode = $m_CheckedFiles{$f};
+ if (exists ${$fnode}{"ERR"}) {
+ if (!defined $m_errors_found) {
+ $m_errors_found = 1;
+ print "\n\n*********** Error details: **********\n";
+ sleep 0.5;
+ }
+ #print "\n$f";
+ my $err_hash = ${$fnode}{"ERR"};
+ for my $e (sort keys %$err_hash) {
+ print "\n$f";
+ print " at line $e:\n " . ${$err_hash}{$e} . "\n";
+ sleep 0.5;
+ }
+ }
+ }
+ if ($m_errors_found) {
+ die "\n*** There where errors ***\n";
+ } else {
+ print "Everything that was checked is ok\n";
+ }
+} # report_errors
+
+#############################
+### Help
+#############################
+sub usage() {
+ die "Usage: $0 --site=SITE-DIR --start=START-FILE\n";
+}
+
+#############################
+### Parameters
+#############################
+#my $m_start_file; # File to start checking in
+sub get_params() {
+ usage() unless $#ARGV > -1;
+ for (my $i = 0; $i <= $#ARGV; $i++) {
+ my ($k, $v) = ($ARGV[$i] =~ m!-?-?(.*?)=(.*)!);
+ if ($k eq "site") {
+ $m_site_dir = $v;
+ } elsif( $k eq "start") {
+ #$m_FilesToCheck{$v} = 1;
+ add_file_to_check($v);
+ } else {
+ print STDERR "Unknown parameter: $ARGV[$i]\n";
+ usage();
+ }
+ }
+ foreach my $key (keys %m_FilesToCheck) {
+ die "Can't find $key\n" unless -e $key;
+ }
+ if (! $m_site_dir) {
+ print STDERR "No site directory given\n";
+ usage();
+ }
+ die "Can't find $m_site_dir\n" unless -d $m_site_dir;
+ if ((scalar keys %m_FilesToCheck) == 0) {
+ my $add_files =
+ sub {
+ return unless m/.html?$/i;
+ return if -d $_;
+ #$m_FilesToCheck{$File::Find::name} = 1;
+ add_file_to_check($File::Find::name);
+ };
+ File::Find::find($add_files, $m_site_dir);
+ }
+}
+
+sub check_canonpath() {
+ my $testpath = "/test/../some.txt";
+ if ($testpath eq File::Spec->canonpath($testpath)) {
+ my $errmsg = <<_BADCANON_
+
+** Fatal Error:
+
+ File::Spec->canonpath does not clean up path.
+
+ If you are doing this from Emacs with html-chklnk-check-site-links
+ it may be because you are using Cygwin as your shell. You can cure
+ this in the following ways:
+
+ 1) Use w32shell.el - this will temporary switch to "cmd" as shell.
+ 2) Use the default shell on w32.
+
+_BADCANON_
+;
+
+ die $errmsg;
+ }
+}
+
+#############################
+### Main
+#############################
+
+check_canonpath();
+
+$| = 1; # flush or blush!
+
+print "\n";
+get_params();
+
+check_next_file();
+check_external_anchors();
+report_errors();
--- /dev/null
+;;; html-imenu --- imneu suport for html modes
+;;
+;; This is a slightly modified version of
+;; html-helper-imenu.el. This version comes with nXhtml.
+(defconst html-imenu:version "0.9") ;;Version:
+;; Last-Updated: 2008-09-30T19:22:05+0200 Tue
+;;
+;; ~/share/emacs/pkg/html/html-helper-imenu.el ---
+;;
+;; $Id: html-helper-imenu.el,v 1.11 2004/03/23 07:39:37 harley Exp $
+;;
+
+;; Author: Harley Gorrell <harley@panix.com>
+;; URL: http://www.mahalito.net/~harley/elisp/html-helper-imenu.el
+;; License: GPL v2
+;; Keywords: html-helper, imenu, html, table of contents
+
+;;; Commentary:
+;; * Adds an indented table of contents to the menubar
+;; * The regexp only matches headers on a single line
+;; and well formed tags. (Which is pretty common.)
+;;
+;; Put somthing like the following in your .emacs:
+;; (autoload 'html-helper-imenu-setup "html-helper-imenu")
+;; (add-hook 'html-helper-mode-hook 'html-helper-imenu-setup)
+;;
+;; While this was originaly written for html-helper,
+;; It will work with sgml-mode and others.
+;;
+;; http://www.santafe.edu/~nelson/hhm-beta/html-helper-mode.el
+
+;;; History:
+;;
+;; 1998-06-25 : added regexp
+;; 2003-03-18 : updated contact info
+;; 2004-03-22 : minor clean up
+;; 2007-11-23 : changed setup function to do nothing if done already
+
+;;; Code:
+
+(eval-when-compile (require 'imenu))
+
+(defvar html-imenu-title "Index"
+ "*Title of the menu which will be added to the menubar.")
+
+(defvar html-imenu-regexp
+ "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
+ "*A regular expression matching a head line to be added to the menu.
+The first `match-string' should be a number from 1-9.
+The second `match-string' matches extra tags and is ignored.
+The third `match-string' will be the used in the menu.")
+
+;; Make an index for imenu
+(defun html-imenu-index ()
+ "Return an table of contents for an html buffer for use with Imenu."
+ (let ((space ?\ ) ; a char
+ (toc-index '())
+ toc-str)
+ (save-excursion
+ (goto-char (point-min))
+ (save-match-data
+ (while (re-search-forward html-imenu-regexp nil t)
+ (setq toc-str
+ (concat
+ (make-string
+ (* 6 (- (string-to-number (match-string 1)) 1))
+ space)
+ (match-string 3)))
+ (beginning-of-line)
+ (setq toc-index (cons (cons toc-str (point)) toc-index))
+ (end-of-line))))
+ (nreverse toc-index)))
+
+(defun html-imenu-setup ()
+ "Setup the variables to support imenu."
+ (interactive)
+ ;; Fix-me: It looks like this function has to be called every time
+ ;; switching to some html mode in mumamo. Values are "survived" by
+ ;; mumamo, but the menu item disappears.
+ ;;(message "html-imenu-setup imenu-create-index-function =%s" imenu-create-index-function)
+ (unless nil ;(eq imenu-create-index-function 'html-imenu-index)
+ (setq imenu-create-index-function 'html-imenu-index)
+ (set (make-local-variable 'imenu-sort-function) nil) ; sorting the menu defeats the purpose
+ (imenu-add-to-menubar html-imenu-title)
+ ;; Run an update to make it easier to access the menubar
+ ;;(run-with-idle-timer 5 nil 'html-imenu-update-menubar (current-buffer))
+ ))
+
+(defun html-imenu-update-menubar (buffer)
+ (condition-case err
+ (html-imenu-update-menubar-1 buffer)
+ (error (message "html-imenu-update-menubar error: %s" err))))
+
+(defun html-imenu-update-menubar-1 (buffer)
+ (with-current-buffer buffer
+ (message "HTML Imenu: update menubar...")
+ (imenu-update-menubar)
+ (message "")))
+
+(provide 'html-imenu)
+;;; html-imenu ends here
--- /dev/null
+;;; html-move.el --- Move a file in a local file web site.
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Thu Jan 12 08:11:30 2006
+(defconst html-move:version "0.31") ;; Version:
+;; Last-Updated: Tue Feb 20 23:59:43 2007 (3600 +0100)
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;DO NOT USE YET!
+;;
+;; Functions for moving a file in a local file web site. Moves the
+;; file and fixes the local affected links after the move.
+;;
+;; To use this file you may in your .emacs put
+;;
+;; (require 'html-move)
+;;
+;; Call the function `html-move-buffer-file' to move a file.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (add-to-list 'load-path default-directory load-path))
+(eval-when-compile (require 'html-site nil t))
+(require 'url-parse)
+
+(defun html-move-make-new-url (old-url from-dir to-dir)
+ "Make new relative url.
+If OLD-URL is an absolute path then return it. Otherwise OLD-URL
+is assumed to be relative FROM-DIR. Return a new url relative
+TO-DIR that gives the same absolute path."
+ (if (or (file-name-absolute-p old-url)
+ (char-equal ?# (string-to-char old-url))
+ (let ((urlobj (url-generic-parse-url old-url)))
+ (url-host urlobj)))
+ (progn
+ nil)
+ (let* (
+ (relative-path (file-relative-name from-dir to-dir))
+ (new-abs-url (expand-file-name (concat relative-path old-url) to-dir))
+ (new-url (file-relative-name new-abs-url to-dir)))
+ new-url)))
+
+
+(defun html-move-in-dir-tree (file tree)
+ (let ((rel-path (file-relative-name file tree)))
+ (or (string= "." rel-path)
+ (not (string= ".." (substring rel-path 0 2))))))
+
+(defun html-move-buffer-file (to)
+ "Move current buffer file to another directory and/or name.
+Correct the affected relative links in the moved file and the
+links to the file moved in the directory tree
+`html-site-current-site-dir'."
+ ;;(interactive "GMove to: ")
+ (interactive
+ (let* ((use-dialog-box nil)
+ (name (read-file-name "Move to (directory or file name): "
+ ))
+ )
+ (list (expand-file-name name))))
+ (html-site-current-ensure-site-defined)
+ (let ((from (buffer-file-name))
+ (site-directory (html-site-current-site-dir)))
+ (unless from
+ (error "No buffer file name, can't move file!"))
+ (let* ((from-dir (file-name-directory from))
+ (from-ext (file-name-extension from))
+ to-dir
+ to-ext
+ new-name
+ new-file
+ new-buffer
+ relative-path)
+ (unless (html-move-in-dir-tree from-dir site-directory)
+ (error "Buffer file is not in site directory tree"))
+ (if (file-directory-p to)
+ (progn
+ (setq to-dir to)
+ (setq new-name (file-name-nondirectory from))
+ )
+ (setq to-ext (file-name-extension to))
+ (unless (string= to-ext from-ext)
+ (if (not to-ext)
+ (error "Can't find directory %s (or missing extension?)" to)
+ (error "Move must not change file extension")))
+ (setq to-dir (file-name-directory to))
+ (unless (file-directory-p to-dir)
+ (if (file-exists-p to-dir)
+ (error "Not a directory: %s" to-dir)
+ (error "Can't find directory %s" to-dir)))
+ (setq new-name (file-name-nondirectory to))
+ )
+
+ (unless (html-move-in-dir-tree to-dir site-directory)
+ (error "Target is not in site directory tree"))
+
+
+ (setq relative-path (file-relative-name to-dir from-dir))
+ (when (file-name-absolute-p relative-path)
+ (error "Can't make a relative path from %s to %s" from to))
+ (setq new-file (expand-file-name new-name to))
+ (let ((moved-buffer (current-buffer))
+ (moved-contents (buffer-substring-no-properties
+ (point-min)
+ (point-max))))
+ (when (file-exists-p new-file)
+ (error "File already exists: %s" new-file))
+ ;; Open in new location
+ (find-file new-file)
+ (setq new-buffer (current-buffer))
+ (erase-buffer)
+ (insert moved-contents)
+ (goto-char (point-min))
+ (while (re-search-forward "\\(?:href\\|src\\)\\s-*=\\s-*\"\\([^\"]*\\)\"" nil t)
+ (let ((old-url (match-string 1))
+ (new-url))
+ (unless (or (> 11 (length old-url))
+ (string= "javascript:"
+ (downcase (substring old-url 0 11))))
+ (setq new-url (html-move-make-new-url old-url from-dir to-dir))
+ (when new-url
+ (replace-match new-url t t nil 1)))))
+ (save-buffer)
+ (html-move-fix-site-backlinks from to-dir from-dir)
+ ;; Make backup at current location of "from" file
+ (with-current-buffer moved-buffer
+ (set-buffer-modified-p t)
+ (save-buffer))
+ (kill-buffer moved-buffer)
+ ;; Delete moved
+ (delete-file from))
+ (set-buffer new-buffer)
+ (goto-char (point-min))
+ (lwarn '(html-move) :warning "Moved to %s" new-file)
+ )))
+
+(defun html-move-fix-site-backlinks (to-moved-file to-dir from-dir)
+ "Fix all links back to TO-MOVED-FILE.
+This is called by `html-move-buffer-file' to fix all links back
+to the moved file. TO-MOVED-FILE is the old location of the
+moved file. FROM-DIR is the old directory and TO-DIR the target
+directory for the move."
+ (html-move-fix-all-backlinks to-moved-file (html-site-current-site-dir) to-dir from-dir)
+ (when (html-move-fix-page-list to-moved-file to-dir from-dir)
+ (message "Page list for site TOC changed. You need to update TOC.")
+ (lwarn '(html-move-fix-site-backlinks) :warning "Page list for site TOC changed. You need to update TOC.")
+ ))
+
+(defun html-move-fix-all-backlinks (to-moved-file for-dir to-dir from-dir)
+ ;;(message "for-dir=%s" for-dir);(sit-for 2)
+ (let ((html-files (directory-files for-dir t ".*\\.html?$"))
+ (sub-dirs (directory-files-and-attributes for-dir t)))
+ (dolist (html-file html-files)
+ (html-move-fix-backlinks to-moved-file html-file to-dir from-dir))
+ (dolist (sub-entry sub-dirs)
+ (let* ((sub-dir (car sub-entry))
+ (sub-name (file-name-nondirectory sub-dir)))
+ (when (and (eq t (car (cdr sub-entry)))
+ (not (string= "." sub-name))
+ (not (string= ".." sub-name)))
+ (html-move-fix-all-backlinks to-moved-file sub-dir to-dir from-dir))))))
+
+(defun html-move-fix-backlinks (to-moved-file for-file to-dir from-dir)
+ (when (file-exists-p for-file)
+ (let ((old-file-buffer (get-file-buffer for-file))
+ (buffer (find-file-noselect for-file)))
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (while
+ (re-search-forward
+ "\\(?:href\\|src\\)\\s-*=\\s-*\"\\([^#\"]*\\)\\(?:#[^\"]*\\|\\)\""
+ nil t)
+ (let* ((old-url (match-string 1))
+ (old-absolute-url (expand-file-name
+ old-url
+ (file-name-directory for-file)))
+ new-url)
+ (when (string= old-absolute-url to-moved-file)
+ (setq new-url (html-move-make-new-url old-url to-dir from-dir))
+ ;;(message "new-backlink=%s" new-url);(sit-for 2)
+ (replace-match new-url t t nil 1)
+ )))
+ (save-buffer)
+ (unless old-file-buffer
+ (kill-this-buffer))))))
+
+(defun html-move-fix-page-list (to-moved-file to-dir from-dir)
+ (let ((for-file (html-site-current-page-list))
+ some-change)
+ (when (file-exists-p for-file)
+ (let ((old-file-buffer (get-file-buffer for-file))
+ (buffer (find-file-noselect for-file)))
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (while
+ (re-search-forward
+ ;;"\\(?:href\\|src\\)\\s-*=\\s-*\"\\([^#\"]*\\)\\(?:#[^\"]*\\|\\)\""
+ "\\s-+###\\s-+\\([^#]*?\\)\\(?:#[^#]*\\|\\)[:space:]*$"
+ nil t)
+ (let* ((old-url (match-string 1))
+ (old-absolute-url (expand-file-name
+ old-url
+ (file-name-directory for-file)))
+ new-url)
+ (when (string= old-absolute-url to-moved-file)
+ (setq new-url (html-move-make-new-url old-url to-dir from-dir))
+ ;;(message "new-backlink=%s" new-url);(sit-for 2)
+ (replace-match new-url t t nil 1)
+ (setq some-change t)
+ )))
+ (save-buffer)
+ (unless old-file-buffer
+ (kill-this-buffer)))))
+ some-change))
+
+(provide 'html-move)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; html-move.el ends here
--- /dev/null
+;;; html-pagetoc.el --- Insert/rebuild table of contents for html page
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2005-08-03
+;; Last-Updated: Sat Apr 21 14:11:13 2007 (7200 +0200)
+(defconst html-pagetoc:version "0.85") ;; Version:
+;; Keywords: tools hypermedia html
+;; Features that might be required by this library:
+;;
+;; None
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This file is not part of Emacs
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; html-pagetoc.el has functions for building (and rebuilding) a
+;; simple table of contents for a single html file. It is supposed to
+;; be a quick tool for this. The table of contents are made from the
+;; header tags (H1, H2, H3 etc). If you have ID attributes on the
+;; header the table of contents will have links to those. Otherwise it
+;; is just text.
+
+;; To use this module put it in emacs load-path and enter the line
+;; below in your .emacs:
+;;
+;; (require 'html-pagetoc)
+;;
+;; When editing a html file put your cursor where you want the table
+;; of contents and do M-x html-pagetoc-insert-toc.
+;;
+;; To rebuild the table of contents use M-x html-pagetoc-rebuild-toc.
+;; If you want to add styles to it you can use M-x
+;; html-pagetoc-insert-style-guide.
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;(define-key global-map [f2] 'eval-buffer)
+;;(define-key global-map [f3] 'html-pagetoc-insert-toc)
+
+;;;###autoload
+(defgroup html-pagetoc nil
+ "Html page local table of contents settings"
+ :group 'nxhtml
+ :group 'hypermedia)
+
+(defcustom html-pagetoc-tocheads
+ '(
+ ("" . "On THIS Page:")
+ )
+ "Head titles for table of contents.
+The titles are put above the table of contents.
+
+The value of this variable should be a list of cons cells where
+the car is a regexp to match against file names and the cdr is
+the head title to use. The first match in the list is used. If
+there is no match then no head title is inserted."
+ :type '(repeat (cons regexp string))
+ :group 'html-pagetoc)
+
+(defcustom html-pagetoc-min 1
+ "Default for min header level"
+ :type 'integer
+ :group 'html-pagetoc)
+(make-variable-buffer-local 'html-pagetoc-min)
+
+(defcustom html-pagetoc-max 3
+ "Default for max header level"
+ :type 'integer
+ :group 'html-pagetoc)
+(make-variable-buffer-local 'html-pagetoc-max)
+
+(defconst html-pagetoc-begin-cmnt "<!-- Table of contents BEGIN -->\n")
+(defconst html-pagetoc-end-cmnt "<!-- END of Table of contents -->\n")
+(defconst html-pagetoc-maxmin-cmnt "<!-- Table of contents min=%s max=%s -->\n")
+
+;;(defconst html-pagetoc-buffers nil)
+
+(defun html-pagetoc-get-title (filename)
+ "Find the head title for filename.
+See `html-pagetoc-tocheads'."
+ (when filename
+ (let ((ths html-pagetoc-tocheads)
+ th
+ re
+ header)
+ (while (and ths (not header))
+ (setq th (car ths))
+ (setq ths (cdr ths))
+ (setq re (car th))
+ (when (string-match re filename)
+ (setq header (cdr th))))
+ header)))
+
+;;;###autoload
+(defun html-pagetoc-insert-toc (&optional min-level max-level)
+ "Inserts a table of contents for the current html file.
+The html header tags h1-h6 found in the file are inserted into
+this table. MIN-LEVEL and MAX-LEVEL specifies the minimum and
+maximum level of h1-h6 to include. They should be integers."
+ (interactive (let* ((maxstr)
+ (max 0)
+ (min 1)
+ (prmax (format "Max header level (%s): " html-pagetoc-max))
+ (prmax2 (concat "Please give an integer 1-5. " prmax))
+ (prmin "Include header level 1? ")
+ )
+ (while (= max 0)
+ (setq maxstr (read-string prmax))
+ (if (equal maxstr "")
+ (setq max html-pagetoc-max)
+ (when (not (string-match "\\." maxstr))
+ (setq max (string-to-number maxstr)) ))
+ (when (> max 5) (setq max 0))
+ (when (< max 0) (setq max 0))
+ (setq prmax prmax2) )
+ (when (> max 1)
+ (when (not (y-or-n-p prmin)) (setq min 2)))
+ (list min max)))
+
+ (let* ((curr-buffer (current-buffer))
+ (header (html-pagetoc-get-title (buffer-file-name)))
+ (toc-buffer (get-buffer-create "*html-pagetoc*"))
+ (toc)
+ (buffer-val (cons (buffer-file-name) (list min-level max-level)))
+ )
+ (setq html-pagetoc-min min-level)
+ (setq html-pagetoc-max max-level)
+ (with-current-buffer toc-buffer (erase-buffer))
+ (with-temp-buffer
+ (insert-buffer-substring curr-buffer)
+ ;;(replace-regexp "<!--.*?-->" "")
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "<!--.*?-->" nil t)
+ (replace-match "" nil nil))
+ (goto-char (point-min))
+ (let ((b (current-buffer))
+ (standard-output toc-buffer)
+ (level (- min-level 1))
+ (skip-level (- min-level 1))
+ (prev-level)
+ )
+ (princ html-pagetoc-begin-cmnt)
+ (princ (format
+ html-pagetoc-maxmin-cmnt
+ min-level
+ max-level))
+ (princ "<table id=\"PAGETOC\"><tr><td>\n")
+ (when header
+ (princ "<span class=\"tochead\">")
+ (princ header)
+ (princ "</span>\n"))
+ (while (re-search-forward
+ (concat "\\(?:<h\\([1-9]\\)\\([^>]*\\)>\\(.*?\\)</h[1-9]>"
+ "\\|"
+ "<!--\\(?:.\\|\n\\)-->\\)")
+ nil t)
+ (let ((m0 (match-string 0))
+ (m1 (match-string 1))
+ (m2 (match-string 2))
+ (title (match-string 3))
+ (id)
+ (new-level)
+ )
+ (unless (not m1)
+ (setq new-level (string-to-number m1))
+ (when (and (<= new-level max-level) (<= min-level new-level))
+ (setq prev-level level)
+ (setq level new-level)
+ (while (< prev-level level)
+ (princ (make-string (* (- prev-level skip-level) 4) 32))
+ ;; class liul is a fix for a problem in IE
+ (when (> prev-level (- min-level 1)) (princ "<li class=\"liul\">"))
+ (princ "<ul>\n")
+ (setq prev-level (+ prev-level 1)))
+ (while (> prev-level level)
+ (princ (make-string (* (- prev-level skip-level) 4) 32))
+ (princ "</ul></li>\n")(setq prev-level (- prev-level 1)))
+ (when (nth 3 (match-data t))
+ (when (string-match "id=\"\\([^\"]*\\)\"" m2)
+ (setq id (substring m2 (match-beginning 1) (match-end 1)))))
+ (princ (make-string (* (- level skip-level) 4) 32))
+ (princ "<li>")
+ (if id
+ (princ (format "<a href=\"#%s\">%s</a>" id title))
+ (princ title))
+ (princ "</li>\n")
+ ))))
+ (while (> level (- min-level 1))
+ (setq level (- level 1))
+ (princ (concat (make-string (* (- level skip-level) 4) 32) "</ul>"))
+ (when (> level (- min-level 1)) (princ "</li>"))
+ (princ "\n"))
+ (princ "</td></tr></table>\n")
+ (princ html-pagetoc-end-cmnt)
+ (with-current-buffer toc-buffer
+ (setq toc (buffer-string)))
+ )
+ ) ; save-excursion
+ ) ; with-temp-buffer
+ (when toc
+ (when (re-search-forward "<body.*?>" nil t)
+ (forward-line))
+ (set-mark (point))
+ (insert toc)
+ (let ((start (copy-marker (region-beginning)))
+ (end (copy-marker (region-end))))
+ (indent-region (region-beginning) (region-end) nil)
+ (set-mark start)
+ (goto-char end))
+ (setq deactivate-mark nil)
+ (message "Toc created"))
+ )
+ )
+
+(defun html-pagetoc-insert-style-guide ()
+ "Inserts a style tag for toc inserted by `html-pagetoc-insert-toc'.
+This can be used as a guide for creating your own style sheet for
+the table of contents."
+ (interactive)
+ (goto-char (point-min))
+ (unless (re-search-forward "^\\s-*</head>")
+ (error "%s" "Can not find ^\\s-*</head>"))
+ (beginning-of-line)
+ (set-mark (point))
+ (insert "\n")
+ (insert "<!-- Style for the table of contents. -->\n")
+ (insert "<style type=\"text/css\">\n")
+ (insert "#PAGETOC {\n")
+ (insert " background-color: #df7;\n")
+ (insert " padding: 0.5em;\n")
+ (insert "}\n")
+ ;;(insert "#PAGETOC strong { color: #ac4; }\n")
+ (insert "#PAGETOC a { color: maroon; display: block; }\n")
+ (insert "#PAGETOC a:hover { background-color: yellow; }\n")
+ (insert "#PAGETOC ul {\n")
+ (insert " list-style-type: none;\n")
+ (insert " margin-left: 0;\n")
+ (insert " padding-left: 1.5em;\n")
+ (insert "}\n")
+ (insert "#PAGETOC ul li { font-weight: bold; }\n")
+ (insert "#PAGETOC ul li ul { }\n")
+ (insert "#PAGETOC ul li ul li { font-weight: normal;}\n")
+ (insert "#PAGETOC .liul {\n")
+ (insert " //display:inline; /* IE fix */\n")
+ (insert "}\n")
+ (insert "#PAGETOC .tochead {\n")
+ (insert " font-weight: bold;\n")
+ (insert " margin-bottom: 0.5em;\n")
+ (insert "}\n")
+ (insert "</style>\n")
+ (insert "\n")
+ (let ((start (copy-marker (region-beginning)))
+ (end (copy-marker (region-end))))
+ (indent-region (region-beginning) (region-end) nil)
+ (set-mark start)
+ (goto-char end))
+ (setq deactivate-mark nil)
+ (message "Please edit the style guide!")
+ )
+
+;;;###autoload
+(defun html-pagetoc-rebuild-toc ()
+ "Update the table of contents inserted by `html-pagetoc-insert-toc'."
+ (interactive)
+ (let* (;;(old-val (assoc (buffer-file-name) html-pagetoc-buffers))
+ ;;(old-min (nth 1 old-val))
+ ;;(old-max (nth 2 old-val))
+ (old-min html-pagetoc-min)
+ (old-max html-pagetoc-max)
+ )
+ (goto-char (point-min))
+ (if (not (search-forward html-pagetoc-begin-cmnt nil t))
+ (when (y-or-n-p "Could not find table of contents. Insert one here? ")
+ (html-pagetoc-insert-toc))
+ (backward-char 4)
+ (beginning-of-line)
+ (let ((minmax-patt (format html-pagetoc-maxmin-cmnt "\\([[:alnum:]]+\\)" "\\([[:alnum:]]+\\)")))
+ (save-excursion
+ (when (search-forward-regexp minmax-patt nil t)
+ (setq old-min (string-to-number (match-string 1)))
+ (setq old-max (string-to-number (match-string 2))))))
+ (let ((start-toc (point)))
+ (when (search-forward html-pagetoc-end-cmnt)
+ (beginning-of-line)
+ (let ((end-toc (point)))
+ (set-mark start-toc)
+ (goto-char end-toc)
+ (when (y-or-n-p "Rebuild this TOC? ")
+ ;;(unless old-min (setq old-min 1))
+ (setq old-min (eval-minibuffer "Min TOC level: " (format "%s" old-min)))
+ ;;(unless old-max (setq old-max 3))
+ (setq old-max (eval-minibuffer "Max TOC level: " (format "%s" old-max)))
+ (delete-region start-toc end-toc)
+ (html-pagetoc-insert-toc old-min old-max ))))))))
+
+;;;###autoload
+(defconst html-pagetoc-menu-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [html-pagetoc-rebuild-toc]
+ (list 'menu-item "Update Page TOC" 'html-pagetoc-rebuild-toc))
+ (define-key map [html-pagetoc-insert-style-guide]
+ (list 'menu-item "Insert CSS Style for Page TOC" 'html-pagetoc-insert-style-guide))
+ (define-key map [html-pagetoc-insert-toc]
+ (list 'menu-item "Insert Page TOC" 'html-pagetoc-insert-toc))
+ map))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;; Ready:
+(provide 'html-pagetoc)
+
+;;; html-pagetoc.el ends here
--- /dev/null
+;;; html-quote.el --- Simple quoting of html characters
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Sun Dec 30 12:55:38 2007
+;; Version:
+;; Last-Updated: Sun Dec 30 12:59:43 2007 (3600 +0100)
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Just simple quoting of & < > etc
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+
+(defcustom html-quote-html '((?< . "<")
+ (?& . "&"))
+ "*Alist of char -> entity mappings used to make the text html-safe."
+ :group 'html-qoute
+ :type '(alist :key-type character
+ :value-type string))
+
+
+(defun html-quote-html-char (char)
+ "Return CHAR as string if safe, otherwise its html entity."
+ (or (cdr (assoc char html-quote-html))
+ (char-to-string char)))
+
+(defun html-quote-html-string (str)
+ "Return html escaped STR."
+ (mapconcat 'html-quote-html-char
+ (append str nil)
+ ""))
+
+;; (html-quote-html-string "is & < s")
+
+(provide 'html-quote)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; html-quote.el ends here
--- /dev/null
+;;; html-site.el --- Keeping (X)HTML files together
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Wed Mar 01 17:25:52 2006
+(defconst html-site:version "0.3");; Version:
+;; Last-Updated: 2008-03-22T03:32:06+0100 Sat
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `cl', `html-site', `html-upl', `ietf-drums', `mail-parse',
+;; `mail-prsvr', `mailcap', `mm-util', `qp', `rfc2045', `rfc2047',
+;; `rfc2231', `time-date', `timer', `timezone', `tls', `url',
+;; `url-auth', `url-c', `url-cookie', `url-expand', `url-gw',
+;; `url-history', `url-http', `url-methods', `url-parse',
+;; `url-privacy', `url-proxy', `url-util', `url-vars'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; TODO: maybe use browse-url-filename-alist
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'compile))
+(eval-when-compile (require 'dired))
+(eval-when-compile (require 'ffip nil t))
+(eval-when-compile (require 'grep))
+(eval-when-compile (require 'ourcomments-util nil t))
+(eval-when-compile (require 'url-parse))
+;;(defvar html-site-list) ;; Silence compiler
+;;(defvar html-site-current) ;; Silence compiler
+
+;;;###autoload
+(defgroup html-site nil
+ "Customization group for html-site."
+ :group 'nxhtml)
+
+;; Fix-me: Rewrite using directory variables
+(defcustom html-site-list nil
+ "Known site directories and corresponding attributes.
+Each element in the list is a list containing:
+
+* Name for the site.
+* Site root directory.
+* Page list file - Pages for table of contents (TOC). Usually
+ initially built from the site directory by
+ `html-toc-create-pages-file'.
+* Frames file.
+* TOC file for the frames file.
+* Output directory - where to put the merged TOC and site
+ pages.
+* Output template file - html template for merging. See `html-wtoc-dir'
+ for examples.
+* Function for additional tasks - for example copying images, style
+ sheets, scripts etc.
+--
+"
+ :type '(repeat
+ (list
+ (string :tag "*** Site name ***")
+ (directory :tag "Site root directory")
+ (file :tag "Page list file")
+ (file :tag "Frames file")
+ (file :tag "Contents file for frames")
+ (directory :tag "Output directory for pages with TOC" :help-echo "Where to put the merged files")
+ (file :tag "Template file for pages with TOC" :help-echo "HTML template for merging")
+ (choice :tag "Extra function for pages with TOC"
+ (const nil :tag "Default function")
+ (function)
+ )
+ (string :tag "Ftp host address")
+ (string :tag "Ftp user")
+ (string :tag "Ftp password")
+ (string :tag "Ftp directory root")
+ (string :tag "Ftp directory root for pages with TOC")
+ (string :tag "Web host address")
+ (string :tag "Web directory root")
+ (string :tag "Web directory root for pages with TOC")
+ ))
+ :set (lambda (symbol value)
+ ;;(message "sym=%s, value=%s" symbol value)
+ (set-default symbol value)
+ (when (featurep 'html-site)
+ (let ((ok t))
+ (dolist (e value)
+ (let (
+ (name (elt e 0))
+ (site-dir (elt e 1))
+ (pag-file (elt e 2))
+ (frm-file (elt e 3))
+ (toc-file (elt e 4))
+ (out-dir (elt e 5))
+ (tpl-file (elt e 6))
+ (fun (elt e 7))
+ (ftp-host (elt e 8))
+ (ftp-user (elt e 9))
+ (ftp-pw (elt e 10))
+ (ftp-dir (elt e 11))
+ (ftp-wtoc-dir (elt e 12))
+ (web-host (elt e 13))
+ (web-dir (elt e 14))
+ (web-wtoc-dir (elt e 15))
+ )
+ (unless (not (string= "" name))
+ (html-site-lwarn '(html-site-list) :error "Empty site name"))
+ (if (not (file-directory-p site-dir))
+ (progn
+ (html-site-lwarn '(html-site-list) :error "Site directory for %s not found: %s" name site-dir)
+ (setq ok nil))
+ (unless (file-exists-p pag-file)
+ (html-site-lwarn '(html-site-list) :warning "Pages list file for %s does not exist: %s" name pag-file))
+ (unless (file-exists-p tpl-file)
+ (html-site-lwarn '(html-site-list) :warning "Template file for %s does not exist: %s" name tpl-file)))
+ (when (< 0 (length out-dir))
+ (html-site-chk-wtocdir out-dir site-dir))
+ (when fun
+ (unless (functionp fun)
+ (html-site-lwarn '(html-site-list) :error "Site %s - Unknown function: %s" name fun)
+ (setq ok nil)
+ ))
+ ))
+ )))
+ :group 'html-site)
+
+(defcustom html-site-current ""
+ "Current site name.
+Use the entry with this name in `html-site-list'."
+ :set (lambda (symbol value)
+ ;;(message "sym=%s, value=%s" symbol value)
+ (set-default symbol value)
+ (when (featurep 'html-site)
+ (or (when (= 0 (length value))
+ (message "html-site-current (information): No current site set"))
+ (let ((site-names))
+ (dolist (m html-site-list)
+ (setq site-names (cons (elt m 0) site-names)))
+ (or
+ (unless (member value site-names)
+ (html-site-lwarn '(html-site-current) :error "Can't find site: %s" value))
+ (let ((site-dir (html-site-site-dir value)))
+ (unless (file-directory-p site-dir)
+ (html-site-lwarn '(html-site-current) :error "Can't find site directory: %s" value))))))))
+ :type 'string
+ :set-after '(html-site-list)
+ :group 'html-site)
+
+(defun html-site-looks-like-local-url (file)
+ "Return t if this looks like a local file something url."
+ (require 'url-parse)
+ (let ((url-type (url-type (url-generic-parse-url file))))
+ (not
+ (and url-type
+ ;; Test if it really is an url, the is 1 for w32 drive
+ ;; letters
+ (or (not (memq system-type '(ms-dos windows-nt)))
+ (< 1 (length url-type)))))))
+
+(when nil
+ (assert (not (html-site-looks-like-local-url "http://www.some.where/")))
+ (assert (html-site-looks-like-local-url "/unix/file"))
+ (when (memq system-type '(windows-nt))
+ (assert (html-site-looks-like-local-url "c:/w32/file"))))
+
+(defun html-site-dir-contains (dir file)
+ ;;(when (= ?~ (string-to-char file)) (setq file (expand-file-name file)))
+ ;;
+ ;; It is not possible to unconditionally expand the file name here
+ ;; since url file names can be involved.
+ ;; (url-type (url-generic-parse-url "c:/some/file.txt"))
+ (let* ((file-is-local (html-site-looks-like-local-url file))
+ (dir-is-local (html-site-looks-like-local-url dir))
+ (file-is-dir (and file-is-local
+ (file-directory-p file)))
+ (true-f (if file-is-local
+ (if file-is-dir
+ (file-name-as-directory
+ (file-truename
+ (expand-file-name file)))
+ (file-truename
+ (expand-file-name file)))
+ file))
+ ;; (file-name-as-directory (expand-file-name "~/"))
+ (true-d (if dir-is-local
+ (file-name-as-directory
+ (file-truename
+ (expand-file-name dir)))
+ (if (eq ?/ (car (reverse (append dir nil))))
+ dir
+ (concat dir "/")))))
+ (assert (eq file-is-local dir-is-local))
+ (if (< (length true-d) (length true-f))
+ (string= true-d
+ (substring true-f 0 (length true-d)))
+ (when file-is-dir
+ (string= true-d true-f)))))
+
+(defun html-site-lwarn (warn-type level format-string &rest args)
+ (apply 'message (concat "%s:" format-string) warn-type args)
+ (apply 'lwarn warn-type level args))
+
+(defun html-site-chk-wtocdir (out-dir site-dir)
+ (or
+ (unless (file-name-absolute-p out-dir)
+ (html-site-lwarn '(html-site) :error "Output directory is not absolute: %s" out-dir))
+ (if (file-exists-p out-dir)
+ (unless (file-directory-p out-dir)
+ (html-site-lwarn '(html-site) :error "File %s for output exists but is not a directory" out-dir))
+ (unless (string= out-dir (file-name-as-directory out-dir))
+ (html-site-lwarn '(html-site) :error "File name could not be a directory: %s" out-dir)))
+ (when (html-site-dir-contains out-dir site-dir)
+ (html-site-lwarn '(html-site) :error "Ouput directory for pages with TOC must not contain site dir."))
+ (when (html-site-dir-contains site-dir out-dir)
+ (html-site-lwarn '(html-site) :error "Site dir must not contain ouput directory for pages with TOC."))))
+
+
+;;;###autoload
+(defun html-site-buffer-or-dired-file-name ()
+ "Return buffer file name or file pointed to in dired."
+ (if (derived-mode-p 'dired-mode)
+ (dired-get-file-for-visit)
+ buffer-file-name))
+
+;;;###autoload
+(defun html-site-set-site (name)
+ (interactive
+ (let ((site-names)
+ (must-contain (when (boundp 'must-contain) must-contain))
+ (file (html-site-buffer-or-dired-file-name))
+ (use-dialog-box nil))
+ (unless (< 0 (length html-site-list))
+ (error "No sites defined yet"))
+ (when (and file
+ ;;(string-match "ml" (symbol-name major-mode))
+ )
+ (when (or must-contain
+ (y-or-n-p "Should site contain current file? "))
+ (setq must-contain file)))
+ (dolist (m html-site-list)
+ (let* ((name (elt m 0))
+ (dir (html-site-site-dir name)))
+ (when (or (not must-contain)
+ (html-site-dir-contains dir file))
+ (setq site-names (cons name site-names)))))
+ (unless site-names
+ (when must-contain
+ (error "No sites contains %s" must-contain)))
+ (list (when site-names
+ (let ((prompt (if (< 0 (length html-site-current))
+ (concat "Current site is \""
+ html-site-current
+ "\". "
+ (if must-contain
+ "New site containing file: "
+ "New site's name: "))
+ (if must-contain
+ "Site containing file: "
+ "Site name: "))))
+ (completing-read prompt site-names nil t nil 'site-names))))))
+ (unless (or (string= name "")
+ (string= name html-site-current))
+ (setq html-site-current name)
+ (customize-save-variable 'html-site-current html-site-current)))
+
+;;;###autoload
+(defun html-site-dired-current ()
+ "Open `dired' in current site top directory."
+ (interactive)
+ (dired (html-site-current-site-dir)))
+
+;;;###autoload
+(defun html-site-find-file ()
+ "Find file in current site."
+ (interactive)
+ ;;(require 'ffip)
+ (ffip-set-current-project html-site-current
+ (html-site-current-site-dir)
+ 'nxhtml)
+ (call-interactively 'ffip-find-file-in-project))
+
+;;;###autoload
+(defun html-site-rgrep (regexp files)
+ "Search current site's files with `rgrep'.
+See `rgrep' for the arguments REGEXP and FILES."
+ (interactive
+ (progn
+ (grep-compute-defaults)
+ (let* ((regexp (grep-read-regexp))
+ (files (grep-read-files regexp)))
+ (list regexp files))))
+ ;; fix-me: ask for site
+ ;;(when (called-interactively-p) )
+ (rgrep regexp files (html-site-current-site-dir)))
+
+;;;###autoload
+(defun html-site-query-replace (from to file-regexp delimited)
+ "Query replace in current site's files."
+ (interactive
+ (let ((parameters (dir-replace-read-parameters t t)))
+ ;; Delete element 3
+ ;;(length parameters)
+ (setcdr (nthcdr 2 parameters) (nthcdr 4 parameters))
+ ;;(length parameters)
+ parameters))
+ ;; fix-me: ask for site
+ ;;(when (called-interactively-p) )
+ (rdir-query-replace from to file-regexp
+ ;;root
+ (html-site-current-site-dir)
+ delimited)
+ )
+
+(defun html-site-ensure-site-defined (site-name)
+ (unless html-site-list
+ (error "No sites defined. Please customize `html-site-list'."))
+ (unless (file-directory-p (html-site-site-dir site-name))
+ (error "Local file web site directory does not exists: %s"
+ (html-site-site-dir site-name))))
+(defun html-site-current-ensure-site-defined ()
+ (unless (and (< 0 (length html-site-current))
+ (assoc html-site-current html-site-list))
+ (error "No current site set"))
+ (html-site-ensure-site-defined html-site-current))
+
+(defun html-site-remote-contains (site-name url with-toc)
+ (html-site-dir-contains (html-site-remote-root site-name with-toc) url))
+(defun html-site-current-remote-contains (url with-toc)
+ (html-site-remote-contains html-site-current url with-toc))
+
+(defun html-site-ensure-file-in-site (site-name file-name &optional no-error)
+ (html-site-ensure-site-defined site-name)
+ (if (html-site-contains site-name file-name)
+ t
+ (if no-error
+ nil
+ (error "This file is not in site %s" site-name))))
+(defun html-site-current-ensure-file-in-site (file-name)
+ ;;(html-site-ensure-file-in-site html-site-current file-name))
+ (let ((in-site (html-site-ensure-file-in-site html-site-current
+ file-name t)))
+ (while (not in-site)
+ (if (not (y-or-n-p
+ (format "This file is not in site %s, change site? "
+ html-site-current)))
+ (error "This file is not in site %s" html-site-current)
+ (let ((must-contain t))
+ (call-interactively 'html-site-set-site))
+ (setq in-site (html-site-ensure-file-in-site html-site-current
+ file-name t))))))
+
+(defun html-site-ensure-buffer-in-site (site-name)
+ (unless buffer-file-name
+ (error "This buffer is not visiting a file"))
+ (html-site-ensure-file-in-site site-name buffer-file-name))
+(defun html-site-current-ensure-buffer-in-site ()
+ (html-site-ensure-buffer-in-site html-site-current))
+
+
+(defun html-site-site-dir (site-name)
+ (file-name-as-directory
+ (nth 1 (assoc site-name html-site-list))))
+(defun html-site-current-site-dir () (html-site-site-dir html-site-current))
+
+(defun html-site-contains (site-name file)
+ (html-site-dir-contains (html-site-site-dir site-name) file))
+(defun html-site-current-contains (file)
+ (html-site-contains html-site-current file))
+
+(defun html-site-page-list (site-name)
+ (let ((page-list (nth 2 (assoc site-name html-site-list))))
+ (when (< 0 (length page-list))
+ page-list)))
+
+(defun html-site-current-page-list () (html-site-page-list html-site-current))
+
+(defun html-site-frames-file (site-name)
+ (nth 3 (assoc site-name html-site-list)))
+(defun html-site-current-frames-file () (html-site-frames-file html-site-current))
+
+(defun html-site-toc-file (site-name)
+ (nth 4 (assoc site-name html-site-list)))
+(defun html-site-current-toc-file () (html-site-toc-file html-site-current))
+
+(defun html-site-merge-dir (site-name)
+ (let ((dir (nth 5 (assoc site-name html-site-list))))
+ (when (< 0 (length dir))
+ dir)))
+(defun html-site-current-merge-dir () (html-site-merge-dir html-site-current))
+
+(defun html-site-merge-template (site-name)
+ (nth 6 (assoc site-name html-site-list)))
+(defun html-site-current-merge-template () (html-site-merge-template html-site-current))
+
+(defun html-site-extra-fun (site-name)
+ (nth 7 (assoc site-name html-site-list)))
+(defun html-site-current-extra-fun () (html-site-extra-fun html-site-current))
+
+(defun html-site-ftp-host (site-name)
+ (nth 8 (assoc site-name html-site-list)))
+(defun html-site-current-ftp-host () (html-site-ftp-host html-site-current))
+
+(defun html-site-ftp-user (site-name)
+ (nth 9 (assoc site-name html-site-list)))
+(defun html-site-current-ftp-user () (html-site-ftp-user html-site-current))
+
+(defun html-site-ftp-password (site-name)
+ (nth 10 (assoc site-name html-site-list)))
+(defun html-site-current-ftp-password () (html-site-ftp-password html-site-current))
+
+(defun html-site-ftp-dir (site-name)
+ (nth 11 (assoc site-name html-site-list)))
+(defun html-site-current-ftp-dir () (html-site-ftp-dir html-site-current))
+
+(defun html-site-ftp-wtoc-dir (site-name)
+ (nth 12 (assoc site-name html-site-list)))
+(defun html-site-current-ftp-wtoc-dir () (html-site-ftp-wtoc-dir html-site-current))
+
+(defun html-site-web-host (site-name)
+ (nth 13 (assoc site-name html-site-list)))
+(defun html-site-current-web-host () (html-site-web-host html-site-current))
+
+(defun html-site-web-dir (site-name)
+ (nth 14 (assoc site-name html-site-list)))
+(defun html-site-current-web-dir () (html-site-web-dir html-site-current))
+
+(defun html-site-web-wtoc-dir (site-name)
+ (nth 15 (assoc site-name html-site-list)))
+(defun html-site-current-web-wtoc-dir () (html-site-web-wtoc-dir html-site-current))
+
+(defun html-site-web-full (site-name with-toc)
+ (let ((host (html-site-web-host site-name)))
+ (unless (and host
+ (< 0 (length host)))
+ (error "Web site host not known for %s" site-name))
+ (save-match-data
+ (unless (string-match "^https?://" host)
+ (setq host (concat "http://" host))))
+ (concat host
+ (if with-toc
+ (html-site-web-wtoc-dir site-name)
+ (html-site-web-dir site-name)))))
+(defun html-site-current-web-full (with-toc)
+ (html-site-web-full html-site-current with-toc))
+
+(defvar html-site-ftp-temporary-passwords nil)
+(defun html-site-get-ftp-pw ()
+ (let ((pw (html-site-current-ftp-password)))
+ (unless (< 0 (length pw))
+ (let* ((user-site (concat (html-site-current-ftp-user)
+ "@"
+ (html-site-current-ftp-host)))
+ (site-pw (assoc user-site html-site-ftp-temporary-passwords)))
+ (if site-pw
+ (setq pw (cdr site-pw))
+ (setq pw (read-string
+ (concat "Ftp password for "
+ (html-site-current-ftp-user)
+ " at "
+ (html-site-current-ftp-host)
+ " : ")))
+ (setq html-site-ftp-temporary-passwords
+ (cons
+ (cons user-site pw)
+ html-site-ftp-temporary-passwords)))))
+ pw))
+
+
+
+
+
+(defun html-site-path-in-mirror (site-root path-in-site mirror-root)
+ (assert (html-site-dir-contains site-root path-in-site) t)
+ (let ((rel-path (file-relative-name path-in-site site-root)))
+ (if (string= rel-path ".")
+ (directory-file-name mirror-root)
+ (concat (file-name-as-directory mirror-root) rel-path))))
+
+;; Some checks to see if html-site-path-in-mirror works:
+(when nil
+ (require 'cl)
+ ;; Try to make a non-existent directory name to work around Emacs
+ ;; bug (which was fixed today in CVS):
+ (let ((local-file "/temp814354/in/hej.html")
+ (local-dir "/temp814354"))
+ (when (memq system-type '(ms-dos windows-nt))
+ (setq local-file (concat "c:" local-file))
+ (setq local-dir (concat "c:" local-dir )))
+ (assert (string=
+ "http://some.site/tempmirror/in/hej.html"
+ (html-site-path-in-mirror local-dir
+ local-file
+ "http://some.site/tempmirror"))
+ t)
+ (assert (string=
+ local-file
+ (html-site-path-in-mirror "http://some.site/tempmirror"
+ "http://some.site/tempmirror/in/hej.html"
+ local-dir))
+ t)
+ (assert (string=
+ "in/hej.html"
+ (file-relative-name "http:/temp/in/hej.html" "http:/temp"))
+ t)
+ ))
+
+
+(defun html-site-local-to-web (site-name local-file with-toc)
+ (html-site-ensure-file-in-site site-name local-file)
+ (html-site-path-in-mirror (html-site-site-dir site-name)
+ local-file
+ (html-site-web-full site-name with-toc)))
+(defun html-site-current-local-to-web (local-file with-toc)
+ (html-site-local-to-web html-site-current local-file with-toc))
+
+(defun html-site-remote-root (site-name with-toc)
+ (concat "/ftp:"
+ (html-site-ftp-user site-name)
+ "@" (html-site-ftp-host site-name)
+ ":"
+ (if with-toc
+ (html-site-ftp-wtoc-dir site-name)
+ (html-site-ftp-dir site-name))))
+(defun html-site-current-remote-root (with-toc)
+ (html-site-remote-root html-site-current with-toc))
+
+(defun html-site-local-to-remote (site-name local-file with-toc)
+ (html-site-ensure-file-in-site site-name local-file)
+ (html-site-path-in-mirror (html-site-site-dir site-name)
+ local-file
+ (html-site-remote-root site-name with-toc)))
+(defun html-site-current-local-to-remote (local-file with-toc)
+ (html-site-local-to-remote html-site-current local-file with-toc))
+
+(defun html-site-remote-to-local (site-name remote-file with-toc)
+ ;;(html-site-ensure-file-in-site remote-file)
+ ;; Fix-me above
+ (html-site-path-in-mirror (html-site-remote-root site-name with-toc)
+ remote-file
+ (html-site-site-dir site-name)))
+(defun html-site-current-remote-to-local (remote-file with-toc)
+ (html-site-remote-to-local html-site-current remote-file with-toc))
+
+
+(defvar html-site-files-re "\.x?html?$")
+
+(defun html-site-edit-pages-file ()
+ "Edit the list of pages to be used for table of contents."
+ (interactive)
+ (html-site-current-ensure-site-defined)
+ (find-file (html-site-current-page-list))
+ )
+
+(defun html-site-get-sub-files (dir file-patt)
+ (let ((sub-files)
+ (sub-dirs)
+ (dir-files (directory-files dir t "^[^.]")))
+ (dolist (f dir-files)
+ (if (file-directory-p f)
+ (add-to-list 'sub-dirs f)
+ (when (string-match file-patt f)
+ (add-to-list 'sub-files f))))
+ (dolist (sub-dir sub-dirs)
+ (setq sub-files (append sub-files (html-site-get-sub-files sub-dir file-patt)))
+ )
+ sub-files))
+
+(defun html-site-file-is-local (filename)
+ "Return t if FILENAME is a local file name.
+No check is done that the file exists."
+ ;;(find-file-name-handler "/ftp:c:/eclean/" 'file-exists-p)
+ (null (find-file-name-handler filename 'file-exists-p)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Put subprocess here at the moment ...
+
+(defconst noshell-procbuf-name "*Noshell process buffer*")
+
+(defvar noshell-proc-name nil)
+(defun noshell-procbuf-setup (procbuf-name)
+ (unless procbuf-name
+ (setq procbuf-name noshell-procbuf-name))
+ (with-current-buffer (get-buffer-create procbuf-name)
+ (unless (get-buffer-window (current-buffer))
+ (when (one-window-p) (split-window))
+ (let ((cb (current-buffer)))
+ (set-window-buffer (other-window 1) cb)))
+ ;;(setq buffer-read-only t)
+ (noshell-process-mode)
+ (compilation-minor-mode 1)
+;; (let ((inhibit-read-only t)
+;; (output-buffer (current-buffer)))
+;; (goto-char (point-max))
+;; (setq noshell-proc-name name)
+;; (let ((s (concat
+;; "\n\n\n>>>>>>>>>>>>>>>>>> Starting "
+;; noshell-proc-name "\n")))
+;; (put-text-property 0 (length s)
+;; 'face (list 'bold '(:foreground "green"))
+;; s)
+;; (insert s)))
+ (sit-for 0.01) ;; Display update
+ (current-buffer)))
+
+(defun noshell-procbuf-teardown (proc)
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-max))
+ (let ((inhibit-read-only t)
+ (s (concat
+ "<<<<<<<<<<<<<<<<<<< Finished OK: "
+ noshell-proc-name "\n")))
+ (put-text-property 0 (length s)
+ 'face (list 'bold '(:foreground "green"))
+ s)
+ (insert s))))
+
+(defun noshell-procbuf-run (buffer prog &rest args)
+ (with-current-buffer buffer
+ (let ((inhibit-read-only t)
+ (proc nil)
+ )
+ (unwind-protect
+ (progn
+ (setq proc (apply 'start-process "myproc" (current-buffer) prog args))
+ )
+ )
+ (save-excursion
+ (unless proc
+ (let ((s "\n\n<<<<<<<<<<<<< There was a process starting error!"))
+ (put-text-property 0 (length s)
+ 'face (list 'bold '(:foreground "red"))
+ s)
+ (insert s))
+ (error "Subprocess terminated with error status")))
+ (set-process-sentinel proc 'noshell-sentinel)
+ proc)
+ )
+ )
+(defun noshell-sentinel (process event)
+ (with-current-buffer (process-buffer process)
+ (let ((inhibit-read-only t))
+ ;;(insert (format "Process: %s recieved %s\n" process event))
+ (cond ((string-match "abnormally" event)
+ (let ((s (concat "\n<<<<<< Error: "
+ (substring event 0 -1)
+ " <<<<<<<<<")))
+ (put-text-property 0 (length s)
+ 'face (list 'bold '(:foreground "red"))
+ s)
+ (insert s)))
+ ((string-match "finished" event)
+ (noshell-procbuf-teardown process))
+ (t
+ (insert event))))))
+
+(defun noshell-procbuf-syncrun (prog &rest args)
+ (with-current-buffer (get-buffer noshell-procbuf-name)
+ (let ((inhibit-read-only t)
+ (sts nil))
+ (unwind-protect
+ (progn
+ ;;(setq sts (apply 'call-process prog nil (current-buffer) t args))
+ (setq sts (apply 'call-process prog nil (list (current-buffer) t) t args))
+ )
+ )
+ (save-excursion
+ (unless (= 0 sts)
+ (let ((s (format "\n\n<<<<<<<<<<<<< There was a process error: %s" sts)))
+ (put-text-property 0 (length s)
+ 'face (list 'bold '(:foreground "red"))
+ s)
+ (insert s))
+ (error "Subprocess terminated with error status")))
+ )
+ )
+ )
+
+(defvar noshell-process-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c)(control ?k)] 'noshell-kill-subprocess)
+ (define-key map [(control ?g)] 'noshell-quit)
+ map))
+
+(define-derived-mode noshell-process-mode fundamental-mode "Subprocess"
+ nil
+ (setq buffer-read-only t)
+ (buffer-disable-undo (current-buffer)))
+
+(defun noshell-quit ()
+ (interactive)
+ (noshell-kill-subprocess)
+ (keyboard-quit))
+
+(defun noshell-kill-subprocess ()
+ (interactive)
+ (when (eq major-mode 'noshell-process-mode)
+ (if (get-buffer-process (current-buffer))
+ (interrupt-process (get-buffer-process (current-buffer)))
+ (error "The subprocess is not running"))))
+
+
+
+;; Provide here to be able to load the files in any order
+(provide 'html-site)
+
+(eval-when-compile (require 'html-upl nil t))
+
+(defvar html-site-mode-menu-map
+ (let ((map (make-sparse-keymap "html-site-mode-menu-map")))
+
+ (when (featurep 'html-upl)
+ (let ((upl-map (make-sparse-keymap)))
+ (define-key map [html-site-upl-map]
+ (list 'menu-item "File Transfer" upl-map))
+ ;;(define-key upl-map [html-site-upl-edit-remote-wtoc]
+ ;; (list 'menu-item "Edit Remote File With TOC" 'html-upl-edit-remote-file-with-toc))
+ (define-key upl-map [html-site-upl-edit-remote]
+ (list 'menu-item "Edit Remote File" 'html-upl-edit-remote-file))
+ (define-key upl-map [html-site-upl-ediff-buffer]
+ (list 'menu-item "Ediff Remote/Local Files" 'html-upl-ediff-file))
+ (define-key upl-map [html-site-upl-sep] (list 'menu-item "--"))
+ (define-key upl-map [html-site-upl-upload-site-with-toc]
+ (list 'menu-item "Upload Site with TOC" 'html-upl-upload-site-with-toc))
+ (define-key upl-map [html-site-upl-upload-site]
+ (list 'menu-item "Upload Site" 'html-upl-upload-site))
+ (define-key upl-map [html-site-upl-upload-file]
+ (list 'menu-item "Upload Single File" 'html-upl-upload-file))
+ ))
+
+ (let ((site-map (make-sparse-keymap)))
+ (define-key map [html-site-site-map]
+ (list 'menu-item "Site" site-map))
+ (define-key site-map [html-site-customize-site-list]
+ (list 'menu-item "Edit Sites" (lambda () (interactive)
+ (customize-option 'html-site-list))))
+ (define-key site-map [html-site-set-site]
+ (list 'menu-item "Set Current Site" 'html-site-set-site))
+ )
+
+ map))
+
+
+(defvar html-site-mode-map
+ (let ((map (make-sparse-keymap )))
+ (define-key map [menu-bar html-site-mode]
+ (list 'menu-item "Web Site" html-site-mode-menu-map))
+ map))
+
+(define-minor-mode html-site-mode
+ "Adds a menu for easy access of setting site, uploading etc."
+ :init-value nil
+ :lighter nil
+ :keymap html-site-mode-map
+ :group 'html-site)
+
+(defvar html-site-mode-off-list
+ '(nxhtml-mode))
+
+(define-global-minor-mode html-site-global-mode html-site-mode
+ (lambda ()
+ (html-site-mode 1)
+ (when t ;buffer-file-name
+ (unless (memq major-mode html-site-mode-off-list)
+ (html-site-mode 1))))
+ :group 'html-site)
+;; The problem with global minor modes:
+(when (and html-site-global-mode
+ (not (boundp 'define-global-minor-mode-bug)))
+ (html-site-global-mode 1))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; html-site.el ends here
--- /dev/null
+;;; html-toc.el --- Building and updating TOC for a site
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Wed Feb 01 14:40:13 2006
+(defconst html-toc:version "0.4");; Version:
+;; Last-Updated: Tue Apr 10 04:09:29 2007 (7200 +0200)
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Create table of contents for a static web site. See
+;; `html-toc-write-toc-file' and `html-toc-write-frames-file' for
+;; more info.
+;;
+;; To use this you can add (require 'html-toc) to your .emacs.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (add-to-list 'load-path default-directory load-path))
+(eval-when-compile (require 'fupd nil t))
+;;(require 'html-move)
+(eval-when-compile (require 'html-site nil t))
+;;(require 'dom)
+(require 'xml)
+
+(defconst html-toc-mark-begin "<!-- html-toc START -->")
+(defconst html-toc-mark-middle "<!-- html-toc MIDDLE -->")
+(defconst html-toc-mark-end "<!-- html-toc END -->")
+
+(defun html-toc-create-pages-file ()
+ "Write a list of pages to be used for table of contents.
+Return the file name."
+ (interactive)
+ (html-site-current-ensure-site-defined)
+ (let* (
+ (site-dir (html-site-current-site-dir))
+ (page-file (html-site-current-page-list))
+ (page-file-dir (file-name-directory page-file))
+ (page-file-exists (file-exists-p page-file))
+ (sub-files (html-site-get-sub-files
+ site-dir
+ html-site-files-re))
+ (pages-text)
+ )
+ (setq sub-files
+ (sort (mapcar (lambda (full-file)
+ (assert (file-exists-p full-file))
+ (file-relative-name full-file page-file-dir))
+ sub-files)
+ 'string<))
+ ;;(setq sub-files (delete html-toc-file-default-name sub-files))
+ (with-temp-buffer
+ (let ((this-level)
+ (dir-title)
+ (title)
+ (full-file))
+ (dolist (file sub-files)
+ (setq full-file (expand-file-name file page-file-dir))
+ (setq dir-title (file-name-nondirectory
+ (substring (file-name-directory full-file) 0 -1)))
+ (setq title (html-toc-get-title full-file))
+ (setq this-level 0)
+ (mapc (lambda (c) (when (eq c ?/) (setq this-level (1+ this-level)))) file)
+ (insert (format "%s ### %s ### %s\n" this-level title file))))
+ (setq pages-text (buffer-string)))
+ (with-current-buffer (find-file page-file)
+ (if (string= pages-text (buffer-string))
+ (message "List of pages is already the default list")
+ (if (= 0 (length (buffer-string)))
+ (progn
+ (insert pages-text)
+ (save-buffer)
+ )
+ (if (y-or-n-p "Replace old list of pages? ")
+ (progn
+ (erase-buffer)
+ (insert pages-text)
+ (save-buffer)
+ )
+ (message "Keeping old list of pages.")))))
+ page-file))
+(defun html-toc-dir ()
+ (let* ((this-file (if load-file-name
+ load-file-name
+ buffer-file-name))
+ (this-dir (file-name-directory this-file))
+ )
+ (expand-file-name "html-toc" this-dir)))
+
+;;;###autoload
+(defgroup html-toc nil
+ "Customization group for html-toc."
+ :group 'nxhtml)
+
+(defcustom html-toc-template-file
+ (expand-file-name "html-toc-template.html" (html-toc-dir))
+ "Template file for table of contents file."
+ :type 'file
+ :group 'html-toc)
+
+
+(defun html-toc-write-toc-file ()
+ "Write a table of contents for a web site.
+Build the table of content from the information in
+`html-site-current-page-list'. Write it to the file
+`html-site-current-toc-file' and return that file name.
+
+When viewed in a browser the table of contents can be
+expanded/collapsed (if JavaScript is allowed)."
+ (interactive)
+ (html-site-current-ensure-site-defined)
+ (let* ((toc-file (html-site-current-toc-file))
+ (page-file (html-site-current-page-list))
+ page-lines
+ toc)
+ (unless (< 0 (length toc-file))
+ (error "There is no name for the table of content file in site \"%s\""
+ html-site-current))
+ (unless (< 0 (length page-file))
+ (error "There is no name for the pages file in site \"%s\""
+ html-site-current))
+ (with-temp-buffer
+ (insert-file-contents page-file)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((line (buffer-substring (point) (line-end-position)))
+ (line-parts (split-string line "\\s-+###\\s-+")))
+ (setq page-lines (cons line-parts page-lines)))
+ (forward-line)))
+ (setq page-lines (reverse page-lines))
+ (with-temp-buffer
+ (html-toc-insert-toc page-lines toc-file)
+ (setq toc (buffer-substring-no-properties (point-min) (point-max))))
+ (with-current-buffer (find-file-noselect toc-file)
+ (erase-buffer)
+ (insert-file-contents-literally html-toc-template-file)
+ (let (toc-start)
+ (while (search-forward "%%TOC%%" nil t)
+ (unless toc-start
+ (setq toc-start (match-beginning 0)))
+ (replace-match toc t t))
+ (forward-line) ;; for indentation
+ (indent-region toc-start (point-marker)))
+ (goto-char (point-min))
+ (save-buffer))
+ toc-file))
+
+
+(defun html-toc-insert-toc (page-lines toc-file)
+ (let* ((curr-level)
+ (min-level 100)
+ div-levels
+ (site-directory (html-site-current-site-dir))
+ (toc-rel-file (file-relative-name toc-file site-directory)))
+ (dolist (line page-lines)
+ (let ((level (string-to-number (nth 0 line))))
+ (when (< level min-level)
+ (setq min-level level))))
+ (setq curr-level min-level)
+ (while page-lines
+ (let* ((line (car page-lines))
+ (file (nth 2 line))
+ (title (nth 1 line))
+ (this-level (string-to-number (nth 0 line)))
+ (next-level (progn
+ ;; Note:
+ (setq page-lines (cdr page-lines))
+ (let ((next-line (car page-lines)))
+ (when next-line
+ (string-to-number (nth 0 next-line))))))
+ (full-file (expand-file-name file site-directory))
+ (dir-title (file-name-nondirectory
+ (substring (file-name-directory full-file) 0 -1))))
+ ;;(insert "<!-- " (format "%s, %s, %s" curr-level this-level div-levels) " -->\n")
+ ;; Don't insert a link to the toc file
+ (unless (string= toc-rel-file file)
+ ;; If there are childs then insert a <div> before them. Save
+ ;; the level so we can close the div-tag later.
+ (when (< curr-level this-level)
+ ;; Save level so we can find the end of the <div>.
+ (setq div-levels (cons this-level div-levels))
+ (insert "<div class=\"html-toc-childs\">\n"))
+ ;; Close div-tags if this level is lower when the previous.
+ (when (> curr-level this-level)
+ (while (and div-levels
+ (> (car div-levels) this-level))
+ (insert "</div>\n")
+ (setq div-levels (cdr div-levels))))
+ (setq curr-level this-level)
+ (insert "<div class=\"html-toc-link\">"
+ "<span style=\"display:table-cell; width:15em; background-color:yellow;\">"
+ "<a style=\"padding-left:" (number-to-string (1+ (- curr-level min-level))) "em;\" "
+ (format "href=\"%s\">%s</a>" file title)
+ "</span>")
+ (when (and next-level (> next-level this-level))
+ (insert "<span onclick=\"html_toc_hs(this)\" class=\"html-toc-hs\""
+ " style=\"display:table-cell; background-color:white;\">HS</span>"))
+ (insert "</div>"
+ "\n")
+ )))
+ (while div-levels
+ (insert "</div>\n")
+ (setq div-levels (cdr div-levels)))))
+
+(defun html-toc-get-title (file)
+ (save-excursion
+ (with-temp-buffer
+ (insert-file-contents file nil 0 1000)
+ (goto-char (point-min))
+ (when (search-forward-regexp "<title>\\(.*\\)</title>" nil t)
+ (match-string 1)))))
+
+(defun html-toc-parse-toc (toc-str)
+ (let ((nodes))
+ (with-temp-buffer
+ (insert toc-str)
+ (setq nodes (xml-parse-region (point-min) (point-max))))
+ ))
+
+(defun html-toc-get-hrefs (nodes)
+ (let ((atags (html-toc-get-atags nodes)))
+ (mapcar (lambda (atag)
+ (xml-get-attribute atag 'href))
+ atags)))
+(defun html-toc-get-atags (nodes)
+ (let ((atags))
+ (dolist (node nodes)
+ (when (listp node)
+ (setq atags (append atags (xml-get-children node 'a)))
+ (setq atags (append atags (html-toc-get-atags (xml-node-children node))))))
+ atags))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Frames and viewing
+(defcustom html-toc-frames-default-name "html-toc-frames.html"
+ "Default file name sans directory for frames file."
+ :type 'string
+ :group 'html-toc)
+
+(defvar html-toc-frames-contents
+ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+ <head>
+ <title>Frames for html-toc</title>
+ </head>
+ <frameset cols=\"20%, 80%\">
+ <frame name=\"html-toc-TOC\" src=\"%%TOCFILE%%\"/>
+ <frame name=\"html-toc-Document\" />
+ <noframes>
+ <body>
+ Html frame support required
+ </body>
+ </noframes>
+ </frameset>
+</html>
+")
+
+(defun html-toc-browse-frames-file ()
+ "View frames file written by `html-toc-write-frames-file'."
+ (interactive)
+ (html-site-current-ensure-site-defined)
+ (let ((frames-file (html-site-current-frames-file)))
+ (unless (< 0 (length frames-file))
+ (error "There is no frames file set for site \"%s\"" html-site-current))
+ ;;(message "frames-file=%s" frames-file)(sit-for 4)
+ (unless (file-exists-p frames-file)
+ (html-toc-write-frames-file))
+ (browse-url-of-file frames-file)))
+
+;; (defun html-toc-frames-file-name ()
+;; "Return name of file written by `html-toc-write-frames-file'."
+;; (html-toc-get-site)
+;; (expand-file-name html-toc-frames-default-name html-move-site-directory))
+
+(defun html-toc-write-frames-file ()
+ "Write a frames file.
+This frames file should load the table of contents build by
+`html-toc-write-toc-file' in one frame and shows the documents in
+another.
+
+The contents of the frames file is defined by
+`html-toc-frames-contents'.
+
+Returns the file name of the written or existing frames file.
+
+You may also want to look at `html-wtoc-write-pages-with-toc'."
+ (interactive)
+ ;;(html-toc-get-site)
+ (html-site-current-ensure-site-defined)
+ (let* ((frames-file (html-site-current-frames-file))
+ (frames-cont html-toc-frames-contents)
+ (toc-file (html-toc-write-toc-file))
+ toc-file-relative)
+ (when toc-file
+ (setq toc-file-relative (file-relative-name
+ toc-file
+ (file-name-directory frames-file)))
+ (save-match-data
+ (unless (string-match "%%TOCFILE%%" frames-cont)
+ (error "Can't find %%TOCFILE%% in html-toc-frames-contents"))
+ (setq frames-cont (replace-match toc-file-relative t t frames-cont)))
+ (with-current-buffer (find-file-noselect frames-file)
+ (erase-buffer)
+ (insert frames-cont)
+ (save-buffer))
+ frames-file)))
+
+;;;###autoload
+(defconst html-toc-menu-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [html-toc-browse-frames-file]
+ (list 'menu-item "Browse Frames File" 'html-toc-browse-frames-file))
+ (define-key map [html-toc-write-frames-file]
+ (list 'menu-item "Write Frames File" 'html-toc-write-frames-file))
+ (define-key map [html-toc-write-toc-file]
+ (list 'menu-item "Write TOC File for Frames" 'html-toc-write-toc-file))
+ (define-key map [html-toc-sep1] (list 'menu-item "--"))
+ (define-key map [html-toc-edit-pages-file]
+ (list 'menu-item "Edit List of Pages for TOC" 'html-site-edit-pages-file))
+ (define-key map [html-toc-create-pages-file]
+ (list 'menu-item "Write List of Pages for TOC" 'html-toc-create-pages-file))
+ map))
+
+
+
+(provide 'html-toc)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; html-toc.el ends here
--- /dev/null
+<?xml version="1.0"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>HEAD</title>
+ <link rel="stylesheet" href="html-toc/html-toc.css" type="text/css" />
+ <link rel="stylesheet" href="html-toc/html-toc-template.css" type="text/css" />
+ <script type="text/javascript" src="html-toc/html-toc.js"></script>
+ <script type="text/javascript" src="html-toc/html-toc-template.js"></script>
+ <script type="text/javascript">
+ var my_old_onload = window.onload;
+ function my_onload() {
+ HTML_WTOC_NS.onload_actions(%%PNUM%%);
+ if (undefined != my_old_onload) { my_old_onload(); }
+ }
+ window.onload = my_onload;
+ </script>
+ </head>
+ <body>
+
+
+ <table summary="Page columns" cellspacing="0" border="0" cellpadding="0" xwidth="100%" >
+ <tr valign="top">
+ <td id="html-wtoc-id-toccol" class="html-wtoc-contcol">
+ <table summary="Contents column" id="html-wtoc-id-toc" class="html-wtoc-contcol"
+ cellspacing="0" border="1" cellpadding="0" width="100%">
+ <tr valign="top">
+ <td colspan="2" height="50" >
+ <table summary="Logo" id="html-wtoc-id-logo">
+ <tr>
+ <td align="right" valign="bottom" >
+ <a href="http://www.OurComments.org/Emacs/EmacsW32.html"
+ ><img src="img/gnu-m-x-160.png" width="80" height="80"
+ alt="Go to EmacsW32 Home Page"
+ title="Go to EmacsW32 Home Page"
+ onmouseover="transLbi(this, false);"
+ onmouseout ="transLbi(this, true);"
+ style="
+ margin-top:10px;
+ padding-left:20px;
+ padding-right:20px;
+ padding-top:10px;
+ padding-bottom:10px;
+ "
+ border="0"
+ /></a>
+ </td>
+ </tr>
+ </table>
+ </td>
+ </tr><tr valign="top">
+ <td >
+ <table border="1">
+ <tr>
+ <td>%%TOC%%</td>
+ </tr>
+ <tr>
+ <td id="nxhtml-link">
+ <br />
+ Built using Emacs
+ <br />
+ with nxhtml from
+ <br />
+ <a href="http://ourcomments.org/Emacs/Emacs.html"
+ target="_blank">ourcomments.org</a>
+ </td>
+ </tr>
+ </table>
+ </td>
+ </tr><tr>
+ <td colspan="2" style="background-color:red;">
+
+ </td>
+ </tr>
+ </table>
+ <table summary="Ensure table width"
+ cellspacing="0" id="html-wtoc-id-tocwidth"><tr><td></td></tr></table>
+ </td>
+
+ </tr>
+ </table>
+ </body>
+</html>
--- /dev/null
+/* Main structures >>>>>>>>>>>>>>> */
+.html-wtoc-maintop {
+ font-size: 1px;
+ font-size: 1em;
+ margin-top: 0em;
+ margin-bottom: 0em;
+/* background-color:green; */
+}
+.html-wtoc-main {
+}
+
+td.html-wtoc-vdivline {
+ //background-color: #8be;
+ width: 0px;
+}
+
+.html-wtoc-search-form {
+ margin-bottom: 0.1em;
+}
+.html-wtoc-search {
+ font-size: 0.8em;
+ color: green;
+}
+.html-wtoc-search a {
+ color: green;
+}
+/* <<<<<<<<<<<<<<<<<<< */
+
+
+
+
+/* Table of content >>>>>>>>>>>>>> */
+
+#html-wtoc-id-hidetoc {
+ height: 20px;
+ border-bottom: 2px inset #ddf;
+ border-color: #dff;
+}
+
+#html-wtoc-id-tocdiv {
+ width: 2.5em;
+ //background-color: #eff;
+}
+#html-wtoc-id-logo {
+ width: 100%;
+ height: 120px;
+ padding: 0em;
+ margin: 0em;
+ border: 0em;
+}
+#html-wtoc-id-toc {
+}
+#html-wtoc-id-tocwidth {
+ width: 18em;
+ height: 0em;
+ padding: 0em;
+ margin: 0em;
+ border: 0em;
+ line-height: 0em;
+/* background-color: red; */
+}
+#html-wtoc-id-toccol {
+ width: 18em;
+}
+
+.html-wtoc-contcol {
+ background-color: #dFEfff;
+ background-color: #dFEfff;
+ background-color: #cd950c;
+ background-color: #eead0e;
+}
+/* <<<<<<<<<<<<<<<<<<< */
+
+
+
+
+/* Buttons etc >>>>>>>>>>>>>>> */
+.html-wtoc-button {
+ font-size: 0.75em;
+ font-size: 8pt;
+ color: #5A5D00;
+ background-color: #9cf;
+ background-color: #bcee68;
+ background-color: #a2cd5a;
+ padding: 0.2em;
+ Border-Width: 2px;
+ Border-Style: outset;
+ text-align: center;
+ border-color: #ddf;
+}
+a.html-wtoc-button {
+ text-decoration: none;
+ color: #5A5D00;
+}
+a.html-wtoc-button:hover {
+ text-decoration:none;
+ background-color: #6af;
+ color:#340;
+}
+
+a.html-wtoc-buttonimg img {
+ width: 16px;
+ height: 16px;
+ padding: 4px;
+ border: 8px;
+}
+a.html-wtoc-buttonimg {
+ border:2px;
+ margin:2px;
+ margin-left:2px;
+ margin-right:2px;
+}
+a.html-wtoc-buttonimg {
+ font-size:1px;
+}
+a.html-wtoc-buttonimg:hover {
+ margin: 6px;
+ margin-left:0px;
+ margin-right:0px;
+ border-color: #ddf;
+ border-width: 2px;
+ border-style: outset;
+ background-color: #595C00;
+ background-color: #bef;
+ background-color: #b9ffb9;
+}
+
+/* <<<<<<<<<<<<<<<<<<< */
+
+
+#nxhtml-link {
+ font-size: 0.7em;
+ text-align: center;
+ padding-top: 2em;
+ padding: 1em;
+}
+
+.copyright {
+ color : #872;
+}
+
--- /dev/null
+body {
+ margin: 0;
+}
+td {
+ font-size: 1em;
+}
+
+/* Added by html-wtoc.pl >>>>>>>>>>>>> */
+.html-wtoc-mark {
+/* background-color: #9cf; */
+/* background-color: #bcee68; */
+/* background-color: #a2cd5a; */
+ width: 20px;
+ padding: 0;
+ border: 0;
+ text-align: center;
+}
+.html-wtoc-contline {
+ width: 100%;
+}
+
+.html-wtoc-margin {
+ width: 0.6em;
+}
+.html-wtoc-contents {
+ font-size: 0.9em;
+ padding: 1em;
+ background-color: #9cf;
+ background-color: #a2cd5a;
+ background-color: #efffcf;
+ background-color: #ffffdf;
+ -moz-border-radius-topleft: 2em;
+}
+.html-wtoc-contents td {
+/* background-color: #9cf; */
+/* background-color: #bcee68; */
+/* background-color: #a2cd5a; */
+}
+.html-wtoc-contents-a {
+ text-decoration: none;
+ color: #595C00;
+/* background-color: #9cf; */
+/* background-color: #bcee68; */
+/* background-color: #a2cd5a; */
+ border: 1px #9cf solid;
+ border: 1px #a2cd5a solid;
+ border: 1px #ffffc0 solid;
+ padding-left: 0.25em;
+ padding-right: 0;
+ margin: 1px;
+ display: block;
+}
+.html-wtoc-contents a:hover {
+ text-decoration: none;
+ background-color: #b9ffb9;
+ border: 1px #6b8e23 solid;
+}
+.html-wtoc-currcont {
+ background-color: #738600;
+ color: #ffff2f;
+ background-color: #535600;
+ border: 1px #6b8e23 inset;
+ padding-left: 0.25em;
+ padding-right: 0;
+ margin: 1px;
+ display: block;
+}
+a.html-wtoc-currcont {
+ text-decoration: none;
+}
+a.html-wtoc-currcont:hover {
+ background-color: #738600;
+ background-color: #536600;
+ background-color: #434620;
+}
+/* <<<<<<<<<<<<<<<<<<< */
+
+
+
+
+
+
+
+
--- /dev/null
+
+// © Copyright 2006 Lennart Borgman, http://www.OurComments.org/. All rights reserved.
+//
+// This program is free software; you can redistribute it and/or
+// modify it under the terms of the GNU General Public License as
+// published by the Free Software Foundation; either version 3, or (at
+// your option) any later version.
+//
+// This program is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+// General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program; see the file COPYING. If not, write to
+// the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+// Floor, Boston, MA 02110-1301, USA.
+
+
+var HTML_WTOC_NS_sCurrTocId;
+
+
+HTML_WTOC_NS = {
+
+ /////////////////////////////
+ //// Basic event functions
+ /////////////////////////////
+
+ getEventObject : function (ev) {
+ var o;
+ if (window.event)
+ o = window.event.srcElement;
+ else if (null != ev)
+ o = ( ev.target );
+ return o;
+ },
+ getEvent : function (ev) {
+ if (window.event) {
+ return window.event;
+ } else if (null != ev) {
+ return ev;
+ }
+ },
+
+ eventStopPropagation : function (e) {
+ if (e.stopPropagation)
+ e.stopPropagation();
+ else
+ e.cancelBubble=true;
+ },
+
+ eventPreventDefault : function (e) {
+ if (e.preventDefault)
+ e.preventDefault();
+ else
+ e.returnValue=false;
+ },
+
+ /////////////////////////////
+ //// TOC hide
+ /////////////////////////////
+
+ show_content : function (on) {
+ var toc = document.getElementById("html-wtoc-id-toccol").style;
+ var tdv = document.getElementById("html-wtoc-id-tocdiv").style;
+ var shw = document.getElementById("html-wtoc-id-showtoc").style;
+ var hid = document.getElementById("html-wtoc-id-hidetoc").style;
+ if (on) {
+ toc.display = "";
+ tdv.display = "";
+ shw.display = "none";
+ hid.display = "";
+ HTML_WTOC_NS.focus_page_link(0);
+ } else {
+ toc.display = "none";
+ tdv.display = "none";
+ shw.display = "";
+ hid.display = "none";
+ }
+ },
+
+
+
+
+
+ /////////////////////////////
+ //// Open-Close
+ /////////////////////////////
+ onblur_action : function(ev) {
+ HTML_WTOC_NS_sCurrTocId = null;
+ },
+ onfocus_action : function(ev) {
+ var o = HTML_WTOC_NS.getEventObject(ev);
+ if (!o) return;
+
+ HTML_WTOC_NS_sCurrTocId = o.id;
+ },
+ onclick_action : function(ev) {
+ var o = HTML_WTOC_NS.getEventObject(ev);
+ var e = HTML_WTOC_NS.getEvent(ev);
+ if (13 == e.keyCode) return true;
+ if (!o) return true;
+ if ("IMG" == o.tagName) o = o.parentNode;
+ var iId = HTML_WTOC_NS.getIdnumFromId(o.id);
+ var sChildId = "toc_child_"+iId;
+ var sOldCurrTocId = HTML_WTOC_NS_sCurrTocId;
+ HTML_WTOC_NS.toggle_open(sChildId, o);
+ HTML_WTOC_NS_sCurrTocId = sOldCurrTocId;
+ return false;
+ },
+
+ toggle_open : function (id, parent) {
+ var child = document.getElementById(id).style;
+ var sInner = parent.innerHTML;
+ var re = new RegExp("[^/]*\.gif", "i");
+ if ("none" == child.display) {
+ child.display = "";
+ parent.innerHTML = sInner.replace(re, "down.gif")+"";
+ } else {
+ child.display = "none";
+ parent.innerHTML = sInner.replace(re, "right.gif")+"";
+ }
+ },
+
+
+
+ /////////////////////////////
+ //// Load
+ /////////////////////////////
+
+ onload_actions : function (iPageNum) {
+ document.body.onkeydown = HTML_WTOC_NS.onkeydown_action;
+ document.body.onmouseover = HTML_WTOC_NS.onmouseover_action;
+ var aATags = document.getElementsByTagName("a");
+ for(var i = 0; i < aATags.length; i++) {
+ var o = aATags[i];
+ if (null != HTML_WTOC_NS.getIdnumFromId(o.id)) {
+ o.onfocus = HTML_WTOC_NS.onfocus_action;
+ o.onblur = HTML_WTOC_NS.onblur_action;
+ if (o.id.substr(0, 12) == "opener_text_") {
+ o.onclick = HTML_WTOC_NS.onclick_action;
+ o.title = "Open/Close";
+ } else if (o.id.substr(0, 7) == "opener_") {
+ o.onclick = HTML_WTOC_NS.onclick_action;
+ o.className = "html-wtoc-mark";
+ o.title = "Open/Close";
+ }
+ }
+ }
+ HTML_WTOC_NS.focus_page_link(iPageNum);
+ },
+ focus_page_link : function (iPageNum) {
+ // Element might be hidden
+ try {
+ document.getElementById("toc_link_"+iPageNum).focus();
+ } catch (exc) {
+ }
+ },
+
+
+
+
+
+
+
+ /////////////////////
+ //// Mouse
+ /////////////////////
+
+ onmouseover_action : function (ev) {
+ if (null == HTML_WTOC_NS_sCurrTocId) return true;
+ var o = HTML_WTOC_NS.getEventObject(ev);
+ var iId = HTML_WTOC_NS.getIdnumFromId(o.id);
+ if (null == iId) return true;
+ o.focus();
+ },
+
+
+
+ /////////////////////
+ //// Key
+ /////////////////////
+
+ onkeydown_action: function (ev) {
+ var keyDown = 40;
+ var keyUp = 38;
+ var keyLeft = 37;
+ var keyRight = 39;
+ var keyReturn = 13;
+ var keyF2 = 113;
+ var keyInsert = 45;
+ // Opera
+ var keyOperaDown = 57386;
+ var keyOperaUp = 57385;
+ var keyOperaLeft = 57387;
+ var keyOperaRight = 57388;
+ var keyOperaF2 = 57346;
+ var keyOperaInsert = 57394;
+
+ var SwitchKey = keyInsert;
+ var SwitchKeyOpera = keyOperaInsert;
+
+ var bUp;
+ var e = HTML_WTOC_NS.getEvent(ev);
+ if (null == HTML_WTOC_NS_sCurrTocId) {
+ switch (e.keyCode) {
+ case SwitchKey:
+ case SwitchKeyOpera:
+ HTML_WTOC_NS.focus_page_link(0);
+ HTML_WTOC_NS.eventStopPropagation(e);
+ HTML_WTOC_NS.eventPreventDefault(e);
+ return false;
+ }
+ return true;
+ }
+ switch (e.keyCode) {
+ case keyLeft:
+ case keyOperaLeft:
+ case keyRight:
+ case keyOperaRight:
+ HTML_WTOC_NS.handle_leftright_keys(e);
+ HTML_WTOC_NS.eventStopPropagation(e);
+ HTML_WTOC_NS.eventPreventDefault(e);
+ return false;
+ case keyDown:
+ case keyOperaDown:
+ bUp = false;
+ break;
+ case keyUp:
+ case keyOperaUp:
+ bUp = true;
+ break;
+ case SwitchKey:
+ case SwitchKeyOpera:
+ if (null != HTML_WTOC_NS_sCurrTocId) {
+ var o = document.getElementById(HTML_WTOC_NS_sCurrTocId);
+ if (o) o.blur();
+ HTML_WTOC_NS_sCurrTocId = null;
+ }
+ HTML_WTOC_NS.eventStopPropagation(e);
+ HTML_WTOC_NS.eventPreventDefault(e);
+ return false;
+ default:
+ //alert(e.keyCode);
+ return true;
+ }
+ var oOpener;
+ oOpener = HTML_WTOC_NS.getNextVisOpener(HTML_WTOC_NS_sCurrTocId, bUp);
+ oOpener.focus();
+ HTML_WTOC_NS.eventStopPropagation(e);
+ HTML_WTOC_NS.eventPreventDefault(e);
+ return false;
+ },
+
+ handle_leftright_keys: function (e) {
+ var keyLeft = 37;
+ var keyRight = 39;
+ var keyOperaLeft = 57387;
+ var keyOperaRight = 57388;
+ var iId = HTML_WTOC_NS.getIdnumFromId(HTML_WTOC_NS_sCurrTocId);
+ if (null == iId) return;
+ var sId = "opener_" + iId;
+ var oOpener = document.getElementById(sId);
+ var sId = HTML_WTOC_NS_sCurrTocId; // It will be cleared before getNextVis
+
+ var bOpenAction;
+ var bOpened;
+ var bUp;
+ var oChild = document.getElementById("toc_child_"+iId);
+ if (null == oChild) {
+ } else {
+ bOpened = (oChild.style.display != "none");
+ }
+ switch (e.keyCode) {
+ case keyLeft:
+ case keyOperaLeft:
+ bUp = true;
+ bOpenAction = (null != bOpened) && (bOpened);
+ break;
+ case keyRight:
+ case keyOperaRight:
+ bUp = false;
+ bOpenAction = (null != bOpened) && (!bOpened);
+ break;
+ default:
+ alert("bad key handling...");
+ }
+ if (bOpenAction) {
+ oOpener.click();
+ HTML_WTOC_NS_sCurrTocId = sId;
+ } else {
+ var oPrev = HTML_WTOC_NS.getNextVisOpener(sId, bUp);
+ oPrev.focus();
+ }
+ },
+
+
+
+
+
+
+ //////////////////////
+ //// Util
+ //////////////////////
+ getNameFromId: function (sId) {
+ var re = new RegExp("(.*?_)(\\d+)", "i");
+ if (!re.test(sId)) return null;
+ var iId = sId.replace(re, "$1");
+ return iId;
+ },
+ getIdnumFromId: function (sId) {
+ var re = new RegExp("(.*?_)(\\d+)", "i");
+ if (!re.test(sId)) return null;
+ var iId = sId.replace(re, "$2");
+ return iId;
+ },
+
+
+ getNextVisOpener: function (sId, bUp, bTrace) {
+ if (bTrace) alert("getNextVisOpener("+sId+","+bUp+")");
+ var iId = HTML_WTOC_NS.getIdnumFromId(sId);
+ if (null == iId) {
+ alert("getNextVisOpener err iId==null");
+ return;
+ }
+ var sIdName = HTML_WTOC_NS.getNameFromId(sId);
+ if (null == sIdName) {
+ alert("getNextVisOpener err sIdName==null");
+ return;
+ }
+ var oOpener;
+ var iLoop = -2;
+ while (oOpener == null) {
+ if (bTrace) alert(iId);
+ if (iLoop++ > iMaxChildNum) { alert("Child num error"); return; }
+ if (!bUp) {
+ iId++;
+ } else {
+ iId--;
+ }
+ if (iId > iMaxChildNum) { iId = 0; }
+ if (iId < 0) { iId = iMaxChildNum; }
+ var s = sIdName+iId;
+ oOpener = document.getElementById(s);
+ if (oOpener != null) {
+ if (bTrace) alert(oOpener.offsetLeft);
+ if (oOpener.style.display == "none") { // All
+ oOpener = null;
+ } else if (oOpener.offsetLeft < 0) { // IE
+ oOpener = null;
+ } else if (0 == oOpener.scrollWidth) { // Opera
+ oOpener = null;
+ }
+ }
+ }
+ return oOpener;
+ }
+
+
+
+}; //HTML_WTOC_NS
--- /dev/null
+;;; html-upl.el --- Uploading of web sites
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Mon Mar 06 19:09:19 2006
+(defconst html-upl:version "0.3") ;; Version:
+;; Last-Updated: 2008-03-22T01:23:01+0100 Sat
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `cl', `html-site', `html-upl', `mail-prsvr', `mm-util', `timer',
+;; `url-c', `url-parse', `url-vars'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+(eval-when-compile (add-to-list 'load-path default-directory load-path))
+(eval-when-compile (require 'html-site nil t))
+
+;;;###autoload
+(defgroup html-upl nil
+ "Customization group for html-upl."
+ :group 'nxhtml)
+
+(defcustom html-upl-dir
+ (file-name-as-directory
+ (expand-file-name
+ "html-upl"
+ (file-name-directory
+ (if load-file-name load-file-name buffer-file-name))))
+
+ "Directory where the tools needed are located.
+The tools for html-upl includes:
+
+- ftpsync.pl
+"
+ :type 'directory
+ :group 'html-upl)
+
+(defun html-upl-browse-remote ()
+ (interactive)
+ (let ((url (html-site-local-to-web html-site-current
+ ;;buffer-file-name
+ (html-site-buffer-or-dired-file-name)
+ nil)))
+ (browse-url url)))
+(defun html-upl-browse-remote-with-toc ()
+ (interactive)
+ (let ((url (html-site-local-to-web html-site-current
+ ;;buffer-file-name
+ (html-site-buffer-or-dired-file-name)
+ t)))
+ (browse-url url)))
+(defun html-upl-browse-remote-frames ()
+ (interactive)
+ (let ((url (html-site-local-to-web (html-site-current-frames-file)
+ ;;buffer-file-name
+ (html-site-buffer-or-dired-file-name)
+ nil)))
+ (browse-url url)))
+
+;;;###autoload
+(defun html-upl-upload-site-with-toc ()
+ (interactive)
+ (html-upl-upload-site1 t))
+
+;;;###autoload
+(defun html-upl-upload-site ()
+ (interactive)
+ (html-upl-upload-site1 nil))
+(defun html-upl-upload-site1(with-toc)
+ (html-site-current-ensure-site-defined)
+ (html-upl-ensure-site-has-host)
+ (let ((local-dir (if with-toc
+ (html-site-current-merge-dir)
+ (html-site-current-site-dir)))
+ (ftp-host (html-site-current-ftp-host))
+ (ftp-user (html-site-current-ftp-user))
+ (ftp-pw (html-site-current-ftp-password))
+ (ftp-dir (if with-toc
+ (html-site-current-ftp-wtoc-dir)
+ (html-site-current-ftp-dir)))
+ (ftpsync-pl (expand-file-name "ftpsync.pl" html-upl-dir))
+ )
+ (unless (< 0 (length ftp-host))
+ (error "Ftp host not defined"))
+ (unless (< 0 (length ftp-user))
+ (error "Ftp user not defined"))
+ (unless (< 0 (length ftp-dir))
+ (if with-toc
+ (error "Ftp remote directory for pages with TOC not defined")
+ (error "Ftp remote directory not defined")))
+ (unless (< 0 (length ftp-pw))
+ (setq ftp-pw (html-site-get-ftp-pw)))
+ (let* (
+ (buffer (noshell-procbuf-setup "subprocess for upload"))
+ (remote-url (concat "ftp://" ftp-user ":" ftp-pw "@" ftp-host ftp-dir))
+ (opt (list
+ "-v"
+ "-p"
+ local-dir
+ remote-url)))
+ (apply 'noshell-procbuf-run
+ buffer
+ "perl" "-w"
+ ftpsync-pl
+ opt
+ ))))
+
+(defun html-upl-ensure-site-has-host ()
+ (let ((host (html-site-current-ftp-host)))
+ (unless (and host (< 0 (length host)))
+ (error "Site %s has no ftp host defined" html-site-current))))
+
+;;;###autoload
+(defun html-upl-remote-dired (dirname)
+ "Start dired for remote directory or its parent/ancestor."
+ (interactive (list
+ (read-directory-name "Local directory: " nil nil t)))
+ (html-site-current-ensure-file-in-site dirname)
+ (html-upl-ensure-site-has-host)
+ (let* ((local-dir dirname)
+ (remote-dir (html-site-current-local-to-remote local-dir nil))
+ to-parent
+ res
+ msg)
+ (while (not res)
+ (condition-case err
+ (progn
+ (dired remote-dir)
+ (setq res t))
+ (error ;;(lwarn 't :warning "err=%s" err)
+ (setq msg (error-message-string err))))
+ ;; It does not look like we always get an error. Check where we are:
+ (when res
+ (unless (string= default-directory remote-dir)
+ (setq res nil)
+ (setq msg "")))
+ (unless res
+ ;; 450 Requested file action not taken File unavailable (e.g. file busy).
+ ;; 550 Requested action not taken File unavailable (e.g. file not found, no access).
+ (if (or (string= msg "")
+ (save-match-data (string-match " \\(?:550\\|450\\) " msg)))
+ (progn
+ (if (not to-parent)
+ (setq to-parent (concat
+ (file-name-nondirectory remote-dir)
+ "/.."))
+ (setq to-parent (concat
+ (file-name-nondirectory remote-dir)
+ "/"
+ to-parent "/..")))
+ ;;(setq local-dir (directory-file-name (file-name-directory (directory-file-name local-dir))))
+ ;;(html-site-current-ensure-file-in-site local-dir)
+ ;;(setq remote-dir (html-site-current-local-to-remote local-dir nil))
+ (setq remote-dir (directory-file-name (file-name-directory remote-dir)))
+ )
+ (setq res msg))))
+ (if (stringp res)
+ (error "%s" msg)
+ (when to-parent
+ (message "Remote dir not found, showing ancestor %s" to-parent)))))
+
+;;;###autoload
+(defun html-upl-upload-file (filename)
+ "Upload a single file in a site.
+For the definition of a site see `html-site-current'."
+ (interactive (list
+ (let ((use-dialog-box nil)
+ (f (file-relative-name
+ ;;(if (derived-mode-p 'dired-mode) (dired-get-file-for-visit) buffer-file-name)
+ (html-site-buffer-or-dired-file-name)
+ )))
+ (read-file-name "File: " nil nil t f))
+ ))
+ (html-site-current-ensure-file-in-site filename)
+ (html-upl-ensure-site-has-host)
+ (let* ((buffer (get-file-buffer filename))
+ (remote-file (html-site-current-local-to-remote filename nil))
+ (remote-buffer (get-file-buffer remote-file))
+ (local-file filename))
+ (when (or (not buffer-file-name)
+ (not (buffer-modified-p buffer))
+ (and
+ (y-or-n-p (format "Buffer %s is modified. Save buffer and copy? "
+ (buffer-name buffer)))
+ (with-current-buffer buffer
+ (save-buffer)
+ (not (buffer-modified-p)))))
+ (when (= ?~ (string-to-char local-file))
+ (setq local-file (expand-file-name local-file)))
+ (when (and (fboundp 'w32-short-file-name)
+ (string-match " " local-file))
+ (setq local-file (w32-short-file-name local-file)))
+ (copy-file local-file
+ ;;(html-site-current-local-to-remote filename nil)
+ remote-file
+ 0)
+ (when remote-buffer
+ (with-current-buffer remote-buffer
+ (revert-buffer nil t t)))
+ (message "Upload ready")
+ )))
+
+;;;###autoload
+(defun html-upl-edit-remote-file ()
+ (interactive)
+ (html-upl-edit-remote-file1 nil))
+
+;;;###autoload
+(defun html-upl-edit-remote-file-with-toc ()
+ (interactive)
+ (html-upl-edit-remote-file1 t))
+
+(defun html-upl-edit-remote-file1(with-toc)
+ (html-site-current-ensure-buffer-in-site)
+ (html-upl-ensure-site-has-host)
+ (let* ((remote-root (concat "/ftp:"
+ (html-site-current-ftp-user)
+ "@" (html-site-current-ftp-host)
+ ":"
+ (if with-toc
+ (html-site-current-ftp-wtoc-dir)
+ (html-site-current-ftp-dir))))
+;; (remote-file (html-site-path-in-mirror (html-site-current-site-dir)
+;; buffer-file-name
+;; remote-root))
+ (remote-file (html-site-current-local-to-remote buffer-file-name nil))
+ )
+ (find-file remote-file)))
+
+;;;###autoload
+(defun html-upl-ediff-file (filename)
+ "Run ediff on local and remote file.
+FILENAME could be either the remote or the local file."
+ ;;(interactive "fFile (local or remote): ")
+ (interactive (list
+ (or (html-site-buffer-or-dired-file-name)
+ (read-file-name "File: "))))
+ (html-upl-ensure-site-has-host)
+ (let* ((is-local (html-site-file-is-local filename))
+ remote-name
+ local-name)
+ (if is-local
+ (progn
+ (html-site-current-ensure-file-in-site filename)
+ (setq remote-name (html-site-current-local-to-remote filename nil))
+ (setq local-name filename))
+ (setq local-name (html-site-current-remote-to-local filename nil))
+ (html-site-current-ensure-file-in-site local-name)
+ (setq remote-name filename))
+ (let ((local-buf (find-file local-name))
+ (remote-buf (find-file remote-name)))
+ (ediff-buffers local-buf remote-buf))))
+
+;;(defun html-site-buffer-or-dired-file-name ()
+;; (defun html-upl-ediff-buffer ()
+;; "Run ediff on local and remote buffer file.
+;; The current buffer must contain either the local or the remote file."
+;; (interactive)
+;; (html-upl-ediff-file (buffer-file-name)))
+
+(provide 'html-upl)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; html-upl.el ends here
+
+;; (defun html-site-local-to-remote-path (local-file protocol with-toc)
+;; (let ((remote-dir (if (eq protocol 'ftp)
+;; (if with-toc
+;; (html-site-current-ftp-wtoc-dir)
+;; (html-site-current-ftp-dir))
+;; (if with-toc
+;; (html-site-current-web-wtoc-dir)
+;; (html-site-current-web-dir)))))
+;; (html-site-path-in-mirror
+;; (html-site-current-site-dir) local-file remote-dir)))
+
+;; (defun html-site-local-to-web (local-file with-toc)
+;; (let ((web-file (html-site-local-to-remote-path local-file 'http with-toc))
+;; (web-host (html-site-current-web-host)))
+;; (save-match-data
+;; (unless (string-match "^https?://" web-host)
+;; (setq web-host (concat "http://" web-host))))
+;; (when (string= "/" (substring web-host -1))
+;; (setq web-host (substring web-host 0 -1)))
+;; (concat web-host web-file)
+;; ))
+;;
+;;; Use tramp-tramp-file-p instead:
+;; (defun html-upl-file-name-is-local (file-name)
+;; "Return nil unless FILE-NAME is a Tramp file name."
+;; (save-match-data
+;; (not (string-match "^/[a-z]+:" file-name))))
+
+;; (defun html-upl-remote-to-local (remote-file)
+;; (let ((remote-site-dir (html-site-current-web-dir)))
+;; (unless (html-site-dir-contains remote-site-dir remote-file)
+;; (error "")))
+;; )
+
--- /dev/null
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+\f
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+\f
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+\f
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+\f
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+\f
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
--- /dev/null
+
+1.26 => 1.27 (2004-08-23)
+=========================
+
+ * Proposed and partially provided by Samuel Marshall <sam@leafdigital.com>
+ * enhanced timezone handling, should be perfect now
+ * new option -c, like -i but then asks interactively to let do it
+ * if FTP user/password are set to ?, they are asked for interactively
+
+
+1.25 => 1.26 (2004-03-31)
+=========================
+
+ * fixed "dangerous" algorithm of synchronization direction
+
+
+1.24 => 1.25 (2004-03-20)
+=========================
+
+ * fixed some 1.24 bugs
+ * clock offset computation now more resistant against very slow connections
+ * clock offset computation disabled for GET mode, so mirroring of foreign
+ stuff is now possible again
+ * default localdir of . disabled, therefore
+ * using . as localdir parameter does not cause a parsing error any more
+ * replaced damn indentation tabs in sourcecode by appropriate number of
+ spaces, so code is readable independent of tab settings
+ * enabled handling of ftpdir /
+ * handling of relative ftpdir corrected
+
+
+1.23 => 1.24 (2003-10-11)
+=========================
+
+ By Michiel Steltman <Msteltman@disway.nl>
+
+ * handle files with blanks etc in names
+ * clock offset remote-local to reduce unnecessary transfers
+ * error handling
+
+
+1.22 => 1.23 (2003-09-28)
+=========================
+
+ * New parameter timeout
+
+
+1.21 => 1.22 (2003-03-24)
+=========================
+
+ * Now cuts of / at directory spec's end, to avoid pwd() being different
+ from target of cwd() (which lead to unneccesarry abortions)
+
+
+1.20 => 1.21 (2003-03-24)
+=========================
+
+ * version information in sourcefile and output of -h command
+
+
+1.11 => 1.20 (2003-03-22)
+=========================
+
+ * generally, most foreseeable problems are beeing checked, in particular:
+
+ - unability to connect to FTP server
+ - unability to login into FTP server
+ - unability to change to local or remote base directory
+ - unability to change to remote subdirectory
+ - unability to create local or remote subdirectory
+ - unability to remove local or remote subdirectory
+ - unability to put or get a file within 3 trials
+
+ All these errors (except the last one) leads to immediate abortion.
+
+
+1.10 => 1.11 (2002-05-10)
+=========================
+
+ * Some optical corrections concerning output
+
+ * Files are now automatically re-transferred until the size on both ends
+ matches
+
+ * -? now corrrectly recognized
+
+
+1.00 => 1.10 (2001-10-28)
+=========================
+
+ * config file support
+ This is mportant to avoid putting ftp passwords in the process list!
+
+ * much more informative standard and verbose/debug output, including kind
+ of a advance information
+
+ * better FTP-URL parsing supporting such without user/password
+
+ * much better default values, e.g. ftp://ftp:anonymous@localhost/., ...
+
+ * softlinks are now detected (locally and remote) and treated somewhat
+ correctly, i.e. they are ignored correctly ;-))
+
+
+
+=> 1.00 (2001-10-26)
+====================
+
+* 1.0 created 2001-10-20 23:10 by Christoph Lechleitner <lech@ibcl.at>
+
+Quite good for a 5 hour hack, isn't it?
+O.K., I have already written similar programs for local file systems
+in Pascal for DOS, Win3x and OS/2, and in VisualBasic for Win95b.
+
+
--- /dev/null
+# README file for ftpsync.pl
+
+
+Contents:
+=========
+
+- Overview
+- Why use ftpsync.pl instead of mirror, sitecopy, ...?
+- Requirements/Restrictions
+- Bug reports, Contact
+- License
+- Updates
+
+
+Overview:
+---------
+
+ftpsync.pl synchronizes a local directory tree and a remote FTP directory tree.
+
+It was initally written to automize web publishing, but might be useful for
+some other purposes, like mirroring not-too-large public sites, data
+replication, and more.
+
+Call "ftpsync.pl -h" to get a short parameter explanation.
+
+
+Why use ftpsync.pl instead of mirror, sitecopy, ...?
+----------------------------------------------------
+
+Yes, there are similar projects, so some comments on them:
+
+Compared to mirror, ftpsync.pl is capable of PUTing, not only GETing stuff
+(Don't blame me if mirror is able to PUT, I could'nt find a way).
+
+Compared to sitecopy, ftpsync.pl has no problems, if the remote site has been
+changed since its last run by other tools and activites. Unless network
+problems or bugs occur, ftpsync.pl does a reliable synchronization.
+
+Compared to both, ftpsync.pl is very lightweight ;-))
+
+
+Requirements / Restrictions:
+----------------------------
+
+- Perl 5.6+
+ ftpsync.pl was initially developed on Perl 5.6.0-81 on SuSE Linux 7.2,
+ older Perl 5.x version might work. Test reports welcome at ftpsync@ibcl.at!
+
+- File::Find, IO::Handle
+ IMHO parts of the basic perl package.
+
+- Net::FTP
+ Part of the perl-libnet package.
+
+- UNIX like operating systems on local system
+ Porting to DOS based systems should be easily done by changing the
+ directory separator.
+
+- Perhaps, the script does not work with all FTP servers
+ It is beeing tested only against UNIX based FTP servers.
+
+
+Bug-Reports, Contact:
+---------------------
+
+Besides ftpsync.sourceforge.net, ftpsync@ibcl.at is a good target for comments
+of any kind.
+
+
+License:
+--------
+
+FTPSync.pl is GNU/GPL software and eMail ware.
+
+
+FTPSync.pl as GNU/GPL software:
+-------------------------------
+
+FTPSync.pl (ftpsync.pl) is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+See attached file COPYING.
+
+
+FTPSync.pl as eMail ware:
+-------------------------
+
+FTPSync.pl is also eMail-Ware, which means that the initial author
+(Christoph Lechleitner) would like to get an eMail (to ftpsync@ibcl.at),
+- if anyone uses the script on production level,
+- if anyone distributes or advertises it in any way,
+- if anyone starts to (try to) improve it.
+
+
+Updates
+-------
+
+The software and updates should be available from
+http://ftpsync.sourceforge.net/
+http://www.ibcl.at/ossw/FTPSync
--- /dev/null
+
+Nothing as of now.
--- /dev/null
+#!/usr/bin/perl
+#
+# ftpsync.pl
+#
+# See attached README file for any details, or call
+# ftpsync.pl -h
+# for quick start.
+#
+# LICENSE
+#
+# FTPSync.pl (ftpsync) is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# FTPSync.pl (ftpsync) is also eMail-Ware, which means that the initial author
+# (Christoph Lechleitner) would like to get an eMail at ftpsync@ibcl.at, if
+# - if anyone uses the script on production level,
+# - if anyone distributes or advertises it in any way,
+# - if anyone starts to (try to) improve it.
+#
+#
+################################################################################
+
+#
+# Options etc.
+#
+#print "Starting imports.\n"; # For major problem debugging
+printf STDERR "argv=@ARGV\n";
+
+use File::Find;
+use File::Listing;
+use Net::FTP;
+use strict;
+# flushing ...
+use IO::Handle;
+STDOUT->autoflush(1);
+STDERR->autoflush(1);
+
+sub dosync();
+sub print_syntax();
+sub print_options();
+sub buildremotetree();
+sub buildlocaltree();
+sub listremotedirs();
+sub parseRemoteURL();
+
+# Option Variables
+#print "Defining variables.\n"; # For major problem debugging
+# meta
+my $returncode=0;
+my $configfile=$ENV{"HOME"}."/.ftpsync";
+# basics
+my $localdir="";
+my $remoteURL="";
+my $syncdirection="";
+my $ftpuser="ftp";
+my $ftppasswd="anonymous";
+my $ftpserver="localhost";
+my $ftpdir="";
+my $ftptimeout=120;
+my $syncoff=0;
+# verbosity
+my $doverbose=1;
+my $dodebug=0;
+my $doquiet=0;
+my $doinfoonly=0;
+my $infotext="";
+my $docheckfirst=0;
+
+# Read command line options/parameters
+#print "Reading command line options.\n"; # For major problem debugging
+my $curopt;
+my @cloptions=();
+for $curopt (@ARGV) {
+ if ($curopt =~ /^cfg=/) {
+ $configfile=$';
+ if (! -r $configfile) { print "Config file does not exist: ".$configfile."\n"; $returncode+=1; }
+ } else {
+ push @cloptions, $curopt;
+ }
+}
+
+# Read Config File, if given
+my @cfgfoptions=();
+if ($configfile ne "") {
+ if (-r $configfile) {
+ #print "Reading config file.\n"; # For major problem debugging
+ open (CONFIGFILE,"<$configfile");
+ while (<CONFIGFILE>) {
+ $_ =~ s/([ \n\r]*$|\.\.|#.*$)//gs;
+ if ($_ eq "") { next; }
+ if ( ($_ =~ /[^=]+=[^=]+/) || ($_ =~ /^-[a-zA-Z]+$/) ) { push @cfgfoptions, $_; }
+ }
+ close (CONFIGFILE);
+ } # else { print "Config file does not exist.\n"; } # For major problem debugging
+} # else { print "No config file to read.\n"; } # For major problem debugging
+
+# Parse Options/Parameters
+print "Parsing all options.\n"; # For major problem debugging
+my $noofopts=0;
+for $curopt (@cfgfoptions, @cloptions) {
+ if ($curopt =~ /^-[a-zA-Z]/) {
+ my $i;
+ for ($i=1; $i<length($curopt); $i++) {
+ my $curoptchar=substr($curopt,$i,1);
+ $noofopts++;
+ if ($curoptchar =~ /[cC]/) { $docheckfirst=1; }
+ elsif ($curoptchar =~ /[dD]/) { $dodebug=1; $doverbose=1; $doquiet=0; }
+ elsif ($curoptchar =~ /[gG]/) { $syncdirection="get"; }
+ elsif ($curoptchar =~ /[hH?]/) { print_syntax(); exit 0; }
+ elsif ($curoptchar =~ /[iI]/) { $doinfoonly=1; }
+ elsif ($curoptchar =~ /[pP]/) { $syncdirection="put"; }
+ elsif ($curoptchar =~ /[qQ]/) { $dodebug=0; $doverbose=0; $doquiet=1; }
+ elsif ($curoptchar =~ /[vV]/) { $doverbose++; }
+ else { print "ERROR: Unknown option: \"-".$curoptchar."\"\n"; $returncode+=1; }
+ }
+ }
+ elsif ($curopt =~ /^ftp:\/\/(([^@\/\\\:]+)(:([^@\/\\\:]+))?@)?([a-zA-Z01-9\.]+)\/(.*)/) {
+ $remoteURL = $curopt;
+ parseRemoteURL();
+ if ( $syncdirection eq "" )
+ { $syncdirection="get"; }
+ }
+ elsif ($curopt =~ /^[a-z]+=.+/) {
+ my ($fname, $fvalue) = split /=/, $curopt, 2;
+ if ($fname eq "cfg") { next; }
+ elsif ($fname eq "ftpdir") { $ftpdir =$fvalue;
+ if ($ftpdir ne "/") { $ftpdir=~s/\/$//; }
+ if ( $syncdirection eq "" ) { $syncdirection="get"; }
+ }
+ elsif ($fname =~ m/ftppass(w(or)?d)?/i)
+ { $ftppasswd=$fvalue;
+ if ( $syncdirection eq "" ) { $syncdirection="get"; }
+ }
+ elsif ($fname eq "ftpserver") { $ftpserver =$fvalue;
+ if ( $syncdirection eq "" ) { $syncdirection="get"; }
+ }
+ elsif ($fname eq "ftpuser") { $ftpuser =$fvalue;
+ if ( $syncdirection eq "" ) { $syncdirection="get"; }
+ }
+ elsif ($fname eq "localdir") { $localdir =$fvalue; $localdir=~s/\/$//;
+ if ( $syncdirection eq "" ) { $syncdirection="put"; }
+ }
+ elsif ($fname eq "timeout") { if ($fvalue>0) { $ftptimeout =$fvalue; } }
+ }
+ else {
+ if ($localdir eq "") {
+ $localdir = $curopt;
+ if ( $syncdirection eq "" )
+ { $syncdirection="put"; }
+ } else {
+ print "ERROR: Unknown parameter: \"".$curopt."\"\n"; $returncode+=1
+ }
+ }
+}
+if ($noofopts == 0) { print_syntax(); exit 0; }
+
+if($ftpuser eq "?") { print "User: "; $ftpuser=<STDIN>; chomp($ftpuser); }
+if($ftppasswd eq "?") { print "Password: "; $ftppasswd=<STDIN>; chomp($ftppasswd); }
+
+if ($dodebug) { print_options(); }
+# check options
+if ( ($localdir eq "") || (! -d $localdir) )
+{ print "ERROR: Local directory does not exist: ".$localdir."\n"; $returncode+=1; }
+#if ($localdir eq "") { print "ERROR: No localdir given.\n"; $returncode+=1; }
+#if ( ($remoteURL eq "") { print "ERROR: No remoteURL given.\n"; $returncode+=1; }
+if ($ftpserver eq "") { print "ERROR: No FTP server given.\n"; $returncode+=1; }
+if ($ftpdir eq "") { print "ERROR: No FTP directory given.\n"; $returncode+=1; }
+if ($ftpuser eq "") { print "ERROR: No FTP user given.\n"; $returncode+=1; }
+if ($ftppasswd eq "") { print "ERROR: No FTP password given.\n"; $returncode+=1; }
+if ($returncode > 0) { die "Aborting due to missing or wrong options! Call ftpsync -? for more information.\n"; }
+
+
+#print "Exiting.\n"; exit 0;
+
+if ($dodebug) { print "\nFind out if ftp server is online & accessible.\n"; }
+my $doftpdebug=($doverbose > 2);
+my $ftpc = Net::FTP->new($ftpserver,Debug=>$doftpdebug,Timeout=>$ftptimeout) || die "Could not connect to $ftpserver\n";
+if ($dodebug) { print "Logging in as $ftpuser with password $ftppasswd.\n" }
+$ftpc->login($ftpuser,$ftppasswd) || die "Could not login to $ftpserver as $ftpuser\n";
+my $ftpdefdir=$ftpc->pwd();
+if ($dodebug) { print "Remote directory is now ".$ftpdefdir."\n"; }
+if ($ftpdir !~ /^\//) # insert remote login directory into relative ftpdir specification
+{ if ($ftpdefdir eq "/")
+ { $ftpdir = $ftpdefdir . $ftpdir; }
+ else
+ { $ftpdir = $ftpdefdir . "/" . $ftpdir; }
+ if (!$doquiet)
+ { print "Absolute remote directory is $ftpdir\n"; }
+}
+if (substr($ftpdir, -1) eq "/") {
+ if (!$doquiet)
+ { print " Remote directory ends in /, removing this\n"; }
+ chop($ftpdir);
+}
+if ($dodebug) { print "Changing to remote directory $ftpdir.\n" }
+$ftpc->binary()
+ or die "Cannot set binary mode :\n\t" . $ftpc->message;
+$ftpc->cwd($ftpdir)
+ or die "Cannot cwd to $ftpdir :\n\t" . $ftpc->message;
+if ($ftpc->pwd() ne $ftpdir) {
+ my $pwd = $ftpc->pwd();
+ die "Could not change to remote base directory $ftpdir (at $pwd)\n"; }
+if ($dodebug) { print "Remote directory is now ".$ftpc->pwd()."\n"; }
+
+if (! $doquiet) { print "\nDetermine s offset.\n"; }
+if ($syncdirection eq "put") { clocksync($ftpc,"syncfile"); }
+
+# local & remote tree vars
+#chdir $localdir;
+my $ldl=length($localdir) + 1;
+#my $ldl=length($localdir);
+my %localfiledates=();
+my %localfilesizes=();
+my %localdirs=();
+my %locallinks=();
+
+my %remotefilesizes=();
+my %remotefiledates=();
+my %remotedirs=();
+my %remotelinks=();
+my $curremotesubdir="";
+
+# Build local & remote tree
+if (! $doquiet) { print "\nBuilding local file tree.\n"; }
+buildlocaltree();
+if (! $doquiet) { print "\nBuilding remote file tree.\n"; }
+buildremotetree();
+listremotedirs();
+#if ($dodebug) { print "Quitting FTP connection.\n" }
+#$ftpc->quit();
+
+#print "Exiting.\n"; exit 0;
+
+# Work ...
+if ($doinfoonly) { $docheckfirst=0; }
+if ($docheckfirst)
+{ print "Simulating synchronization.\n";
+ $doinfoonly=1;
+ dosync();
+ $doinfoonly=0;
+ print "\nOK to really update files? (y/n) [n] ";
+ my $yn=<STDIN>;
+ if ($yn =~ /^y/i)
+ { print "OK, going to do it.\n";
+ }
+ else
+ { print "OK, exiting without actions.\n";
+ exit 1;
+ }
+}
+if ($doinfoonly) { print "\nSimulating synchronization.\n"; }
+elsif (! $doquiet) { print "\nStarting synchronization.\n"; }
+dosync();
+
+if (!$doquiet) { print "Done.\n"; }
+
+if ($dodebug) { print "Quitting FTP connection.\n" }
+$ftpc->quit();
+
+exit 0;
+
+
+
+#
+# Subs
+#
+
+sub buildlocaltree() {
+ find (\¬icelocalfile, $localdir."/");
+ sub noticelocalfile {
+ if ($ldl > length($File::Find::name)) { return; }
+ #printf "name=%s, length(name)=%d, ldl=$ldl\n", $File::Find::name, length($File::Find::name);
+ my $relfilename=substr($File::Find::name,$ldl);
+ if (length($relfilename) == 0) { return; }
+ if (-d $_) {
+ if ($dodebug) { print "Directory: ".$File::Find::name."\n"; }
+ elsif (! $doquiet) { print ":"; }
+ $localdirs{$relfilename}="$relfilename";
+ }
+ elsif (-f $_) {
+ #my @curfilestat=lstat $File::Find::name;
+ my @curfilestat=lstat $_;
+ my $curfilesize=$curfilestat[7];
+ my $curfilemdt=$curfilestat[9];
+ if ($dodebug) { print "File: ".$File::Find::name."\n";
+ print "Modified ".$curfilemdt."\nSize ".$curfilesize." bytes\n"; }
+ elsif (! $doquiet) { print "."; }
+ $localfiledates{$relfilename}=$curfilemdt;
+ $localfilesizes{$relfilename}=$curfilesize;
+ }
+ elsif (-l $_) {
+ if ($dodebug) { print "Link: ".$File::Find::name."\n"; }
+ elsif (! $doquiet) { print ","; }
+ $locallinks{$relfilename}="$relfilename";
+ } else {
+ #print "u ".$File::Find::name."\n";
+ if (! $doquiet) { print "Ignoring file of unknown type: ".$File::Find::name."\n"; }
+ }
+ #if (! ($doquiet || $dodebug)) { print "\n"; }
+ #print "File mode is ".@curfilestat[2]."\n";
+ }
+ if ($dodebug) {
+ print "Local dirs (relative to ".$localdir."/):\n";
+ my $curlocaldir="";
+ foreach $curlocaldir (keys(%localdirs))
+ { print $curlocaldir."/\n"; }
+ print "Local files (relative to ".$localdir."/):\n";
+ my $curlocalfile="";
+ foreach $curlocalfile (keys(%localfiledates))
+ { print $curlocalfile."\n"; }
+ }
+}
+
+
+sub buildremotetree() {
+ my @currecursedirs=();
+ #$ftpc->ls()
+ # or die $ftpc->message . "\nCannot ls remote dir " . $ftpc->pwd();
+ my @rfl = $ftpc->dir();
+ # or @rfl=(); # we have to survive empty remote directories !!!
+ my $currf="";
+ my $curyear = (gmtime(time))[5] + 1900;
+ my %monthtonr=();
+ $monthtonr{"Jan"}=1; $monthtonr{"Feb"}=2; $monthtonr{"Mar"}=3; $monthtonr{"Apr"}=4; $monthtonr{"May"}=5; $monthtonr{"Jun"}=6;
+ $monthtonr{"Jul"}=7; $monthtonr{"Aug"}=8; $monthtonr{"Sep"}=9; $monthtonr{"Oct"}=10; $monthtonr{"Nov"}=11; $monthtonr{"Dec"}=12;
+ if ($dodebug) { print "Remote pwd is ".$ftpc->pwd()."\nDIRing.\n"; }
+ my $curlsline;
+ foreach $curlsline (parse_dir(\@rfl)) {
+ my ($cfname,$cftype,$cfsize,$cftime,$mode)=@$curlsline;
+ #if ($dodebug) { print "Analysing remote file/dir ".$currf."\n" };
+ if ( $cftype ) {
+ if ($cfname eq ".") { next; }
+ if ($cfname eq "..") { next; }
+ if (substr($cftype,0,1) eq 'l') { # link, rest of string = linkto
+ my $curnrl;
+ if ($curremotesubdir eq "") { $curnrl = $cfname; }
+ else { $curnrl = $curremotesubdir."/".$cfname; }
+ $remotelinks{$curnrl}=$cfname;
+ if ($dodebug) { print "Link: ".$curnrl." -> ".$cfname."\n"; }
+ }
+ elsif ($cftype eq 'd') {
+ my $curnewrsd;
+ if ($curremotesubdir eq "") { $curnewrsd = $cfname; }
+ else { $curnewrsd = $curremotesubdir."/".$cfname; }
+ $remotedirs{$curnewrsd}=$curnewrsd;
+ if ($dodebug) { print "Directory: ".$curnewrsd."\n"; }
+ elsif (! $doquiet) { print ":"; }
+ push @currecursedirs, $cfname;
+ }
+ elsif ($cftype eq 'f') { #plain file
+ my $curnewrf;
+ if ($curremotesubdir eq "") { $curnewrf = $cfname; }
+ else { $curnewrf = $curremotesubdir."/".$cfname; }
+ #$remotefiledates{$curnewrf}=$cftime;
+ $remotefiledates{$curnewrf}=$ftpc->mdtm($cfname)+$syncoff;
+ if ($remotefiledates{$curnewrf} le 0) { die "Timeout detecting modification time of $curnewrf\n"; }
+ $remotefilesizes{$curnewrf}=$cfsize;
+ if ($remotefilesizes{$curnewrf} lt 0) { die "Timeout detecting size of $curnewrf\n"; }
+ if ($dodebug) { print "File: ".$curnewrf."\n"; }
+ elsif (! $doquiet) { print "."; }
+ }
+ elsif (! $doquiet) { print "Unkown file: $curlsline\n"; }
+ }
+ elsif ($dodebug) { print "Ignoring.\n"; }
+ }
+ #recurse
+ my $currecurseddir;
+ foreach $currecurseddir (@currecursedirs)
+ { my $oldcurremotesubdir;
+ $oldcurremotesubdir=$curremotesubdir;
+ if ($curremotesubdir eq "") { $curremotesubdir = $currecurseddir; }
+ else { $curremotesubdir .= "/".$currecurseddir; }
+ my $curcwddir="";
+ if ($ftpdir eq "/")
+ { $curcwddir=$ftpdir.$curremotesubdir; }
+ else
+ { $curcwddir=$ftpdir."/".$curremotesubdir; }
+ if ($dodebug) { print "Change dir: ".$curcwddir."\n"; }
+ $ftpc->cwd($curcwddir)
+ or die "Cannot cwd to $curcwddir :\n\t" . $ftpc->message ;
+ if ($ftpc->pwd() ne $curcwddir) {
+ die "Could not cwd to $curcwddir :\n\t" . $ftpc->message ; }
+ if (! $doquiet) { print "\n"; }
+ buildremotetree();
+ $ftpc->cdup();
+ $curremotesubdir = $oldcurremotesubdir;
+ }
+}
+
+
+# Synchronize clocks.
+sub clocksync {
+ my $conn = shift @_;
+ my $fn = shift @_;
+ my $fndidexist=1;
+
+ if(! -f $fn) {
+ open(SF, ">$fn") or die "Cannot create $fn for time sync option";
+ close(SF);
+ $fndidexist=0;
+ }
+ -z $fn or
+ die "File $fn for time sync must be empty.";
+ my $putsyncok=1;
+ $conn->put($fn) or $putsyncok=0;
+ if (!$putsyncok)
+ { unlink($fn); # cleanup!
+ die "Cannot send timesync file $fn";
+ }
+
+ my $now_here1 = time();
+ my $now_there = $conn->mdtm($fn) or
+ die "Cannot get write time of timesync file $fn";
+ my $now_here2 = time();
+
+ if ($now_here2 < $now_there) # remote is in the future
+ { $syncoff=($now_there - $now_here1);
+ $syncoff -= $syncoff % 60;
+ $syncoff = 0-$syncoff;
+ }
+ else
+ #if ($now_here1 > $now_there) # remote is the past # or equal
+ { $syncoff=($now_here2 - $now_there);
+ $syncoff -= $syncoff % 60;
+ }
+
+ $conn->delete($fn);
+
+ my $hrs = int(abs($syncoff)/3600);
+ my $mins = int(abs($syncoff)/60) - $hrs*60;
+ my $secs = abs($syncoff) - $hrs*3600 - $mins*60;
+ if (! $doquiet) {
+ printf("Clock sync offset: %d:%02d:%02d\n", $hrs, $mins, $secs);
+ }
+ unlink ($fn) unless $fndidexist;
+}
+
+
+sub dosync()
+{
+ chdir $localdir || die "Could not change to local base directory $localdir\n";
+ if ($syncdirection eq "put") {
+ # create dirs missing at the target
+ if ($doinfoonly) { print "\nWould create new remote directories.\n"; }
+ elsif (! $doquiet) { print "\nCreating new remote directories.\n"; }
+ my $curlocaldir;
+ foreach $curlocaldir (sort { return length($a) <=> length($b); } keys(%localdirs))
+ { if (! exists $remotedirs{$curlocaldir})
+ { if ($doinfoonly) { print $curlocaldir."\n"; next; }
+ if ($doverbose) { print $curlocaldir."\n"; }
+ elsif (! $doquiet) { print "d"; }
+ if ($ftpc->mkdir($curlocaldir) ne $curlocaldir) { die "Could not create remote subdirectory $curlocaldir\n"; }
+ }
+ }
+ # copy files missing or too old at the target, synchronize timestamp _after_ copying
+ if ($doinfoonly) { print "\nWould copy new(er) local files.\n"; }
+ elsif (! $doquiet) { print "\nCopying new(er) local files.\n"; }
+ my $curlocalfile;
+ foreach $curlocalfile (sort { return length($b) <=> length($a); } keys(%localfiledates))
+ { my $dorefresh=0;
+ if (! exists $remotefiledates{$curlocalfile}) {
+ $dorefresh=1;
+ $infotext="New: ".$curlocalfile." (".$localfilesizes{$curlocalfile}." bytes)\n";
+ if ($doinfoonly) { print $infotext; next; }
+ elsif ($doverbose) { print $infotext; }
+ elsif (! $doquiet) { print "n"; }
+ }
+ elsif ($remotefiledates{$curlocalfile} < $localfiledates{$curlocalfile}) {
+ $dorefresh=1;
+ $infotext="Newer: ".$curlocalfile." (".$localfilesizes{$curlocalfile}." bytes, ".$localfiledates{$curlocalfile}." versus ".$remotefiledates{$curlocalfile}.")\n";
+ if ($doinfoonly) { print $infotext; next; }
+ if ($doverbose) { print $infotext; }
+ elsif (! $doquiet) { print "u"; }
+ }
+ elsif ($remotefilesizes{$curlocalfile} != $localfilesizes{$curlocalfile}) {
+ $dorefresh=1;
+ $infotext="Changed (different sized): ".$curlocalfile." (".$localfilesizes{$curlocalfile}." versus ".$remotefilesizes{$curlocalfile}." bytes)\n";
+ if ($doinfoonly) { print $infotext; next; }
+ if ($doverbose) { print $infotext; }
+ elsif (! $doquiet) { print "u"; }
+ }
+ if (! $dorefresh) { next; }
+ if ($dodebug) { print "Really PUTting file ".$curlocalfile."\n"; }
+ if ($ftpc->put($curlocalfile, $curlocalfile) ne $curlocalfile)
+ { print STDERR "Could not put localfile $curlocalfile\n"; }
+ my $retries = 3;
+ while ( ($ftpc->size($curlocalfile) != (lstat $curlocalfile)[7]) and ($retries-- > 0) )
+ { if (! $doquiet) { print "Re-Transfering $curlocalfile\n"; }
+ if ($ftpc->put($curlocalfile, $curlocalfile) ne $curlocalfile)
+ { print STDERR "Could not re-put localfile $curlocalfile\n"; }
+ }
+ my $newremotemdt=$ftpc->mdtm($curlocalfile)+$syncoff;
+ utime ($newremotemdt, $newremotemdt, $curlocalfile);
+ }
+ # delete files too much at the target
+ if ($doinfoonly) { print "\nWould delete obsolete remote files.\n"; }
+ elsif (! $doquiet) { print "\nDeleting obsolete remote files.\n"; }
+ my $curremotefile;
+ foreach $curremotefile (keys(%remotefiledates))
+ { if (not exists $localfiledates{$curremotefile})
+ { if ($doinfoonly) { print $curremotefile."\n"; next; }
+ if ($doverbose) { print $curremotefile."\n"; }
+ elsif (! $doquiet) { print "r"; }
+ if ($ftpc->delete($curremotefile) ne 1) { die "Could not delete remote file $curremotefile\n"; }
+ }
+ }
+ # delete dirs too much at the target
+ if ($doinfoonly) { print "\nWould delete obsolete remote directories.\n"; }
+ elsif (! $doquiet) { print "\nDeleting obsolete remote directories.\n"; }
+ my $curremotedir;
+ foreach $curremotedir (sort { return length($b) <=> length($a); } keys(%remotedirs))
+ { if (! exists $localdirs{$curremotedir})
+ { if ($doinfoonly) { print $curremotedir."\n"; next; }
+ if ($doverbose) { print $curremotedir."\n"; }
+ elsif (! $doquiet) { print "R"; }
+ if ($ftpc->rmdir($curremotedir) ne 1) { die "Could not remove remote subdirectory $curremotedir\n"; }
+ }
+ }
+ } else { # $syncdirection eq "GET"
+ # create dirs missing at the target
+ if ($doinfoonly) { print "\nWould create new local directories.\n"; }
+ elsif (! $doquiet) { print "\nCreating new local directories.\n"; }
+ my $curremotedir;
+ foreach $curremotedir (sort { return length($a) <=> length($b); } keys(%remotedirs))
+ { if (! exists $localdirs{$curremotedir})
+ { if ($doinfoonly) { print $curremotedir."\n"; next; }
+ if ($doverbose) { print $curremotedir."\n"; }
+ elsif (! $doquiet) { print "d"; }
+ mkdir($curremotedir) || die "Could not create local subdirectory $curremotedir\n";
+ }
+ }
+ # copy files missing or too old at the target, synchronize timestamp _after_ copying
+ if ($doinfoonly) { print "\nWould copy new(er) remote files.\n"; }
+ elsif (! $doquiet) { print "\nCopying new(er) remote files.\n"; }
+ my $curremotefile;
+ foreach $curremotefile (sort { return length($b) <=> length($a); } keys(%remotefiledates))
+ { my $dorefresh=0;
+ if (! exists $localfiledates{$curremotefile}) {
+ $dorefresh=1;
+ $infotext="New: ".$curremotefile." (".$remotefilesizes{$curremotefile}." bytes)\n";
+ if ($doinfoonly) { print $infotext; next; }
+ if ($doverbose) { print $infotext; }
+ elsif (! $doquiet) { print "n"; }
+ }
+ elsif ($remotefiledates{$curremotefile} > $localfiledates{$curremotefile}) {
+ $dorefresh=1;
+ $infotext="Newer: ".$curremotefile." (".$remotefilesizes{$curremotefile}." bytes, ".$remotefiledates{$curremotefile}." versus ".$localfiledates{$curremotefile}.")\n";
+ if ($doinfoonly) { print $infotext; next; }
+ if ($doverbose) { print $infotext; }
+ elsif (! $doquiet) { print "u"; }
+ }
+ elsif ($remotefilesizes{$curremotefile} != $localfilesizes{$curremotefile}) {
+ $dorefresh=1;
+ $infotext="Changed (different sized): ".$curremotefile." (".$remotefilesizes{$curremotefile}." bytes)\n";
+ if ($doinfoonly) { print $infotext; next; }
+ if ($doverbose) { print $infotext; }
+ elsif (! $doquiet) { print "c"; }
+ }
+ if (! $dorefresh) { next; }
+ if ($dodebug) { print "Really GETting file ".$curremotefile."\n"; }
+ my $rc=$ftpc->get($curremotefile, $curremotefile);
+ if ( ($rc eq undef) or ($rc ne $curremotefile) )
+ { print STDERR "Could not get file ".$curremotefile."\n"; }
+ my $retries=3;
+ while ( ($ftpc->size($curremotefile) != (lstat $curremotefile)[7]) and ($retries-- > 0) )
+ { if (! $doquiet) { print "Re-Transfering $curremotefile\n"; }
+ if ( ($rc eq undef) or ($rc ne $curremotefile) )
+ { print STDERR "Could not get file ".$curremotefile."\n"; }
+ }
+ my $newlocalmdt=$remotefiledates{$curremotefile};
+ utime ($newlocalmdt, $newlocalmdt, $curremotefile);
+ }
+ # delete files too much at the target
+ if ($doinfoonly) { print "\nWould delete obsolete local files.\n"; }
+ elsif (! $doquiet) { print "\nDeleting obsolete local files.\n"; }
+ my $curlocalfile;
+ foreach $curlocalfile (sort { return length($b) <=> length($a); } keys(%localfiledates))
+ { if (not exists $remotefiledates{$curlocalfile})
+ { if ($doinfoonly) { print $curlocalfile."\n"; next; }
+ if ($doverbose) { print $curlocalfile."\n"; }
+ elsif (! $doquiet) { print "r"; }
+ if (unlink($curlocalfile) ne 1) { die "Could not remove local file $curlocalfile\n"; }
+ }
+ }
+ # delete dirs too much at the target
+ if ($doinfoonly) { print "\nWould delete obsolete local directories.\n"; }
+ elsif (! $doquiet) { print "\nDeleting obsolete local directories.\n"; }
+ my $curlocaldir;
+ foreach $curlocaldir (keys(%localdirs))
+ { if (! exists $remotedirs{$curlocaldir})
+ { if ($doinfoonly) { print $curlocaldir."\n"; next; }
+ if ($doverbose) { print $curlocaldir."\n"; }
+ elsif (! $doquiet) { print "d"; }
+ rmdir($curlocaldir) || die "Could not remove local subdirectory $curlocaldir\n";
+ }
+ }
+ }
+}
+
+
+sub listremotedirs() {
+ if ($dodebug) {
+ print "Remote dirs (relative to ".$ftpdir."):\n";
+ my $curremotedir="";
+ foreach $curremotedir (keys(%remotedirs))
+ { print $curremotedir."/\n"; }
+ print "Remote files (relative to ".$ftpdir."):\n";
+ my $curremotefile="";
+ foreach $curremotefile (keys(%remotefiledates))
+ { print $curremotefile."\n"; }
+ print "Remote links (relative to ".$ftpdir."):\n";
+ my $curremotelink="";
+ foreach $curremotelink (keys(%remotelinks))
+ { print $curremotelink." -> ".$remotelinks{$curremotelink}."\n"; }
+ }
+}
+sub parseRemoteURL() {
+ if ($remoteURL =~ /^ftp:\/\/(([^@\/\\\:]+)(:([^@\/\\\:]+))?@)?([a-zA-Z01-9\.]+)\/(.*)/) {
+ #print "DEBUG: parsing ".$remoteURL."\n";
+ #print "match 1 = ".$1."\n";
+ #print "match 2 = ".$2."\n";
+ #print "match 3 = ".$3."\n";
+ #print "match 4 = ".$4."\n";
+ #print "match 5 = ".$5."\n";
+ #print "match 6 = ".$6."\n";
+ #print "match 7 = ".$7."\n";
+ if (length($2) > 0) { $ftpuser=$2; }
+ if (length($4) > 0) { $ftppasswd=$4; }
+ $ftpserver=$5;
+ $ftpdir=$6;
+ #if ($ftpdir eq "") { $ftpdir="/"; }
+ }
+}
+
+
+sub print_syntax() {
+ print "\n";
+ print "FTPSync.pl 1.27 (2004-08-23)\n";
+ print "\n";
+ print " ftpsync [ options ] [ localdir remoteURL ]\n";
+ print " ftpsync [ options ] [ remoteURL localdir ]\n";
+ print " options = [-dgpqv] [ cfg|ftpuser|ftppasswd|ftpserver|ftpdir=value ... ] \n";
+ print " localdir local directory, defaults to \".\".\n";
+ print " ftpURL full FTP URL, scheme\n";
+ print ' ftp://[ftpuser[:ftppasswd]@]ftpserver/ftpdir'."\n";
+ print " ftpdir is relative, so double / for absolute paths as well as /\n";
+ print " -c | -C like -i, but then prompts whether to actually do work\n";
+ print " -d | -D turns debug output (including verbose output) on\n";
+ print " -g | -G forces sync direction to GET (remote to local)\n";
+ print " -h | -H turns debugging on\n";
+ print " -i | -I forces info mode, only telling what would be done\n";
+ print " -p | -P forces sync direction to PUT (local to remote)\n";
+ print " -q | -Q turnes quiet operation on\n";
+ print " -v | -V turnes verbose output on\n";
+ print " cfg= read parameters and options from file defined by value.\n";
+ print " ftpserver= defines the FTP server, defaults to \"localhost\".\n";
+ print " ftpdir= defines the FTP directory, defaults to \".\" (/wo '\"') \n";
+ print " ftpuser= defines the FTP user, defaults to \"ftp\".\n";
+ print " ftppasswd= defines the FTP password, defaults to \"anonymous\".\n";
+ print "\n";
+ print " Later mentioned options and parameters overwrite those mentioned earlier.\n";
+ print " Command line options and parameters overwrite those in the config file.\n";
+ print " Don't use '\"', although mentioned default values might motiviate you to.\n";
+ print "\n";
+}
+
+
+sub print_options() {
+ print "\nPrinting options:\n";
+ # meta
+ print "returncode = ", $returncode , "\n";
+ print "configfile = ", $configfile , "\n";
+ # basiscs
+ print "syncdirection = ", $syncdirection , "\n";
+ print "localdir = ", $localdir , "\n";
+ # FTP stuff
+ print "remoteURL = ", $remoteURL , "\n";
+ print "ftpuser = ", $ftpuser , "\n";
+ print "ftppasswd = ", $ftppasswd , "\n";
+ print "ftpserver = ", $ftpserver , "\n";
+ print "ftpdir = ", $ftpdir , "\n";
+ # verbsityosity
+ print "doverbose = ", $doverbose , "\n";
+ print "dodebug = ", $dodebug , "\n";
+ print "doquiet = ", $doquiet , "\n";
+ #
+ print "doinfoonly = ", $doinfoonly , "\n";
+ print "\n";
+}
--- /dev/null
+;;; html-wtoc.el --- Creating pages with site TOC
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Sat Feb 11 00:06:14 2006
+(defconst html-wtoc:version "0.2") ;; Version:
+;; Last-Updated: Sun Nov 04 21:49:34 2007 (3600 +0100)
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (add-to-list 'load-path default-directory load-path))
+(eval-when-compile (require 'html-site nil t))
+
+;;;###autoload
+(defgroup html-wtoc nil
+ "Customization group for html-wtoc."
+ :group 'nxhtml)
+
+(defcustom html-wtoc-dir
+ (file-name-as-directory
+ (expand-file-name
+ "html-wtoc"
+ (file-name-directory
+ (if load-file-name load-file-name buffer-file-name))))
+
+ "Directory where the tools needed are located.
+The tools for html-wtoc includes:
+
+- html-wtoc.pl
+- html-wtoc.js
+- html-wtoc.css
+- html-wtoc-template.htm
+- html-wtoc-template.js
+- html-wtoc-template.css
+- img/
+
+"
+ :type 'directory
+ :group 'html-wtoc)
+
+;; (defun html-wtoc-get-parsed-html-toc ()
+;; (save-excursion
+;; (let ((toc-file (html-toc-file)))
+;; (unless (file-exists-p toc-file)
+;; (html-toc-write-toc-file))
+;; (with-current-buffer (find-file-noselect toc-file)
+;; (goto-char (point-min))
+;; (let ((toc-begin (search-forward html-toc-mark-begin nil t))
+;; (toc-middle (search-forward html-toc-mark-middle nil t))
+;; toc-parsed)
+;; (unless (and toc-begin toc-middle)
+;; (error "Can't find table of contents in %s" toc-file))
+;; (setq toc-parsed (html-toc-parse-toc
+;; (buffer-substring-no-properties
+;; toc-begin toc-middle))))))))
+
+;; (defun html-wtoc-get-atags (parsed-ul level)
+;; (assert (eq 'ul (car parsed-ul)))
+;; (let (atags)
+;; (dolist (l parsed-ul)
+;; (when (and (listp l)
+;; (eq 'li (car l)))
+;; (dolist (ll l)
+;; (when (listp ll)
+;; (when (eq 'a (car ll))
+;; (setq atags
+;; (cons
+;; (list level
+;; (caddr ll)
+;; (cdaadr ll))
+;; atags)))
+;; (when (eq 'ul (car ll))
+;; (let ((subs (html-wtoc-get-atags ll (1+ level))))
+;; (dolist (s subs)
+;; (setq atags (cons s atags)))))))))
+;; (reverse atags)))
+
+;; (defcustom html-wtoc-pages-default-name "html-wtoc-pages.txt"
+;; "Default file name sans directory for list of pages file.
+;; This file is located in the same directory as `html-toc-file'."
+;; :type 'string)
+
+;; (defun html-wtoc-pages-file ()
+;; (expand-file-name html-wtoc-pages-default-name
+;; (file-name-directory (html-toc-file))))
+
+(defun html-wtoc-browse-page-with-toc ()
+ (interactive)
+ (unless buffer-file-name
+ (error "This buffer is not visiting a file"))
+ (html-site-current-ensure-site-defined)
+ (let ((merge-dir (html-site-current-merge-dir))
+ merged-file
+ (in-site (html-site-dir-contains
+ (html-site-current-site-dir)
+ buffer-file-name)))
+ (unless merge-dir
+ (error "There is no output dir for pages with TOC defined for the site %s"
+ html-site-current))
+ (unless in-site
+ (error "This buffer's file is not in %s" (html-site-current-site-dir)))
+ (setq merged-file
+ (expand-file-name
+ (file-relative-name buffer-file-name
+ (html-site-current-site-dir))
+ (html-site-current-merge-dir)))
+ (unless (file-exists-p merged-file)
+ (error "The file %s does not yet exist.\nPlease do use `html-wtoc-write-merged' to create it."
+ merged-file))
+ (browse-url-of-file merged-file)))
+
+
+(defun html-wtoc-write-pages-with-toc (allow-overwrite)
+ "Merge the TOC with the pages.
+
+If an entry with the name MERGE-NAME exists in `html-wtoc-merges'
+then this is chosen. Otherwise a new entry is created and added
+to `html-wtoc-merges'. The entry has all necessary information to
+do the merge.
+
+If `html-move-site-directory' has a non-nil value then the list
+of completions when prompting for MERGE-NAME contains only those
+merge names from `html-wtoc-merges' where the site directory has
+the same value. Otherwise the completion list contains all merge
+names and `html-move-site-directory' will be set to the chosen
+merge's site directory.
+
+The merging of the pages and the table of contents is done in a
+subprocess using a Perl script named html-wtoc.pl the directory
+`html-wtoc-dir'.
+"
+ (interactive (list (y-or-n-p "Allow overwrite? ")))
+ (html-site-current-ensure-site-defined)
+ (let ((pag-file (html-site-current-page-list))
+ (out-dir (html-site-current-merge-dir))
+ (tpl-file (html-site-current-merge-template))
+ (html-wtoc-pl (expand-file-name "html-wtoc.pl" html-wtoc-dir))
+ )
+ (unless (< 0 (length pag-file))
+ (error "Page list file not defined for site %s" html-site-current))
+ (unless (file-exists-p pag-file)
+ (error "Can't find page file for site %s.\nHave you done M-x html-toc-create-pages-file?"
+ html-site-current))
+ (unless (< 0 (length tpl-file))
+ ;;(error "Template file not defined for site %s.\nPlease use customize to add this in `html-site-list'." html-site-current)
+ (setq tpl-file (expand-file-name "html-wtoc-template.html" html-wtoc-dir))
+ )
+ (let (
+ (buffer (noshell-procbuf-setup "*Merging pages and TOC*"))
+ (opt (list
+ (concat "pages=" pag-file)
+ (concat "outroot=" out-dir)
+ (concat "template=" tpl-file))))
+ (when allow-overwrite
+ (setq opt (cons "update=1" opt)))
+ (apply 'noshell-procbuf-run
+ buffer
+ "perl" "-w"
+ html-wtoc-pl "merge"
+ opt
+ ))))
+
+(provide 'html-wtoc)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; html-wtoc.el ends here
--- /dev/null
+# Copyright 2006 Lennart Borgman, http://OurComments.org/. All rights
+# reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; see the file COPYING. If not, write to the
+# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+# Boston, MA 02110-1301, USA.
+
+package PathSubs;
+
+#####################################################
+### This package contains general path handling
+### routines and some win32 specific dito.
+### The latter should ev be moved to a new module!
+#####################################################
+use strict;
+
+use File::Spec;
+
+### Absolute path names
+
+sub is_abs_path ($) {
+ my $path = shift;
+ return 0 if $path eq "";
+ return 1 if File::Spec->file_name_is_absolute($path);
+ #return 1 if substr($path, 1, 1) eq ":"; # MSWin32
+ #return 1 if substr($path, 0, 1) eq "/";
+ return 1 if $path =~ /^https?:/i;
+ return 1 if $path =~ /^file:/i;
+ return 1 if $path =~ /^javascript:/i;
+ return 1 if $path =~ /^mailto:/i;
+}
+sub is_abs_netpath($) {
+ my $path = shift;
+ return 1 if $path =~ /^https?:/i;
+ # New
+ return 1 if $path =~ /^ftp:/i;
+ return 1 if $path =~ /^mailto:/i;
+}
+
+
+sub uniq_file($) {
+ my $fname = shift;
+ $fname =~ s!^\s+|\s+$!!g;
+ return "" if ($fname eq "");
+ $fname = File::Spec->rel2abs($fname);
+ if (!File::Spec->file_name_is_absolute($fname)) {
+ die "File name is not absolute: $fname";
+ }
+ #print STDERR "uniq_file($fname)\n";
+ $fname =~ tr!\\!/!;
+ if (-e $fname) {
+ #print STDERR "exists $fname\n";
+ ### There is an error in 522, compensate for this!
+ #die substr($fname, -1);
+ if (substr($fname, -1) eq "/") { chop $fname; }
+ #print STDERR "exists $fname\n";
+ ### Translate ..
+ if (substr($fname, 1, 1) eq ":") {
+ my $ffname = Win32::GetFullPathName($fname);
+ ### Get case
+ my $lfname = Win32::GetLongPathName($ffname);
+ #print STDERR "lexists $lfname\n";
+ $fname = $lfname if ($lfname ne "");
+ }
+ } else {
+ #print STDERR "NOT exists $fname\n";
+ if (substr($fname, -1) eq "/") { chop $fname; }
+ my $head = "";
+ if (substr($fname, 0, 2) eq "//") {
+ $head = "//";
+ $fname = substr($fname, 2);
+ }
+ my @fname = split("/", $fname);
+ my $tail = pop @fname;
+ $fname = uniq_dir($head . join("/", @fname)) . $tail;
+ }
+ if (substr($fname, 1, 1) eq ":") {
+ $fname = uc(substr($fname, 0, 1)) . substr($fname, 1);
+ #print STDERR "fname $fname\n";
+ }
+ $fname =~ tr!\\!/!;
+ #print STDERR "fname ($fname)\n";
+ return $fname;
+}
+sub uniq_dir($) {
+ my $dir = shift;
+ my $uq_dir = uniq_file($dir);
+ if (substr($uq_dir, -1) ne "/") { $uq_dir .= "/"; }
+ return $uq_dir;
+}
+
+
+
+### Relative paths
+sub _get_link_root($) {
+ my $lnk = shift;
+ if ($lnk =~ m!^(/|ftp://[^/]*|https?://[^/]*|[a-z]:/)!i) {
+ return $1;
+ } else {
+ return "";
+ }
+}
+
+sub resolve_dotdot($) {
+ my $orig_url = shift;
+ my $root = _get_link_root($orig_url);
+ return $orig_url if length($root) == length($orig_url);
+ my $url = substr($orig_url, length($root));
+ if (substr($root, -1) eq "/") {
+ chop $root;
+ $url = "/$url";
+ }
+ #die "$root\n$url";
+ my $iPosSearch = 2;
+ #print "url=$url\n";
+ while ((my $iPos = index($url, "/../", $iPosSearch)) > -1) {
+ my $sLeft = substr($url, 0, $iPos);
+ if (substr($sLeft, -2) eq "..") {
+ $iPosSearch += 3;
+ next;
+ }
+ my $sRight = substr($url, $iPos+3);
+ #print "url=$url\n";
+ #print "iPos=$iPos\n";
+ #print "sLeft=$sLeft\n";
+ $sLeft =~ s!/[^/]*$!!;
+ #print "sLeft=$sLeft\n";
+ #print "sRight=$sRight\n";
+ $url = $sLeft . $sRight;
+ #print "\t***url=$url\n";
+ #print "url=$url\n";
+ }
+ if (index($url, "../") > -1) {
+ return $orig_url;
+ }
+ return $root . $url;
+}
+
+sub mk_relative_link($$;$) {
+ my $from = shift;
+ my $to = shift;
+ my $norm = shift;
+ if ($norm) {
+ $from = uniq_file($from);
+ $to = uniq_file($to);
+ }
+ if (-e $from) {
+ $from = uniq_file($from);
+ } else {
+ $from = resolve_dotdot($from);
+ }
+ if (-e $to) {
+ $to = uniq_file($to);
+ } else {
+ $to = resolve_dotdot($to);
+ }
+ my $root_from = _get_link_root($from);
+ my $root_to = _get_link_root($to );
+ if ($root_from ne $root_to) {
+ return $to;
+ }
+ my @from = split "/", $from;
+ my @to = split "/", $to;
+ while (@to) {
+ last if ($to[0] ne $from[0]);
+ shift @to;
+ shift @from;
+ }
+ if (@to == 1 && @from == 1) {
+ if (length($to[0]) > length($from[0])) {
+ if (substr($to[0], 0, length($from[0])+1) eq ($from[0] . "#")) {
+ return substr($to[0], length($from[0]));
+ }
+ }
+ }
+ my $rl;
+ for (1..$#from) { $rl .= "../"; }
+ $rl .= join("/", @to);
+
+ return $rl;
+}
+
+
+
+sub mk_absolute_link($$) {
+ my $from = shift;
+ my $rel_to = shift;
+ my $abs = $from;
+ $abs =~ s![^/]*$!!;
+ $abs .= $rel_to;
+ if (!is_abs_netpath($abs)) { $abs = uniq_file($abs); }
+ $abs;
+}
+
+
+1;
--- /dev/null
+# Copyright 2006 Lennart Borgman, http://OurComments.org/. All rights
+# reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; see the file COPYING. If not, write to the
+# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+# Boston, MA 02110-1301, USA.
+
+
+package html_tags;
+use strict;
+
+use vars qw($AUTOLOAD);
+
+sub _make_attributes {
+ my($self,$attr) = @_;
+ return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
+ my(@att);
+ foreach (keys %{$attr}) {
+ my($key) = $_;
+ $key=~s/^\-//; # get rid of initial - if present
+ #$key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes
+ $key=~tr/A-Z_/a-z-/; # parameters are lower case in XHTML
+ push(@att,defined($attr->{$_}) ? qq/$key="$attr->{$_}"/ : qq/$key/);
+ }
+ return @att;
+}
+
+sub _tag {
+ my $tag_name = shift;
+ my $part = shift;
+ my($attr) = '';
+ if (ref($_[0]) && ref($_[0]) eq 'HASH') {
+ my(@attr) = html_tags::_make_attributes( '',shift() );
+ $attr = " @attr" if @attr;
+ }
+ #return "<$tag_name$attr />" unless @_;
+ return "<$tag_name$attr />" if $part == 1;
+ return "<$tag_name$attr>" if $part == 2;
+ my($tag,$untag) = ("<$tag_name$attr\n>","</$tag_name\n>");
+ my @result = map { "$tag$_$untag" } (ref($_[0]) eq 'ARRAY') ? @{$_[0]} : "@_";
+ return $result[0] if $part == 1;
+ return "@result";
+}
+
+sub _mk_tag_sub($$) {
+ my $name = shift;
+ my $package = shift;
+ my $caller = caller;
+ my $sep = ($name =~ s/^\*//);
+ my $lc_name = lc $name;
+ my $code =
+ ($lc_name =~ m/^(?:br|hr|input|img)$/ ?
+ "sub $package\:\:$name(;\$\$) { return $caller\:\:_tag('$lc_name',1,\@_); }\n"
+ :
+ "sub $package\:\:$name(\$;\$) { return $caller\:\:_tag('$lc_name',0,\@_); }\n"
+ );
+ if ($sep) {
+ if ($lc_name eq "html") {
+ $code .= "sub $package\:\:start_$name(\$;\$\$)
+ {return $caller\:\:_start_html(\@_);}\n";
+ $code .= "sub $package\:\:end_$name {return $caller\:\:_end_html();}\n";
+ } else {
+ $code .= "sub $package\:\:start_$name(;\$\$)
+ {return $caller\:\:_tag('$lc_name',1,\@_);}\n";
+ $code .= "sub $package\:\:end_$name {'</$lc_name>';}\n";
+ }
+ }
+ $code;
+}
+sub _start_html {
+ my $title = shift;
+ my $head_tags = shift;
+ my $body_attr = shift;
+ # compensate for perl laziness... (will not detect undef sub)
+ $head_tags = $head_tags . _tag("title", 0, $title);
+ my $start =
+ _tag("html", 2) .
+ _tag("head", 0, $head_tags) .
+ _tag("body", 2, $body_attr);
+}
+sub _end_html {
+ return '</body></html>';
+}
+
+sub header(@) {
+ my @lines = @_;
+ my $header;
+ my $type;
+ while (@lines) {
+ my $key = shift @lines; my $value = shift @lines;
+ $header .= "$key: $value\n";
+ $type = $value if $key =~ m/content-type/i;
+ }
+ $header .= "Content-type: text/html\n" unless defined $type;
+ $header .= "\n";
+}
+sub import {
+ shift;
+ my %exported;
+ $exported{$_}++ for (@_);
+ my $caller = caller;
+ my $to_eval = "package $caller;\n";
+ for my $name (keys %exported) {
+ die "Will not redefine $caller\:\:$name" if $caller->can($name);
+ my $func;
+ if ($name eq "header") {
+ $func = "sub header { html_tags::header(); }";
+ }
+ $func = _mk_tag_sub($name, $caller) unless defined $func;
+ $to_eval .= "$func\n";
+ }
+ eval $to_eval;
+ die $@ if $@;
+}
+
+1;
--- /dev/null
+/* Main structures >>>>>>>>>>>>>>> */
+.html-wtoc-maintop {
+ font-size: 1px;
+ font-size: 1em;
+ margin-top: 0em;
+ margin-bottom: 0em;
+/* background-color:green; */
+}
+.html-wtoc-main {
+}
+
+td.html-wtoc-vdivline {
+ //background-color: #8be;
+ width: 0px;
+}
+
+.html-wtoc-search-form {
+ margin-bottom: 0.1em;
+}
+.html-wtoc-search {
+ font-size: 0.8em;
+ color: green;
+}
+.html-wtoc-search a {
+ color: green;
+}
+/* <<<<<<<<<<<<<<<<<<< */
+
+
+
+
+/* Table of content >>>>>>>>>>>>>> */
+
+#html-wtoc-id-hidetoc {
+ height: 20px;
+ border-bottom: 2px inset #ddf;
+ border-color: #dff;
+}
+
+#html-wtoc-id-tocdiv {
+ width: 2.5em;
+ //background-color: #eff;
+}
+#html-wtoc-id-logo {
+ width: 100%;
+ height: 120px;
+ padding: 0em;
+ margin: 0em;
+ border: 0em;
+}
+#html-wtoc-id-toc {
+}
+#html-wtoc-id-tocwidth {
+ width: 18em;
+ height: 0em;
+ padding: 0em;
+ margin: 0em;
+ border: 0em;
+ line-height: 0em;
+/* background-color: red; */
+}
+#html-wtoc-id-toccol {
+ width: 18em;
+}
+
+.html-wtoc-contcol {
+ background-color: #dFEfff;
+ background-color: #dFEfff;
+ background-color: #cd950c;
+ background-color: #eead0e;
+}
+/* <<<<<<<<<<<<<<<<<<< */
+
+
+
+
+/* Buttons etc >>>>>>>>>>>>>>> */
+.html-wtoc-button {
+ font-size: 0.75em;
+ font-size: 8pt;
+ color: #5A5D00;
+ background-color: #9cf;
+ background-color: #bcee68;
+ background-color: #a2cd5a;
+ padding: 0.2em;
+ Border-Width: 2px;
+ Border-Style: outset;
+ text-align: center;
+ border-color: #ddf;
+}
+a.html-wtoc-button {
+ text-decoration: none;
+ color: #5A5D00;
+}
+a.html-wtoc-button:hover {
+ text-decoration:none;
+ background-color: #6af;
+ color:#340;
+}
+
+a.html-wtoc-buttonimg img {
+ width: 16px;
+ height: 16px;
+ padding: 4px;
+ border: 8px;
+}
+a.html-wtoc-buttonimg {
+ border:2px;
+ margin:2px;
+ margin-left:2px;
+ margin-right:2px;
+}
+a.html-wtoc-buttonimg {
+ font-size:1px;
+}
+a.html-wtoc-buttonimg:hover {
+ margin: 6px;
+ margin-left:0px;
+ margin-right:0px;
+ border-color: #ddf;
+ border-width: 2px;
+ border-style: outset;
+ background-color: #595C00;
+ background-color: #bef;
+ background-color: #b9ffb9;
+}
+
+/* <<<<<<<<<<<<<<<<<<< */
+
+
+#nxhtml-link {
+ font-size: 0.7em;
+ text-align: center;
+ padding-top: 2em;
+ padding: 1em;
+}
+
+.copyright {
+ color : #872;
+}
+
--- /dev/null
+<?xml version="1.0"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>HEAD</title>
+ <link rel="stylesheet" href="html-wtoc.css" type="text/css" />
+ <link rel="stylesheet" href="html-wtoc-template.css" type="text/css" />
+ <script type="text/javascript" src="html-wtoc.js"></script>
+ <script type="text/javascript" src="html-wtoc-template.js"></script>
+ <script type="text/javascript">
+ var my_old_onload = window.onload;
+ function my_onload() {
+ HTML_WTOC_NS.onload_actions(%%PNUM%%);
+ if (undefined != my_old_onload) { my_old_onload(); }
+ }
+ window.onload = my_onload;
+ </script>
+
+ </head>
+<body>
+
+
+
+
+ <table summary="Page columns" cellspacing="0" border="0" cellpadding="0" width="100%" >
+ <tr valign="top">
+ <td id="html-wtoc-id-toccol" class="html-wtoc-contcol">
+ <table summary="Contents column" id="html-wtoc-id-toc" class="html-wtoc-contcol"
+ cellspacing="0" border="0" cellpadding="0" width="100%">
+ <tr valign="top">
+ <td colspan="2" height="50" >
+ <table summary="Contents displaying buttons" id="html-wtoc-id-hidetoc"
+ border="0" cellpadding="0" cellspacing="0" width="100%">
+ <tr>
+ <td width="70%">
+ <a href="javascript:HTML_WTOC_NS.show_content(0); void(0);"
+ class="html-wtoc-buttonimg"
+ ><img src="img/showCont.gif"
+ alt="Show table of content"
+ border="0" /></a>
+
+ <a style="display:none;"
+ href="javascript:toggle_toc_nailing()"
+ class="html-wtoc-buttonimg"
+ ><img id="html-wtoc-id-nailimg"
+ src="img/freeCont.gif"
+ alt="Let table of content move with page"
+ border="0" /></a>
+
+ </td>
+ </tr>
+ </table>
+ <table summary="Logo" id="html-wtoc-id-logo">
+ <tr>
+ <td align="right" valign="bottom" >
+ <a href="http://www.OurComments.org/Emacs/EmacsW32.html"
+ ><img src="img/gnu-m-x-160.png" width="80" height="80"
+ alt="Go to EmacsW32 Home Page"
+ title="Go to EmacsW32 Home Page"
+ onmouseover="transLbi(this, false);"
+ onmouseout ="transLbi(this, true);"
+ style="
+ margin-top:10px;
+ padding-left:20px;
+ padding-right:20px;
+ padding-top:10px;
+ padding-bottom:10px;
+ "
+ border="0"
+ /></a>
+ </td>
+ </tr>
+ </table>
+ </td>
+ </tr><tr valign="top">
+ <td >
+ <table>
+ <tr>
+ <td>%%TOC%%</td>
+ </tr>
+ <tr>
+ <td id="nxhtml-link">
+ <br />
+ Built using Emacs
+ <br />
+ with nxhtml from
+ <br />
+ <a href="http://ourcomments.org/Emacs/Emacs.html"
+ target="_blank">ourcomments.org</a>
+ </td>
+ </tr>
+ </table>
+ </td>
+ <td class="html-wtoc-vdivline" width="1"></td>
+ </tr><tr>
+ <td colspan="2">
+ </td>
+ </tr>
+ </table>
+ <table summary="Ensure table width"
+ cellspacing="0" id="html-wtoc-id-tocwidth"><tr><td></td></tr></table>
+ </td>
+ <td id="html-wtoc-id-tocdiv" ></td>
+ <td align="left" >
+ <table summary="Right column outermost"
+ cellspacing="0" border="0" cellpadding="0" width="100%">
+ <tr valign="top">
+ <td > </td>
+ <td align="left" class="html-wtoc-main">
+ <p class="html-wtoc-maintop">
+ <a href="javascript:HTML_WTOC_NS.show_content(1); void(0);"
+ id="html-wtoc-id-showtoc" style="display:none;"
+ class="html-wtoc-buttonimg"
+ ><img src="img/hideCont.gif"
+ alt="Hide table of content"
+ border="0"
+ /></a>
+
+ </p>
+ %%PAGE%%
+ <p> </p>
+ <!--
+ <hr style="clear:both" width="50%" class="copyright" />
+ <span class="copyright"
+ >
+ © Copyright 2006 OurComments.org,
+ <a href="http://www.OurComments.org/" target="_blank"
+ class="copyright"
+ >http://www.OurComments.org/</a>.
+ All rights reserved.
+ </span>
+ -->
+ <br />
+ <br />
+ </td>
+ <td width="10"> </td>
+ </tr>
+ </table>
+ </td>
+ </tr>
+ </table>
+ </body>
+</html>
--- /dev/null
+body {
+ margin: 0;
+}
+td {
+ font-size: 1em;
+}
+
+/* Added by html-wtoc.pl >>>>>>>>>>>>> */
+.html-wtoc-mark {
+/* background-color: #9cf; */
+/* background-color: #bcee68; */
+/* background-color: #a2cd5a; */
+ width: 20px;
+ padding: 0;
+ border: 0;
+ text-align: center;
+}
+.html-wtoc-contline {
+ width: 100%;
+}
+
+.html-wtoc-margin {
+ width: 0.6em;
+}
+.html-wtoc-contents {
+ font-size: 0.9em;
+ padding: 1em;
+ background-color: #9cf;
+ background-color: #a2cd5a;
+ background-color: #efffcf;
+ background-color: #ffffdf;
+ -moz-border-radius-topleft: 2em;
+}
+.html-wtoc-contents td {
+/* background-color: #9cf; */
+/* background-color: #bcee68; */
+/* background-color: #a2cd5a; */
+}
+.html-wtoc-contents-a {
+ text-decoration: none;
+ color: #595C00;
+/* background-color: #9cf; */
+/* background-color: #bcee68; */
+/* background-color: #a2cd5a; */
+ border: 1px #9cf solid;
+ border: 1px #a2cd5a solid;
+ border: 1px #ffffc0 solid;
+ padding-left: 0.25em;
+ padding-right: 0;
+ margin: 1px;
+ display: block;
+}
+.html-wtoc-contents a:hover {
+ text-decoration: none;
+ background-color: #b9ffb9;
+ border: 1px #6b8e23 solid;
+}
+.html-wtoc-currcont {
+ background-color: #738600;
+ color: #ffff2f;
+ background-color: #535600;
+ border: 1px #6b8e23 inset;
+ padding-left: 0.25em;
+ padding-right: 0;
+ margin: 1px;
+ display: block;
+}
+a.html-wtoc-currcont {
+ text-decoration: none;
+}
+a.html-wtoc-currcont:hover {
+ background-color: #738600;
+ background-color: #536600;
+ background-color: #434620;
+}
+/* <<<<<<<<<<<<<<<<<<< */
+
+
+
+
+
+
+
+
--- /dev/null
+
+// © Copyright 2006 Lennart Borgman, http://www.OurComments.org/. All rights reserved.
+//
+// This program is free software; you can redistribute it and/or
+// modify it under the terms of the GNU General Public License as
+// published by the Free Software Foundation; either version 3, or (at
+// your option) any later version.
+//
+// This program is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+// General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program; see the file COPYING. If not, write to
+// the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+// Floor, Boston, MA 02110-1301, USA.
+
+
+var HTML_WTOC_NS_sCurrTocId;
+
+
+HTML_WTOC_NS = {
+
+ /////////////////////////////
+ //// Basic event functions
+ /////////////////////////////
+
+ getEventObject : function (ev) {
+ var o;
+ if (window.event)
+ o = window.event.srcElement;
+ else if (null != ev)
+ o = ( ev.target );
+ return o;
+ },
+ getEvent : function (ev) {
+ if (window.event) {
+ return window.event;
+ } else if (null != ev) {
+ return ev;
+ }
+ },
+
+ eventStopPropagation : function (e) {
+ if (e.stopPropagation)
+ e.stopPropagation();
+ else
+ e.cancelBubble=true;
+ },
+
+ eventPreventDefault : function (e) {
+ if (e.preventDefault)
+ e.preventDefault();
+ else
+ e.returnValue=false;
+ },
+
+ /////////////////////////////
+ //// TOC hide
+ /////////////////////////////
+
+ show_content : function (on) {
+ var toc = document.getElementById("html-wtoc-id-toccol").style;
+ var tdv = document.getElementById("html-wtoc-id-tocdiv").style;
+ var shw = document.getElementById("html-wtoc-id-showtoc").style;
+ var hid = document.getElementById("html-wtoc-id-hidetoc").style;
+ if (on) {
+ toc.display = "";
+ tdv.display = "";
+ shw.display = "none";
+ hid.display = "";
+ HTML_WTOC_NS.focus_page_link(0);
+ } else {
+ toc.display = "none";
+ tdv.display = "none";
+ shw.display = "";
+ hid.display = "none";
+ }
+ },
+
+
+
+
+
+ /////////////////////////////
+ //// Open-Close
+ /////////////////////////////
+ onblur_action : function(ev) {
+ HTML_WTOC_NS_sCurrTocId = null;
+ },
+ onfocus_action : function(ev) {
+ var o = HTML_WTOC_NS.getEventObject(ev);
+ if (!o) return;
+
+ HTML_WTOC_NS_sCurrTocId = o.id;
+ },
+ onclick_action : function(ev) {
+ var o = HTML_WTOC_NS.getEventObject(ev);
+ var e = HTML_WTOC_NS.getEvent(ev);
+ if (13 == e.keyCode) return true;
+ if (!o) return true;
+ if ("IMG" == o.tagName) o = o.parentNode;
+ var iId = HTML_WTOC_NS.getIdnumFromId(o.id);
+ var sChildId = "toc_child_"+iId;
+ var sOldCurrTocId = HTML_WTOC_NS_sCurrTocId;
+ HTML_WTOC_NS.toggle_open(sChildId, o);
+ HTML_WTOC_NS_sCurrTocId = sOldCurrTocId;
+ return false;
+ },
+
+ toggle_open : function (id, parent) {
+ var child = document.getElementById(id).style;
+ var sInner = parent.innerHTML;
+ var re = new RegExp("[^/]*\.gif", "i");
+ if ("none" == child.display) {
+ child.display = "";
+ parent.innerHTML = sInner.replace(re, "down.gif")+"";
+ } else {
+ child.display = "none";
+ parent.innerHTML = sInner.replace(re, "right.gif")+"";
+ }
+ },
+
+
+
+ /////////////////////////////
+ //// Load
+ /////////////////////////////
+
+ onload_actions : function (iPageNum) {
+ document.body.onkeydown = HTML_WTOC_NS.onkeydown_action;
+ document.body.onmouseover = HTML_WTOC_NS.onmouseover_action;
+ var aATags = document.getElementsByTagName("a");
+ for(var i = 0; i < aATags.length; i++) {
+ var o = aATags[i];
+ if (null != HTML_WTOC_NS.getIdnumFromId(o.id)) {
+ o.onfocus = HTML_WTOC_NS.onfocus_action;
+ o.onblur = HTML_WTOC_NS.onblur_action;
+ if (o.id.substr(0, 12) == "opener_text_") {
+ o.onclick = HTML_WTOC_NS.onclick_action;
+ o.title = "Open/Close";
+ } else if (o.id.substr(0, 7) == "opener_") {
+ o.onclick = HTML_WTOC_NS.onclick_action;
+ o.className = "html-wtoc-mark";
+ o.title = "Open/Close";
+ }
+ }
+ }
+ HTML_WTOC_NS.focus_page_link(iPageNum);
+ },
+ focus_page_link : function (iPageNum) {
+ // Element might be hidden
+ try {
+ document.getElementById("toc_link_"+iPageNum).focus();
+ } catch (exc) {
+ }
+ },
+
+
+
+
+
+
+
+ /////////////////////
+ //// Mouse
+ /////////////////////
+
+ onmouseover_action : function (ev) {
+ if (null == HTML_WTOC_NS_sCurrTocId) return true;
+ var o = HTML_WTOC_NS.getEventObject(ev);
+ var iId = HTML_WTOC_NS.getIdnumFromId(o.id);
+ if (null == iId) return true;
+ o.focus();
+ },
+
+
+
+ /////////////////////
+ //// Key
+ /////////////////////
+
+ onkeydown_action: function (ev) {
+ var keyDown = 40;
+ var keyUp = 38;
+ var keyLeft = 37;
+ var keyRight = 39;
+ var keyReturn = 13;
+ var keyF2 = 113;
+ var keyInsert = 45;
+ // Opera
+ var keyOperaDown = 57386;
+ var keyOperaUp = 57385;
+ var keyOperaLeft = 57387;
+ var keyOperaRight = 57388;
+ var keyOperaF2 = 57346;
+ var keyOperaInsert = 57394;
+
+ var SwitchKey = keyInsert;
+ var SwitchKeyOpera = keyOperaInsert;
+
+ var bUp;
+ var e = HTML_WTOC_NS.getEvent(ev);
+ if (null == HTML_WTOC_NS_sCurrTocId) {
+ switch (e.keyCode) {
+ case SwitchKey:
+ case SwitchKeyOpera:
+ HTML_WTOC_NS.focus_page_link(0);
+ HTML_WTOC_NS.eventStopPropagation(e);
+ HTML_WTOC_NS.eventPreventDefault(e);
+ return false;
+ }
+ return true;
+ }
+ switch (e.keyCode) {
+ case keyLeft:
+ case keyOperaLeft:
+ case keyRight:
+ case keyOperaRight:
+ HTML_WTOC_NS.handle_leftright_keys(e);
+ HTML_WTOC_NS.eventStopPropagation(e);
+ HTML_WTOC_NS.eventPreventDefault(e);
+ return false;
+ case keyDown:
+ case keyOperaDown:
+ bUp = false;
+ break;
+ case keyUp:
+ case keyOperaUp:
+ bUp = true;
+ break;
+ case SwitchKey:
+ case SwitchKeyOpera:
+ if (null != HTML_WTOC_NS_sCurrTocId) {
+ var o = document.getElementById(HTML_WTOC_NS_sCurrTocId);
+ if (o) o.blur();
+ HTML_WTOC_NS_sCurrTocId = null;
+ }
+ HTML_WTOC_NS.eventStopPropagation(e);
+ HTML_WTOC_NS.eventPreventDefault(e);
+ return false;
+ default:
+ //alert(e.keyCode);
+ return true;
+ }
+ var oOpener;
+ oOpener = HTML_WTOC_NS.getNextVisOpener(HTML_WTOC_NS_sCurrTocId, bUp);
+ oOpener.focus();
+ HTML_WTOC_NS.eventStopPropagation(e);
+ HTML_WTOC_NS.eventPreventDefault(e);
+ return false;
+ },
+
+ handle_leftright_keys: function (e) {
+ var keyLeft = 37;
+ var keyRight = 39;
+ var keyOperaLeft = 57387;
+ var keyOperaRight = 57388;
+ var iId = HTML_WTOC_NS.getIdnumFromId(HTML_WTOC_NS_sCurrTocId);
+ if (null == iId) return;
+ var sId = "opener_" + iId;
+ var oOpener = document.getElementById(sId);
+ var sId = HTML_WTOC_NS_sCurrTocId; // It will be cleared before getNextVis
+
+ var bOpenAction;
+ var bOpened;
+ var bUp;
+ var oChild = document.getElementById("toc_child_"+iId);
+ if (null == oChild) {
+ } else {
+ bOpened = (oChild.style.display != "none");
+ }
+ switch (e.keyCode) {
+ case keyLeft:
+ case keyOperaLeft:
+ bUp = true;
+ bOpenAction = (null != bOpened) && (bOpened);
+ break;
+ case keyRight:
+ case keyOperaRight:
+ bUp = false;
+ bOpenAction = (null != bOpened) && (!bOpened);
+ break;
+ default:
+ alert("bad key handling...");
+ }
+ if (bOpenAction) {
+ oOpener.click();
+ HTML_WTOC_NS_sCurrTocId = sId;
+ } else {
+ var oPrev = HTML_WTOC_NS.getNextVisOpener(sId, bUp);
+ oPrev.focus();
+ }
+ },
+
+
+
+
+
+
+ //////////////////////
+ //// Util
+ //////////////////////
+ getNameFromId: function (sId) {
+ var re = new RegExp("(.*?_)(\\d+)", "i");
+ if (!re.test(sId)) return null;
+ var iId = sId.replace(re, "$1");
+ return iId;
+ },
+ getIdnumFromId: function (sId) {
+ var re = new RegExp("(.*?_)(\\d+)", "i");
+ if (!re.test(sId)) return null;
+ var iId = sId.replace(re, "$2");
+ return iId;
+ },
+
+
+ getNextVisOpener: function (sId, bUp, bTrace) {
+ if (bTrace) alert("getNextVisOpener("+sId+","+bUp+")");
+ var iId = HTML_WTOC_NS.getIdnumFromId(sId);
+ if (null == iId) {
+ alert("getNextVisOpener err iId==null");
+ return;
+ }
+ var sIdName = HTML_WTOC_NS.getNameFromId(sId);
+ if (null == sIdName) {
+ alert("getNextVisOpener err sIdName==null");
+ return;
+ }
+ var oOpener;
+ var iLoop = -2;
+ while (oOpener == null) {
+ if (bTrace) alert(iId);
+ if (iLoop++ > iMaxChildNum) { alert("Child num error"); return; }
+ if (!bUp) {
+ iId++;
+ } else {
+ iId--;
+ }
+ if (iId > iMaxChildNum) { iId = 0; }
+ if (iId < 0) { iId = iMaxChildNum; }
+ var s = sIdName+iId;
+ oOpener = document.getElementById(s);
+ if (oOpener != null) {
+ if (bTrace) alert(oOpener.offsetLeft);
+ if (oOpener.style.display == "none") { // All
+ oOpener = null;
+ } else if (oOpener.offsetLeft < 0) { // IE
+ oOpener = null;
+ } else if (0 == oOpener.scrollWidth) { // Opera
+ oOpener = null;
+ }
+ }
+ }
+ return oOpener;
+ }
+
+
+
+}; //HTML_WTOC_NS
--- /dev/null
+#! perl
+
+# Copyright 2006, 2007 Lennart Borgman, http://OurComments.org/. All
+# rights reserved.
+#
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This file is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+
+use strict;
+use File::Copy;
+use File::Spec;
+#use File::Path qw();
+use File::Path;
+use File::Find qw();
+use FindBin;
+
+use lib "$FindBin::Bin/PerlLib";
+use PathSubs qw();
+use html_tags qw(
+*html header
+div
+table Tr td
+p hr br
+a span img b
+);
+
+### Script start parameters
+my $m_param_action;
+my $m_param_files = 1;
+my $m_param_pnum = 0;
+my $m_param_single = 0;
+my $m_param_Template;
+my $m_param_InPages;
+my $m_param_OutRoot;
+my @m_param_InRoot;
+my $m_param_Overwrite;
+
+### Globals
+my $m_iAlwaysOpenedLevel = 0;
+my $m_sCommonIn;
+my $m_sInPagesFolder;
+my $m_sTemplateFolder;
+my $m_sStartTemplate;
+my $m_sBodyTemplate;
+#my $m_sEndTemplate;
+my $m_bBorders = 0;
+my @pages;
+my %page_num;
+my %js_show_page;
+my $m_TemplateTime;
+my $m_InPagesTime;
+my %m_linked_files;
+
+sub get_params();
+sub get_template();
+sub read_page_list($);
+sub find_pages($$);
+sub write_pages();
+sub send_page();
+sub find_template_files();
+sub find_linked_from_pages();
+sub copy_wtoc_files();
+sub copy_linked_files();
+
+#push @pages, [$ind, $tit, $full_fil, $anc, $hrf, $trg, $tip];
+sub IND { 0 }
+sub TIT { 1 }
+sub FULL_FIL { 2 }
+sub ANC { 3 }
+sub HRF { 4 }
+sub TRG { 5 }
+sub TIP { 6 }
+
+##########################################################
+### Main
+##########################################################
+print "\n";
+get_params();
+if ($m_param_action eq "FIND") {
+ find_pages(\@m_param_InRoot, $m_param_InPages);
+} elsif($m_param_action eq "MERGE") {
+ get_template();
+ read_page_list($m_param_InPages);
+ find_template_files();
+ copy_wtoc_files();
+ if ($m_param_files) {
+ write_pages();
+ } else {
+ send_page();
+ }
+ find_linked_from_pages();
+ copy_linked_files();
+} elsif($m_param_action eq "TOC") {
+}
+exit;
+
+sub copy_if_newer_or_overwrite($$) {
+ my $in_file = shift;
+ my $out = shift;
+ my $out_file = $out;
+ if (-d $out) {
+ my ($in_v, $in_d, $in_f) = File::Spec->splitpath( $in_file );
+ my ($out_v,$out_d,$out_f) = File::Spec->splitpath( $out, 1 );
+ $out_file = File::Spec->catpath( $out_v, $out_d, $in_f );
+ }
+ my $should_write = 1;
+ if (-e $out_file) {
+ if ($m_param_Overwrite) {
+ my $in_mdt = (stat $in_file)[9];
+ my $outmdt = (stat $out_file)[9];
+ if (($outmdt > $in_mdt)) {
+ $should_write = 0;
+ }
+ } else {
+ $should_write = 0;
+ }
+ }
+ if ($should_write) {
+ if (!File::Copy::syscopy($in_file, $out_file)) {
+ die "syscopy($in_file, $out_file): $!";
+ } else {
+ print " $in_file => $out_file\n";
+ }
+ }
+} # copy_if_newer_or_overwrite
+
+sub copy_wtoc_files() {
+ print "\n**** Copy html-wtoc files\n";
+ mkdir $m_param_OutRoot, 0777;
+ my $css_file = $FindBin::Bin . "/html-wtoc.css";
+ copy_if_newer_or_overwrite($css_file, $m_param_OutRoot);
+ my $js_file = $FindBin::Bin . "/html-wtoc.js";
+ copy_if_newer_or_overwrite($js_file, $m_param_OutRoot);
+ my $OutRootImg = $m_param_OutRoot . "img/";
+ mkpath($OutRootImg);
+ my $imgsrc = $FindBin::Bin . "/img/";
+ opendir(IMGDIR, $imgsrc) or die "Can't opendir $imgsrc: $!";
+ while (my $imgfile = readdir(IMGDIR)) {
+ my $outimg = $OutRootImg . $imgfile;
+ $imgfile = $imgsrc . $imgfile;
+ #print STDERR ">>>$imgfile\n";
+ if (-f $imgfile) {
+ copy_if_newer_or_overwrite($imgfile, $outimg);
+ }
+ }
+ closedir(IMGDIR);
+} # copy_wtoc_files
+
+sub add_to_linked_files($$) {
+ my $from_file = shift;
+ my $to_file = shift;
+ if (exists $m_linked_files{$to_file}) {
+ my $old_from = $m_linked_files{$to_file};
+ unless ($old_from eq $from_file) {
+ die "Both $from_file and $old_from should be copied to $to_file";
+ }
+ }
+ $m_linked_files{$to_file} = $from_file;
+} # add_to_linked_files
+
+sub copy_linked_files() {
+ print "\n**** Copy linked files\n";
+ my %pages;
+ for my $pnum (0..$#pages) {
+ $pages{ full_in_name($pnum) } = 1;
+ }
+ for my $to_file (keys %m_linked_files) {
+ my $from_file = $m_linked_files{$to_file};
+ unless (exists $pages{$from_file}) {
+ if (-e $from_file) {
+ mkpath4file($to_file);
+ copy_if_newer_or_overwrite($from_file, $to_file);
+ }
+ }
+ }
+} # copy_linked_files
+
+sub find_linked_files($;$) {
+ my $in_file = shift;
+ my $out_file = shift;
+ $out_file = in2out($in_file) unless ($out_file);
+ my $whole = get_file($in_file);
+ while ($whole =~ m!(?:\s|^)(?:href|src)="(.*?)"!gis) {
+ my $l = $1;
+ next unless $l =~ m!\.(?:css|js|jpg|jpeg|gif|png)$!;
+ if (!File::Spec->file_name_is_absolute($l)) {
+ next if $l =~ m!^javascript:!;
+ next if $l =~ m!^http://!;
+ next if $l =~ m!^ftp://!;
+ next if $l =~ m!^mailto:!;
+ }
+ my $rel_l = $l;
+ my $full_in = $l;
+ if (File::Spec->file_name_is_absolute($l)) {
+ $rel_l = PathSubs::mk_relative_link($in_file, $l);
+ } else {
+ $full_in = PathSubs::mk_absolute_link($in_file, $l);
+ }
+ my $full_out = PathSubs::mk_absolute_link($out_file, $rel_l);
+ add_to_linked_files($full_in, $full_out);
+ }
+} # find_linked_files
+
+sub find_template_files() {
+ print "\n**** Find files referenced in template file\n";
+ my $in_file = $m_param_Template;
+ my $out_file = $m_param_OutRoot . "dummy.htm";
+ find_linked_files($in_file, $out_file);
+}
+sub find_linked_from_pages() {
+ for my $pnum (0..$#pages) {
+ next unless defined $pages[$pnum][FULL_FIL];
+ next unless $pages[$pnum][FULL_FIL] ne "";
+ next if defined $pages[$pnum][TRG];
+ find_linked_files( full_in_name($pnum) );
+ }
+}
+
+sub should_write_merged($$) {
+ my $pnum = shift;
+ my $out_file = shift;
+ my $should_write = 1;
+ if (-e $out_file) {
+ if ($m_param_Overwrite) {
+ my $srcmdt = page_src_time($pnum);
+ my $outmdt = (stat $out_file)[9];
+ if (($outmdt > $srcmdt)
+ && ($outmdt > $m_TemplateTime)
+ && ($outmdt > $m_InPagesTime)) {
+ $should_write = 0;
+ }
+ } else {
+ $should_write = 0;
+ }
+ }
+ return $should_write;
+}
+sub write_pages() {
+ #print STDERR "*** param_OutRoot=$m_param_OutRoot\n";
+ if ($m_param_single) {
+ my $out_file = $m_param_OutRoot . "single_$m_param_pnum.html";
+ if (should_write_merged($m_param_pnum, $out_file)) {
+ my $page = create_single_page($m_param_pnum);
+ $page = shrink($page);
+ create_file_and_path($out_file, $page);
+ }
+ } else {
+ my $iPages = 0;
+ print "\n*** Creating pages:\n";
+ for my $pnum (0..$#pages) {
+ next unless defined $pages[$pnum][FULL_FIL];
+ next unless $pages[$pnum][FULL_FIL] ne "";
+ next if defined $pages[$pnum][TRG];
+ $iPages++;
+ my $out_file = full_out_name($pnum);
+ if (should_write_merged($pnum, $out_file)) {
+ my $page = create_page($pnum);
+ next unless $page;
+ print " Creating page $iPages: " . full_in_name($pnum) . "\n";
+ $page = shrink($page);
+ print "\t=> $out_file\n";
+ create_file_and_path($out_file, $page);
+ }
+ }
+ }
+} # write_pages
+
+sub send_page() {
+ my $page = ($m_param_single ?
+ create_single_page($m_param_pnum)
+ :
+ create_page($m_param_pnum) );
+ print $page;
+} # send_page
+
+##########################################################
+### Params
+##########################################################
+sub die_usage() {
+ my $sScript = $0;
+ $sScript =~ tr!\\!/!;
+ $sScript =~ s!.*/(.*)!$1!;
+ die qq(Usage:
+ Making preliminary file list:
+ $sScript find in="in-dir" pages="pages-file" [overwrite=1]
+
+ Merging pages and table of contents:
+ $sScript merge pages="pages-file" outroot="out-dir" template="template-file" [overwrite=1]
+
+ \n);
+}
+#use Getopt::Long;
+sub get_params() {
+ $| = 1;
+ for my $arg (@ARGV) { print " "; print $arg; } print "\n\n";
+ die_usage() unless $#ARGV > 0;
+ $m_param_action = $ARGV[0];
+ $m_param_action =~ tr/a-z/A-Z/;
+ #push @m_param_InRoot, $FindBin::Bin . "/doc/";
+ #$m_param_OutRoot = $FindBin::Bin . "/tmp/";
+ #$m_param_Template = $FindBin::Bin . "/doc/home_template.htm";
+ #$m_param_InPages = $FindBin::Bin . "/doc/toc_pages.txt";
+ for (my $i = 1; $i <= $#ARGV; $i++) {
+ my ($k, $v) = ($ARGV[$i] =~ m!(.*?)=(.*)!);
+ $v =~ tr!\\!/!;
+ if ($k eq "in") {
+ $v = PathSubs::uniq_file($v);
+ $v .= "/" unless substr($v, -1) eq "/";
+ push @m_param_InRoot, $v;
+ } elsif( $k eq "outroot") {
+ $v = PathSubs::uniq_dir($v);
+ $v .= "/" unless substr($v, -1) eq "/";
+ $m_param_OutRoot = $v;
+ } elsif( $k eq "pages") {
+ $v = PathSubs::uniq_file($v);
+ $m_param_InPages = $v;
+ } elsif( $k eq "template") {
+ $v = PathSubs::uniq_file($v);
+ $m_param_Template = $v;
+ } elsif( $k eq "overwrite" ) {
+ $m_param_Overwrite = $v;
+ } elsif( $k eq "openedlevel" ) {
+ $m_iAlwaysOpenedLevel = $v * 1;
+ } else {
+ die "Unknown parameter: $ARGV[$i]\n";
+ }
+ }
+ if($m_param_action eq "FIND") {
+ if ($#m_param_InRoot < 0) { die_usage(); }
+ if (! defined $m_param_InPages) { die_usage(); }
+ } elsif($m_param_action eq "MERGE") {
+ if (! defined $m_param_InPages) { die_usage(); }
+ if (! defined $m_param_OutRoot) { die_usage(); }
+ if (! defined $m_param_Template) { die_usage(); }
+ $m_sTemplateFolder = $m_param_Template;
+ $m_sTemplateFolder =~ s![^/]*$!!;
+ } else {
+ die_usage();
+ }
+
+ $m_sInPagesFolder = $m_param_InPages;
+ $m_sInPagesFolder =~ s![^/]*$!!;
+ print "Parameters:\n";
+ print " " . $m_param_action . "\n";
+ print " pages=" . $m_param_InPages . "\n";
+ print " outroot=" . $m_param_OutRoot . "\n";
+ print " template=" . $m_param_Template . "\n";
+ if (defined $m_param_Overwrite) {
+ print " overwrite=" . $m_param_Overwrite . "\n";
+ }
+ #if ($#m_param_InRoot == -1) { push @m_param_InRoot,$m_sInPagesFolder; }
+}
+
+sub get_template() {
+ my $sTemplate = get_file($m_param_Template, 1);
+ $m_TemplateTime = (stat $m_param_Template)[9];
+ $m_InPagesTime = (stat $m_param_InPages)[9];
+ $sTemplate =~ s/<!--.*?-->//gs;
+ if ( $sTemplate =~ m!(.*?<body.*?>)(.*)</body>!si ) {
+ $m_sStartTemplate = $1;
+ $m_sBodyTemplate = $2;
+ #$m_sEndTemplate = $3;
+ } else {
+ die "Can't find body of template\n";
+ }
+} # get_template
+
+sub read_page_list($) {
+ my $sPagesFile = shift;
+ my @in_files;
+ open(P,$sPagesFile) or die "Can't open toc list file $sPagesFile: $!\n";
+ while (my $sLine = <P>) {
+ chomp $sLine;
+ $sLine =~ s/^\s+|\s+$//g;
+ next if $sLine eq "";
+ next if substr($sLine, 0, 1) eq ";";
+ #print STDERR "$sLine\n";
+ my ($ind, $tit, $ref, $tip, $trg, $ico)
+ = map { s/^\s+|\s+$//g; $_; } split("###", $sLine);
+ #warn "trg=$trg\n" if defined $trg;
+ my ($fil, $anc) = ("", "");
+ my $hrf = "";
+ my $full_fil = "";
+ #$ref = "" unless defined $ref;
+ #print STDERR "ref=$ref\n";
+ if (defined $ref) {
+ if (defined $trg) { undef $trg unless $trg ne ""; }
+ if ((defined $trg) || ($ref =~ m/https?:/i)) {
+ $hrf = $ref;
+ } else {
+ ($fil, $anc) = split('#', $ref);
+ if ($ind >= 0) {
+ if (File::Spec->file_name_is_absolute($fil)) {
+ $full_fil = $fil;
+ } else {
+ $full_fil = PathSubs::uniq_file($m_sInPagesFolder . $fil);
+ }
+ }
+ }
+ }
+ if ((!$tip) && ($full_fil ne "")) {
+ $tip = get_title($full_fil);
+ }
+ push @pages, [$ind, $tit, $full_fil, $anc, $hrf, $trg, $tip];
+ push @in_files, $full_fil if !defined $trg;
+ }
+ close P;
+ $m_sCommonIn = get_common_root(\@in_files). "/";
+} # read_page_list
+
+
+
+sub get_common_root($) {
+ my $psRoots = shift;
+ my @sCommon;
+ for my $s (@$psRoots) {
+ my $full_s = PathSubs::uniq_file($s);
+ my @full_s = split("/", $full_s);
+ if ($#sCommon == -1) {
+ @sCommon = @full_s;
+ } else {
+ my $iMax = $#sCommon; if ($#full_s < $iMax) { $iMax = $#full_s; }
+ for (my $i = 0; $i <= $iMax; $i++) {
+ if ($sCommon[$i] ne $full_s[$i]) {
+ #print STDERR "$i: $sCommon[$i] != $full_s[$i]\n";
+ @sCommon = @sCommon[0..$i-1];
+ last;
+ }
+ }
+ }
+ }
+ my $sCommon = join("/", @sCommon);
+ return $sCommon;
+} # get_common_root
+
+
+sub find_pages($$) {
+ my $pasInRoot = shift;
+ my $sOutFile = shift;
+ if (!$m_param_Overwrite) {
+ die "Don't want to overwrite existing output file $sOutFile!\n" if -e $sOutFile;
+ }
+ my $root_level;
+ my $sList;
+ my $handle_file =
+ sub {
+ return unless m/.html?/i;
+ return if -d $_;
+ my $fname = PathSubs::uniq_file($_);
+ die "Can't read $fname\n" unless -r $_;
+ my $title = get_title($_);
+ my $level = $fname =~ tr!/!!;
+ $level -= $root_level;
+ my $rel_fname = PathSubs::mk_relative_link($sOutFile, $fname);
+ $sList .= "$level ### $title ### $rel_fname\n";
+ };
+ for my $sInRoot (@$pasInRoot) {
+ $sInRoot = PathSubs::uniq_file($sInRoot);
+ chop($sInRoot) if (substr($sInRoot, -1) eq "/");
+ $root_level = $sInRoot =~ tr!/!!;
+ File::Find::find($handle_file, $sInRoot);
+ }
+ create_file($sOutFile, $sList);
+} # find_pages
+
+
+##########################################################
+### File - page helpers
+##########################################################
+
+sub file_name($) {
+ my $num = shift;
+ return $pages[$num][FULL_FIL];
+}
+sub file_anchor($) {
+ my $num = shift;
+ return $pages[$num][ANC];
+}
+sub file_href($) {
+ my $num = shift;
+ #die $pages[$num][HRF] if defined $pages[$num][HRF];
+ return $pages[$num][HRF];
+}
+sub file_target($) {
+ my $num = shift;
+ return $pages[$num][TRG];
+}
+sub file_title($) {
+ my $num = shift;
+ return $pages[$num][TIT];
+}
+sub file_tip($) {
+ my $num = shift;
+ return $pages[$num][TIP];
+}
+sub full_in_name($) {
+ my $num = shift;
+ my $name = file_name($num);
+ return $name;
+}
+sub full_out_href($) {
+ my $num = shift;
+ my $anchor = file_anchor($num);
+ my $full_href = full_out_name($num);
+ warn "full_href is null" unless $full_href;
+ if ((defined $anchor) && ($anchor ne "")) { $full_href .= "#" . $anchor; }
+ return $full_href;
+}
+sub full_out_name($) {
+ my $num = shift;
+ my $in_name = file_name($num);
+ return unless $in_name;
+ my $anchor = file_anchor($num);
+ #$m_param_OutRoot . $name;
+ $anchor = "";
+ my $name = substr($in_name, length($m_sCommonIn));
+ if ($anchor) {
+ my $base;
+ my $ext;
+ for (my $i = length($name);$i>0;$i--) {
+ if (substr($name, $i, 1) eq ".") {
+ $base = substr($name, 0, $i-1);
+ $ext = substr($name, $i);
+ $name = $base . "_sharp_" . $anchor . $ext;
+ last;
+ }
+ }
+ }
+ $m_param_OutRoot . $name;
+}
+sub replace_name_link($) {
+ my $page = shift;
+ for my $k (keys %page_num) {
+ my $num = $page_num{$k};
+ my $href = ($m_param_single ? "javascript:ShowPage($num)" : file_name($num));
+ $page =~ s!%%$k%%!$href!gs;
+ }
+ return $page;
+}
+
+##########################################################
+### File name helpers
+##########################################################
+sub in2out($) {
+ my $in_name = shift;
+ die "in2out: File name is not abs: $in_name" unless File::Spec->file_name_is_absolute($in_name);
+ my $name = substr($in_name, length($m_sCommonIn));
+ $m_param_OutRoot . $name;
+}
+
+##########################################################
+### File reading/writing
+##########################################################
+
+sub mkpath4file($) {
+ my $file = shift;
+ my $path = $file;
+ $path =~ s|[^/]*$||;
+ File::Path::mkpath($path);
+}
+sub create_file($$) {
+ my ($out_file, $page) = @_;
+ if (!$m_param_Overwrite) {
+ if (-e $out_file) { die "Will not overwrite $out_file\n"; }
+ }
+ open(OUT, ">$out_file") or die "Can't create $out_file: $!";
+ print OUT $page;
+ close OUT;
+ chmod 0111|((stat $out_file)[2]&07777), $out_file
+}
+sub create_file_and_path($$) {
+ my ($out_file, $page) = @_;
+ mkpath4file($out_file);
+ create_file($out_file, $page);
+}
+
+
+sub get_file($$) {
+ my ($file, $need) = @_;
+ if (open(FL, $file)) {
+ local $/;
+ my $whole = <FL>;
+ close FL;
+ return $whole;
+ } else {
+ my $err = $!;
+ die "Can't open $file: $err\n" if $need;
+ return "";
+ }
+}
+
+sub get_title($) {
+ my $file = shift;
+ open(H, $file) or die "Can't open and get title from $file: $!";
+ while (my $line = <H>) {
+ if ($line =~ m!<title>(.*?)</title>!i) { close H; return $1; }
+ }
+ close H;
+}
+
+
+
+##########################################################
+### Html parsing etc
+##########################################################
+
+sub get_head_from_file($) {
+ my $fname = shift;
+ my $err;
+ my $head = get_head(get_file($fname, 1), \$err);
+ die "\n\n$fname\n\t" . $err if defined $err;
+ return $head;
+}
+# BUG: These actually requires parsing of the file, but it does not
+# seem very important:
+sub get_head($$) {
+ my $html = shift;
+ my $perr = shift;
+ return "" unless $html;
+ $html =~ s/<!--.*?-->//g;
+ if ($html =~ m!<head.*?>(.*)</head>!is) {
+ return $1;
+ }
+ $$perr = "Can't find <head>-tag in $html\n";
+}
+sub get_body($) {
+ my $html = shift;
+ return "" unless $html;
+ $html =~ s/<!--.*?-->//gs;
+ if ($html =~ m!<body[^>]*>(.*)</body>!is) {
+ return $1;
+ }
+ die "Can't find <body>-tag in $html\n";
+}
+
+sub shrink($) {
+ my $str = shift;
+ my $out_str = "";
+ my @str = split("\n", $str);
+ my $in_pre = 0;
+ for my $s (@str) {
+ if ($s =~ m!<pre>!i) { $in_pre = 1; }
+ if ($s =~ m!</pre>!i) { $in_pre = 0; }
+ $s =~ s!^(\s*)!! unless $in_pre;
+ $out_str .= $s . "\n";
+ }
+ return $out_str;
+ $str =~ s!^(\s*)!!gm;
+ $str;
+}
+
+
+##########################################################
+### Making what we see
+##########################################################
+
+sub mk_search() {
+ return "" if ! $m_param_single;
+ return qq[
+ <a href="javascript:show_search()" xstyle="font-size: 8pt"
+ title="Show Search Form"
+ ><img src="img/search.gif" border="$m_bBorders" align="left"></a>
+ <a href="javascript:show_search()" xstyle="font-size: 8pt"
+ title="Show Search Form"
+ class="html-wtoc-search"
+ >Sök</a>
+ ];
+}
+sub mk_main_table($$$$$) {
+ my $left = shift;
+ my $main = shift;
+ my $srch_table = shift;
+ my $sFile = shift;
+ my $pNum = shift;
+ my $search_tr = "";
+ if ($m_param_single) {
+ $search_tr =
+ Tr(
+ td(" ")
+ . td({-valign=>'bottom', }, mk_search(), ) )
+ }
+ my $cont_table =
+ table(
+ { -border=>"$m_bBorders", -cellpadding=>0, -cellspacing=>0,
+ -width=>"100%",
+ -id=>"html-wtoc-contents",
+ #-style=>"display:",
+ -summary=>"Table of contents",
+ },
+ Tr(
+ #td(" ")
+ td({-class=>"html-wtoc-margin"})
+ . td({-valign=>'top'}, $left) )
+ . $search_tr
+ )
+ ;
+ my $page = $m_sBodyTemplate;
+ $page = replace_template_links($m_sBodyTemplate, $sFile);
+ $page =~ s!%%TOC%%!$cont_table!;
+ $page =~ s!%%PAGE%%!$main!;
+ return $page;
+} # mk_main_table
+
+
+sub find_ind_level_prev($) {
+ my $lThis = shift;
+ for (my $i = $lThis - 1; $i > 0; $i--) {
+ my $ind_lev = $pages[$i][IND];
+ if ($ind_lev < 50) { return $ind_lev; }
+ }
+ return undef;
+}
+sub find_ind_level_next($) {
+ my $lThis = shift;
+ #print "find_ind_level_next($lThis)";
+ #print ", ";
+ #print file_title($lThis);
+ #print "\n";
+ #for (my $i = $lThis; $i < $#pages; $i++) {
+ for (my $i = $lThis + 1; $i <= $#pages; $i++) {
+ my $ind_lev = $pages[$i][IND];
+ if ($ind_lev < 50) { return $ind_lev; }
+ }
+ return undef;
+}
+
+
+
+
+
+
+
+
+sub mk_opener_elem($$$) {
+ my $iPi = shift;
+ my $sHref = shift;
+ my $bOpened = shift;
+ my $Aattrib =
+ {
+ -id =>"opener_$iPi",
+ };
+ if ($sHref) { $$Aattrib{href} = $sHref; }
+ my $sImg;
+ my $sAlt;
+ if ($bOpened) {
+ $sImg = "down";
+ $sAlt = "Close";
+ } else {
+ $sImg = "right";
+ $sAlt = "Open";
+ }
+ return
+ a(
+ $Aattrib,
+ img({
+ -src=>"img/$sImg.gif",
+ -alt=>$sAlt,
+ -border=>0,
+ -width=>12,
+ -height=>12,
+ },
+ ),
+ );
+} # mk_opener_elem
+
+sub mk_content($) {
+ my $pnum = shift;
+ if (!$pages[$pnum]) {
+ return br();
+ }
+ my $cont;
+ my @father;
+ my @child_trace;
+ my $this_indent = $pages[$pnum][IND];
+ my $this_file = $pages[$pnum][FULL_FIL];
+ if ($this_indent == -2) {
+ return "";
+ }
+ my $this_href = full_out_name($pnum);
+ #my $anchor = file_anchor($pnum);
+ #if (defined $anchor) { $this_href .= "#" . $anchor; }
+ my @size;
+ $size[0] = "1em";
+ $size[1] = "0.8em";
+ $size[2] = "0.8em";
+
+
+
+ ### Open all main level nodes
+ my @opened; # rename to visible!!!!!
+ for my $pi (0..$#pages) {
+ my $indent = $pages[$pi][IND];
+ if ($indent <= $m_iAlwaysOpenedLevel) {
+ $opened[$pi] = 1;
+ } else {
+ $opened[$pi] = 0; # more simple to handle
+ }
+ }
+
+
+
+ ### Open ancestors and older sisters (if not a standalone node)
+ my $pnum_indent = $pages[$pnum][IND];
+ my $high_open = $pnum_indent;
+ my $standalone_open = 10;
+ if ($high_open < $standalone_open) { ### Not a standalone node
+ for (my $pi = $pnum; $pi >= 0; $pi--) {
+ my $pi_indent = $pages[$pi][IND];
+ if ($high_open >= $pi_indent) {
+ $opened[$pi] = 1;
+ $high_open = $pi_indent;
+ for (my $ps = $pi+1; $ps <= $#pages; $ps++) {
+ my $ps_indent = $pages[$ps][IND];
+ last if $ps_indent < $pi_indent;
+ $opened[$ps] = 1 if $ps_indent == $pi_indent;
+ }
+ }
+ last if $pi_indent == 0;
+ }
+ }
+
+
+
+
+ ### Open direct childs and younger sisters
+ my $maybe_child = 1;
+ my $more_sisters = 1;
+ my $max_open_indent = $pnum_indent;
+ for my $pi ($pnum+1..$#pages) {
+ my $pi_indent = $pages[$pi][IND];
+ if ($pi_indent <= $max_open_indent) { $maybe_child = 0; }
+ if ($pi_indent < $pnum_indent) { $more_sisters = 0; }
+ if ($pi_indent == $pnum_indent) {
+ if ($more_sisters) { $opened[$pi] = 1; }
+ $maybe_child = 0;
+ } elsif ($pi_indent == $pnum_indent+1) {
+ if ($maybe_child) { $opened[$pi] = 1; }
+ }
+ }
+ #exit if $pnum == 3;
+
+
+
+
+ ### Open all in the same file (necessary for non-JavaScript)
+ for my $pi (0..$#pages) {
+ my $file = $pages[$pi][FULL_FIL];
+ #printf STDERR "file - open=(%s)\n", $file;
+ #if ($file eq $this_file) {
+ if ($file eq $this_file) {
+ $opened[$pi] = 1;
+ }
+ if ($file eq "") {
+ if ($pi < $#pages) {
+ if ($pages[$pi][IND] < $pages[$pi+1][IND]) {
+ $opened[$pi+1] = 1;
+ }
+ }
+ }
+ if ($pages[$pi][IND] > 10) {
+ $opened[$pi] = 0;
+ #print ">>>>>>>>\$opened[$pi] = 0;\n";
+ }
+ #print STDERR "+++++++++\$opened[$pi] = $opened[$pi]\n";
+ }
+
+
+
+
+ ### Make the actual contents
+ my $tooltip;
+ my $child_id;
+ for my $pi (0..$#pages) {
+# if (!$pages[$pi][FULL_FIL] && !$pages[$pi][HRF]) {
+# my $txt = file_title($pi); #$pages[$pi][TIT];
+# $txt = qq(</p><hr width="50%" align="left" /><p style='margin-top:0'>) if $txt eq "-";
+# $cont .= $txt;
+# $cont .= br();
+# next;
+# }
+ my $txt = file_title($pi); #$pages[$pi][TIT];
+ if ($txt eq "-") {
+ $txt = qq(</p><hr width="50%" align="left" /><p style='margin-top:0'>);
+ $cont .= $txt;
+ $cont .= br();
+ next;
+ }
+ #if ($pages[$pi][TRG]) {
+ # next;
+ #}
+ #next if ! defined $opened[$pi];
+ #next if ! $opened[$pi];
+ my $ind_lev = $pages[$pi][IND];
+ next if $ind_lev > 50;
+ my $ind_lev_next = find_ind_level_next($pi);
+ #my $ind_lev_prev = find_ind_level_prev($pi);
+
+ my $this_entry = "";
+
+ ### Child id from previous row
+ if (defined $child_id) {
+ my $display = "";
+ if (!$opened[$pi]) {
+ $display = qq(style="display:none");
+ } else {
+ }
+ $this_entry .= "\n<div id=\"$child_id\" $display>\n";
+ undef $child_id;
+ }
+ my $opener_elem = ""; #qq(<img src="img/blank12.gif" width=12 height=12 alt=" ">);
+ my $childs_are_visible = ($pi == $pnum);
+ if ($pi < $#pages) {
+ if ($pages[$pi][IND] < $pages[$pi+1][IND]) {
+ if ($opened[$pi+1]) { $childs_are_visible = 1; }
+ }
+ }
+ #if ($pages[$pi][IND] < $m_iAlwaysOpenedLevel) { $childs_are_visible = 1; }
+
+ my $file_href;
+ my $target;
+ my $href;
+ my $href_self;
+ my $target_attrib;
+ my $title = file_title($pi);
+ my $file_name = file_name($pi);
+ if ($title) {
+ $file_href = file_href($pi); # || "";
+ $target = file_target($pi);
+ $href =
+ ($file_name ?
+ ($m_param_files ?
+ ($m_param_single ? "JavaScript:ShowPage($pi);" :
+ ($file_href ne ""? $file_href
+ :
+ PathSubs::mk_relative_link($this_href, full_out_href($pi))))
+ :
+ ($m_param_single ? "JavaScript:ShowPage($pi)" : "?pnum=$pi")
+ )
+ :
+ (File::Spec->splitpath($this_href))[2]);
+ if ($pi == $pnum) {
+ $href_self = $this_href;
+ if ($href_self =~ m!([^/\\]*$)!) {
+ $href_self = $1;
+ }
+ }
+ $target_attrib = (defined $target? qq(target="$target"): "");
+ } else {
+ $href = "";
+ $target_attrib = "";
+ }
+
+ if (defined $ind_lev_next && $ind_lev_next > $ind_lev) {
+ $child_id = "toc_child_$pi";
+ #print " child_id=$child_id\n";
+ push @child_trace, $child_id;
+ $opener_elem = mk_opener_elem($pi,
+ ($href? $href : $href_self),
+ $childs_are_visible);
+ }
+ $title =~ s/_/ /go;
+ my $indent = ($ind_lev ? " " x (($ind_lev-1) * 4) : "");
+ my $size = $size[$ind_lev];
+ $title = b($title) if $ind_lev == 0;
+
+ my $Aattrib =
+ {
+ id=>"toc_link_$pi",
+ onclick=>"html_wtoc_nailing(this)",
+ };
+ if (!$file_name) {
+ $Aattrib =
+ {
+ id=>"opener_text_$pi",
+ };
+ }
+ if ($pi == $pnum) {
+ ### Current page
+ $$Aattrib{class} = "html-wtoc-currcont";
+ $$Aattrib{title} = "You are here";
+ $$Aattrib{href} = $href_self;
+ $this_entry .=
+ table({
+ -cellspacing=>0,
+ -cellpadding=>0,
+ -class=>"html-wtoc-contline",
+ -border=>0,
+ -summary=>"Formatter",
+ },
+ Tr({
+ },
+ td({
+ },
+ a(
+ $Aattrib,
+ $indent . $title . " "
+ )
+ )
+ . td({
+ -class=>"html-wtoc-mark",
+ },
+ $opener_elem
+ )
+ )
+ );
+
+
+
+
+ } else {
+ ### Link to other page
+ if (file_title($pi)) {
+ $tooltip = $pages[$pi][TIP];
+ if (!defined $tooltip) { $tooltip = "Go to the page $title"; }
+ $$Aattrib{class} = "html-wtoc-contents-a";
+ my $a_or_span;
+ if (!defined $href) {
+ $a_or_span = span($Aattrib, $indent . $title);
+ } else {
+ $$Aattrib{title} = $tooltip;
+ $$Aattrib{href} = $href;
+ if (defined $target) { $$Aattrib{target} = $target; }
+ $a_or_span = a($Aattrib, $indent . $title);
+ }
+ $this_entry .=
+ table({
+ -cellspacing=>0,
+ -cellpadding=>0,
+ -class=>"html-wtoc-contline",
+ -border=>0,
+ -summary=>"Formatter",
+ },
+ Tr({
+ },
+ td({
+ },
+ $a_or_span
+ )
+ . td({
+ -class=>"html-wtoc-mark",
+ },
+ $opener_elem
+ )
+ )
+ );
+ } else {
+ $this_entry .= $indent . " " . $title;
+ #die $this_entry;
+ }
+ }
+ if ((!defined $ind_lev_next) || $ind_lev_next <= $ind_lev) {
+ my $ind_end = $ind_lev;
+ if (defined $ind_lev_next) { $ind_end = $ind_lev_next+1; }
+ for (my $i = $ind_end; $i <= $ind_lev; $i++) {
+ my $end_id = pop @child_trace;
+ if (defined $end_id) {
+ $this_entry .= "</div><!-- end child $end_id -->"; # end childs' span
+ #print " end $end_id\n";
+ }
+ }
+ }
+ $cont .= $this_entry;
+ $father[$ind_lev] = $pi;
+ } #for my $pi (0..$#pages)
+
+ $cont = div({-class=>"html-wtoc-contents"}, $cont) . p(" ");
+ #$cont =~ s|<|\n<|gms;
+ #$cont =~ tr!\n\r! !;
+ $cont =~ s{
+ (\ssrc=)"(.*?)"
+ }
+ {
+ my $s1 = $1;
+ my $src = $2;
+ if (!PathSubs::is_abs_path($src)) {
+ my $srcabs = PathSubs::mk_absolute_link(full_out_name(0), $src);
+ $src = PathSubs::mk_relative_link(full_out_name($pnum), $srcabs);
+ };
+ "${s1}\"$src\"";
+ }egsmx;
+ $cont;
+} # mk_content
+
+sub mk_main_window($) {
+ my $pnum = shift;
+ my $full_name = full_in_name($pnum);
+ return unless defined $full_name;
+ return get_body(get_file($full_name, 1));
+}
+
+
+
+
+
+
+
+
+##########################################################
+### The JavaScripts and styles we need
+##########################################################
+
+sub mk_style($) {
+ return "";
+ my $pnum = shift;
+ my $rel_link =
+ PathSubs::mk_relative_link(full_out_name($pnum), $m_param_OutRoot . "html-wtoc.css");
+ return qq(<link rel="stylesheet" href="$rel_link" type="text/css">\n);
+}
+sub mk_js($) {
+ my $pnum = shift;
+ return <<__HTML_END_JS_PNUM__;
+ <script type="text/JavaScript">
+ var iCurrentChild = $pnum;
+ var iMaxChildNum = $#pages;
+ </script>
+__HTML_END_JS_PNUM__
+ return "";
+ my $single_js = "";
+ if ($m_param_single) {
+ $single_js = qq[if (!document.all) { navigate("0.html"); }];
+ my $page_info = "var page_name = new Array;\n";
+ for my $i (0..$#pages) {
+ my $page_name = file_title($i); #$pages[$i][TIT];
+ $page_info .= qq[ page_name[$i] = "$page_name";\n];
+ }
+ $single_js .= $page_info;
+ }
+ my $sch_link =
+ PathSubs::mk_relative_link(full_out_name($pnum), $m_param_OutRoot . "search.js");
+ my $top_link =
+ PathSubs::mk_relative_link(full_out_name($pnum), $m_param_OutRoot . "html-wtoc.js");
+ return <<__HTML_END_JS__;
+ <script type="text/JavaScript" src="$sch_link"></script>
+ <script type="text/JavaScript" src="$top_link"></script>
+ <script type="text/JavaScript">
+ $single_js
+ </script>
+__HTML_END_JS__
+}
+
+##########################################################
+### Page creation
+##########################################################
+
+sub replace_template_links($$) {
+ my $template = shift;
+ my $sFile = shift;
+ $template =~ s{\ssrc="(.*?)"}
+ {
+ my $sSrc = $m_param_OutRoot . $1;
+ my $sRelSrc = PathSubs::mk_relative_link($sFile, $sSrc);
+ qq( src="$sRelSrc");
+ }exg;
+ $template =~ s{\shref="(.*?)"}
+ {
+ my $sOld = $1;
+ if ((lc substr($sOld, 0, 11)) eq "javascript:") {
+ qq( href="$sOld");
+ } elsif (PathSubs::is_abs_netpath($sOld)) {
+ qq( href="$sOld");
+ } else {
+ my $sSrc = $m_param_OutRoot . $sOld;
+ my $sRelSrc = PathSubs::mk_relative_link($sFile, $sSrc);
+ qq( href="$sRelSrc");
+ }
+ }exg;
+ return $template;
+} # replace_template_links
+
+sub mk_start_of_page($) {
+ my $pnum = shift;
+ my $page = "";
+ my $page_style = mk_style($pnum);
+ my $page_js = mk_js($pnum);
+ my $sFile = full_out_name($pnum);
+ my $head = "";
+ $head .= $page_js;
+ $head .= $page_style;
+ $head .= get_head_from_file(full_in_name($pnum));
+ $page .= header if !$m_param_files;
+ $page .= replace_template_links($m_sStartTemplate, $sFile);
+ $page =~ s!<title>HEAD</title>!$head!;
+ my $focus_pnum = $pnum;
+ my $ind_lev = $pages[$pnum][IND];
+ if ($ind_lev > 50) { $focus_pnum = 0; }
+ $page =~ s!%%PNUM%%!$focus_pnum!;
+ return $page;
+} # mk_start_of_page
+
+my %m_sCreatedPages;
+sub page_src_time($) {
+ my $pnum = shift;
+ my $src_file = $pages[$pnum][FULL_FIL];
+ return (stat $src_file)[9];
+}
+sub create_page($) {
+ my $pnum = shift;
+ return unless $pages[$pnum][FULL_FIL];
+
+ my $out_name = full_out_name($pnum);
+ return if exists $m_sCreatedPages{$out_name};
+ $m_sCreatedPages{$out_name} = 1;
+
+ my $page = mk_start_of_page($pnum);
+ my $cont_win = mk_content($pnum);
+ my $main_win = mk_main_window($pnum);
+ $page .= mk_main_table(
+ $cont_win,
+ $main_win,
+ "",
+ $out_name,
+ $pnum,
+ );
+ $page .= end_html;
+ $page = replace_name_link($page);
+ return $page;
+} # create_page
+
+
+__END__
+
+
+ ##########################################################
+ ### Unused currently
+ ##########################################################
+
+ sub build_ShowPage() {
+ for my $num (0..$#pages) {
+ $page_num{$pages[$num][FULL_FIL]} = $num;
+ my $fon = full_out_name($num);
+ if ($fon) { $js_show_page{$fon} = "ShowPage($num);"; }
+ }
+}
+build_ShowPage();
+
+
+sub mk_meta_enter_exit() {
+ return <<__HTML_EE__;
+ <meta HTTP-EQUIV="Page-Enter" content="RevealTrans (Duration=0.1, Transition=31)">
+ <meta HTTP-EQUIV="Page-Exit" content="RevealTrans (Duration=1, Transition=23)">
+__HTML_EE__
+}
+
+##########################################################
+### Single page
+##########################################################
+
+sub mk_noscript() {
+ return <<__HTML_END_NOSCRIPT__;
+ <noScript>
+ Sorry, there is not yet any version for non-JavaScript browsers.
+ You need to enable JavaScript to see the rest of the pages!
+__HTML_END_NOSCRIPT__
+}
+
+sub create_single_page($) {
+ my $pnum = shift;
+
+ my $page = mk_start_of_page($pnum);
+ my $left_col = "";
+ my $main = "";
+ for my $pi (0..$#pages) {
+ next unless $pages[$pi][FULL_FIL];
+ my $display = ($pi == $pnum ? 'style="display: block"' : 'Style="display: none"');
+ my $pi_left_col = replace_rel_link(mk_content($pi), full_out_name($pi));
+ my $pi_main = replace_rel_link(mk_main_window($pi), full_out_name($pi));
+ my $pi_margin = "";
+ $left_col .= "\n<div id='left_col_$pi' $display>" . $pi_left_col . "</div>\n";
+ $main .= "\n<div id='main_$pi' $display>" . $pi_main . "</div>\n";
+ }
+ my $search_table = qq[
+ <table border="0" width="100%" height="200"
+ cellpadding="0" cellspacing="0"
+ xbgcolor="yellow"
+ class="html-wtoc-search"
+ id="search" style="display:none">
+ <tr>
+ <td> </td>
+ <td align="left" valign="top" height="1">
+ <form onsubmit="return do_search(input.value);"
+ class="html-wtoc-search-form"
+ >
+ <input id="input" size="14"
+ ><input type="image" name="Search" value="Search"
+ title="Search"
+ src="img/search.gif"
+ align="top"
+ >
+ </td>
+ </form>
+ </tr>
+ <tr valign="top">
+ <td> </td>
+ <td id="hits" valign="top">
+ </td>
+ </tr>
+ <tr>
+ <td> </td>
+ <td valign="bottom">
+
+ <a href="javascript:hide_search()" xstyle="font-size: 8pt"
+ title="Show Menu"
+ ><img src="img/nosearch.gif" border=0 align="left"></a>
+ <a href="javascript:hide_search()"
+ title="Show Menu"
+ >Göm sökning</a>
+ </td>
+ </tr>
+ </table>
+ ];
+ $page .= mk_main_table(
+ $left_col,
+ $main,
+ $search_table,
+ full_out_name($pnum),
+ $pnum,
+ );
+ $page .= mk_noscript();
+ $page .= end_html;
+ $page =~ s/(\d+)\.html/javascript:ShowPage($1);/gs;
+ #$page =~ s/<body(.*?)>/<body$1 onload="ShowPage(0)">/gis;
+ $page =~ s/<body(.*?)>/<body$1 onload="HTML_WTOC_NS.onload_actions()">/gis;
+ $page = replace_name_link($page);
+ return $page;
+} # create_single_page
+
+my $abs_pos_tbl =
+ qq(
+ <table border="$m_bBorders" cellpadding=0 cellspacing=0
+ width="100%" height=70
+ bgcolor="white"
+ style="
+ position: absolute;
+ left: 0;
+ top: 0;
+ "
+ >
+ <tr>
+ <td>
+ </td>
+ </tr>
+ </table>
+ );
+
+
+##########################################################
+### Index.htm
+##########################################################
+
+# sub mk_index_page($) {
+# my $page = shift;
+# my $check_browser = qq[ //if (document.all) { navigate("single_0.html"); }\n];
+# #$page =~ s/(<script.*?>)/$1\n$check_browser/s;
+# mkdir $m_param_OutRoot, 0777;
+# my $out_file = $m_param_OutRoot . "index.htm";
+# create_file_and_path($out_file, $page);
+# }
+
+
+
+
+##########################################################
+### Links handling
+##########################################################
+
+
+sub replace_rel_link($$) {
+ my ($page, $page_file) = @_;
+ my $qr;
+ $page =~
+ s{
+ (src|href)="(.*?)"
+ }{
+ my $src_href = $1;
+ my $href = $2;
+ if (!PathSubs::is_abs_path($href)) {
+ $href = PathSubs::mk_absolute_link($page_file, $href);
+ $href =~ tr|\\|/|;
+ if (exists $js_show_page{$href}) {
+ $href = "javascript:$js_show_page{$href}";
+ }
+ }
+ qq($src_href="$href");
+ }xegsm;
+
+ $page;
+}
+
--- /dev/null
+;; nxhtml-autoload.el -- Autoloading of nxthml-mode
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Sat Feb 11 00:06:14 2006
+;; Version: 0.51
+;; Last-Updated: 2008-02-13T01:21:14+0100 Wed
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when (load)
+ (message "nxhtml-autoload starting ... (hm, should maybe be renamed ...)"))
+
+(eval-when-compile (require 'majmodpri nil t))
+(eval-when-compile (require 'moz nil t))
+
+;;; Convenient moving by tags:
+(eval-after-load 'nxml-mode
+ '(progn
+ (define-key nxml-mode-map [C-M-left] 'nxml-backward-element)
+ (define-key nxml-mode-map [C-M-right] 'nxml-forward-element)
+ (define-key nxml-mode-map [C-M-up] 'nxml-backward-up-element)
+ (define-key nxml-mode-map [C-M-down] 'nxml-down-element)))
+
+;; MozLab support, for more info see moz.el
+;;(autoload 'inferior-moz-mode "moz" "MozRepl Inferior Mode" t)
+;;(autoload 'moz-minor-mode "moz" "MozRepl Minor Mode" t)
+(defun javascript-moz-setup () (moz-minor-mode 1))
+(add-hook 'javascript-mode-hook 'javascript-moz-setup)
+;;(add-hook 'js2-fl-mode-hook 'javascript-moz-setup)
+
+
+(defun nxhtml-setup-file-assoc ()
+ "Setup file associations for nXhtml.
+Add nXhtml entries similar to those that are already there for
+html-mode and xml-mode.
+
+Add multi major mode entries.
+
+Finally run `majmodpri-sort-lists' to get everything in the right
+order."
+ ;; Add nXhtml entries similar to those that are already there for
+ ;; html-mode and xml-mode.
+ (dolist (mode-list '(auto-mode-alist magic-fallback-mode-alist magic-mode-alist))
+ (dolist (rec (symbol-value mode-list))
+ (when (eq (cdr rec) 'html-mode)
+ (add-to-list mode-list (cons (car rec) 'nxhtml-mode)))
+ (when (eq (cdr rec) 'html-mode)
+ (add-to-list mode-list (cons (car rec) 'nxhtml-mumamo-mode)))
+ ;; (when (eq (cdr rec) 'html-mode)
+ ;; (add-to-list mode-list (cons (car rec) 'html-mumamo-mode)))
+ (when (eq (cdr rec) 'xml-mode)
+ (add-to-list mode-list (cons (car rec) 'nxml-mode)))
+ ))
+
+ ;; Add multi major mode entries.
+ (add-to-list 'magic-mode-alist
+ '("\\(?:.\\|\n\\)\\{,500\\}xmlns:py=\"http://genshi.edgewall.org/\""
+ . genshi-nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.htm\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.html\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.xhtm\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.xhtml\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.html\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.htmlf\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.xhtml\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.xhtmlf\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.php\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.phtml\\'" . nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.jsp\\'" . jsp-nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.gsp\\'" . gsp-nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.asp\\'" . asp-nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.djhtml\\'" . django-nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.rhtml\\'" . eruby-nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.erb\\'" . eruby-javascript-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.phps\\'" . smarty-nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.epl\\'" . embperl-nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.ghtml\\'" . genshi-nxhtml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.mhtml\\'" . mason-nxhtml-mumamo-mode))
+
+ ;; Add html-mumamo style entry if there is an nxhtml-mumamo style entry.
+ (save-match-data
+ (dolist (mode-list '(auto-mode-alist magic-fallback-mode-alist magic-mode-alist))
+ (dolist (rec (symbol-value mode-list))
+ (let* ((mode (cdr rec))
+ (name (when (symbolp mode) (symbol-name mode)))
+ nxmode)
+ (when (and name
+ (string-match "nxhtml-mumamo" name))
+ (setq name (replace-regexp-in-string "nxhtml-mumamo" "html-mumamo" name t t))
+ (setq nxmode (intern-soft name))
+ (when nxmode
+ (add-to-list mode-list (cons (car rec) nxmode))))))))
+
+ (add-to-list 'auto-mode-alist '("\\.lzx\\'" . laszlo-nxml-mumamo-mode))
+ (add-to-list 'auto-mode-alist '("\\.js\\'" . javascript-mode))
+ (add-to-list 'auto-mode-alist '("\\.css\\'" . css-mode))
+ (add-to-list 'auto-mode-alist '("\\.rnc\\'" . rnc-mode))
+
+ (majmodpri-sort-lists)
+ ;;(message "nxhtml-autoload finished")
+ )
+
+;;(defvar nxhtml-src-dir (file-name-directory (if load-file-name load-file-name buffer-file-name)))
+
+;;(eval-when (load) (nxhtml-setup-file-assoc))
+(nxhtml-setup-file-assoc)
+
+(provide 'nxhtml-autoload)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtml-autoload.el ends here
--- /dev/null
+;;; nxhtml-bug.el --- Reporting nXhtml bugs
+;;
+;; Author: Lennar Borgman
+;; Maintainer:
+;; Created: Wed Mar 07 15:57:15 2007
+;; Version:
+;; Lxast-Updated: Wed Mar 07 16:00:22 2007 (3600 +0100)
+;; Keywords:
+;; Compatibility:
+;;
+;; Fxeatures that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'nxhtml-menu nil t))
+
+(require 'sendmail)
+
+;;(require 'emacsbug)
+(autoload 'report-emacs-bug-info "emacsbug" "Go to the Info node on reporting Emacs bugs." t)
+
+(defvar nxhtml-report-bug-orig-text nil
+ "The automatically-created initial text of bug report.")
+
+(defvar nxhtml-report-bug-no-confirmation nil
+ "*If non-nil, suppress the confirmations asked for the sake of novice users.")
+
+(defvar nxhtml-report-bug-no-explanations nil
+ "*If non-nil, suppress the explanations given when reporting bugs.")
+
+;; (defvar nxhtml-bug-launchpad-mode-map
+;; (let ((map (make-sparse-keymap)))
+;; (define-key map [(control ?c) (control ?c)] 'nxhtml-bug-maybe-to-launchpad)
+;; map))
+
+;; (define-minor-mode nxhtml-bug-launchpad-mode
+;; "Changes C-c C-c to ask to report on Launchpad."
+;; nil
+;; :keymap 'nxhtml-bug-launchpad-mode-map
+;; nil)
+
+;; (defun nxhtml-bug-maybe-to-launchpad ()
+;; (interactive)
+;; (if (y-or-n-p "Do you want to report bug on Launchad (preferred): ")
+;; (browse-url "https://bugs.launchpad.net/nxhtml")
+;; (mail-send-and-exit)))
+
+;;;###autoload
+(defun nxhtml-report-bug ()
+ "Report a bug in nXhtml."
+ (interactive)
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'nxhtml-report-bug) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (let ((here (point)))
+ (insert
+ "A lot of things can interfere with nXhtml/MuMaMo to cause bugs.\n"
+ "Therefore when reporting a bug please try to describe\n"
+ "how to show it without your own Emacs initializations.\n"
+ "To do that start from")
+ (fill-region here (point))
+ (insert "\n\n M-x `emacs-Q-nxhtml'\n\n")
+ (setq here (point))
+ (insert
+ "If you want to find out if your initialization files interfere\n"
+ "then you can try the both test commands `nxhtmltest-run' and\n"
+ "`nxhtmltest-run-Q' and see if there is any difference.\n\n")
+ (fill-region here (point))
+ (setq here (point))
+ (insert
+ "You may also want to look at the installation part of the ")
+ (insert-text-button "The Quick Guide"
+ 'action (lambda (btn)
+ (browse-url
+ (concat
+ (nxhtml-docfile-url)
+ "#qg"))))
+ (insert " or the file ")
+ (insert-text-button
+ "nxhtml/readme.txt"
+ 'action (lambda (btn)
+ (find-file-other-window
+ (expand-file-name "../readme.txt"
+ (file-name-directory
+ (symbol-file 'nxhtml-report-bug))))))
+ (insert ".\n\n")
+ (fill-region here (point))
+ (setq here (point))
+ (insert
+ "If you know Emacs lisp and are reporting a bug it would be nice "
+ "if you wrote a new unit test case.\n"
+ "Please see the file ")
+ (insert-text-button "nxhtmltest-suites.el"
+ 'help-echo "Visit file"
+ 'action (lambda (button)
+ (find-file (symbol-file 'nxhtmltest-run))))
+ (insert " for examples.\n\n")
+ (fill-region here (point))
+ (setq here (point))
+ (insert
+ "There are several ways to report a bug, use the links below:\n"
+ "- By visiting URL `https://bugs.launchpad.net/nxhtml'.\n")
+ (setq here (point))
+ (insert
+ "- By ")
+ (insert-text-button "email to Launchpad"
+ 'help-echo "Send email to Launchpad bug system"
+ 'action (lambda (button)
+ (call-interactively
+ 'nxhtml-report-bug-by-mail)))
+ (insert
+ ".\n")
+ (insert
+ " This requires PGP signing the email\n"
+ " and that you have told your PGP key to Launchpad.\n")
+ (fill-region here (point))
+ (setq here (point))
+ (insert
+ "- The above ways are best since the bug get into the database,\n"
+ " and it is easy to communicate about it, but if they does\n"
+ " not work for you please go to \n"
+ " URL `http://www.emacswiki.org/cgi-bin/wiki/NxhtmlMode'.\n")
+ (fill-region here (point))
+ (setq here (point))
+ )
+ (with-no-warnings (print-help-return-message)))))
+
+(defun nxhtml-report-bug-by-mail (topic)
+ "Report a bug by mail.
+Prompts for bug subject. Leaves you in an Emacs mail
+buffer. However when you send the bug your normal mail client
+will take over the job (with your help)."
+ (interactive (list (read-string "nXhtml Bug Subject: ")))
+ ;; If there are four numbers in emacs-version, this is a pretest
+ ;; version.
+ (require 'nxhtml-menu)
+ (let* ((pretest-p (string-match "\\..*\\..*\\." emacs-version))
+ (from-buffer (current-buffer))
+ ;;(reporting-address "lennart.borgman@gmail.com")
+ ;;(reporting-address "emacs-nxml-mode@yahoogroups.com")
+ (reporting-address "new@bugs.launchpad.net")
+ ;; Put these properties on semantically-void text.
+ (prompt-properties '(field nxhtml-bug-prompt
+ intangible but-helpful
+ rear-nonsticky t))
+ user-point message-end-point)
+ (setq message-end-point
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (point-max-marker)))
+ (compose-mail reporting-address
+ topic)
+ ;; The rest of this does not execute
+ ;; if the user was asked to confirm and said no.
+ (rfc822-goto-eoh)
+ (forward-line 1)
+
+ (let ((signature (buffer-substring (point) (point-max))))
+ (delete-region (point) (point-max))
+ (insert signature)
+ (backward-char (length signature)))
+ ;;(nxhtml-bug-launchpad-mode 1)
+ (insert
+ "\nThis is a bug report for nXhtml mode.\n")
+ (unless nxhtml-report-bug-no-explanations
+ ;; Insert warnings for novice users.
+ (when (string-match "nxml-mode" reporting-address)
+ (insert "This bug report will be sent to the nXhtml maintainers,\n")
+ (let ((pos (point)))
+ (insert "not to your local site managers!\n")
+ (put-text-property pos (point) 'face 'highlight)))
+ (insert "\nPlease write in ")
+ (let ((pos (point)))
+ (insert "English")
+ (put-text-property pos (point) 'face 'highlight))
+ (insert " if possible, because the nXhtml maintainers
+usually do not have translators to read other languages for them.\n\n")
+ )
+ (insert "Please describe exactly what actions triggered the bug\n"
+ "and the precise symptoms of the bug, preferrably starting\n"
+ "from `M-x emacs-Q-nxhtml'\n"
+ "(it may also be helpful to include an *EXAMPLE FILE*!).\n\n")
+ (add-text-properties (point) (save-excursion (mail-text) (point))
+ prompt-properties)
+
+ (setq user-point (point))
+ (insert "\n\n")
+
+ (insert "\n\nnXhtml version " nxhtml-menu:version ", " (emacs-version) "\n\n")
+ (insert (format "Major mode: %s\n"
+ (buffer-local-value 'mode-name from-buffer)))
+ (insert "\n")
+ (insert "Minor modes in effect:\n")
+ (dolist (mode minor-mode-list)
+ (and (boundp mode) (buffer-local-value mode from-buffer)
+ (insert (format " %s: %s\n" mode
+ (buffer-local-value mode from-buffer)))))
+ (insert "\n")
+ (let ((message-buf (get-buffer "*Messages*")))
+ (if message-buf
+ (let (beg-pos
+ (end-pos message-end-point))
+ (with-current-buffer message-buf
+ (goto-char end-pos)
+ (forward-line -10)
+ (setq beg-pos (point)))
+ (insert "\n\nRecent messages:\n")
+ (insert-buffer-substring message-buf beg-pos end-pos))))
+ ;; This is so the user has to type something
+ ;; in order to send easily.
+ (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
+ (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
+ (unless nxhtml-report-bug-no-explanations
+ (with-output-to-temp-buffer "*Bug Help*"
+ (if (eq mail-user-agent 'sendmail-user-agent)
+ (princ (substitute-command-keys
+ "Type \\[mail-send-and-exit] to send the bug report.\n")))
+ (princ (substitute-command-keys
+ "Type \\[kill-buffer] RET to cancel (don't send it).\n"))
+ (terpri)
+ (princ (substitute-command-keys
+ "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
+about when and how to write a bug report,
+and what information to supply so that the bug can be fixed.
+
+When there type SPC to scroll through this section and its subsections.
+
+Please notice that you are now reporting a bug for nXhtml, not
+Emacs itself, so everyting in that manual section might not
+apply."))))
+ ;; Make it less likely people will send empty messages.
+ (make-local-variable 'mail-send-hook)
+ (add-hook 'mail-send-hook 'nxhtml-report-bug-hook)
+ (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (make-local-variable 'nxhtml-report-bug-orig-text)
+ (setq nxhtml-report-bug-orig-text (buffer-substring (point-min) (point))))
+ (goto-char user-point)))
+
+
+(defun nxhtml-report-bug-hook ()
+ (save-excursion
+ (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (if (and (= (- (point) (point-min))
+ (length nxhtml-report-bug-orig-text))
+ (equal (buffer-substring (point-min) (point))
+ nxhtml-report-bug-orig-text))
+ (error "No text entered in bug report")))
+
+ ;; Check the buffer contents and reject non-English letters.
+ (save-excursion
+ (goto-char (point-min))
+ (skip-chars-forward "\0-\177")
+ (if (not (eobp))
+ (if (or nxhtml-report-bug-no-confirmation
+ (y-or-n-p "Convert non-ASCII letters to hexadecimal? "))
+ (while (progn (skip-chars-forward "\0-\177")
+ (not (eobp)))
+ (let ((ch (following-char)))
+ (delete-char 1)
+ (insert (format "=%02x" ch)))))))
+
+ ;; The last warning for novice users.
+ (if (or nxhtml-report-bug-no-confirmation
+ (yes-or-no-p
+ "Send this bug report to the nXhtml maintainers? "))
+ ;; Just send the current mail.
+ nil
+ (goto-char (point-min))
+ (if (search-forward "To: ")
+ (let ((pos (point)))
+ (end-of-line)
+ (delete-region pos (point))))
+ (kill-local-variable 'mail-send-hook)
+ (with-output-to-temp-buffer "*Bug Help*"
+ (princ (substitute-command-keys "\
+You invoked the command nxhtml-report-bug,
+but you decided not to mail the bug report to the nXhtml maintainer.
+
+If you want to mail it to someone else instead,
+please insert the proper e-mail address after \"To: \",
+and send the mail again using \\[mail-send-and-exit].")))
+ (error "M-x nxhtml-report-bug was cancelled, please read *Bug Help* buffer"))
+
+ ;; Unclutter
+ (mail-text)
+ (insert
+ "Next line tells Launchpad bug system what this is. Don't change it!\n"
+ " affects nxhtml\n\n")
+ (mail-text)
+ (let ((pos (1- (point))))
+ (while (setq pos (text-property-any pos (point-max)
+ 'field 'nxhtml-bug-prompt))
+ (delete-region pos (field-end (1+ pos)))))))
+
+(provide 'nxhtml-bug)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtml-bug.el ends here
--- /dev/null
+;;; nxhtml-menu.el --- Defines menus for nXhtml
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Sat Apr 21 2007
+;; Moved version to autostart.el.
+;; Last-Updated: 2010-01-04 Mon
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Menus for nXhtml to be used in different major modes.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cus-edit))
+(eval-when-compile (require 'dired))
+(eval-when-compile (require 'gimpedit nil t))
+(eval-when-compile (require 'html-site nil t))
+(eval-when-compile (when (fboundp 'nxml-mode) (require 'nxhtml-mode nil t)))
+(eval-when-compile (require 'css-color nil t))
+(eval-when-compile (require 'flymake))
+;;(eval-when-compile (require 'flymake-php))
+(eval-when-compile (require 'flymake-js nil t))
+(eval-when-compile (require 'mumamo nil t))
+(eval-when-compile (require 'nxhtml-base))
+(eval-when-compile (require 'udev-ecb nil t))
+;;(eval-when-compile (require 'udev-cedet))
+(eval-when-compile (require 'udev-rinari nil t))
+
+(defun nxhtml-nxhtml-in-buffer ()
+ (or (derived-mode-p 'nxhtml-mode)
+ (when (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)
+ (let ((major-mode (mumamo-main-major-mode)))
+ (derived-mode-p 'nxhtml-mode)))))
+
+(defun nxhtml-nxml-in-buffer ()
+ (or (derived-mode-p 'nxml-mode)
+ (when (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)
+ (let ((major-mode (mumamo-main-major-mode)))
+ (derived-mode-p 'nxml-mode)))))
+
+(defun nxhtml-html-in-buffer ()
+ (or (derived-mode-p 'html-mode)
+ (when (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)
+ (let ((major-mode (mumamo-main-major-mode)))
+ (derived-mode-p 'html-mode)))
+ (nxhtml-nxhtml-in-buffer)))
+
+(defun nxhtml-nxml-html-in-buffer ()
+ (or (derived-mode-p 'html-mode)
+ (when (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)
+ (let ((major-mode (mumamo-main-major-mode)))
+ (derived-mode-p 'html-mode)))
+ (nxhtml-nxml-in-buffer)))
+
+(defun buffer-or-dired-file-name ()
+ "Return buffer file name or file pointed to in dired."
+ (if (derived-mode-p 'dired-mode)
+ (dired-get-file-for-visit)
+ buffer-file-name))
+
+(defun nxhtml-this-file-can-have-toc (&optional file)
+ (unless file
+ (setq file (buffer-or-dired-file-name)))
+ (and (nxhtml-buffer-possibly-local-viewable file)
+ (html-site-current-merge-dir)
+ (html-site-current-ensure-file-in-site file)))
+
+(defun nxhtml-buffer-possibly-local-viewable (&optional file)
+ (unless file
+ (setq file (buffer-or-dired-file-name)))
+ (or (and file
+ (member (file-name-extension file)
+ '("html" "htm" "gif" "png")))))
+
+(defun nxhtml-buffer-possibly-remote-viewable ()
+ ;; Fix-me
+ (let* ((fmt "nxhtml-buffer-possibly-remote-viewable.dgffv: %s")
+ (file (or buffer-file-name
+ (and (derived-mode-p 'dired-mode)
+ (condition-case err
+ (dired-get-file-for-visit)
+ (error
+ (message fmt (error-message-string err))
+ nil))))))
+ (and (featurep 'html-upl)
+ file
+ (member (downcase (file-name-extension file))
+ '("html" "htm" "gif" "png" "pl" "php")))))
+
+;; (nxhtml-insert-menu-dynamically 'temp)
+(defun nxhtml-insert-menu-dynamically (real-binding)
+ (or (and (symbolp real-binding)
+ (boundp real-binding)
+ (symbol-value real-binding))
+ (let ((map (make-sparse-keymap "Not loaded yet")))
+ (define-key map [dummy]
+ (list 'menu-item "Not loaded yet" 'ignore))
+ map)
+ ;; (easy-menu-filter-return
+ ;; (easy-menu-create-menu
+ ;; "Not ready"
+ ;; '(["Not Loaded Yet" ignore t])))
+ ))
+
+(defun nxhtml-menu-image-file ()
+ (or (get-char-property (point) 'image-file)
+ buffer-file-name))
+
+(defun nxhtml-gimp-can-edit ()
+ (or (not (featurep 'gimp))
+ (gimpedit-can-edit (nxhtml-menu-image-file))))
+
+;;;###autoload
+(defun nxhtml-edit-with-gimp ()
+ "Edit with GIMP buffer or file at point."
+ (interactive)
+ (gimpedit-edit-file (nxhtml-menu-image-file)))
+
+;;;###autoload
+(defun nxhtml-browse-file (file)
+ "View file in web browser."
+ (interactive (list
+ (or (buffer-or-dired-file-name)
+ (read-file-name "File: "))))
+ (let* ((buf (if (buffer-file-name)
+ (current-buffer)
+ (find-buffer-visiting file)))
+ (use-temp (and (buffer-file-name)
+ (or (and (boundp 'nxhtml-current-validation-header)
+ nxhtml-current-validation-header)
+ (buffer-modified-p)
+ (not buffer-file-name)
+ (not (file-exists-p buffer-file-name)))))
+ (file-to-browse file))
+ (when use-temp
+ (setq file-to-browse (nxhtml-save-browseable-temp-file nil nil use-temp)))
+ ;; Fix-me: Workaround for Emacs bug on w32
+ ;; http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?bug=4015
+ (if (eq system-type 'windows-nt)
+ (w32-shell-execute nil (concat "file:///" file-to-browse) nil 1)
+ (browse-url-of-file file-to-browse))
+ ))
+
+;;;###autoload
+(defun nxhtml-browse-region ()
+ "View region in web browser."
+ (interactive)
+ (unless mark-active
+ (error "The region is not active"))
+ (browse-url (nxhtml-save-browseable-temp-file (region-beginning) (region-end))))
+
+;;(defvar nxhtml-browseable-buffer-name "*nXhtml Browsing Buffer*")
+(defvar nxhtml-browseable-buffer-file "~/.temp-nxhtml-browse.htm")
+;; Fix-me: Handle base href here!
+(defun nxhtml-save-browseable-temp-file (start end &optional doit-anyway)
+ "Return a temporary file for viewing in web browser."
+ ;; When using this either region should be active or there should be
+ ;; a validation header or both.
+ (or doit-anyway
+ (and start end) ;mark-active
+ (and (boundp 'nxhtml-validation-header-mode)
+ nxhtml-validation-header-mode
+ nxhtml-current-validation-header)
+ (error "Neither region nor validation header"))
+ (save-excursion
+ (let ((curbuf (current-buffer))
+ (view-buffer (find-file-noselect nxhtml-browseable-buffer-file))
+ header
+ content)
+ ;; Get header and content
+ (save-restriction
+ (widen)
+ (setq header
+ (if nxhtml-validation-header-mode
+ (let* ((key nxhtml-current-validation-header)
+ (rec (unless (listp key)
+ (assoc key nxhtml-validation-headers)))
+ (header (cdr rec)))
+ header)
+ (if (and doit-anyway (not start))
+ ""
+ (goto-char (point-min))
+ (save-match-data
+ (let ((body (re-search-forward "<body[^>]*>")))
+ (if body
+ (buffer-substring-no-properties (point-min) (match-end 0))
+ ""))))))
+ (setq content
+ (if start
+ (buffer-substring-no-properties start end)
+ (buffer-substring-no-properties (point-min) (point-max))))
+ )
+ ;; Switch to view buffer
+ (set-buffer view-buffer)
+ ;; (unless buffer-file-name
+ ;; (set-visited-file-name nxhtml-browseable-buffer-file)
+ ;; (rename-buffer nxhtml-valhead-view-buffer-name))
+ (erase-buffer)
+ (insert header content)
+ ;;(when (fboundp 'emacsw32-eol-set) (emacsw32-eol-set nil))
+ (nxhtml-mode)
+ (save-buffer)
+ ;;(current-buffer)
+ (kill-buffer view-buffer)
+ (expand-file-name nxhtml-browseable-buffer-file)
+ )))
+
+
+
+(defvar nxhtml-menu-mode-menu-map
+ (let ((map (make-sparse-keymap "nxhtml-menu-mode-menu")))
+
+ (let ((help-map (make-sparse-keymap)))
+ (define-key help-map [emacs-Q-nxhtml]
+ (list 'menu-item "Start 'emacs -Q' and load nXhtml" 'emacs-Q-nxhtml))
+ (define-key help-map [nxhtmltest-run]
+ (list 'menu-item "Run nXhtml Tests in Current Emacs" 'nxhtmltest-run))
+ (define-key help-map [nxhtmltest-run-Q]
+ (list 'menu-item "Run nXhtml Tests in a Fresh Emacs" 'nxhtmltest-run-Q))
+ (define-key help-map [nxhtml-report-bug]
+ (list 'menu-item "Report a Bug in nXhtml ..." 'nxhtml-report-bug))
+ (define-key help-map [nxhtml-help-separator2] (list 'menu-item "--"))
+ (define-key help-map [nxhtml-byte-compile-nxhtml]
+ (list 'menu-item "Byte Compile nXhtml" 'nxhtmlmaint-start-byte-compilation))
+ ;; Downloads
+ (let ((download-map (make-sparse-keymap)))
+ (define-key help-map [nxhtml-downloading]
+ (list 'menu-item "Download nXhtml Updates" download-map))
+ (define-key download-map [nxhtml-web-download-log]
+ (list 'menu-item "View Download Log" 'web-vcs-log-edit))
+ (define-key download-map [nxhtml-view-dl-log-separator]
+ (list 'menu-item "--" nil))
+ (define-key download-map [nxhtml-web-auto-download]
+ (list 'menu-item "Auto download from Devel Sources"
+ 'nxhtml-autoload-web
+ :button '(:toggle . (and (boundp 'nxhtml-autoload-web)
+ nxhtml-autoload-web))))
+ (define-key download-map [nxhtml-web-download]
+ (list 'menu-item "Update nXhtml (from devel sources)" 'nxhtml-update-existing-files))
+ )
+ (define-key help-map [nxhtml-features-check]
+ (list 'menu-item "Check Optional Features" 'nxhtml-features-check))
+ (define-key help-map [nxhtml-list-multi-modes]
+ (list 'menu-item "List Available Multi Major Modes" 'mumamo-list-defined-multi-major-modes))
+ (define-key help-map [nxhtml-customize]
+ (list 'menu-item "Customize nXhtml ..." 'nxhtml-customize))
+;;; (define-key help-map [nxhtml-quick-customize]
+;;; (list 'menu-item "Quick Customize nXhtml ..." 'nxhtml-quick-customize))
+ (define-key help-map [nxhtml-help-separator3] (list 'menu-item "--"))
+;;; (define-key help-map [nxhtml-help]
+;;; (list 'menu-item "nXhtml Help" 'nxhtml-help))
+ (define-key help-map [nxhtml-tutorials]
+ (list 'menu-item "nXhtml Tutorials" 'nxhtml-tutorials))
+ (define-key help-map [nxhtml-overview]
+ (list 'menu-item (concat "nXhtml Version "
+ (if (boundp 'nxhtml-menu:version)
+ nxhtml-menu:version
+ "(unknown)")
+ " Overview")
+ 'nxhtml-overview))
+ (define-key help-map [nxhtml-welcome]
+ (list 'menu-item "Welcome to nXhtml" 'nxhtml-welcome))
+ (define-key map [nxhtml-help-map]
+ (list 'menu-item "nXhtml Help and Setup" help-map))
+ (define-key map [nxhtml-info-separator] (list 'menu-item "--"))
+ )
+
+
+
+
+ (let ((tools-map (make-sparse-keymap)))
+ (define-key map [nxhtml-tools-map]
+ (list 'menu-item "Tools" tools-map))
+ (define-key tools-map [nxhtml-last-resort]
+ (list 'menu-item "Last Resort" 'n-back-game))
+ (define-key tools-map [nxhtml-pause]
+ (list 'menu-item "Life Reminder" 'pause-start-in-new-emacs))
+ (define-key tools-map [nxhtml-last-resort-separator]
+ (list 'menu-item "--" nil))
+ (define-key tools-map [nxhtml-viper-tut]
+ (list 'menu-item "Viper Try-Out Tutorial"
+ 'viper-tutorial))
+ (define-key tools-map [nxhtml-viper-separator]
+ (list 'menu-item "--" nil))
+ ;;(define-key tools-map [nxhtml-frame-win-separator] (list 'menu-item "--" nil))
+ (define-key tools-map [nxhtml-resize-windows]
+ (list 'menu-item "Resize Windows"
+ 'resize-windows))
+
+
+
+ (define-key tools-map [nxhtml-ecb-separator]
+ (list 'menu-item "--" nil))
+
+
+ (let ((ecb-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-ecb-map]
+ (list 'menu-item "ECB" ecb-map))
+ (define-key ecb-map [nxhtml-custom-important-ecb]
+ (list 'menu-item "Customize important ECB things"
+ (lambda ()
+ "Customize group `ecb-most-important'."
+ (interactive)
+ (customize-group-other-window 'ecb-most-important))
+ :enable '(featurep 'ecb)))
+ (define-key ecb-map [nxhtml-ecb-mode]
+ (list 'menu-item "ECB Minor Mode"
+ 'ecb-minor-mode
+ :button '(:toggle . (and (boundp 'ecb-minor-mode)
+ ecb-minor-mode))
+ :enable '(boundp 'ecb-minor-mode)))
+ (define-key ecb-map [nxhtml-ecb-show-help]
+ (list 'menu-item "ECB Help"
+ 'ecb-show-help
+ :enable '(fboundp 'ecb-show-help)))
+ (define-key ecb-map [nxhtml-ecb-custom-separator]
+ (list 'menu-item "--" nil))
+ (define-key ecb-map [nxhtml-custom-ecb]
+ (list 'menu-item "Customize ECB dev startup from nXhtml"
+ 'udev-ecb-customize-startup))
+ (define-key ecb-map [nxhtml-update-ecb]
+ (list 'menu-item "Fetch/update ECB dev sources"
+ 'udev-ecb-update))
+ (define-key ecb-map [nxhtml-ecb-home-separator]
+ (list 'menu-item "--" nil))
+ (define-key ecb-map [nxhtml-rinari-homepage]
+ (list 'menu-item "ECB Home Page"
+ (lambda ()
+ "Open ECB home page in your web browser."
+ (interactive)
+ (browse-url "http://ecb.sourceforge.net/"))))
+ )
+
+
+ ;; (let ((cedet-map (make-sparse-keymap)))
+ ;; (define-key tools-map [nxhtml-cedet-map]
+ ;; (list 'menu-item "CEDET" cedet-map))
+ ;; (define-key cedet-map [nxhtml-custom-cedet]
+ ;; (list 'menu-item "Customize CEDET dev startup from nXhtml"
+ ;; 'udev-cedet-customize-startup))
+ ;; (define-key cedet-map [nxhtml-cedet-utest]
+ ;; (list 'menu-item "Run CEDET unit tests"
+ ;; 'udev-cedet-utest))
+ ;; (define-key cedet-map [nxhtml-update-cedet]
+ ;; (list 'menu-item "Fetch/update and install CEDET dev sources"
+ ;; 'udev-cedet-update))
+ ;; (define-key cedet-map [nxhtml-cedet-home-separator]
+ ;; (list 'menu-item "--" nil))
+ ;; (define-key cedet-map [nxhtml-rinari-homepage]
+ ;; (list 'menu-item "CEDET Home Page"
+ ;; (lambda ()
+ ;; "Open CEDET home page in your web browser."
+ ;; (interactive)
+ ;; (browse-url "http://cedet.sourceforge.net/"))))
+ ;; )
+
+
+ (let ((rinari-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-rinari-map]
+ (list 'menu-item "Rinari" rinari-map))
+ (define-key rinari-map [nxhtml-custom-rinari]
+ (list 'menu-item "Customize Rinari startup from nXhtml"
+ (lambda ()
+ "Customize Rinari dev nXhtml startup options."
+ (interactive)
+ (customize-group-other-window 'udev-rinari))))
+ (define-key rinari-map [nxhtml-update-rinari]
+ (list 'menu-item "Fetch/update Rinari dev sources"
+ 'udev-rinari-update))
+ (define-key rinari-map [nxhtml-rinari-home-separator]
+ (list 'menu-item "--" nil))
+ (define-key rinari-map [nxhtml-rinari-homepage]
+ (list 'menu-item "Rinari Home Page"
+ (lambda ()
+ "Open Rinari home page in your web browser."
+ (interactive)
+ (browse-url "http://rubyforge.org/projects/rinari/"))))
+ )
+ (let ((mozrepl-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-mozrepl-map]
+ (list 'menu-item "MozRepl - control Firefox" mozrepl-map))
+
+ (let ((mozrepl-low-map (make-sparse-keymap)))
+ (define-key mozrepl-map [nxhtml-mozrepl-map]
+ (list 'menu-item "MozRepl Basic Functions" mozrepl-low-map))
+ (define-key mozrepl-low-map [nxhtml-mozrepl-run-mozilla]
+ (list 'menu-item "Display/Start MozRepl Process" 'run-mozilla
+ :enable '(fboundp 'moz-minor-mode)))
+ (define-key mozrepl-low-map [nxhtml-mozrepl-separator1]
+ (list 'menu-item "--" nil))
+ (define-key mozrepl-low-map [nxhtml-mozrepl-save-and-send]
+ (list 'menu-item "Save Buffer and Send it" 'moz-save-buffer-and-send
+ :enable '(or (not (boundp 'mumamo-multi-major-mode))
+ (not mumamo-multi-major-mode))))
+ (define-key mozrepl-low-map [nxhtml-mozrepl-send-defun-and-go]
+ (list 'menu-item "Send Current Function, Go to MozRepl"
+ 'moz-send-defun-and-go
+ :enable '(and (boundp 'moz-minor-mode) moz-minor-mode)))
+ (define-key mozrepl-low-map [nxhtml-mozrepl-send-defun]
+ (list 'menu-item "Send Current Function" 'moz-send-defun
+ :enable '(and (boundp 'moz-minor-mode) moz-minor-mode)))
+ (define-key mozrepl-low-map [nxhtml-mozrepl-send-region]
+ (list 'menu-item "Send the Region" 'moz-send-region
+ :enable '(and mark-active
+ (boundp 'moz-minor-mode) moz-minor-mode))))
+
+ (define-key mozrepl-map [nxhtml-mozrepl-separator2]
+ (list 'menu-item "--" nil))
+ (define-key mozrepl-map [nxhtml-mozrepl-refresh]
+ (list 'menu-item "Refresh Firefox on Save" 'mozadd-refresh-edited-on-save-mode
+ :button '(:toggle . (and (boundp 'mozadd-refresh-edited-on-save-mode)
+ mozadd-refresh-edited-on-save-mode))))
+ (define-key mozrepl-map [nxhtml-mozrepl-mirror]
+ (list 'menu-item "Mirror Buffer in Firefox" 'mozadd-mirror-mode
+ :button '(:toggle . (and (boundp 'mozadd-mirror-mode)
+ mozadd-mirror-mode))))
+ (define-key mozrepl-map [nxhtml-mozrepl-separator3]
+ (list 'menu-item "--" nil))
+ (define-key mozrepl-map [nxhtml-mozrepl-home-page]
+ (list 'menu-item "MozLab/MozRepl Home Page"
+ (lambda ()
+ "Open MozLab/MozRepl home page in your web browser."
+ (interactive)
+ (browse-url "http://hyperstruct.net/projects/mozlab"))))
+ )
+
+ (define-key tools-map [nxhtml-ediff-url]
+ (list 'menu-item "Compare download file" 'ediff-url))
+ (define-key tools-map [nxhtml-investigate-elisp]
+ (list 'menu-item "Investigate Elisp File" 'web-vcs-investigate-elisp-file))
+
+ (define-key tools-map [nxhtml-tidy-separator]
+ (list 'menu-item "--" nil))
+ (define-key tools-map [nxhtml-flymake]
+ (list 'menu-item "Flymake Mode" 'flymake-mode
+ :button '(:toggle . (and (boundp 'flymake-mode)
+ flymake-mode))
+ :enable '(and buffer-file-name
+ (require 'flymake)
+ (fboundp 'flymake-get-init-function)
+ (flymake-get-init-function buffer-file-name)
+ )))
+ (let ((flyspell-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-flyspell-map]
+ (list 'menu-item "Flyspell" flyspell-map))
+ (define-key flyspell-map [nxhtml-flyspell-goto-next]
+ (list 'menu-item "Flyspell Go To Next Error" 'flyspell-goto-next-error
+ :enable 'flyspell-mode))
+ (define-key flyspell-map [nxhtml-flyspell-region]
+ (list 'menu-item "Flyspell Region" 'flyspell-region
+ :enable 'flyspell-mode))
+ (define-key flyspell-map [nxhtml-flyspell-div-1]
+ (list 'menu-item "--"))
+ (define-key flyspell-map [nxhtml-flyspell]
+ (list 'menu-item "Flyspell Mode" 'flyspell-mode
+ :button '(:toggle . (and (boundp 'flyspell-mode)
+ flyspell-mode))))
+ )
+ (define-key tools-map [nxhtml-flyspell-separator]
+ (list 'menu-item "--"))
+ (let ((img-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-img-map]
+ (list 'menu-item "Images" img-map))
+ (define-key img-map [nxhtml-chartg]
+ (list 'menu-item "Make Chart" 'chartg-make-chart))
+ (define-key img-map [nxhtml-chartg-separator] (list 'menu-item "--"))
+ (define-key img-map [nxhtml-gimp-edit]
+ (list 'menu-item "Edit with GIMP" 'nxhtml-edit-with-gimp
+ :enable '(nxhtml-gimp-can-edit)))
+ (define-key img-map [nxhtml-gimp-separator] (list 'menu-item "--"))
+ (define-key img-map [nxhtml-inlimg-toggle-display]
+ (list 'menu-item "Toggle Display of Image" 'inlimg-toggle-display))
+ (define-key img-map [nxhtml-inlimg-toggle-slicing]
+ (list 'menu-item "Toggle Slicing of Image" 'inlimg-toggle-slicing))
+ (define-key img-map [nxhtml-inlimg-mode]
+ (list 'menu-item "Show <img ...> Images" 'inlimg-mode
+ :button '(:toggle . (and (boundp 'inlimg-mode)
+ inlimg-mode)))))
+ (define-key tools-map [nxhtml-img-separator]
+ (list 'menu-item "--"))
+ (let ((some-help-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-some-help-map]
+ (list 'menu-item "Help for Item at Point" some-help-map))
+ (define-key some-help-map [nxhtml-css-help]
+ (list 'menu-item "CSS Help" 'xhtml-help-show-css-ref))
+ (define-key some-help-map [nxhtml-tag-help]
+ (list 'menu-item "XHTML Tag Help" 'nxhtml-short-tag-help)))
+
+ (let ((cssclr-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-css-color]
+ (list 'menu-item "Color Help" cssclr-map))
+ (define-key cssclr-map [nxhtml-css-color-mode]
+ (list 'menu-item "Css Color Mode" 'css-color-mode
+ :enable '(and font-lock-mode
+ ;; (or (not (boundp 'mumamo-multi-major-mode))
+ ;; (not mumamo-multi-major-mode))
+ ;; (featurep 'css-color)
+ )
+ :button '(:toggle . (and (boundp 'css-color-mode)
+ css-color-mode))))
+ (define-key cssclr-map [nxhtml-css-color-test]
+ (list 'menu-item "Color Test" 'css-color-test
+ ;; :enable '(featurep 'css-color)
+ )))
+
+ (define-key tools-map [nxhtml-help-separator]
+ (list 'menu-item "--"))
+
+
+ (let ((html-link-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-link-map]
+ (list 'menu-item "HTML Links" html-link-map
+ :enable '(nxhtml-html-in-buffer)))
+
+ (define-key html-link-map [nxhtml-chklnk]
+ (list 'menu-item "Check Links" 'html-chklnk-check-site-links
+ :enable '(featurep 'html-chklnk)))
+
+ (let ((move-map (make-sparse-keymap)))
+ (define-key html-link-map [move-map]
+ (list 'menu-item "Moving Files" move-map))
+ (define-key move-map [html-move-buffer-file]
+ (list 'menu-item "Move Buffer File" 'html-move-buffer-file
+ :help "Move buffer file and update links"
+ :enable '(and buffer-file-name
+ (featurep 'html-move))))
+ (define-key html-link-map [move-map-separator] (list 'menu-item "--"))
+ )
+
+
+ (define-key html-link-map [nxhtml-paste-link]
+ (list 'menu-item "Paste Saved Relative Link" 'nxhtml-paste-link
+ :help "Paste link"
+ :enable '(and (boundp 'nxhtml-saved-link-file)
+ nxhtml-saved-link-file)))
+ (define-key html-link-map [nxhtml-paste-link-as-a-tag]
+ (list 'menu-item "Paste Saved Relative Link as <a href=...>" 'nxhtml-paste-link-as-a-tag
+ :help "Paste link as <a ...> tag"
+ :enable '(and (boundp 'nxhtml-saved-link-file)
+ nxhtml-saved-link-file
+ (nxhtml-nxml-html-in-buffer))))
+ (define-key html-link-map [nxhtml-save-link-to-here]
+ (list 'menu-item "Save Relative Link to Current File" 'nxhtml-save-link-to-here
+ :help "Save link info for current file"
+ :enable 'buffer-file-name))
+ )
+
+ (let ((quick-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-quick-map]
+ (list 'menu-item "Quick Inserts etc" quick-map
+ :visible '(or (derived-mode-p 'html-mode)
+ (nxhtml-nxhtml-in-buffer))))
+ (let ((sometoc-map (make-sparse-keymap)))
+ (let ((toc-map (make-sparse-keymap)))
+ (define-key sometoc-map [nxhtml-toc-map]
+ (list 'menu-item "For Site" toc-map
+ :enable '(featurep 'html-toc)))
+ (define-key toc-map [nxhtml-html-wtoc]
+ (list 'menu-item "Merge Pages and TOC"
+ 'html-wtoc-write-pages-with-toc
+ :enable '(or (not (featurep 'html-site))
+ (html-site-current-page-list))))
+ (define-key toc-map [nxthml-html-toc]
+ (list 'menu-item "With Frames" 'html-toc-menu-map
+ :filter 'nxhtml-insert-menu-dynamically)))
+ (define-key sometoc-map [nxhtml-html-pagetoc]
+ (list 'menu-item "For Page" 'html-pagetoc-menu-map
+ :enable (boundp 'html-pagetoc-menu-map)
+ :filter 'nxhtml-insert-menu-dynamically
+ ))
+ (define-key quick-map [nxhtml-sometoc-map]
+ (list 'menu-item "Table of Contents" sometoc-map
+ :visible '(or (derived-mode-p 'html-mode)
+ (nxhtml-nxhtml-in-buffer)))))
+ (define-key quick-map [nxhtml-quick-sep-1]
+ (list 'menu-item "--"))
+ (define-key quick-map [nxhtml-spec-chars]
+ (list 'menu-item "Insert special character"
+ 'nxml-insert-named-char))
+ (define-key quick-map [nxhtml-css-rollover]
+ (list 'menu-item "Insert CSS Rollover Images"
+ 'nxhtml-rollover-insert-2v)))
+
+
+ (define-key tools-map [nxhtml-html-write-mode]
+ (list 'menu-item "HTML Write Mode"
+ 'html-write-mode
+ :enable '(nxhtml-html-in-buffer)
+ :button '(:toggle . (and (boundp 'html-write-mode)
+ html-write-mode))))
+ (define-key tools-map [nxhtml-tidy-map]
+ (list 'menu-item "Tidy XHTML" 'tidy-menu-symbol
+ ;; Seems like :visible is called before :filter so we
+ ;; can compute things in :visible.
+ :filter 'nxhtml-insert-menu-dynamically
+ :visible '(or (and (or (derived-mode-p 'html-mode)
+ (nxhtml-nxhtml-in-buffer))
+ (fboundp 'tidy-build-menu) (tidy-build-menu))
+ t)
+ :enable '(and (or (derived-mode-p 'html-mode)
+ (nxhtml-nxhtml-in-buffer))
+ (fboundp 'tidy-build-menu) (tidy-build-menu))
+ ))
+ (define-key tools-map [zencoding]
+ (list 'menu-item "Zen coding for HTML/CSS" 'zencoding-mode
+ :button '(:toggle . (and (boundp 'zencoding-mode)
+ zencoding-mode))
+ :enable '(nxhtml-html-in-buffer)))
+
+ (let ((where-map (make-sparse-keymap)))
+ (define-key tools-map [nxml-where]
+ (list 'menu-item "XML Path" where-map
+ :enable '(and (fboundp 'nxml-where-mode)
+ (or (derived-mode-p 'nxml-mode)
+ (nxhtml-nxhtml-in-buffer)))))
+ (define-key where-map [nxhtml-nxml-where-cust]
+ (list 'menu-item "Customize display of XML Path"
+ (lambda ()
+ "Customize XML path, ie group `nxml-where'."
+ (interactive)
+ (customize-group-other-window 'nxml-where))))
+ (define-key where-map [where-separator-2] (list 'menu-item "--"))
+ (define-key where-map [nxml-where-inner]
+ (list 'menu-item "Show inly inner tag" 'nxml-where-only-inner-toggle
+ :enable '(boundp 'nxml-where-only-inner)
+ :button '(:toggle . (and (boundp 'nxml-where-only-inner)
+ nxml-where-only-inner))))
+ (define-key where-map [nxml-where-id]
+ (list 'menu-item "Show tag ids in path" 'nxml-where-tag+id-toggle
+ :enable '(boundp 'nxml-where-tag+id)
+ :button '(:toggle . (and (boundp 'nxml-where-tag+id)
+ nxml-where-tag+id))))
+ (define-key where-map [nxml-where-header]
+ (list 'menu-item "Show XML path in header" 'nxml-where-header-toggle
+ :enable '(boundp 'nxml-where-header)
+ :button '(:toggle . (and (boundp 'nxml-where-header)
+ 'nxml-where-header))))
+ (define-key where-map [nxml-where-marks]
+ (list 'menu-item "Show XML path marks" 'nxml-where-marks-toggle
+ :enable '(boundp 'nxml-where-marks)
+ :button '(:toggle . (and (boundp 'nxml-where-marks)
+ nxml-where-marks))))
+ (define-key where-map [where-separator] (list 'menu-item "--"))
+ (define-key where-map [nxml-where-global-toggle]
+ (list 'menu-item "Show XML path" 'nxml-where-global-mode
+ :button '(:toggle . (and (boundp 'nxml-where-global-mode)
+ nxml-where-global-mode))))
+ (define-key where-map [nxml-where-toggle]
+ (list 'menu-item "Show XML path in buffer" 'nxml-where-mode
+ :button '(:toggle . (and (boundp 'nxml-where-mode)
+ nxml-where-mode))))
+ )
+
+
+ (let ((cmpl-map (make-sparse-keymap)))
+ (define-key tools-map [nxhtml-cmpl-map]
+ (list 'menu-item "XHTML Completion and Validation" cmpl-map
+ ;; :enable '(or (derived-mode-p 'nxml-mode) (nxhtml-nxhtml-in-buffer))
+ :visible `(not (derived-mode-p 'dired-mode))
+ :enable ' (or (derived-mode-p 'nxml-mode)
+ (nxhtml-nxhtml-in-buffer))
+ ))
+ (let ((val-map (make-sparse-keymap)))
+ (define-key cmpl-map [nxhtml-cmpl-val-map]
+ (list 'menu-item "Validation Helpers (for php etc)" val-map
+ :enable '(nxhtml-nxhtml-in-buffer)
+ :visible '(nxhtml-nxml-html-in-buffer)))
+;;; (define-key val-map [nxhtml-strval-mode]
+;;; (list 'menu-item "Allow attr=\"<?php...?>\" etc"
+;;; 'nxhtml-strval-mode
+;;; :button '(:toggle . nxhtml-strval-mode)))
+ (define-key val-map [mumamo-alt-php-tags]
+ (list 'menu-item "Use <?php -> (?php"
+ 'mumamo-alt-php-tags-mode
+ :button '(:toggle . (and (boundp 'mumamo-alt-php-tags-mode)
+ mumamo-alt-php-tags-mode))))
+ (define-key val-map [mumamo-alt-tags-separator] (list 'menu-item "--"))
+ (define-key val-map [nxhtml-toggle-warnings]
+ (list 'menu-item "Hide Validation Errors"
+ 'nxhtml-toggle-visible-warnings
+ :button '(:toggle . (not (nxhtml-warnings-are-visible)))
+ ))
+ (define-key val-map [nxhtml-error-separator] (list 'menu-item "--"))
+ (define-key val-map [nxhtml-remove-saved-validation-header]
+ (list 'menu-item "Remove File's Fictive XHTML Validation Header"
+ 'nxhtml-remove-saved-validation-header
+ ;; Fix-me: maybe a better enable here?
+ :enable 'nxhtml-validation-header-mode))
+ (define-key val-map [nxhtml-save-validation-header]
+ (list 'menu-item "Save File's Fictive XHTML Validation Header"
+ 'nxhtml-save-validation-header
+ :enable 'nxhtml-validation-header-mode))
+ (define-key val-map [nxhtml-set-validation-header]
+ (list 'menu-item "Choose Fictive XHTML Validation Header for Buffer"
+ 'nxhtml-set-validation-header))
+ (define-key val-map [nxhtml-update-validation-header]
+ (list 'menu-item "Update Fictive XHTML Validation Header for Buffer"
+ 'nxhtml-update-validation-header))
+ (define-key val-map [nxhtml-use-saved-val-separator] (list 'menu-item "--"))
+;;; (let ((afic-map (make-sparse-keymap)))
+;;; (define-key val-map [nxhtml-afic-map]
+;;; (list 'menu-item "Automatic Fictive XHTML Validation Header" afic-map))
+;;; (define-key afic-map [nxhtml-validation-header-mumamo-set]
+;;; (list 'menu-item "Customize Automatic XHTML Validation Turn On"
+;;; (lambda () (interactive) (customize-option 'nxhtml-validation-header-mumamo-modes))))
+;;; (define-key afic-map [nxhtml-validation-header-mumamo]
+;;; (list 'menu-item "Turn on Fictive XHTML Validation Header with MuMaMo"
+;;; 'nxhtml-validation-header-if-mumamo-toggle
+;;; :button '(:toggle . nxhtml-validation-header-if-mumamo))))
+ (define-key val-map [nxhtml-show-validation-header]
+ (list 'menu-item "Display Fictive XHTML Validation Header"
+ 'rngalt-display-validation-header-toggle
+ :help-echo "Displays the Fictive XHTML validation header (if any) at top of buffer"
+ :button '(:toggle . (and (boundp 'rngalt-display-validation-header)
+ rngalt-display-validation-header))))
+ (define-key val-map [nxhtml-recheck-validation-header]
+ (list 'menu-item "Recheck Fictive XHTML Validation Header in Buffer"
+ 'nxhtml-recheck-validation-header
+ :enable 'nxhtml-validation-header-mode))
+ (define-key val-map [nxhtml-validation-header-mode]
+ (list 'menu-item "Use Fictive XHTML Validation Header in Buffer"
+ 'nxhtml-validation-header-mode
+ :button '(:toggle . (and (boundp 'nxhtml-validation-header-mode)
+ nxhtml-validation-header-mode))))
+ )
+ (define-key cmpl-map [nxhtml-validation-separator]
+ (list 'menu-item "--" nil
+ :visible '(nxhtml-nxml-html-in-buffer)))
+ (let ((style-map (make-sparse-keymap)))
+ (define-key cmpl-map [nxhtml-cmpl-style-map]
+ (list 'menu-item "Completion Style" style-map
+ :visible '(nxhtml-nxml-html-in-buffer)
+ :enable '(nxhtml-nxhtml-in-buffer)))
+ (define-key style-map [popcmp-customize]
+ (list 'menu-item "Customize Completion Style"
+ (lambda () (interactive) (customize-group-other-window 'popcmp))))
+ (define-key style-map [popcmp-style-div2]
+ (list 'menu-item "--"))
+ ;;(defun nxhtml-nxml-html-in-buffer ()
+ (define-key style-map [popcmp-with-help]
+ (list 'menu-item "Show Short Help Beside Alternatives"
+ 'popcmp-short-help-beside-alts-toggle
+ :button '(:toggle . (and (boundp 'popcmp-short-help-beside-alts)
+ popcmp-short-help-beside-alts))))
+ (define-key style-map [nxhtml-tag-do-also]
+ (list 'menu-item "Complete Tag Extras"
+ 'nxhtml-tag-do-also-toggle
+ :button '(:toggle . (and (boundp 'nxhtml-tag-do-also)
+ nxhtml-tag-do-also))))
+ (define-key style-map [popcmp-group-alternatives]
+ (list 'menu-item "Group Alternatives"
+ 'popcmp-group-alternatives-toggle
+ :button '(:toggle . (and (boundp 'popcmp-group-alternatives)
+ popcmp-group-alternatives))))
+ (define-key style-map [popcmp-style-div1]
+ (list 'menu-item "--"))
+ (define-key style-map [popcmp-anything-completion]
+ (list 'menu-item "Anything Style Completion"
+ (lambda () (interactive) (customize-set-variable 'popcmp-completion-style 'anything))
+ :enable `(fboundp 'anything)
+ :button `(:radio . (eq popcmp-completion-style 'anything))))
+ (define-key style-map [popcmp-company-completion]
+ (list 'menu-item "Company Mode Style Completion"
+ (lambda () (interactive) (customize-set-variable 'popcmp-completion-style 'company-mode))
+ :enable `(fboundp 'company-mode)
+ :button `(:radio . (eq popcmp-completion-style 'company-mode))))
+ (define-key style-map [popcmp-emacs-completion]
+ (list 'menu-item "Emacs Default Style Completion"
+ (lambda () (interactive) (customize-set-variable 'popcmp-completion-style 'emacs-default))
+ :button `(:radio . (eq popcmp-completion-style 'emacs-default))))
+ (define-key style-map [popcmp-popup-completion]
+ (list 'menu-item "Popup Style Completion"
+ (lambda () (interactive) (customize-set-variable 'popcmp-completion-style 'popcmp-popup))
+ :button `(:radio . (eq popcmp-completion-style 'popcmp-popup))))
+ )
+ (define-key cmpl-map [nxhtml-cmpl-separator]
+ (list 'menu-item "--" nil
+ :visible '(nxhtml-nxml-html-in-buffer)))
+ (define-key cmpl-map [nxhtml-untag-element]
+ (list 'menu-item "Untag Element" 'nxml-untag-element
+ :enable '(nxhtml-nxhtml-in-buffer)
+ :visible '(nxhtml-nxml-html-in-buffer)))
+ (define-key cmpl-map [rngalt-finish-element]
+ (list 'menu-item "Insert End Tag" 'rngalt-finish-element
+ :enable '(nxhtml-nxhtml-in-buffer)
+ :visible '(nxhtml-nxml-html-in-buffer)))
+ (define-key cmpl-map [nxhtml-complete]
+ (list 'menu-item "Complete tag, attribute etc" 'nxml-complete
+ :enable '(nxhtml-nxml-in-buffer)
+ :visible '(nxhtml-nxml-html-in-buffer)))
+ )
+
+
+ )
+
+ (let ((options-map (make-sparse-keymap)))
+ (define-key map [nxhtml-options-map]
+ (list 'menu-item "Options" options-map))
+
+ (define-key options-map [nxhtml-save-opt]
+ (list 'menu-item "Save All Changed Options" 'customize-save-customized))
+
+ (define-key options-map [nxhtml-save-sep] (list 'menu-item "--"))
+
+ (define-key options-map [nxhtml-load-flymake]
+ (list 'menu-item "Use nXhtml CSS/JS Flymake"
+ 'nxhtml-flymake-setup
+ :button '(:toggle . (and (boundp 'nxhtml-flymake-setup)
+ nxhtml-flymake-setup))))
+
+ (define-key options-map [nxhtml-save-sep] (list 'menu-item "--"))
+
+ (define-key options-map [nxhtml-winsav-mode]
+ (list 'menu-item "Save/restore Frames and Windows"
+ 'winsav-save-mode
+ :button '(:toggle . (and (boundp 'winsav-save-mode)
+ winsav-save-mode))))
+ (define-key options-map [nxhtml-win-sep] (list 'menu-item "--"))
+ (define-key options-map [nxhtml-images-global]
+ (list 'menu-item "Display Images Inline" 'inlimg-global-mode
+ :button '(:toggle . (and (boundp 'inlimg-global-mode)
+ inlimg-global-mode))))
+ (define-key options-map [nxhtml-opt-sep] (list 'menu-item "--"))
+ (define-key options-map [nxhtml-hl-needed-mode]
+ (list 'menu-item "Tell Me Where I Am" 'hl-needed-mode
+ :button '(:toggle . (and (boundp 'hl-needed-mode)
+ hl-needed-mode))))
+ (define-key options-map [nxhtml-mark-nonascii]
+ (list 'menu-item "Mark Special Chars (default non-IDN)" 'markchars-global-mode
+ :button '(:toggle . (and (boundp 'markchars-global-mode)
+ markchars-global-mode))))
+ (define-key options-map [nxhtml-sml-modeline-mode]
+ (list 'menu-item "Mode Line Scroll Indicator" 'sml-modeline-mode
+ :button '(:toggle . (and (boundp 'sml-modeline-mode)
+ sml-modeline-mode))))
+ (define-key options-map [rebind-keys]
+ (list 'menu-item "Rebind My Choosen Keys" 'rebind-keys-mode
+ :button '(:toggle . (and (boundp 'rebind-keys-mode)
+ rebind-keys-mode))))
+ (define-key options-map [nxhtml-appmenu]
+ (list 'menu-item "Context Sensitive AppMenu"
+ 'appmenu-mode
+ :button '(:toggle . (and (boundp 'appmenu-mode)
+ appmenu-mode))))
+ (define-key options-map [nxhtml-menu-to-m-x]
+ (list 'menu-item "Add Menu Commands to M-x history"
+ 'ourcomments-M-x-menu-mode
+ :button '(:toggle . (and (boundp 'ourcomments-M-x-menu-mode)
+ ourcomments-M-x-menu-mode))))
+ (define-key options-map [nxhtml-patch-converting]
+ (list 'menu-item "Paste with Convert"
+ 'ourcomments-paste-with-convert-mode
+ :button '(:toggle . (and (boundp 'ourcomments-paste-with-convert-mode)
+ ourcomments-paste-with-convert-mode))))
+
+ (define-key options-map [nxhtml-tab-separator]
+ (list 'menu-item "--" nil))
+ (define-key options-map [nxhtml-ctrl-tab]
+ (list 'menu-item "Ctrl-TAB Buffer Switching"
+ 'ourcomments-ido-ctrl-tab
+ :button '(:toggle . (and (boundp 'ourcomments-ido-ctrl-tab)
+ ourcomments-ido-ctrl-tab))))
+ (define-key options-map [nxhtml-tab-complete]
+ (list 'menu-item "Indent and then Complete (TabKey2 mode)" 'tabkey2-mode
+ :button '(:toggle . (and (boundp 'tabkey2-mode)
+ tabkey2-mode))))
+
+
+
+ (define-key options-map [nxhtml-majpri-separator]
+ (list 'menu-item "--" nil))
+ (define-key options-map [nxhtml-as-external]
+ (list 'menu-item "External Editor Setup"
+ 'as-external-mode
+ :button '(:toggle . (and (boundp 'as-external-mode)
+ as-external-mode))))
+ (define-key options-map [nxhtml-sex-mode]
+ (list 'menu-item "Open Files in External Apps"
+ 'sex-mode
+ :button '(:toggle . (and (boundp 'sex-mode)
+ sex-mode))))
+ (let ((majpri-map (make-sparse-keymap)))
+ (define-key options-map [nxhtml-majpri-map]
+ (list 'menu-item "Major Modes Priorities" majpri-map))
+ (define-key majpri-map [nxhtml-majpri-act]
+ (list 'menu-item "Apply Major Modes Priorities"
+ 'majmodpri-apply-priorities))
+ (define-key majpri-map [nxhtml-majpri-cust]
+ (list 'menu-item "Customize Major Mode Priorities"
+ (lambda ()
+ "Customize group Major Mode priorities."
+ (interactive)
+ (customize-group-other-window 'majmodpri))))
+ )
+ )
+
+ (let ((edit-map (make-sparse-keymap)))
+ (define-key map [nxhtml-edit-map]
+ (list 'menu-item "Edit" edit-map))
+
+ (let ((folding-map (make-sparse-keymap)))
+ (define-key edit-map [nxhtml-folding-map]
+ (list 'menu-item "Folding" folding-map))
+ (define-key folding-map [nxhtml-fold-unhide-all]
+ (list 'menu-item "Unhide Everything"
+ 'fold-dwim-unhide-hs-and-outline))
+ (define-key folding-map [nxhtml-fold-dwim]
+ (list 'menu-item "Maybe DWIM Folding"
+ 'fold-dwim-toggle))
+ (define-key folding-map [nxhtml-separator2] (list 'menu-item "--" nil))
+ (define-key folding-map [nxhtml-hs]
+ (list 'menu-item "Turn On Hide/Show and Hide"
+ 'fold-dwim-turn-on-hs-and-hide))
+ (define-key folding-map [nxhtml-outline]
+ (list 'menu-item "Turn On Outline and Hide All"
+ 'fold-dwim-turn-on-outline-and-hide-all))
+ (define-key folding-map [nxhtml-separator1] (list 'menu-item "--" nil))
+ (define-key folding-map [nxhtml-foldit-mode]
+ (list 'menu-item "Folding Markers in Buffer"
+ 'foldit-mode
+ :button '(:toggle . (and (boundp 'foldit-mode)
+ foldit-mode))))
+ (define-key folding-map [nxhtml-foldit-global-mode]
+ (list 'menu-item "Folding Markers Everywhere"
+ 'foldit-global-mode
+ :button '(:toggle . (and (boundp 'foldit-global-mode)
+ foldit-global-mode))))
+ )
+
+ (define-key edit-map [nxhtml-folding-sep] (list 'menu-item "--"))
+
+ (define-key edit-map [nxhtml-wrap-to-fill-column-mode]
+ (list 'menu-item "Wrap To Fill Column Mode"
+ 'wrap-to-fill-column-mode
+ :button '(:toggle . (and (boundp 'wrap-to-fill-column-mode)
+ wrap-to-fill-column-mode))))
+ (define-key edit-map [nxhtml-fill-dwim]
+ (list 'menu-item "Fill DWIM" 'fill-dwim))
+
+ (define-key edit-map [nxhtml-fill-sep] (list 'menu-item "--"))
+
+
+ (let ((link-map (make-sparse-keymap)))
+ (define-key edit-map [nxhtml-link-map]
+ (list 'menu-item "Links" link-map
+ :enable '(not (derived-mode-p 'dired-mode))
+ ))
+
+ (define-key link-map [mlinks-goto-link-other-frame]
+ (list 'menu-item "Follow MLink Link in New Frame" 'mlinks-goto-other-frame
+ :enable '(and (boundp 'mlinks-mode)
+ mlinks-mode)
+ :help "Follow MLinks Link in New Frame"))
+ (define-key link-map [mlinks-goto-link-other-window]
+ (list 'menu-item "Follow MLink Link in Other Window" 'mlinks-goto-other-window
+ :enable '(and (boundp 'mlinks-mode)
+ mlinks-mode)
+ :help "Follow MLinks Link in Other Window"))
+ (define-key link-map [mlinks-goto-link]
+ (list 'menu-item "Follow MLink Link" 'mlinks-goto
+ :enable '(and (boundp 'mlinks-mode)
+ mlinks-mode)
+ :help "Follow MLinks Link"))
+ (define-key link-map [nxhtml-separator-follow-mlink] (list 'menu-item "--"))
+ (define-key link-map [mlinks-next-link]
+ (list 'menu-item "Next MLink Link" 'mlinks-forward-link
+ :enable '(and (boundp 'mlinks-mode)
+ mlinks-mode)
+ :help "Go to next MLinks link"))
+ (define-key link-map [mlinks-prev-link]
+ (list 'menu-item "Previous MLink Link" 'mlinks-backward-link
+ :enable '(and (boundp 'mlinks-mode)
+ mlinks-mode)
+ :help "Go to previous MLinks link"))
+
+ )
+ (define-key edit-map [nxhtml-edit-sep1] (list 'menu-item "--"))
+ (define-key edit-map [nxhtml-grep-replace]
+ (list 'menu-item "Replace in Grepped Files" 'grep-query-replace))
+ (define-key edit-map [nxhtml-rdir-replace]
+ (list 'menu-item "Replace in Files in Tree" 'rdir-query-replace))
+ (define-key edit-map [nxhtml-ldir-replace]
+ (list 'menu-item "Replace in Files in Directory" 'ldir-query-replace))
+
+ (define-key edit-map [nxhtml-edit-sep2] (list 'menu-item "--"))
+ (define-key edit-map [nxhtml-multi-occur]
+ (list 'menu-item "Occur in File Buffers" 'multi-occur-in-matching-buffers))
+ (define-key edit-map [nxhtml-occur]
+ (list 'menu-item "Occur" 'occur))
+ (define-key edit-map [nxhtml-edit-sep3] (list 'menu-item "--"))
+ (define-key edit-map [nxhtml-re-builder]
+ (list 'menu-item "Re-Builder" 're-builder))
+ (define-key edit-map [nxhtml-edit-sep4] (list 'menu-item "--"))
+ (let ((copy+paste-map (make-sparse-keymap "copy+paste")))
+ (define-key edit-map [nxhtml-copy+paste-map]
+ (list 'menu-item "Copy+Paste" copy+paste-map))
+ (define-key copy+paste-map [nxhtml-copy+paste-do]
+ (list 'menu-item "Do Copy+Paste" 'ourcomments-copy+paste
+ :enable '(and (boundp 'ourcomments-copy+paste-mode)
+ ourcomments-copy+paste-mode)))
+ (define-key copy+paste-map [nxhtml-copy+paste-set]
+ (list 'menu-item "Start Copy+Paste" 'ourcomments-copy+paste-set-point
+ :button '(:toggle . (and (boundp 'ourcomments-copy+paste-mode)
+ ourcomments-copy+paste-mode))))
+ )
+ (define-key edit-map [nxhtml-anchored-transpose]
+ (list 'menu-item "Transpose Regions" 'anchored-transpose
+ :button '(:toggle . (and mouse-secondary-overlay
+ (overlay-buffer mouse-secondary-overlay)))))
+ )
+
+ (define-key map [nxhtml-help-tools-separator]
+ ;; Notice that removing nil below gives an error that is quite
+ ;; hard to catch:
+ ;;
+ ;; Wrong type argument: arrayp, not
+ (list 'menu-item "--" nil
+ :visible `(not (derived-mode-p 'dired-mode))
+ ))
+
+
+ (let ((upl-map (make-sparse-keymap "html-upl")))
+ (define-key map [nxhtml-upl-map]
+ (list 'menu-item "File Transfer" upl-map
+ ;;:enable '(featurep 'html-upl)))
+ :enable '(fboundp 'html-upl-upload-file)))
+ (define-key upl-map [nxhtml-upl-remote-dired]
+ (list 'menu-item "Remote Dired" 'html-upl-remote-dired))
+ (define-key upl-map [nxhtml-upl-dired-sep] (list 'menu-item "--"))
+ (define-key upl-map [nxhtml-upl-edit-remote-wtoc]
+ (list 'menu-item "Edit Remote File With TOC" 'html-upl-edit-remote-file-with-toc
+ :visible '(or (not (featurep 'html-site))
+ (nxhtml-this-file-can-have-toc))))
+ (define-key upl-map [nxhtml-upl-edit-remote]
+ (list 'menu-item "Edit Remote File" 'html-upl-edit-remote-file))
+ (define-key upl-map [nxhtml-upl-ediff-file]
+ (list 'menu-item "Ediff Remote/Local Files" 'html-upl-ediff-file))
+ (define-key upl-map [nxhtml-upl-sep] (list 'menu-item "--"))
+ (define-key upl-map [nxhtml-upl-upload-site-with-toc]
+ (list 'menu-item "Upload Site with TOC" 'html-upl-upload-site-with-toc
+ :visible '(or (not (featurep 'html-site))
+ (and (html-site-current-merge-dir)
+ (html-site-current-ensure-file-in-site file)))))
+ (define-key upl-map [nxhtml-upl-upload-site]
+ (list 'menu-item "Upload Site" 'html-upl-upload-site))
+ (define-key upl-map [nxhtml-upl-upload-file]
+ (list 'menu-item "Upload Single File" 'html-upl-upload-file))
+ )
+
+
+ (let ((browse-map (make-sparse-keymap)))
+ (define-key map [nxhtml-browse-map]
+ (list 'menu-item "Browse" browse-map
+ '(or buffer-file-name
+ (eq major-mode 'nxhtml-mode))
+ :enable '(nxhtml-buffer-possibly-local-viewable)))
+ (define-key browse-map [nxhtml-browse-region]
+ (list 'menu-item "Browse the Region Only" 'nxhtml-browse-region
+ :enable 'mark-active))
+ (define-key browse-map [nxhtml-upl-sep3] (list 'menu-item "--"))
+ (define-key browse-map [nxhtml-upl-browse-remote-wtoc]
+ (list 'menu-item "Browse Uploaded File With TOC" 'html-upl-browse-remote-with-toc
+ :visible '(and (nxhtml-buffer-possibly-local-viewable)
+ (featurep 'html-wtoc)
+ (html-site-current-merge-dir)
+ (html-site-current-ensure-file-in-site file)
+ (nxhtml-buffer-possibly-remote-viewable)
+ )))
+ (define-key browse-map [nxhtml-upl-browse-remote-frame-file]
+ (list 'menu-item "Browse Uploaded Frames File" 'html-upl-browse-remote-frames
+ :enable '(nxhtml-buffer-possibly-remote-viewable)))
+ (define-key browse-map [nxhtml-upl-browse-remote]
+ (list 'menu-item "Browse Uploaded File" 'html-upl-browse-remote
+ :enable '(nxhtml-buffer-possibly-remote-viewable)))
+ (define-key browse-map [nxhtml-upl-sep2]
+ (list 'menu-item "--"))
+ (define-key browse-map [nxhtml-browse-merged-file]
+ (list 'menu-item "Browse File With TOC" 'html-wtoc-browse-page-with-toc
+ :visible '(and (nxhtml-buffer-possibly-local-viewable)
+ (featurep 'html-wtoc)
+ (html-site-current-merge-dir)
+ (html-site-current-ensure-file-in-site file)
+ )))
+ (define-key browse-map [nxhtml-browse-frame-file]
+ (list 'menu-item "Browse Frames File" 'html-toc-browse-frames-file
+ :enable '(and (featurep 'html-toc)
+ (nxhtml-buffer-possibly-local-viewable))))
+ (define-key browse-map [nxhtml-browse-file]
+ (list 'menu-item "Browse File" 'nxhtml-browse-file
+ :enable '(nxhtml-buffer-possibly-local-viewable)))
+ )
+
+
+
+ (let ((site-map (make-sparse-keymap)))
+ (define-key map [nxhtml-site-map]
+ (list 'menu-item "Site" site-map))
+ (define-key site-map [html-site-global-mode]
+ (list 'menu-item "HTML Site Global Mode"
+ 'html-site-global-mode
+ :button '(:toggle . (and (boundp 'html-site-global-mode)
+ html-site-global-mode))))
+ (define-key site-map [nxhtml-site-separator] (list 'menu-item "--"))
+ (define-key site-map [nxhtml-customize-site-list]
+ (list 'menu-item "Edit Sites" (lambda ()
+ "Customize option `html-size-list'."
+ (interactive)
+ (customize-option-other-window 'html-site-list))))
+ (define-key site-map [nxhtml-set-site]
+ (list 'menu-item "Set Current Site" 'html-site-set-site))
+ (define-key site-map [nxhtml-site-separator-1] (list 'menu-item "--"))
+ (define-key site-map [nxhtml-dired-site-top]
+ (list 'menu-item "Dired Site" 'html-site-dired-current))
+ (define-key site-map [nxhtml-find-site-file]
+ (list 'menu-item "Find File in Site" 'html-site-find-file))
+ (define-key site-map [nxhtml-site-search-separator]
+ (list 'menu-item "--" nil))
+ (define-key site-map [nxhtml-replace-in-site]
+ (list 'menu-item "Replace in Site Files" 'html-site-query-replace))
+ (define-key site-map [nxhtml-rgrep-in-site]
+ (list 'menu-item "Search Site Files" 'html-site-rgrep))
+ )
+
+ (define-key map [nxhtml-insert-separator]
+ (list 'menu-item "--" nil
+ :visible `(not (derived-mode-p 'dired-mode))
+ ))
+ (let ((chunk-map (make-sparse-keymap)))
+ (define-key map [nxhtml-chunk-map]
+ (list 'menu-item "Multi Major Modes" chunk-map
+ :visible `(not (derived-mode-p 'dired-mode))
+ ))
+ (define-key chunk-map [nxhtml-customize-mumamo]
+ (list 'menu-item "Customize MuMaMo"
+ (lambda () (interactive) (customize-group-other-window 'mumamo))))
+ (define-key chunk-map [nxhtml-list-mumamo]
+ (list 'menu-item "List defined Multi Major Modes"
+ 'mumamo-list-defined-multi-major-modes))
+ (define-key chunk-map [nxhtml-chunks-separator2]
+ (list 'menu-item "--" nil))
+ (define-key chunk-map [nxhtml-chunk-no-colors]
+ (list 'menu-item "Remove Chunk Colors Temporarily"
+ 'mumamo-no-chunk-coloring
+ :button '(:toggle . (and (boundp 'mumamo-no-chunk-coloring)
+ mumamo-no-chunk-coloring))))
+ (define-key chunk-map [nxhtml-chunk-margin-info]
+ (list 'menu-item "Display Chunk Info in Margin"
+ 'mumamo-margin-info-global-mode
+ :button '(:toggle . (and (boundp 'mumamo-margin-info-global-mode)
+ mumamo-margin-info-global-mode))))
+ (define-key chunk-map [nxhtml-chunks-separator1]
+ (list 'menu-item "--" nil))
+ (let ((region-map (make-sparse-keymap)))
+ (define-key chunk-map [nxhtml-region-map]
+ (list 'menu-item "Temprary Region Chunks" region-map))
+ (define-key region-map [mumamo-clear-all-regions]
+ (list 'menu-item "Clear Region Chunks"
+ 'mumamo-clear-all-regions
+ :enable '(and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode
+ (fboundp 'mumamo-clear-all-regions))))
+ (define-key region-map [mumamo-clear-region]
+ (list 'menu-item "Clear Region Chunk at Point"
+ 'mumamo-clear-region
+ :enable '(fboundp 'mumamo-clear-region)))
+ (define-key region-map [nxhtml-region-separator2]
+ (list 'menu-item "--" nil))
+ (define-key region-map [mumamo-region-major]
+ (list 'menu-item "Set Region Chunk Major Mode"
+ 'mumamo-region-set-major
+ :enable '(fboundp 'mumamo-region-set-major)))
+ (define-key region-map [mumamo-add-region-from-string]
+ (list 'menu-item "Add Region Chunk from String"
+ 'mumamo-add-region-from-string))
+ (define-key region-map [mumamo-add-region]
+ (list 'menu-item "Add Region Chunk from Selection"
+ 'mumamo-add-region)))
+ (define-key chunk-map [nxhtml-region-separator]
+ (list 'menu-item "--" nil))
+ (define-key chunk-map [mumamo-mark-chunk]
+ (list 'menu-item "Mark Chunk"
+ 'mumamo-mark-chunk
+ :enable '(and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)))
+ (define-key chunk-map [nxhtml-separator-mark-chunk] (list 'menu-item "--"))
+ (define-key chunk-map [mumamo-backward-chunk]
+ (list 'menu-item "Backward Chunk"
+ 'mumamo-backward-chunk
+ :enable '(and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)))
+ (define-key chunk-map [mumamo-forward-chunk]
+ (list 'menu-item "Forward Chunk"
+ 'mumamo-forward-chunk
+ :enable '(and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode))))
+ (let ((tag-map (make-sparse-keymap)))
+ (define-key map [nxhtml-tag-map]
+ (list 'menu-item "Move by Tag" tag-map
+ :visible '(or (derived-mode-p 'nxml-mode)
+ (derived-mode-p 'sgml-mode))
+ :enable '(or (derived-mode-p 'nxml-mode)
+ (nxhtml-nxhtml-in-buffer))))
+ (define-key tag-map [nxml-forward-par]
+ (list 'menu-item "Forward Paragraph"
+ 'nxml-forward-paragraph))
+ (define-key tag-map [nxml-backward-par]
+ (list 'menu-item "Backward Paragraph"
+ 'nxml-backward-paragraph))
+ (define-key tag-map [nxml-insert-separator-move2] (list 'menu-item "--"))
+ (define-key tag-map [nxml-down]
+ (list 'menu-item "Forward Into Tag"
+ 'nxml-down-element))
+ (define-key tag-map [nxml-backward-up]
+ (list 'menu-item "Backward Out of Tag"
+ 'nxml-backward-up-element))
+ (define-key tag-map [nxml-insert-separator-move] (list 'menu-item "--"))
+ (define-key tag-map [nxml-forward]
+ (list 'menu-item "Forward Balanced Tag"
+ 'nxml-forward-element))
+ (define-key tag-map [nxml-backward]
+ (list 'menu-item "Backward Balanced Tag"
+ 'nxml-backward-element))
+ )
+
+
+ map))
+
+(defvar nxhtml-menu-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c) ?? ?x] 'nxhtml-short-tag-help)
+ (define-key map [(control ?c) ?? ?c] 'xhtml-help-show-css-ref)
+ (define-key map [(control ?c) ?_] 'nxhtml-toggle-visible-warnings)
+ (define-key map [menu-bar nxhtml-menu-mode]
+ (list 'menu-item "nXhtml" nxhtml-menu-mode-menu-map))
+ map))
+
+;;;###autoload
+(define-minor-mode nxhtml-menu-mode
+ "Minor mode to turn on some key and menu bindings.
+See `nxhtml-mode' for more information.
+
+This minor mode adds the entry 'nXhtml' to the menu bar. This
+submenu gives easy access to most of the important features of
+nXhtml.
+
+To see an \(incomplete) overview in html format do
+\\[nxhtml-overview].
+
+* Note: Please observe that when loading nXhtml some file
+ associations are done, see `nxhtml-setup-file-assoc'.
+
+Here are some important features:
+
+- multiple major modes, see `define-mumamo-multi-major-mode'
+- easy uploading and viewing of files, see for example
+ `html-upl-upload-file'
+
+- validation in XHTML part for php etc, see
+ `nxhtml-validation-header-mode' (you probably also want to know
+ about `nxhtml-toggle-visible-warnings' for this!)
+
+- converting of html to xhtml, see `tidy-buffer'
+
+Some smaller, useful, but easy-to-miss features:
+
+* Following links. The href and src attribute names are
+ underlined and a special keymap is bound to
+ them:\\<mlinks-mode-map>
+
+ \\[mlinks-backward-link], \\[mlinks-forward-link] Move
+ between underlined href/src attributes
+
+ \\[mlinks-goto], Mouse-1 Follow link inside Emacs
+ (if possible)
+
+ It is even a little bit quicker when the links are in an active
+ state (marked with the face `isearch'):\\<mlinks-active-hilight-keymap>
+
+ \\[mlinks-backward-link], \\[mlinks-forward-link] Move
+ between underlined href/src attributes
+ \\[mlinks-goto], Mouse-1 Follow link inside Emacs (if possible)
+
+ If the link is not into a file that you can edit (a mailto link
+ for example) you will be prompted for an alternative action.
+
+* Creating links. To make it easier to create links to id/name
+ attribute in different files there are two special
+ functions:\\<nxhtml-mode-map>
+
+ \\[nxhtml-save-link-to-here] copy link to id/name (you must
+ be in the tag to get the link)
+ \\[nxhtml-paste-link-as-a-tag] paste this as an a-tag.
+
+This minor mode also adds some bindings:
+
+\\{nxhtml-menu-mode-map}
+
+---------
+* Note: Some of the features supported are optional and available
+ only if other Emacs modules are found. Use
+ \\[nxhtml-features-check] to get a list of these optional
+ features and modules needed. You should however have no problem
+ with this if you have followed the installation instructions
+ for nXhtml."
+ :keymap nxhtml-menu-mode-map
+ :group 'nxhtml
+ :global t
+ )
+
+(defalias 'nxhtml-minor-mode 'nxhtml-menu-mode)
+(defalias 'nxhtml-global-minor-mode 'nxhtml-menu-mode)
+
+;; (defcustom nxhtml-menu-mode-modes
+;; '(
+;; nxhtml-mode
+;; nxml-mode
+;; html-mode
+;; sgml-mode
+;; xml-mode
+;; php-mode
+;; css-mode
+;; javascript-mode
+;; java-mode ;; jsp
+;; groovy-mode ;; gsp
+;; image-mode
+;; ;;
+;; dired-mode
+;; )
+;; "List for turning on `nxhtml-menu-mode'.
+;; If the buffer's major modes is any of those in this list then
+;; `nxhtml-global-minor-mode' will turn on `nxhtml-menu-mode' in
+;; the buffer."
+;; :type '(repeat (symbol :tag "Major mode"))
+;; :group 'nxhtml)
+
+;; (defun nxhtml-maybe-turn-on-minor-mode ()
+;; "Maybe turn on `nxhtml-menu-mode'.
+;; See `nxhtml-menu-mode-modes'."
+;; (nxhtml-menu-mode 1))
+;; (unless (or (minibufferp (current-buffer))
+;; (string= " " (substring (buffer-name) 0 1))
+;; (string= "*" (substring (buffer-name) 0 1))
+;; )
+;; (let ((on (and (boundp 'mumamo-multi-major-mode)
+;; mumamo-multi-major-mode)))
+;; (dolist (major nxhtml-menu-mode-modes)
+;; (when (derived-mode-p major)
+;; (setq on t)))
+;; (when on
+;; (nxhtml-menu-mode 1)))))
+
+;; (define-globalized-minor-mode nxhtml-global-minor-mode
+;; nxhtml-menu-mode
+;; nxhtml-maybe-turn-on-minor-mode
+;; ;;:require 'nxhtml-menu
+;; :group 'nxhtml)
+;;(message "nxhtml-menu:here A")
+;;(custom-reevaluate-setting 'nxhtml-global-minor-mode)
+;;(message "nxhtml-menu:here B")
+;;(when nxhtml-global-minor-mode (nxhtml-global-minor-mode 1))
+;;(message "nxhtml-menu:here C")
+
+
+;; (file-exists-p (nxhtml-docfile))
+;; (find-file (nxhtml-docfile))
+(defun nxhtml-docfile ()
+ (expand-file-name "nxhtml/doc/nxhtml.html" nxhtml-install-dir))
+
+(defun nxhtml-docfile-url ()
+ (let ((local-docfile (concat "file://" (nxhtml-docfile))))
+ (if (and nxhtml-autoload-web
+ (not (file-exists-p local-docfile)))
+ "http://ourcomments.org/Emacs/nXhtml/doc/nxhtml.html"
+ local-docfile)))
+
+;;;###autoload
+(defun nxhtml-overview ()
+ "Show a HTML page with an overview of nXhtml."
+ (interactive)
+ (browse-url (nxhtml-docfile-url)))
+
+(defun nxhtml-tutorials ()
+ "Show a HTML page with a list of tutorials for nXhtml'."
+ (interactive)
+ (browse-url "http://ourcomments.org/Emacs/nXhtml/tut/tutorials.html"))
+
+(defun nxhtml-custom-valfaced (value &optional bgcolor)
+ (let ((v (if (sequencep value)
+ (copy-seq value)
+ value))
+ (bgcolor (if bgcolor bgcolor "RGB:FF/FF/AA")))
+ (put-text-property 0 (length v)
+ 'face (list
+ 'bold
+ (cons 'background-color bgcolor)
+ )
+ v)
+ v))
+(defun nxhtml-custom-insert-nxhtml-row (symbol nxhtml-value description)
+ (let ((desc (if description
+ (format "%s (%s)" description symbol)
+ (format "%s" (custom-unlispify-tag-name symbol)))))
+ (widget-insert " " description " (")
+ (nxhtml-custom-describe-defun symbol)
+ (widget-insert "): "
+ (nxhtml-custom-valfaced
+ (format "%s" (symbol-value symbol))
+ (if (eq (symbol-value symbol)
+ nxhtml-value)
+ "GreenYellow"
+ "gainsboro"))
+ "\n")))
+
+(defun nxhtml-custom-h1(title &optional divider top-newline)
+ (let ((s title))
+ (put-text-property 0 (length s)
+ 'face '(:weight bold
+ :height 1.4
+ :foreground "DarkGreen"
+ ;;:underline t
+ )
+ s)
+ (when top-newline (widget-insert "\n"))
+ ;;(when divider (widget-insert (nxhtml-custom-divider (length s))))
+ (widget-insert s)
+ ))
+
+(defun widget-button-notify (widget &rest ignore)
+ (apply (widget-get widget 'function) (widget-get widget 'data)))
+
+(defun widget-insert-link (txt function data)
+ (widget-insert-button txt function data
+ :button-face 'link
+ :mouse-face 'highlight
+ :button-prefix ""
+ :button-suffix ""))
+
+(defun widget-insert-button (txt function data &rest keywords)
+ (let ((btn (apply 'widget-create
+ (append
+ '(push-button
+ :notify
+ widget-button-notify)
+ keywords
+ (list txt)))))
+ (widget-put btn 'data data)
+ (widget-put btn 'function function)))
+
+(defun nxhtml-custom-url-link (txt url)
+ (let ((plain-url (substring-no-properties url)))
+ (unless (equal txt url)
+ (put-text-property 0 (length txt) 'help-echo plain-url txt))
+ (put-text-property 0 (length txt) 'mouse-face 'highlight txt)
+ (widget-insert-link txt 'browse-url (list url))))
+
+(defun nxhtml-custom-describe-defun (sym &optional help)
+ (let ((txt (symbol-name sym)))
+ (when help
+ (put-text-property 0 (length txt) 'help-echo help txt))
+ (put-text-property 0 (length txt) 'mouse-face 'highlight txt)
+ (widget-insert-link txt 'describe-function (list sym))))
+
+;; (defun nxhtml-quick-customize (&optional same-window)
+;; "Show page for Quick Customize of nXhtml."
+;; (interactive)
+;; (require 'nxhtml)
+;; (require 'custom)
+;; (require 'cus-edit)
+;; (if same-window
+;; (switch-to-buffer "*Quick Customize nXhtml*")
+;; (switch-to-buffer-other-window "*Quick Customize nXhtml*"))
+;; (kill-all-local-variables)
+;; (custom-mode)
+;; (let ((inhibit-read-only t))
+;; (erase-buffer))
+;; (let ((sFound "found")
+;; (sError "error"))
+;; (put-text-property 0 (length sFound)
+;; 'face '(bold
+;; (foreground-color . "green")) sFound)
+;; (put-text-property 0 (length sError)
+;; 'face '(bold
+;; (foreground-color . "red")) sError)
+;; (let* (
+;; (default-used "(not set yet - default used)")
+;; )
+;; (nxhtml-custom-h1 "Quick Customize for nXhtml" t)
+;; (widget-insert "
+
+;; This page is for a quick and easy setup of some ")
+;; (nxhtml-custom-url-link "nXhtml" (nxhtml-docfile-url))
+;; (widget-insert " features
+;; that I did not want to turn on by default since they alter what
+;; happens when you open a file. I suggest however that you turn
+;; them on since they are quite useful if you just understands what
+;; is happening.
+
+;; The values you set here are saved so that they will be used next
+;; time you start Emacs too.")
+;; ;;(widget-insert-link "customize nXhtml" 'customize-group (list 'nxhtml))
+;; (widget-insert "\n\n")
+
+;; (nxhtml-custom-insert-nxhtml-row 'nxhtml-global-minor-mode t "Show the nXhtml menu in all relevant buffers\n\t")
+;; ;;(nxhtml-custom-insert-nxhtml-row 'mumamo-global-mode t "Turn on Multiple Major Mode in all relevant buffers\n\t")
+;; ;;(nxhtml-custom-insert-nxhtml-row 'mlinks-global-mode t "Make link of lins, for example href=\"...\"\n\t")
+;; ;;(nxhtml-custom-insert-nxhtml-row 'indent-region-mode t "Use TAB to indent region when it is selected\n\t")
+
+;; (widget-insert "\n")
+;; (widget-insert-button " Turn them all on "
+;; (lambda ()
+;; (nxhtml-quick-all t)
+;; (nxhtml-quick-customize t))
+;; nil)
+;; (widget-insert " ")
+;; (widget-insert-button " Turn them all off "
+;; (lambda ()
+;; (nxhtml-quick-all nil)
+;; (nxhtml-quick-customize t))
+;; nil)
+;; (beginning-of-line)
+;; )))
+
+;; (defun nxhtml-quick-all (on)
+;; (custom-set-and-prepare-save 'nxhtml-global-minor-mode on)
+;; ;;(custom-set-and-prepare-save 'mumamo-global-mode on)
+;; (custom-set-and-prepare-save 'indent-region-mode on)
+;; (when custom-file
+;; (custom-save-all)))
+
+(defun custom-set-and-prepare-save (symbol value)
+ "Set SYMBOL to VALUE and add to customize.
+Both the current value and the value to save is set, but
+`custom-save-all' must be called to save customization."
+ (customize-set-variable symbol value)
+ (customize-set-value symbol value)
+ (customize-mark-to-save symbol))
+
+
+;;(nxhtml-quick-customize)
+
+(defun nxhtml-welcome ()
+ "Show welcome information."
+ (interactive)
+ (require 'cus-edit)
+ (let* ((bufnam "*nXhtml Welcome*")
+ (oldbuf (get-buffer bufnam))
+ (curwin (selected-window)))
+ (switch-to-buffer-other-window bufnam)
+ (unless oldbuf
+ (let ((inhibit-read-only t)
+ (here (point)))
+ (Custom-mode)
+ (nxhtml-menu-mode 1)
+ (setq cursor-in-non-selected-windows nil)
+ (nxhtml-custom-h1 "Welcome to nXhtml - a package for web editing" t)
+ (insert "\n\n")
+ (setq here (point))
+ (insert "If you have not done it already it might "
+ "be a good time to read at least The Quick Guide in the ")
+ (nxhtml-custom-url-link "nXhtml overview" (nxhtml-docfile-url))
+ (insert " now.\n\n")
+ (fill-region here (point))
+ (setq here (point))
+ (insert "And oh, wait! If you are new to Emacs too you might want "
+ "to take a quick ")
+ (nxhtml-custom-url-link
+ "Emacs tour"
+ "http://www.gnu.org/software/emacs/tour/")
+ (insert ". And then perhaps the Emacs tutorial "
+ "(which is in the Help menu above).\n\n")
+ (fill-region here (point))
+ (setq here (point))
+
+ (unless (nxhtml-skip-welcome)
+ (insert "Click to ")
+ (widget-insert-link "remove this message"
+ (lambda ()
+ "Customize `nxhtml-skip-welcome'."
+ (customize-option 'nxhtml-skip-welcome))
+ nil)
+ (insert " at startup. (This page is still "
+ "available in the nXhtml menu, at the bottom.)"))
+ (fill-region here (point))
+ (setq here (point))
+ (goto-char (point-min))))
+ (select-window curwin)))
+
+(defcustom nxhtml-skip-welcome nil
+ "Turn this on to always skip the nXhtml welcome message."
+ :type 'boolean
+ :group 'nxhtml)
+
+(defun nxhtml-skip-welcome ()
+ "Return t if nXhtml welcome message should be skipped.
+If nil then the message will be shown when you open the first
+file using nxhtml-mode."
+ (or nxhtml-skip-welcome
+ (and nxhtml-menu-mode
+ ;;mumamo-global-mode
+ ;;indent-region-mode
+ )))
+
+(defun nxhtml-say-welcome-unless-skip ()
+ (condition-case err
+ (unless (nxhtml-skip-welcome)
+ (save-match-data
+ (nxhtml-welcome)))
+ (error (message "ERROR nxhtml-say-welcome-unless-skip: %s" err))))
+
+;; Show welcome screen once after loading nxhtml:
+;;(unless (boundp 'bytecomp-filename)
+(eval-when '(load)
+ (eval-after-load 'nxhtml
+ ;; Use a short delay if something like desktop is used:
+ '(run-with-idle-timer 0.5 nil 'nxhtml-say-welcome-unless-skip)))
+
+(provide 'nxhtml-menu)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtml-menu.el ends here
--- /dev/null
+;;; nxhtml-mode.el --- Edit XHTML files
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Parts are from Peter Heslin (see below)
+;; Created: 2005-08-05
+;;Version:
+;; Last-Updated: 2008-12-28 Sun
+;; Keywords: languages
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; The purpose of nxhtml.el is to add some features that are useful
+;; when editing XHTML files to nxml-mode. For more information see
+;; `nxhtml-mode'.
+;;
+;;
+;; Usage:
+;;
+;; See the file readme.txt in the directory above this file. Or, if
+;; you do not have that follow the instructions below.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; History:
+;;
+;; 2006-04-25: Added completion for href, src etc. Removed xhtmlin.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This file is not part of Emacs
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'hideshow))
+
+(eval-when-compile (require 'appmenu-fold nil t))
+(eval-when-compile (require 'fold-dwim nil t))
+(eval-when-compile (require 'foldit nil t))
+(eval-when-compile (require 'html-pagetoc nil t))
+(eval-when-compile (require 'html-toc nil t))
+(eval-when-compile (require 'mumamo nil t))
+(eval-when-compile (require 'mlinks nil t))
+(eval-when-compile (require 'nxhtml-base))
+;;(eval-when-compile (require 'nxhtml-menu)) ;; recursive load
+(eval-when-compile (require 'ourcomments-util nil t))
+(eval-and-compile (require 'typesetter nil t))
+(eval-when-compile (require 'xhtml-help nil t))
+(eval-when-compile (require 'popcmp nil t))
+;; (eval-when-compile
+;; (unless (or (< emacs-major-version 23)
+;; (boundp 'nxhtml-menu:version)
+;; (featurep 'nxhtml-autostart))
+;; (let ((efn (expand-file-name
+;; "../autostart.el"
+;; (file-name-directory
+;; (or load-file-name
+;; (when (boundp 'bytecomp-filename) bytecomp-filename)
+;; buffer-file-name)))))
+;; (message "efn=%s" efn)
+;; (load efn))
+;; (require 'rng-valid)
+;; (require 'rng-nxml)))
+
+(require 'button)
+(require 'loadhist)
+(require 'nxml-mode nil t)
+(require 'rng-nxml nil t)
+(require 'rng-valid nil t)
+
+;; Require nxml things conditionally to silence byte compiler under
+;; Emacs 22.
+(eval-and-compile (require 'rngalt nil t))
+
+(require 'url-parse)
+(require 'url-expand)
+(require 'popcmp nil t)
+(eval-when-compile (require 'html-imenu nil t))
+(eval-when-compile (require 'tidy-xhtml nil t))
+(eval-when-compile (require 'html-quote nil t))
+
+(defun nxhtml-version ()
+ "Show nxthml version."
+ (interactive)
+ (message "nXhtml mode version %s" nxhtml-menu:version))
+
+;;(defun nxhtml-nxml-fontify-attribute (att &optional namespace-declaration)
+;;"Holds the original `nxml-fontify-attribute' function.")
+;;(fset 'nxhtml-nxml-fontify-attribute (symbol-function 'nxml-fontify-attribute))
+
+
+(defun nxhtml-turn-onoff-tag-do-also (on)
+ (add-hook 'nxhtml-mode-hook 'nxhtml-check-tag-do-also)
+ (dolist (b (buffer-list))
+ (when (with-current-buffer b
+ (eq major-mode 'nxhtml-mode))
+ (if on
+ (progn
+ (add-hook 'rngalt-complete-tag-hooks 'nxhtml-complete-tag-do-also t t)
+ )
+ (remove-hook 'rngalt-complete-tag-hooks 'nxhtml-complete-tag-do-also t)
+ ))))
+
+;;(define-toggle nxhtml-tag-do-also t
+(define-minor-mode nxhtml-tag-do-also
+ "When completing tag names do some more if non-nil.
+For some tag names additional things can be done at completion to
+speed writing up. For example for an <img ...> tag `nxhtml-mode'
+can prompt for src attribute and add width and height attributes
+if this attribute points to a local file.
+
+You can add additional elisp code for completing to
+`nxhtml-complete-tag-do-also'."
+ :global t
+ :init-value t
+ :group 'nxhtml
+ (nxhtml-turn-onoff-tag-do-also nxhtml-tag-do-also))
+(when nxhtml-tag-do-also (nxhtml-tag-do-also 1))
+
+(defun nxhtml-tag-do-also-toggle ()
+ "Toggle `nxhtml-tag-do-also'."
+ (interactive)
+ (nxhtml-tag-do-also (if nxhtml-tag-do-also -1 1)))
+
+(defun nxhtml-check-tag-do-also ()
+ (when nxhtml-tag-do-also
+ (nxhtml-turn-onoff-tag-do-also t)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Folding etc.
+
+
+;; This part is origially taken from
+;; http://www.emacswiki.org/cgi-bin/wiki/NxmlModeForXHTML and was
+;; originally written by Peter Heslin, but has been changed rather
+;; much.
+
+;; (defun nxhtml-hs-adjust-beg-func (pos)
+;; (save-excursion
+;; (save-match-data
+;; ;; (search-backward "<" nil t)
+;; ;; (forward-char)
+;; ;; (search-forward ">" nil t)
+;; )
+;; (point)))
+
+(defun nxhtml-hs-forward-sexp-func (pos)
+ (nxhtml-hs-forward-element))
+
+(defun nxhtml-hs-forward-element ()
+ (let ((nxml-sexp-element-flag))
+ (setq nxml-sexp-element-flag (not (looking-at "<!--")))
+ (unless nil ;;(looking-at outline-regexp)
+ ;;(condition-case nil
+ (nxml-forward-balanced-item 1)
+ ;;(error nil))
+ )))
+
+(defun nxhtml-setup-for-fold-dwim ()
+ (make-local-variable 'outline-regexp)
+ (setq outline-regexp "\\s *<\\([h][1-6]\\|html\\|body\\|head\\)\\b")
+ (make-local-variable 'outline-level)
+ (setq outline-level 'nxhtml-outline-level)
+ ;;(outline-minor-mode 1)
+ ;;(hs-minor-mode 1)
+ (setq hs-special-modes-alist (assq-delete-all 'nxhtml-mode hs-special-modes-alist))
+ (add-to-list 'hs-special-modes-alist
+ '(nxhtml-mode
+ ;;"<!--\\|<[^/>]>\\|<[^/][^>]*[^/]>"
+ "<!--\\|<[^/>]>\\|<[^/][^>]*"
+ "</\\|-->"
+ "<!--" ;; won't work on its own; uses syntax table
+ nxhtml-hs-forward-sexp-func
+ nil ;nxhtml-hs-adjust-beg-func
+ ))
+ (set (make-local-variable 'hs-set-up-overlay) 'nxhtml-hs-set-up-overlay)
+ (put 'hs-set-up-overlay 'permanent-local t)
+ (when (featurep 'appmenu-fold)
+ (appmenu-fold-setup))
+ (foldit-mode 1))
+
+(defun nxhtml-hs-start-tag-end (beg)
+ (save-excursion
+ (save-match-data
+ (goto-char beg)
+ (or (search-forward ">" (line-end-position) t)
+ (line-end-position)))))
+
+(defun nxhtml-hs-set-up-overlay (ovl)
+ (overlay-put ovl 'priority (1+ mlinks-link-overlay-priority))
+ (when foldit-mode
+ (setq foldit-hs-start-tag-end-func 'nxhtml-hs-start-tag-end)
+ (foldit-hs-set-up-overlay ovl)))
+
+(defun nxhtml-outline-level ()
+ ;;(message "nxhtml-outline-level=%s" (buffer-substring (match-beginning 0) (match-end 0)))(sit-for 2)
+ ;; Fix-me: What did I intend to do???
+ ;; (let ((tag (buffer-substring (match-beginning 1) (match-end 1))))
+ ;; (if (eq (length tag) 2)
+ ;; (- (aref tag 1) ?0)
+ ;; 0))
+ 8)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+(defcustom nxhtml-use-imenu t
+ "Use imenu in nxhtml-mode."
+ :type 'boolean
+ :group 'nxhtml)
+
+
+
+(defcustom nxhtml-default-encoding 'iso-8859-1
+ "Default encoding."
+ :type 'coding-system
+ :group 'nxhtml)
+
+(defun nxhtml-insert-empty-frames-page ()
+ "Insert an empty frames page."
+ (interactive)
+ ;;(unless (= 0 (buffer-size))
+ (unless (nxhtml-can-insert-page-here)
+ (error "Buffer is not empty"))
+ (insert
+ "<?xml version=\"1.0\" encoding=\""
+ (symbol-name nxhtml-default-encoding)
+ "\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\"
+ \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+ <head>
+ <title></title>
+ </head>
+ <frameset cols=\"50%, 50%\">
+ <frame src=\"about:blank\" />
+ <frame src=\"about:blank\" />
+ </frameset>
+</html>")
+ (search-backward "</title>"))
+
+(defun nxhtml-insert-empty-page ()
+ "Insert an empty XHTML page."
+ (interactive)
+ ;;(unless (= 0 (buffer-size))
+ (unless (nxhtml-can-insert-page-here)
+ (error "Buffer is not empty"))
+ (insert
+ "<?xml version=\"1.0\" encoding=\""
+ (symbol-name nxhtml-default-encoding)
+ "\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+ <head>
+ <title></title>
+ </head>
+ <body>
+ </body>
+</html>")
+ (search-backward "</title>"))
+
+(defun nxhtml-empty-page-completion ()
+ ;;(unless (= 0 (buffer-size)) (error "Buffer is not empty"))
+ (let* ((frames "Frameset page")
+ (normal "Normal page")
+ ;;(vlhead "Validation header")
+ ;;popcmp-popup-completion
+ (initial nil) ;;(unless popcmp-popup-completion normal))
+ (hist (if (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ ;;(list vlhead frames normal)
+ (list frames normal)
+ (list frames normal)))
+ res
+ (completion-ignore-case t))
+ (setq res (popcmp-completing-read "Insert: " hist nil t initial (cons 'hist (length hist))))
+ (cond ((string= res frames)
+ (nxhtml-insert-empty-frames-page))
+ ((string= res normal)
+ (nxhtml-insert-empty-page))
+ ;;((string= res vlhead)
+ ;; (nxhtml-validation-header-mode))
+ (t
+ (error "Bad res=%s" res))))
+ (rng-auto-set-schema))
+
+
+
+(defvar nxhtml-mode-hook nil)
+;;(add-hook 'nxhtml-mode-hook 'nxml-fontify-buffer)
+
+(defun nxhtml-help ()
+ (interactive)
+ (describe-function 'nxhtml-mode))
+
+(defvar nxhtml-current-validation-header nil)
+(make-variable-buffer-local 'nxhtml-current-validation-header)
+(put 'nxhtml-current-validation-header 'permanent-local t)
+
+
+;; FIX-ME: When should this be done? Get tidy-menu-symbol:
+(when (featurep 'tidy-xhtml)
+ (tidy-build-menu))
+
+
+;; (eval-after-load 'css-mode
+;; '(when (featurep 'xhtml-help)
+;; (define-key css-mode-map [(control ?c) ?? ?c] 'xhtml-help-show-css-ref)
+;; ))
+;; (add-hook 'css-mode-hook
+;; (lambda ()
+;; (and (featurep 'xhtml-help)
+;; (boundp 'css-mode-map)
+;; (define-key css-mode-map [(control ?c) ?? ?c]
+;; 'xhtml-help-show-css-ref))))
+
+;; This should be run in `change-major-mode-hook'."
+;; (defun nxhtml-change-mode ()
+;; (when (fboundp 'mlinks-mode)
+;; (mlinks-mode 0)))
+
+(when (< emacs-major-version 23)
+ (defun nxml-change-mode ()
+ ;; Remove overlays used by nxml-mode.
+ (save-excursion
+ (save-restriction
+ (widen)
+ (rng-validate-mode -1)
+ (let ((inhibit-read-only t)
+ (buffer-undo-list t)
+ (modified (buffer-modified-p)))
+ (nxml-with-invisible-motion
+ (remove-text-properties (point-min) (point-max) '(face nil)))
+ (set-buffer-modified-p modified))))))
+
+(defcustom nxhtml-heading-element-name-regexp "[a-z]*"
+ "Used for `nxml-heading-element-name-regexp."
+ :type 'regexp
+ :group 'nxhtml)
+
+;; Fix-me: Put this is a separate file and load it only if nxml is
+;; availabe.
+(put 'nxhtml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
+;;;###autoload
+(define-derived-mode nxhtml-mode nxml-mode "nXhtml"
+ "Major mode for editing XHTML documents.
+It is based on `nxml-mode' and adds some features that are useful
+when editing XHTML files.\\<nxhtml-mode-map>
+
+The XML menu contains functionality added by `nxml-mode' \(on
+which this major mode is based). There is also a popup menu
+added to the \[apps] key.
+
+The most important features are probably completion and
+validation, which is inherited from `nxml-mode' with some small
+addtions. In very many situation you can use completion. To
+access it type \\[nxml-complete]. Completion has been enhanced in
+the following way:
+
+- If region is active and visible then completion will surround the
+ region with the chosen tag's start and end tag. However only the
+ starting point is checked for validity. If something is wrong after
+ insertion you will however immediately see it if you have validation
+ on.
+- It can in some cases give assistance with attribute values.
+- Completion can be customized, see the menus XHTML - Completion:
+ * You can use a menu popup style completion.
+ * You can have alternatives grouped.
+ * You can get a short help text shown for each alternative.
+- There does not have to be a '<' before point for tag name
+ completion. (`nxml-mode' requires a '<' before point for tag name
+ completion.)
+- Completes xml version and encoding.
+- Completes in an empty buffer, ie inserts a skeleton.
+
+Here are all key bindings in nxhtml-mode itself:
+
+\\{nxhtml-mode-map}
+
+Notice that other minor mode key bindings may also be active, as
+well as emulation modes. Do \\[describe-bindings] to get a list
+of all active key bindings. Also, *VERY IMPORTANT*, if mumamo is
+used in the buffer each mumamo chunk has a different major mode
+with different key bindings. You can however still see all
+bindings with \\[describe-bindings], but you have to do that with
+point in the mumamo chunk you want to know the key bindings in."
+ (set (make-local-variable 'nxml-heading-element-name-regexp)
+ nxhtml-heading-element-name-regexp)
+ (when (fboundp 'nxml-change-mode)
+ (add-hook 'change-major-mode-hook 'nxml-change-mode nil t))
+ ;;(add-hook 'change-major-mode-hook 'nxhtml-change-mode nil t)
+ (when (featurep 'rngalt)
+ (add-hook 'nxml-completion-hook 'rngalt-complete nil t))
+ ;;(define-key nxhtml-mode-map [(meta tab)] 'nxml-complete)
+ ;;(nxhtml-menu-mode 1)
+ (when (and nxhtml-use-imenu
+ (featurep 'html-imenu))
+ (add-hook 'nxhtml-mode-hook 'html-imenu-setup nil t))
+ ;;(mlinks-mode 1)
+ (nxhtml-setup-for-fold-dwim)
+ (when (featurep 'rngalt)
+ (set (make-local-variable 'rngalt-completing-read-tag) 'nxhtml-completing-read-tag)
+ (set (make-local-variable 'rngalt-completing-read-attribute-name) 'nxhtml-completing-read-attribute-name)
+ (set (make-local-variable 'rngalt-completing-read-attribute-value) 'nxhtml-completing-read-attribute-value)
+ (set (make-local-variable 'rngalt-complete-first-try) 'nxhtml-complete-first-try)
+ (set (make-local-variable 'rngalt-complete-last-try) 'nxhtml-complete-last-try)
+ ))
+
+;; Fix-me: The nxhtml-mode-map is define by define-derived-mode, but
+;; how should keys be added?
+
+;; Replace the Insert End Tag function:
+(define-key nxhtml-mode-map [(control ?c) (control ?f)] 'rngalt-finish-element)
+
+;; Put completion on the normal key?
+(define-key nxhtml-mode-map [(meta tab)] 'nxml-complete)
+;; Paragraphs (C-p mnemonic for paragraph)
+(define-key nxhtml-mode-map [(control ?c) (control ?p) ?l] 'longlines-mode)
+(define-key nxhtml-mode-map [(control ?c) (control ?p) ?f] 'fill-paragraph)
+(define-key nxhtml-mode-map [(control ?c) (control ?p) ?u] 'unfill-paragraph)
+;; Html related (C-h mnemonic for html)
+(define-key nxhtml-mode-map [(control ?c) (control ?h) ?c] 'nxhtml-save-link-to-here)
+(define-key nxhtml-mode-map [(control ?c) (control ?h) ?v] 'nxhtml-paste-link-as-a-tag)
+(define-key nxhtml-mode-map [(control ?c) (control ?h) ?b] 'nxhtml-browse-file)
+(define-key nxhtml-mode-map [(control ?c) ?<] 'nxml-untag-element)
+(when (featurep 'html-quote)
+ (define-key nxhtml-mode-map [(control ?c) (control ?q)] 'nxhtml-quote-html)
+ )
+;; Fix-me: Is pagetoc really that important to have its own keybindings?
+(when (featurep 'html-pagetoc)
+ (define-key nxhtml-mode-map [(control ?c) (control ?h) ?t ?i] 'html-pagetoc-insert-toc)
+ (define-key nxhtml-mode-map [(control ?c) (control ?h) ?t ?r] 'html-pagetoc-rebuild-toc)
+ (define-key nxhtml-mode-map [(control ?c) (control ?h) ?t ?s] 'html-pagetoc-insert-style-guide)
+ )
+
+(defun nxhtml-quote-html()
+ "Quote character(s) unsafe in html text parts.
+If region is visible quote all characters in region. Otherwise
+just quote current char.
+
+Note to CUA users: See `cua-mode' for how to prevent CUA from
+just copying region when you press C-c."
+ (interactive)
+ (if (and mark-active
+ transient-mark-mode)
+ (let* ((rb (region-beginning))
+ (re (region-end))
+ (qr (html-quote-html-string
+ (buffer-substring-no-properties rb re))))
+ (delete-region rb re)
+ (insert qr))
+ (let ((cs (html-quote-html-char (char-after))))
+ (delete-char 1)
+ (insert cs))))
+
+(defvar nxhtml-single-tags
+ '("base"
+ "meta"
+ "link"
+ "br"
+ "hr"
+ "frame"
+ "img"
+ "input"
+ "option"
+ "param"))
+
+(defun nxthml-is-single-tag (tag)
+ (member tag nxhtml-single-tags))
+
+(defvar nxhtml-help-attribute-name
+ '(("title" "Element title")
+ ("class" "Style class of element")
+ ("charset" "Encoding of target")
+ ("coords" "Defining shape")
+ ("href" "Target URL")
+ ("hreflang" "Language of target")
+ ("name" "(DEPRECEATED)")
+ ("rel" "Target's relation to document")
+ ("rev" "Document's relation to target")
+ ("shape" "Area shape")
+ ("target" "Where to open target")
+ ("type" "MIME type of target")
+
+ ("id" "Unique id of element")
+ ("lang" "Language code")
+ ("dir" "Text direction")
+ ("accesskey" "Keyboard shortcut")
+ ("tabindex" "Tab order of element")
+
+ ("style" "Inline style")
+ ("disabled" "Tag initially disabled")
+ ("readonly" "User can not modify")
+ ;;("" "")
+
+ ("alink" "(DEPRECEATED)")
+ ("background" "(DEPRECEATED)")
+ ("bgcolor" "(DEPRECEATED)")
+ ("link" "(DEPRECEATED)")
+ ("text" "(DEPRECEATED)")
+ ("vlink" "(DEPRECEATED)")
+ ("xml:lang" "Tag content language")
+ ("cite" "URL with more info")
+ ("method" "HTTP method for sending")
+ ("accept" "Content types")
+ ("accept-charset" "Character sets")
+ ("enctype" "Encoding")
+ ))
+(defvar nxhtml-help-attribute-name-tag
+ '(("textarea"
+ ("name" "Name for textarea")
+ )
+ ))
+
+(defvar nxhtml-help-tag
+ (let ((h (make-hash-table :test 'equal)))
+ (puthash "html" "Document" h)
+ (puthash "head" "Document head" h)
+ (puthash "title" "Document title" h)
+ (puthash "base" "Base URL/target" h)
+ (puthash "meta" "Meta information" h)
+ (puthash "style" "Inline style sheet" h)
+ (puthash "link" "Style sheet etc" h)
+ (puthash "script" "(Java)Script code" h)
+ (puthash "noscript" "Script disabled part" h)
+ (puthash "isindex" "(DEPRECEATED)" h)
+
+ (puthash "iframe" "Inline frame" h)
+ (puthash "frameset" "Organize frames" h)
+ (puthash "frame" "Sub window" h)
+ (puthash "noframes" "Substitute for frames" h)
+
+ (puthash "bdo" "Text direction" h)
+
+ (puthash "body" "Document body" h)
+ (puthash "a" "Link" h)
+ (puthash "p" "Paragraph" h)
+ (puthash "span" "Group inline elements" h)
+ (puthash "br" "Line break" h)
+ (puthash "hr" "Horizontal rule" h)
+ (puthash "div" "Division/section" h)
+ (puthash "img" "Image" h)
+ (puthash "h1" "Header 1" h)
+ (puthash "del" "Deleted text" h)
+ (puthash "strike" "(DEPRECEATED)" h)
+ (puthash "u" "(DEPRECEATED)" h)
+ (puthash "s" "(DEPRECEATED)" h)
+ (puthash "ins" "Inserted text" h)
+ (puthash "sup" "Superscript text" h)
+ (puthash "center" "(DEPRECEATED)" h)
+ (puthash "dir" "(DEPRECEATED)" h)
+
+ (puthash "blockquote" "Long quotation" h)
+ (puthash "q" "Short quotation" h)
+ (puthash "pre" "Preformatted text" h)
+ (puthash "applet" "(DEPRECEATED)" h)
+ (puthash "basefont" "(DEPRECEATED)" h)
+ (puthash "font" "(DEPRECEATED)" h)
+
+ ;; The following elements are all font style elements. They are
+ ;; not deprecated, but it is possible to achieve richer effects
+ ;; using style sheets.
+ (puthash "tt" "Renders as teletype or mono spaced text" h)
+ (puthash "i" "Renders as italic text" h)
+ (puthash "b" "Renders as bold text" h)
+ (puthash "big" "Renders as bigger text" h)
+ (puthash "small" "Renders as smaller text" h)
+
+
+ ;; The following tags are not deprecated, but it is possible to
+ ;; achieve a much richer effect using style sheets:
+ (puthash "em" "Renders as emphasized text" h)
+ (puthash "strong" "Renders as strong emphasized text" h)
+ (puthash "dfn" "Defines a definition term" h)
+ (puthash "code" "Defines computer code text" h)
+ (puthash "samp" "Defines sample computer code" h)
+ (puthash "kbd" "Defines keyboard text" h)
+ (puthash "var" "Defines a variable" h)
+ (puthash "cite" "Defines a citation" h)
+
+ (puthash "ul" "Unordered list" h)
+ (puthash "ol" "Ordered list" h)
+ (puthash "li" "List element" h)
+ (puthash "dl" "Definition list" h)
+ (puthash "dt" "Definition term" h)
+ (puthash "dd" "Definition description" h)
+
+
+ (puthash "fieldset" "Draw box around" h)
+ (puthash "form" "User input form" h)
+ (puthash "input" "Input field/checkbox etc" h)
+ (puthash "textarea" "Input multiline field" h)
+ (puthash "button" "Push button" h)
+ (puthash "label" "Label for control" h)
+ (puthash "map" "Client side image map" h)
+ (puthash "select" "Drop down list" h)
+ (puthash "option" "Option in drop down list" h)
+ (puthash "menu" "(DEPRECEATED)" h)
+
+ (puthash "object" "Embedded object" h)
+ (puthash "param" "Object settings" h)
+
+ (puthash "abbr" "Abbreviation" h)
+ (puthash "address" "For addresses etc" h)
+ (puthash "acronym" "May be used for lookup etc" h)
+
+ (puthash "table" "Table" h)
+ (puthash "caption" "Table caption" h)
+ (puthash "col" "Table column attributes" h)
+ (puthash "colgroup" "Table column group" h)
+ (puthash "thead" "Table header" h)
+ (puthash "tbody" "Table body" h)
+ (puthash "tfoot" "Table footer" h)
+ (puthash "tr" "Table row" h)
+ (puthash "td" "Table cell" h)
+
+ h))
+
+;;;###autoload
+(defun nxhtml-short-tag-help (tag)
+ "Display description of tag TAG. If TAG is omitted, try tag at point."
+ (interactive
+ (let ((tag (xhtml-help-tag-at-point)))
+ (unless (stringp tag)
+ (setq tag (read-string "No tag at point. Give tag name: ")))
+ (list tag)))
+ (setq tag (downcase tag))
+ (let ((desc (gethash tag nxhtml-help-tag))
+ (use-dialog-box nil))
+ (unless desc
+ (setq desc (concat tag " -- No short description available")))
+ (when (y-or-n-p (concat desc ". Fetch more information from the Internet? "))
+ ;; Loaded by the autoloading of `xhtml-help-tag-at-point' above:
+ (xhtml-help-browse-tag tag))))
+
+(defvar nxhtml-no-single-tags nil)
+(defvar nxhtml-no-end-tags nil)
+
+(defadvice rng-complete-qname-function (around nxhtml-rng-complete-qname-function-ad
+ (string predicate flag)
+ disable)
+ ;;(if (not (eq major-mode 'nxhtml-mode))
+ (if (not nxhtml-completing-with-help)
+ ad-do-it
+ (setq ad-return-value
+ (let ((alist (mapcar (lambda (name) (cons name nil))
+ (nxhtml-rng-generate-qname-list string))))
+ (cond ((not flag)
+ (try-completion string alist predicate))
+ ((eq flag t)
+ (all-completions string alist predicate))
+ ((eq flag 'lambda)
+ (and (assoc string alist) t)))))))
+
+
+
+
+(defvar nxhtml-predicate-error nil)
+
+(defun nxhtml-find-ids (file)
+ (let ((buf (find-file-noselect file)))
+ (when buf
+ (with-current-buffer buf
+ (when (eq major-mode 'nxhtml-mode)
+ (save-excursion
+ (let ((ids nil)
+ (id-ptrn
+ (rx space
+ "id"
+ (0+ space)
+ ?=
+ (0+ space)
+ ?\"
+ (submatch
+ (1+ (not (any ?\")))
+ )
+ ?\"
+ )))
+ (goto-char (point-min))
+ (while (re-search-forward id-ptrn nil t)
+ (add-to-list 'ids (match-string-no-properties 1)))
+ ids)))))))
+
+(defun nxhtml-read-url (&optional allowed-types initial-contents extra-predicate prompt-prefix)
+ (popcmp-mark-completing initial-contents)
+ (let ((local-ovl popcmp-mark-completing-ovl))
+ (setq popcmp-mark-completing-ovl nil)
+ (unwind-protect
+ (let* ((url-type (nxhtml-read-url-type allowed-types initial-contents))
+ (base-prompt (cond ((eq url-type 'local-file-url)
+ "File: ")
+ ((eq url-type 'id-url)
+ "Id: ")
+ ((eq url-type 'web-url)
+ "Web URL: ")
+ ((eq url-type 'mail-url)
+ "e-Mail address: ")
+ ((eq url-type 'any-url)
+ "Any URL-type: ")
+ (t
+ ;;(error "Internal error: bad url-type=%s" url-type)
+ "Unknown URL-type: ")
+ ))
+ prompt
+ type-predicate
+ url
+ (bad-url initial-contents)
+ (default-directory (if buffer-file-name
+ (file-name-directory buffer-file-name)
+ default-directory)))
+ (when prompt-prefix
+ (setq base-prompt (concat prompt-prefix " " base-prompt)))
+ (setq nxhtml-predicate-error "")
+ (cond ((eq url-type 'local-file-url)
+ )
+ ((eq url-type 'web-url)
+ )
+ ((eq url-type 'mail-url)
+ (setq type-predicate 'nxhtml-mailto-predicate)
+ (when (and (stringp bad-url)
+ (<= 7 (length bad-url))
+ (string= "mailto:" (substring bad-url 0 7)))
+ (setq bad-url (substring bad-url 7)))))
+ (while (not url)
+ (setq prompt (concat nxhtml-predicate-error " " base-prompt))
+ (cond ((eq url-type 'local-file-url)
+ (setq url (read-file-name prompt nil "" nil bad-url extra-predicate))
+ (when (< 0 (length url))
+ ;; Fix-me: prompt for id here
+ (setq url (file-relative-name
+ (expand-file-name url)))))
+ ((eq url-type 'id-url)
+ (setq url (completing-read prompt (nxhtml-find-ids buffer-file-name)))
+ (when url
+ (setq url (concat "#" url))))
+ ((eq url-type 'web-url)
+ (setq url (nxhtml-read-from-minibuffer prompt bad-url nil nil
+ 'nxhtml-read-web-url-history
+ t)))
+ ((eq url-type 'mail-url)
+ (setq url (nxhtml-read-from-minibuffer prompt bad-url nil nil
+ 'nxhtml-read-mail-url-history
+ t)))
+ (t
+ (setq url (nxhtml-read-from-minibuffer prompt bad-url nil nil
+ 'nxhtml-read-url-history
+ t))))
+ (when (or (and type-predicate
+ (not (funcall type-predicate url)))
+ (and extra-predicate
+ (not (funcall extra-predicate url))))
+ (setq bad-url url)
+ (setq url)))
+ (when (eq url-type 'mail-url)
+ (setq url (concat "mailto:" url)))
+ url)
+ (delete-overlay local-ovl)
+ )))
+
+(defun nxhtml-read-url-type (allowed url-beginning)
+ (assert (or (listp allowed) (eq t allowed)) t)
+ (let* ((prompt "URL-type: ")
+ (parsed-url (url-generic-parse-url url-beginning))
+ (beg-type (url-type parsed-url))
+ (allowed-u allowed)
+ (completion-ignore-case t)
+ choices
+ choice)
+ ;; (url-type (url-generic-parse-url "#some-id"))
+ ;;(lwarn t :warning "url-type=%s, pu=%s" (url-type parsed-url) parsed-url)
+ ;; Emacs 23 bug workaround Sat Jan 26 2008
+ ;;(when (eq beg-type 'cl-struct-url) (setq beg-type (elt parsed-url 1)))
+ (cond ((string= "mailto" beg-type)
+ (setq allowed-u '(?m)))
+ ((or (string= "http" beg-type)
+ (string= "https" beg-type)
+ (string= "ftp" beg-type))
+ (setq allowed-u '(?w)))
+ ((= 1 (length beg-type)) ;; w32
+ (setq allowed-u '(?f)))
+ ((and (null beg-type)
+ url-beginning
+ (= ?# (string-to-char url-beginning)))
+ (setq allowed-u '(?i)))
+ )
+ ;; Be a bit picky and hopefully helpful, check if really allowed:
+ (unless (or (eq allowed t)
+ (equal allowed allowed-u))
+ (let ((temp-u (copy-sequence allowed-u)))
+ (dolist (a allowed)
+ (setq temp-u (delq a temp-u)))
+ (dolist (u temp-u)
+ (setq allowed-u (delq u allowed-u)))))
+ (if allowed-u
+ (when (eq allowed-u t)
+ (setq allowed-u '(?f ?i ?w ?m)))
+ (setq allowed-u '(?f ?w)))
+ (dolist (a allowed-u)
+ (cond
+ ((= a ?f)
+ (setq choices (cons "File" choices)))
+ ((= a ?i)
+ (setq choices (cons "Id" choices)))
+ ((= a ?w) (setq choices (cons "Url" choices)))
+ ((= a ?m) (setq choices (cons "Mail" choices)))
+ ))
+ (if (= 1 (length allowed-u))
+ (setq choice (car choices))
+ (setq choice (popcmp-completing-read prompt choices nil t
+ "" nil nil t)))
+ (cond ((string= choice "Id")
+ 'id-url)
+ ((string= choice "File")
+ 'local-file-url)
+ ((string= choice "Url")
+ 'web-url)
+ ((string= choice "Mail")
+ 'mail-url)
+ )))
+
+(defvar nxhtml-read-url-history nil)
+(defvar nxhtml-read-web-url-history nil)
+(defvar nxhtml-read-mail-url-history nil)
+
+(defconst nxhtml-in-xml-attribute-value-regex
+ (replace-regexp-in-string
+ "w"
+ xmltok-ncname-regexp
+ ;;"<w\\(?::w\\)?\
+ "<\\?xml\
+\\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
+\[ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
+\[ \t\r\n]+\\(w\\(:w\\)?\\)[ \t\r\n]*=[ \t\r\n]*\
+\\(\"[^\"]*\\|'[^']*\\)\\="
+ t
+ t))
+
+(defun nxhtml-mailto-predicate (url)
+ "Tries to match a mailto url.
+This is not supposed to be entirely correct."
+ (setq nxhtml-predicate-error nil)
+ ;; Local pattern copied from gnus.
+ (let ((r (concat "^"
+ ;;"mailto:"
+ "[a-z0-9$%(*-=?[_][^<>\")!;:,{}]*"
+ "\@"
+ "\\(?:[a-z0-9\-]+\.\\)+[a-z0-9]\\{2,4\\}$"))
+ (case-fold-search t))
+ ;;(message "mailpred") (sit-for 1)
+ (if (string-match r url)
+ t
+ (setq nxhtml-predicate-error "Malformed email address.")
+ nil)))
+
+(defcustom nxhtml-image-completion-pattern
+ "\\.\\(?:png\\|jpg\\|jpeg\\|gif\\)$"
+ "Pattern for matching image URLs in completion."
+ :type 'regexp
+ :group 'nxhtml)
+
+(defun nxhtml-image-url-predicate (url)
+ (setq nxhtml-predicate-error nil)
+ (if (or (file-directory-p url)
+ (string-match nxhtml-image-completion-pattern url))
+ t
+ (setq nxhtml-predicate-error "Does not match image file name pattern.")
+ nil
+ ))
+
+(defcustom nxhtml-css-completion-pattern
+ "\\.\\(?:css\\)$"
+ "Pattern for matching css URLs in completion."
+ :type 'regexp
+ :group 'nxhtml)
+
+(defun nxhtml-css-url-predicate (url)
+ (setq nxhtml-predicate-error nil)
+ (if (or (file-directory-p url)
+ (string-match nxhtml-css-completion-pattern url))
+ t
+ (setq nxhtml-predicate-error "Does not match css file name pattern.")
+ nil
+ ))
+
+(defcustom nxhtml-script-completion-pattern
+ "\\.\\(?:js\\)$"
+ "Pattern for matching src URLs in completion in script tags."
+ :type 'regexp
+ :group 'nxhtml)
+
+(defun nxhtml-script-url-predicate (url)
+ (setq nxhtml-predicate-error nil)
+ (if (or (file-directory-p url)
+ (string-match nxhtml-script-completion-pattern url))
+ t
+ (setq nxhtml-predicate-error "Does not match script file name pattern.")
+ nil
+ ))
+
+(defun nxhtml-coding-systems-complete (init default)
+ (let (coding-systems
+ hist-num
+ (n 0)
+ hist)
+ (unless (and init (< 0 (length init)))
+ (setq init default))
+ (mapc (lambda (coding-system)
+ (let ((mime-charset (coding-system-get coding-system 'mime-charset)))
+ (when mime-charset
+ (setq coding-systems (cons
+ (symbol-name mime-charset)
+ coding-systems)))))
+ (coding-system-list t))
+ (setq coding-systems (sort coding-systems 'string=))
+ (mapc (lambda (coding-system)
+ (unless (< 0 (length coding-system))
+ (error "len=0"))
+ (setq n (1+ n))
+ (when (string= coding-system init) (setq hist-num n)))
+ coding-systems)
+ (if hist-num
+ (setq hist (cons 'coding-systems hist-num))
+ (setq hist 'coding-systems))
+ (completing-read "Encoding (coding system): "
+ coding-systems nil t init hist)))
+
+
+;; Note: This function does not currently use the state provided by
+;; the nxml and rng functions directly. Instead it searches the
+;; environment near point to decide what to do.
+;; (defun nxhtml-complete-and-insert ()
+;; "Perform XHTML completion at point.
+;; This is merely an extended version of `nxml-complete' with the following changes:
+
+;; - If region is visible and active then completion will surround the
+;; region with the chosen tag's start and end tag. However only the
+;; starting point is checked for validity. If something is wrong after
+;; insertion you will however immediately see it if you have validation
+;; on.
+;; - Can in some cases give completion help inside attribute values.
+;; - There does not have to be a '<' before point for tag name
+;; completion. (`nxml-mode' requires a '<' before point for tag name
+;; completion.)
+;; - For tag names there is a popup style completion available. This
+;; gives a bit more guiding since it groups the alternative tags. Set
+;; `popcmp-popup-completion' to use this.
+;; - Completes xml version and encoding.
+;; - Completes an empty file, ie inserts a skeleton."
+;; (interactive)
+;; (let (res
+;; (where (nxhtml-check-where)))
+;; (or (when (eq where 'in-empty-page)
+;; (nxhtml-empty-page-completion))
+;; (when (and mark-active
+;; transient-mark-mode
+;; (eq where 'in-text))
+;; (nxhtml-insert-tag))
+;; (progn
+;; (cond ((memq where '(in-start-tag in-closed-start-tag in-end-tag))
+;; (re-search-forward "\\=/?[a-z]*" nil t))
+;; ((memq where '(in-attr))
+;; (re-search-forward "\\=[a-z]*=" nil t))
+;; ((memq where '(in-attr-val in-xml-attr-val))
+;; (re-search-forward "\\=[^<>\" \t\r\n]*" nil t))
+;; )
+;; (when (run-hook-with-args-until-success 'nxml-completion-hook)
+;; (when (re-search-backward "[^=]\"\\=" nil t)
+;; (forward-char) (delete-char 1)
+;; ;;(undo-start) (undo-more 1)
+;; )
+;; t))
+;; (when (and (not where)
+;; (char-before)
+;; (= ?\" (char-before)))
+;; nil)
+;; (when (or (when (char-before) (= ?> (char-before)))
+;; (eq where 'in-text))
+;; (setq res t)
+;; (nxhtml-insert-tag))
+;; ;; Eventually we will complete on entity names here.
+;; res
+;; (progn
+;; (ding)
+;; (message "Cannot complete in this context")))))
+
+(defvar nxhtml-in-proc-instr-back-regex "<\\?[^<>]*\\=")
+(defvar nxhtml-in-proc-instr-forw-regex "\\=[^<>]*\\?>")
+
+(defconst rngalt-in-pre-attribute-value-regex
+ (replace-regexp-in-string
+ "w"
+ xmltok-ncname-regexp
+ "<w\\(?::w\\)?\
+\\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
+\[ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
+\[ \t\r\n]+\\(w\\(:w\\)?\\)[ \t\r\n]*=[ \t\r\n]*\
+\\="
+ t
+ t))
+
+(defun nxhtml-check-where ()
+ "Get a state for `nxhtml-complete-last-try'."
+ (let ((p (point))
+ (lt-pos (save-excursion (search-backward "<" nil t)))
+ res)
+ (cond ((= 0 (buffer-size))
+ (setq res 'in-empty-page))
+ ((looking-back "<!--[^<>]*\\=" 1 t)
+ (setq res 'in-comment))
+ ((let ((face (get-char-property (point) 'face)))
+ (when (memq face '(nxml-comment-content-face
+ nxml-comment-delimiter-face))
+ (setq res 'in-comment)))
+ t)
+ ((looking-back nxhtml-in-xml-attribute-value-regex lt-pos t)
+ (setq res 'in-xml-attr-val))
+ ((looking-back nxhtml-in-proc-instr-back-regex 1 t)
+ (setq res 'in-proc-instr))
+ ((looking-back "<!D[^>]*\\=" 1 t)
+ (setq res 'in-doctype))
+ ((looking-back ">[^<]*" 1 t)
+ (setq res 'in-text))
+ ((looking-back rng-in-start-tag-name-regex 1 t)
+ (setq res 'in-tag-start)
+ (when (looking-at "\\=[^<]*>")
+ (setq res 'in-closed-start-tag)))
+ ((looking-back rng-in-end-tag-name-regex 1 t)
+ (setq res 'in-tag-end))
+ ((looking-back rng-in-attribute-regex 1 t)
+ (setq res 'in-attr))
+ ((looking-back rng-in-attribute-value-regex 1 t)
+ (setq res 'in-attr-val))
+ ((looking-back rngalt-in-pre-attribute-value-regex 1 t)
+ (setq res 'in-pre-attr-val))
+ ((looking-back "\"")
+ (setq res 'after-attr-val))
+ ((and rngalt-validation-header
+ (looking-back "\\`[^<]*"))
+ ;; FIX-ME: This is treated the same as in text currently,
+ ;; but this should be checked. Maybe it is best to test
+ ;; this here and return the relevant value?
+ (setq res 'after-validation-header))
+ )
+ ;;(message "res=%s" res)(sit-for 1)
+ (unless res
+ (error "Could not find a state for completion"))
+ res))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Make the completions additions cleaner:
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst nxhtml-tag-sets
+ '(("logical"
+ "del"
+ "ins"
+ "abbr"
+ "acronym"
+ "fieldset"
+ "blockquote"
+ "q"
+ "code"
+ "samp"
+ "cite"
+ "kbd"
+ "var"
+ "dfn"
+ "address"
+ "em"
+ "strong"
+ "pre"
+ )
+ ("physical"
+ "hr"
+ "sup"
+ "sub"
+ "font"
+ "basefont"
+ "br"
+ "big"
+ "small"
+ "strike"
+ "u"
+ "i"
+ "b"
+ "s"
+ "tt"
+ "center"
+ "bdo"
+ )
+ ("scripting"
+ "script"
+ "noscript"
+ "object"
+ "applet"
+ )
+ ("structure"
+ "iframe"
+ "p"
+ "div"
+ "span"
+ "h6"
+ "h5"
+ "h4"
+ "h3"
+ "h2"
+ "h1"
+ )
+
+ ("form"
+ "isindex"
+ "label"
+ "button"
+ "option"
+ "select"
+ "input"
+ "textarea"
+ "form"
+ )
+
+ ("list"
+ "dt"
+ "dd"
+ "li"
+ "dir"
+ "menu"
+ "ol"
+ "dl"
+ "ul"
+ )
+
+ ("link"
+ "a"
+ )
+
+ ("image"
+ "img"
+ "map"
+ )
+
+ ("table"
+ "table"
+ "tr"
+ "th"
+ "td"
+ "caption"
+ "col"
+ "colgroup"
+ "thead"
+ "tbody"
+ "tfoot"
+ )
+
+ ("document"
+ "base"
+ "style"
+ "link"
+ "head"
+ "body"
+ "frame"
+ "frameset"
+ "noframes"
+ "isindex"
+ "nextid"
+ "meta"
+ "title"
+ )
+ ))
+
+(defvar nxhtml-attr-sets
+ '(("scripting"
+ "onblur"
+ "onchange"
+ "onclick"
+ "ondblclick"
+ "onfocus"
+ "onkeydown"
+ "onkeypress"
+ "onkeyup"
+ "onload"
+ "onunload"
+ "onmousedown"
+ "onmousemove"
+ "onmouseout"
+ "onmouseover"
+ "onmouseup"
+ "onreset"
+ "onselect"
+ "onsubmit"
+ )
+ ("form"
+ "method"
+ "accept"
+ "accept-charset"
+ "enctype"
+ )
+ ("access"
+ "id"
+ "name"
+ "disabled"
+ "readonly")
+ ("layout"
+ "accesskey"
+ "class"
+ "coords"
+ "shape"
+ "style"
+ "tabindex"
+ "title"
+ "align"
+ "valign"
+ "alink"
+ "background"
+ "bgcolor"
+ "link"
+ "text"
+ "vlink"
+ "compact"
+ )
+ ("target"
+ "charset"
+ "href"
+ "hreflang"
+ "rel"
+ "rev"
+ "target"
+ "type"
+ )
+ ("language"
+ "dir"
+ "lang"
+ "xml:lang"
+ )
+ ;; id
+ ;; name
+ ;; xml:lang
+ ))
+
+(defun nxhtml-complete-last-try ()
+ (when rng-current-schema-file-name
+ (let ((where (nxhtml-check-where)))
+ (cond
+ ;;((eq where 'after-attr-val)
+ ;;(insert " ")
+ ;;)
+ ((eq where 'in-pre-attr-val)
+ (insert ?\"))
+ ((eq where 'in-comment)
+ (if (not (looking-at "[^>]*<"))
+ nil
+ (insert " -->")
+ t))
+ ((eq where 'in-xml-attr-val)
+ (let (attr
+ delimiter
+ val)
+ (save-excursion
+ (save-match-data
+ (re-search-forward "\\=[^<> \t\r\n\"]*" nil t)))
+ (let* ((name-start (match-beginning 1))
+ (name-end (match-end 1))
+ (colon (match-beginning 2))
+ (attr (buffer-substring-no-properties name-start
+ (or colon name-end)))
+ (value-start (1+ (match-beginning 3)))
+ (tag (save-excursion
+ (when (search-backward-regexp "<[[:alpha:]]+" nil t)
+ (match-string 0))))
+ (init (buffer-substring-no-properties value-start (point))))
+ (setq delimiter (char-before value-start))
+ (cond ((string= "encoding" attr)
+ ;; Give a default that works in browsers today
+ (setq val (nxhtml-coding-systems-complete
+ init
+ (symbol-name nxhtml-default-encoding))))
+ ((string= "version" attr)
+ (setq val "1.0")))
+ (when val
+ (insert val)
+ t)
+ )))
+ ((or (memq where '(in-text
+ after-validation-header
+ in-empty-page)))
+ (rngalt-complete-tag-region-prepare)
+ (insert "<")
+ (condition-case err
+ (nxhtml-redisplay-complete)
+ (quit
+ (message "%s" (error-message-string err))
+ (undo-start)
+ (undo-more 1)
+ (rngalt-complete-tag-region-cleanup)))
+ t)
+ (t
+ ;;(message "LAST TRY where=%s" (nxhtml-check-where))(sit-for 1)
+ nil)
+ ))))
+
+(defun nxhtml-img-tag-do-also ()
+ (insert "alt=\"")
+ (rngalt-validate)
+ (insert (read-string "Alt attribute: ")
+ "\" ")
+ (insert "src=\"")
+ (rngalt-validate)
+ (let ((src (nxhtml-read-url nil nil 'nxhtml-image-url-predicate "Image")))
+ (insert src)
+ (insert "\"")
+ (when (file-exists-p src)
+ (let ((sizes (image-size (create-image (expand-file-name src)) t)))
+ (insert
+ " width=\"" (format "%d" (car sizes)) "\""
+ " height=\"" (format "%d" (cdr sizes)) "\"")
+ )))
+ (unless (save-match-data (looking-at "[^<]\\{,200\\}>"))
+ (insert " />")))
+
+(defun nxhtml-redisplay-complete ()
+ (rngalt-validate)
+ (rng-cancel-timers)
+ (message "")
+ (redisplay t)
+ (nxml-complete)
+ (rng-activate-timers))
+
+(defun nxhtml-read-from-minibuffer (prompt &optional
+ initial-contents keymap
+ read hist default-value
+ inherit-input-method)
+ (rng-cancel-timers)
+ (message "")
+ (let ((res (read-from-minibuffer prompt initial-contents keymap
+ read hist default-value inherit-input-method)))
+ (rng-activate-timers)
+ res))
+
+(defun nxhtml-meta-tag-do-also ()
+ (let ((type (popcmp-completing-read
+ "Type: "
+ '(
+ ;;"Refresh/Redirect"
+ "HTTP Message Headers"
+ "Robot Rules"
+ "Description for Search Engines"
+ ))))
+ (cond
+ ((string= type "Description for Search Engines")
+ (insert " name=\"Description\"")
+ (insert " content=\"")
+ (insert (nxhtml-read-from-minibuffer "Description: "))
+ (insert "\" />"))
+ ((string= type "Robot Rules")
+ (insert " name=\"Robots\"")
+ (insert " content=\"")
+ (nxhtml-redisplay-complete)
+ (insert " />"))
+ ((string= type "HTTP Message Headers")
+ (insert " http-equiv=\"")
+ (nxhtml-redisplay-complete)
+ (insert " content=\"")
+ (insert (nxhtml-read-from-minibuffer "Content: "))
+ (insert "\" />")))))
+
+(defun nxhtml-style-tag-do-also ()
+ (insert "type=\"text/css\"")
+ (insert " media=\"")
+ (nxhtml-redisplay-complete)
+ (insert ">")
+ (indent-according-to-mode)
+ (insert "\n/* <![CDATA[ */")
+ (indent-according-to-mode)
+ (insert "\n")
+ (indent-according-to-mode)
+ (insert "\n/* ]]> */")
+ (indent-according-to-mode)
+ (insert "\n</style>")
+ (indent-according-to-mode)
+ (insert "\n")
+ (end-of-line -2))
+
+(defun nxhtml-script-tag-do-also ()
+ (let ((type (popcmp-completing-read
+ "Type: "
+ '("Inlined"
+ "Linked"))))
+ (cond
+ ((string= type "Inlined")
+ (insert "type=\"text/javascript\">")
+ (indent-according-to-mode)
+ (insert "\n// <![CDATA[")
+ (indent-according-to-mode)
+ (insert "\n")
+ (indent-according-to-mode)
+ (insert "\n// ]]>")
+ (indent-according-to-mode)
+ (insert "\n</script>")
+ (indent-according-to-mode)
+ (end-of-line -1))
+ ((string= type "Linked")
+ (insert "type=\"text/javascript\"")
+ (insert " src=\"")
+ (nxhtml-redisplay-complete)
+ (insert "></script>")))))
+
+(defun nxhtml-link-tag-do-also ()
+ (let ((type (popcmp-completing-read "Type: "
+ '(
+ "Other"
+ "Shortcut icon"
+ "Style sheet"
+ ))))
+ (cond
+ ((string= type "Style sheet")
+ (insert " rel=\"Stylesheet\" ")
+ (insert "type=\"text/css\" ")
+ (insert "href=\"")
+ (nxhtml-redisplay-complete)
+ (insert " media=\"")
+ (nxhtml-redisplay-complete)
+ (insert " />"))
+ ((string= type "Shortcut icon")
+ (insert " rel=\"Shortcut Icon\" ")
+ (insert "href=\"")
+ (nxhtml-redisplay-complete)
+ (insert " />"))
+ (t
+ (insert " ")
+ (nxhtml-redisplay-complete)
+ ))))
+
+(defun nxhtml-input-tag-do-also ()
+ (insert " ")
+ (rngalt-validate)
+ ;; type=
+ (insert "type=\"")
+ (nxhtml-redisplay-complete)
+ (insert " ")
+
+ (let* ((choice (save-match-data
+ (when (looking-back "type=\"\\(.*\\)\" ")
+ (match-string 1)))))
+ ;;(insert "type=\"" choice "\" ")
+ (rngalt-validate)
+ ;;(message "choice=%s" choice)(sit-for 2)
+ ;; name=
+ (when (member choice '("button" "checkbox" "file" "hidden" "image"
+ "password" "radio" "text"))
+ (insert "name=\""
+ (read-string "Name (name): ")
+ "\" ")
+ (rngalt-validate))
+ ;; checked=
+ (when (member choice '("checkbox" "radio"))
+ (when (y-or-n-p "Checked? (checked): ")
+ (insert "checked=\"checked\" ")
+ (rngalt-validate)))
+ ;; disabled=
+ (unless (string= choice "hidden")
+ (unless (y-or-n-p "Enabled? : ")
+ (insert "disabled=\"disabled\" ")
+ (rngalt-validate)))
+ ;; readonly=
+ (when (string= choice "text")
+ (when (y-or-n-p "Readonly? (readonly): ")
+ (insert "readonly=\"readonly\" "))
+ (rngalt-validate))
+ (when (string= choice "file")
+ ;; accept=
+ (require 'mailcap)
+ (condition-case err
+ (let ((prompt (concat
+ "Accept mime type, RET to stop ("
+ "C-g to skip"
+ "): "))
+ (mime " ")
+ mimes
+ (types (when (boundp 'mailcap-mime-extensions)
+ (mapcar (lambda (elt)
+ (cdr elt))
+ mailcap-mime-extensions))))
+ (while (< 0 (length mime))
+ (setq mime
+ (if types
+ (completing-read prompt types)
+ (read-string prompt)))
+ (when (< 0 (length mime))
+ (if mimes
+ (setq mimes (concat mimes "," mime))
+ (setq mimes mime))))
+ (when (and mimes
+ (< 0 (length mimes)))
+ (insert "accept=\"" mimes "\" ")))
+ (quit (message "Skipped accept attribute")))
+ (rngalt-validate))
+ (when (string= choice "image")
+ ;; alt=
+ (insert "alt=\"")
+ (rngalt-validate)
+ (insert (read-string "Alt attribute: ")
+ "\" ")
+ (rngalt-validate)
+ ;; src=
+ (insert "src=\"")
+ (rngalt-validate)
+ (let ((src (nxhtml-read-url nil nil 'nxhtml-image-url-predicate "Image")))
+ (insert src)
+ (insert "\" "))
+ (rngalt-validate))
+ ;; value=
+ (cond
+ ((member choice '("button" "reset" "submit"))
+ (nxhtml-do-also-value "Label"))
+ ((member choice '("checkbox" "radio"))
+ (nxhtml-do-also-value "Result"))
+ ((member choice '("hidden" "password" "text"))
+ (nxhtml-do-also-value "Value"))
+ )
+ (insert "/>")
+ ;;(message "type=%s" choice)(sit-for 2)
+ ))
+
+(defun nxhtml-do-also-value (label)
+ (let ((v (read-string (concat label " (value): "))))
+ (when (and v
+ (< 0 (length v)))
+ (insert " value=\"" v "\" "))))
+
+(defun nxhtml-form-tag-do-also ()
+ (insert "action=\"")
+ (rngalt-validate)
+ (let ((src (nxhtml-read-url nil nil nil "Action")))
+ (insert src "\" "))
+ )
+
+(defun nxhtml-a-tag-do-also ()
+ (insert " href=\"")
+ (rngalt-validate)
+ (insert (nxhtml-read-url t))
+ (insert "\"")
+ (let* ((pre-choices '("_blank" "_parent" "_self" "_top"))
+ (all-choices (reverse (cons "None" (cons "Frame name" pre-choices))))
+ choice
+ (prompt "Target: "))
+ (setq choice (popcmp-completing-read prompt all-choices nil t
+ "" nil nil t))
+ (unless (string= choice "None")
+ (insert " target=\"")
+ (cond ((member choice pre-choices)
+ (insert choice "\""))
+ ((string= choice "Frame name")
+ (rngalt-validate)
+ (insert (read-string "Frame name: ") "\""))
+ (t (error "Uh?")))))
+ (insert ">")
+ (rngalt-validate)
+ (insert (read-string "Link title: ")
+ "</a>"))
+
+(defconst nxhtml-complete-tag-do-also
+ '(("a" nxhtml-a-tag-do-also)
+ ;; (lambda ()
+ ;; (insert " href=\"")
+ ;; (rngalt-validate)
+ ;; (insert (nxhtml-read-url t))
+ ;; (insert "\"")))
+ ("form" nxhtml-form-tag-do-also)
+ ("img" nxhtml-img-tag-do-also)
+ ("input" nxhtml-input-tag-do-also)
+ ("link" nxhtml-link-tag-do-also)
+ ("script" nxhtml-script-tag-do-also)
+ ("style" nxhtml-style-tag-do-also)
+ ("meta" nxhtml-meta-tag-do-also)
+ )
+ "List of functions to call at tag completion.
+Each element of the list have the form
+
+ \(TAG-NAME TAG-FUN)
+
+If `nxhtml-tag-do-also' is non-nil then TAG-FUN is called after
+by `nxml-complete' (with the special setup of this function for
+`nxhtml-mode') when completing a tag with the name TAG-NAME.
+
+The list is handled as an association list, ie only the first
+occurence of a tag name is used.")
+
+(defun nxhtml-complete-tag-do-also-for-state-completion (dummy-completed)
+ "Add this to state completion functions completed hook."
+ (when (and nxhtml-tag-do-also
+ (derived-mode-p 'nxhtml-mode))
+ ;; Find out tag
+ (let ((tag nil))
+ (save-match-data
+ ;;(when (looking-back "<\\([a-z]+\\)[[:blank:]]+")
+ (when (looking-back "<\\([a-z]+\\)")
+ (setq tag (match-string 1))))
+ (when tag
+ (insert " ")
+ (nxhtml-complete-tag-do-also tag)))))
+
+(defun nxhtml-complete-tag-do-also (tag)
+ ;; First required attributes:
+ (let ((tagrec (assoc tag nxhtml-complete-tag-do-also)))
+ (when tagrec
+ (funcall (cadr tagrec))))
+ )
+
+
+;;;###autoload
+(define-minor-mode nxhtml-validation-header-mode
+ "If on use a Fictive XHTML Validation Header for the buffer.
+See `nxhtml-set-validation-header' for information about Fictive XHTML Validation Headers.
+
+This mode may be turned on automatically in two ways:
+- If you try to do completion of a XHTML tag or attribute then
+ `nxthml-mode' may ask you if you want to turn this mode on if
+ needed.
+- You can also choose to have it turned on automatically whenever
+ a mumamo multi major mode is used, see
+ `nxhtml-validation-header-if-mumamo' for further information."
+ :global nil
+ :lighter " VH"
+ :group 'nxhtml
+ (if nxhtml-validation-header-mode
+ (progn
+ (unless nxhtml-current-validation-header
+ (setq nxhtml-current-validation-header
+ (nxhtml-get-default-validation-header)))
+ ;;(message "nxhtml-current-validation-header=%s" nxhtml-current-validation-header)
+ (if nxhtml-current-validation-header
+ (progn
+ (nxhtml-apply-validation-header)
+ (add-hook 'change-major-mode-hook 'nxhtml-vhm-change-major nil t)
+ (when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ (add-hook 'mumamo-change-major-mode-hook 'nxhtml-vhm-mumamo-change-major nil t)
+ (add-hook 'mumamo-after-change-major-mode-hook 'nxhtml-vhm-mumamo-after-change-major nil t)))
+ (run-with-idle-timer 0 nil 'nxhtml-validation-header-empty (current-buffer))))
+ (rngalt-set-validation-header nil)
+ (setq nxhtml-current-validation-header nil)
+ (remove-hook 'after-change-major-mode-hook 'nxhtml-vhm-after-change-major t)
+ (when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ (remove-hook 'mumamo-change-major-mode-hook 'nxhtml-vhm-mumamo-change-major t)
+ (remove-hook 'mumamo-after-change-major-mode-hook 'nxhtml-vhm-mumamo-after-change-major t))))
+
+(defun nxhtml-can-insert-page-here ()
+ (and (not nxhtml-validation-header-mode)
+ (= 1 (point))
+ (or (= 0 (buffer-size))
+ (save-restriction
+ (widen)
+ (save-match-data
+ (looking-at (rx buffer-start
+ (0+ space)
+ buffer-end)))))))
+
+(defun nxhtml-complete-first-try ()
+ (when (nxhtml-can-insert-page-here)
+ (nxhtml-empty-page-completion)))
+
+(defun nxhtml-completing-read-tag (prompt
+ table
+ &optional predicate require-match
+ initial-input hist def inherit-input-method)
+ (let ((popcmp-in-buffer-allowed t))
+ (popcmp-completing-read prompt
+ table
+ predicate require-match
+ initial-input hist def inherit-input-method
+ nxhtml-help-tag
+ nxhtml-tag-sets)))
+
+(defun nxhtml-add-required-to-attr-set (tag)
+ (let ((missing (when tag
+ (rngalt-get-missing-required-attr
+ (nxthml-is-single-tag tag)))))
+ (if (not missing)
+ nxhtml-attr-sets
+ (cons (cons "Required" missing)
+ nxhtml-attr-sets))))
+
+(defun nxhtml-get-tag-specific-attr-help (tag)
+ (append (cdr (assoc tag nxhtml-help-attribute-name-tag)) nxhtml-help-attribute-name)
+ )
+
+(defconst nxhtml-in-start-tag-regex
+ ;;(defconst rng-in-start-tag-name-regex
+ (replace-regexp-in-string
+ "w"
+ xmltok-ncname-regexp
+ ;; Not entirely correct since < could be part of attribute value:
+ "<\\(w\\(?::w?\\)?\\)+ [^<]*"
+ t
+ t))
+
+(defun nxhtml-completing-read-attribute-name (prompt
+ table
+ &optional predicate require-match
+ initial-input hist def inherit-input-method)
+ (let* ((tag (save-match-data
+ ;;(when (looking-back "<\\([a-z1-6]+\\) [^<]*")
+ (when (looking-back nxhtml-in-start-tag-regex)
+ (match-string 1))))
+ (attr-sets (nxhtml-add-required-to-attr-set tag))
+ (help-attr (nxhtml-get-tag-specific-attr-help tag))
+ (popcmp-in-buffer-allowed t)
+ )
+ (popcmp-completing-read prompt
+ table
+ predicate require-match
+ initial-input hist def inherit-input-method
+ help-attr
+ attr-sets)))
+
+(defun nxhtml-completing-read-attribute-value (prompt
+ table
+ &optional predicate require-match
+ initial-input hist def inherit-input-method)
+ (let (val)
+ (if table
+ (let ((popcmp-in-buffer-allowed t))
+ (setq val (popcmp-completing-read prompt table
+ predicate require-match
+ initial-input hist def inherit-input-method)))
+ (let* (init
+ delimiter
+ (lt-pos (save-excursion (search-backward "<" nil t)))
+ (in-attr-val
+ (save-excursion
+ (re-search-backward rng-in-attribute-value-regex lt-pos t)))
+ (in-xml-attr-val
+ (unless in-attr-val
+ (save-excursion
+ (re-search-backward nxhtml-in-xml-attribute-value-regex lt-pos t))))
+ )
+ (when (or in-attr-val in-xml-attr-val)
+ ;;(save-match-data (save-excursion (re-search-forward "\\=[^<> \t\r\n\"]*" nil t)))
+ (let* ((name-start (match-beginning 1))
+ (name-end (match-end 1))
+ (colon (match-beginning 2))
+ (attr (buffer-substring-no-properties name-start
+ (or colon name-end)))
+ (value-start (1+ (match-beginning 3)))
+ tag-start-end
+ (tag (save-excursion
+ (when (search-backward-regexp "<[[:alpha:]]+" nil t)
+ (setq tag-start-end (match-end 0))
+ (match-string-no-properties 0)))))
+ (setq init (buffer-substring-no-properties value-start (point)))
+ (setq delimiter (char-before value-start))
+ (if in-xml-attr-val
+ (error "in-xml-attr-val should not be true here!")
+ ;; (cond ((string= "encoding" attr)
+ ;; ;; Give a default that works in browsers today
+ ;; (setq val (nxhtml-coding-systems-complete
+ ;; init
+ ;; (symbol-name nxhtml-default-encoding))))
+ ;; ((string= "version" attr)
+ ;; (setq val "1.0")))
+ (cond ((string= "rel" attr)
+ (cond ((string= "<link" tag)
+ (setq val (nxhtml-read-link-rel))
+ )))
+ ((string= "media" attr)
+ (cond ((string= "<link" tag)
+ (setq val (nxhtml-read-link-media)))
+ ((string= "<style" tag)
+ (setq val (nxhtml-read-link-media)))
+ ))
+ ((string= "type" attr)
+ (cond ((string= "<link" tag)
+ (setq val (nxhtml-read-link-type))
+ )))
+ ((string= "http-equiv" attr)
+ (cond ((string= "<meta" tag)
+ (setq val (nxhtml-read-meta-http-equiv)))))
+ ((string= "content" attr)
+ (cond ((string= "<meta" tag)
+ (setq val (nxhtml-read-meta-content)))))
+ ((string= "scheme" attr)
+ (cond ((string= "<meta" tag)
+ (setq val (nxhtml-read-meta-scheme)))))
+ ((string= "name" attr)
+ (cond ((string= "<meta" tag)
+ (setq val (nxhtml-read-meta-name)))))
+ ((string= "href" attr)
+ (cond ((string= "<a" tag)
+ (setq val (nxhtml-read-url t init)))
+ ((string= "<base" tag)
+ (setq val (nxhtml-read-url nil init nil "Base")))
+ ((string= "<area" tag)
+ (setq val (nxhtml-read-url nil init)))
+ ((string= "<link" tag)
+ (let (predicate
+ (here (point)))
+ (save-excursion
+ (goto-char tag-start-end)
+ (cond
+ ((search-forward "text/css" here nil)
+ (setq predicate 'nxhtml-css-url-predicate))
+ ))
+ (setq val (nxhtml-read-url nil init predicate))))
+ (t
+ (setq val (nxhtml-read-url nil init)))))
+ ((string= "src" attr)
+ (cond ((string= "<img" tag)
+ (setq val (nxhtml-read-url nil init 'nxhtml-image-url-predicate "Image")))
+ ((string= "<script" tag)
+ (setq val (nxhtml-read-url nil init 'nxhtml-script-url-predicate "Script")))
+ ((string= "<input" tag)
+ (setq val (nxhtml-read-url nil init 'nxhtml-image-url-predicate "Image")))
+ ((string= "<frame" tag)
+ (setq val (nxhtml-read-url nil init nil "Frame Source")))
+ ((string= "<iframe" tag)
+ (setq val (nxhtml-read-url nil init nil "Frame Source")))
+ (t
+ (setq val (nxhtml-read-url nil init)))))))))))
+ ;;(unless val (setq val (read-from-minibuffer prompt init)))
+ (if (not val)
+ (progn
+ (message "No completion of attribute value available here")
+ nil)
+ val)))
+
+(defun nxhtml-read-link-type ()
+ (require 'mailcap)
+ (let ((types (when (boundp 'mailcap-mime-extensions)
+ (mapcar (lambda (elt)
+ (cdr elt))
+ mailcap-mime-extensions))))
+ (completing-read "Link type: " types nil t)))
+
+(defun nxhtml-read-link-media ()
+ (let ((types '(
+ "screen"
+ "tty"
+ "tv"
+ "projection"
+ "handheld"
+ "print"
+ "braille"
+ "aural"
+ "all"
+ )))
+ (popcmp-completing-read "For media type: " types nil t)))
+
+(defun nxhtml-read-link-rel ()
+ (let ((predefined-linktypes '(
+ "Alternate"
+ "Appendix"
+ "Bookmark"
+ "Chapter"
+ "Contents"
+ "Copyright"
+ "Glossary"
+ "Help"
+ "Index"
+ "Next"
+ "Prev"
+ "Section"
+ "Shortcut Icon"
+ "Start"
+ "Stylesheet"
+ "Subsection"
+ )))
+ (popcmp-completing-read "Predefined LinkTypes: " predefined-linktypes nil t)))
+
+(defun nxhtml-read-meta-name ()
+ (let ((types '(
+ "author"
+ "description"
+ "keywords"
+ "generator"
+ "revised"
+ ;;"others"
+ )))
+ (popcmp-completing-read "Meta name: " types nil t)))
+
+(defun nxhtml-read-meta-content ()
+ (nxhtml-read-from-minibuffer "Meta content: "))
+
+(defun nxhtml-read-meta-scheme ()
+ (nxhtml-read-from-minibuffer "Meta scheme: "))
+
+(defun nxhtml-read-meta-http-equiv ()
+ (let ((types '(
+ "content-type"
+ "expires"
+ "refresh"
+ "set-cookie"
+ )))
+ (popcmp-completing-read "Meta http-equiv: " types nil t)))
+
+(when nil
+ (setq rngalt-completing-read-tag nil)
+ (setq rngalt-complete-last-try nil)
+ )
+
+
+(when (featurep 'typesetter)
+ (defun typesetter-init-nxhtml-mode ()
+ (typesetter-init-html-mode))
+ )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Validation start state
+
+(defcustom nxhtml-validation-headers
+ '(
+ ("body-iso-8859-1" .
+ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+ <head>
+ <title>Fictive XHTML Validation Header</title>
+ </head>
+ <body>
+"
+ )
+ ("head-iso-8859-1" .
+ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+ <head>
+"
+ )
+ ("html-iso-8859-1" .
+ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+"
+ )
+ ;; ("doctype-iso-8859-1" .
+ ;; "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
+ ;; <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+ ;; \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+ ;; "
+ ;; )
+ ;; ("xml-iso-8859-1" .
+ ;; "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
+ ;; "
+ ;; )
+
+ ("body-utf-8" .
+ "<?xml version=\"1.0\" encoding=\"utf-8\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+ <head>
+ <title>Fictive XHTML Validation Header</title>
+ </head>
+ <body>
+"
+ )
+ ("head-utf-8" .
+ "<?xml version=\"1.0\" encoding=\"utf-8\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+ <head>
+"
+ )
+ ("head-closed-utf-8" .
+ "<?xml version=\"1.0\" encoding=\"utf-8\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+ <head>
+ <title></title>
+ </head>
+"
+ )
+ ("html-utf-8" .
+ "<?xml version=\"1.0\" encoding=\"utf-8\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+"
+ )
+ ;; ("doctype-utf-8" .
+ ;; "<?xml version=\"1.0\" encoding=\"utf-8\"?>
+ ;; <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+ ;; \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+ ;; "
+ ;; )
+ ;; ("xml-utf-8" .
+ ;; "<?xml version=\"1.0\" encoding=\"utf-8\"?>
+ ;; "
+ ;; )
+ )
+ "Fictive XHTML validation headers.
+Used by `nxhtml-set-validation-header'."
+ :type '(alist :key-type string :value-type string)
+ :group 'nxhtml)
+
+(defcustom nxhtml-default-validation-header nil
+ "Default Fictive XHTML validation header.
+Must be nil or one of the key values in
+`nxhtml-validation-headers'."
+ :type 'string
+ :set (lambda (sym val)
+ (if (or (null val)
+ (assoc val nxhtml-validation-headers))
+ (set-default sym val)
+ (lwarn 'nxhtml-default-validation-header
+ :warning "There is no Fictive XHTML Validation Header named %s" val)))
+ :group 'nxhtml)
+
+(defun nxhtml-must-have-validation-headers ()
+ (unless nxhtml-validation-headers
+ (error
+ "No XHTML validation headers. Please customize nxhtml-validation-headers.")))
+
+(defvar nxhtml-set-validation-header-hist nil)
+
+(defcustom nxhtml-guess-validation-header-alist
+ ;;(rx line-start (0+ blank) "<body")
+ '(
+ ("^[[:blank:]]*<body" . "body-utf-8")
+ ("^[[:blank:]]*</head>" . "head-closed-utf-8")
+ ("^[[:blank:]]*<head" . "head-utf-8")
+ ("^[[:blank:]]*<html" . "html-utf-8")
+ )
+ "Alist used by `nxhtml-guess-validation-header'.
+Alternatives are tried from top to bottom until one fits."
+ :type '(alist :key-type (regexp :tag "If NOT found in buffer")
+ :value-type (string :tag "Use Fictive XHTML Validation Header"))
+ :group 'nxhtml)
+
+(defun nxhtml-guess-validation-header ()
+ "Return Fictive XHTML validation that could fit current buffer.
+This guess is made by matching the entries in
+`nxhtml-guess-validation-header-alist' against the buffer."
+ (nxhtml-must-have-validation-headers)
+ (save-excursion
+ (save-restriction
+ (save-match-data
+ (widen)
+ (let (rec
+ regexp
+ key
+ (guesses nxhtml-guess-validation-header-alist))
+ (goto-char (point-min))
+ (if (not (search-forward "</" 2000 t))
+ (progn
+ (setq rec (car guesses))
+ (setq key (cdr rec)))
+ (while (and guesses
+ (not key))
+ (setq rec (car guesses))
+ (setq guesses (cdr guesses))
+ (setq regexp (car rec))
+ (goto-char (point-min))
+ ;; Fix-me: check for chunk and check if in string.
+ (let (found)
+ (while (and (not found)
+ (re-search-forward regexp nil t))
+ ;; ensure fontified, but how?
+ (when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ (let ((mumamo-just-changed-major nil))
+ ;;(unless (and (mumamo-get-existing-chunk-at (point))
+ (unless (and (mumamo-find-chunks (point) "guess-validation-header")
+ (eq t (get-text-property (point) 'fontified)))
+ (mumamo-fontify-region (point-min) (+ 1000 (point))))))
+ (unless (memq (get-text-property (point) 'face)
+ '(font-lock-comment-face
+ font-lock-comment-delimiter-face
+ font-lock-doc-face
+ font-lock-string-face
+ ))
+ (setq found t)))
+ (unless found
+ (setq key (cdr rec))))))
+ ;;(unless (re-search-forward regexp nil t) (setq key (cdr rec)))))
+ key)))))
+
+(defun nxhtml-open-dir-saved-validation-headers (must-exist)
+ "Open file with saved validation headers and return buffer."
+ ;;(lwarn 't :warning "must-exist=%s" must-exist)
+ (when (buffer-file-name)
+ (let* ((dir-name (file-name-directory (buffer-file-name)))
+ (file-name (expand-file-name "nxhtml-val-headers.el"))
+ emacs-lisp-mode-hook)
+ (when (or (not must-exist)
+ (file-exists-p file-name))
+ (find-file-noselect file-name)))))
+
+(defun nxhtml-get-saved-validation-header ()
+ (when (buffer-file-name)
+ (let* ((val-buf (nxhtml-open-dir-saved-validation-headers t))
+ (file-name (file-name-nondirectory (buffer-file-name)))
+ validation-headers)
+ (when val-buf
+ (with-current-buffer val-buf
+ (eval-buffer))
+ (cadr (assoc file-name validation-headers))))))
+
+(defun nxhtml-remove-saved-validation-header ()
+ "Removed the saved validation header.
+Reverse the action done by `nxhtml-save-validation-header'."
+ (interactive)
+ (nxhtml-update-saved-validation-header nil))
+
+(defun nxhtml-save-validation-header ()
+ "Save the current validation header.
+The current validation is saved for the next time you open the
+current file. It is then used by `nxhtml-validation-header-mode'
+and `nxhtml-set-validation-header'. This means that if you have
+turned on `nxhtml-global-validation-header-mode' this validation
+header will be set automatically.
+
+The saved validation header can be removed with
+`nxhtml-remove-saved-validation-header'.
+
+* Note: There is normally no need to save the validation headers
+ since `nxhtml-global-validation-header-mode' will add
+ validation headers as needed most of the time."
+ (interactive)
+ (nxhtml-update-saved-validation-header t))
+
+(defun nxhtml-update-saved-validation-header (save)
+ (unless (buffer-file-name)
+ (error "Validation Header can only be saved if buffer contains a file."))
+ (let* ((val-buf (nxhtml-open-dir-saved-validation-headers nil))
+ ;;(get-buffer-create "temp val head"))
+ validation-headers
+ (file-name (file-name-nondirectory (buffer-file-name)))
+ (entry (list file-name nxhtml-current-validation-header))
+ ;;entry-list
+ removed
+ )
+ ;; Get old headers
+ (with-current-buffer val-buf
+ (eval-buffer))
+ ;; Remove old value
+ (setq validation-headers
+ (delq nil
+ (mapcar (lambda (elt)
+ (if (string= file-name (car elt))
+ (progn
+ (setq removed t)
+ nil)
+ elt))
+ validation-headers)))
+ ;; Add new value
+ (when save
+ (setq validation-headers (cons entry validation-headers)))
+ (with-current-buffer val-buf
+ (erase-buffer)
+ ;;(print file-name val-buf)
+ ;;(print nxhtml-current-validation-header val-buf)
+ ;;(print entry val-buf)
+ (insert "(setq validation-headers (quote")
+ (print validation-headers val-buf)
+ (insert "))")
+ (basic-save-buffer)
+ )
+ (if save
+ (message "Current validation header for file saved")
+ (if removed
+ (message "Removed saved validation header")
+ (message "There was no saved validation header")))))
+
+(defun nxhtml-get-default-validation-header ()
+ "Return default Fictive XHTML validation header key for current buffer.
+If `nxhtml-default-validation-header' is non-nil then return
+this. Otherwise return saved validation header if there is one
+or guess using `nxhtml-guess-validation-header'."
+ (or nxhtml-default-validation-header
+ (nxhtml-get-saved-validation-header)
+ (nxhtml-guess-validation-header)))
+
+(defun nxhtml-set-validation-header (&optional key)
+ "Set a Fictive XHTML validation header in the buffer.
+Such a header is not inserted in the buffer, but is only used by
+validation and XHTML completion by `nxhtml-mode'.
+
+The header is active for validation and completion if and only if
+`nxhtml-validation-header-mode' is on.
+
+Note that Fictive XHTML Validation Headers are normally chosen
+automatically, but you can use this function to override that choice.
+
+The header is chosen from `nxhtml-validation-headers'. If there
+is more than one you will be prompted. To set the default fictive
+XHTML validation header customize `nxhtml-validation-headers'.
+
+If called non-interactive then the header corresponding to key
+KEY will be used. If KEY is nil then it is set to
+`nxhtml-default-validation-header'.
+
+This header can be visible or invisible in the buffer, for more
+information see `rngalt-show-validation-header'."
+ (interactive
+ (list
+ (let ((nh (length nxhtml-validation-headers))
+ (default (nxhtml-get-default-validation-header)))
+ (if (> nh 1)
+ (completing-read "XHTML validation header: "
+ nxhtml-validation-headers
+ nil
+ t
+ default
+ nxhtml-set-validation-header-hist)
+ (if (not (y-or-n-p "Only one XHTML validation header is defined. Define more? "))
+ default
+ (customize-option 'nxhtml-validation-headers)
+ 'adding)))))
+ ;;(lwarn 'svh2 :warning "key=%s" key)
+ (or key
+ (setq key (nxhtml-get-default-validation-header))
+ (setq key (cons 'schema "XHTML")))
+ (unless (eq key 'adding)
+ (setq nxhtml-current-validation-header key)
+ (nxhtml-validation-header-mode 1)
+ (nxhtml-apply-validation-header)))
+
+(defun nxhtml-apply-validation-header ()
+ (when nxhtml-current-validation-header
+ (setq rngalt-major-mode
+ (if (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ (mumamo-main-major-mode)
+ major-mode))
+ (let* ((key nxhtml-current-validation-header)
+ (rec (unless (listp key)
+ (assoc key nxhtml-validation-headers)))
+ (header (cdr rec)))
+ (if (listp key)
+ (let ((schema-file (rng-locate-schema-file (cdr key))))
+ (unless schema-file
+ (error "Could not locate schema for type id `%s'" key)) ;type-id))
+ (rng-set-schema-file-1 schema-file))
+ (rngalt-set-validation-header header)
+ ))))
+
+(defun nxhtml-update-validation-header ()
+ "Update the validation header in the buffer as needed."
+ (interactive)
+ (let ((mode-on nxhtml-validation-header-mode))
+ (when mode-on (nxhtml-validation-header-mode 0))
+ (setq nxhtml-current-validation-header nil)
+ (when mode-on (nxhtml-validation-header-mode 1))))
+
+(defun nxhtml-vhm-change-major ()
+ "Turn off `nxhtml-validation-header-mode' after change major."
+ ;;(message "nxhtml-vhm-change-major here")
+ (unless (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ (setq nxhtml-current-validation-header nil))
+ (run-with-idle-timer 0 nil 'nxhtml-validation-header-empty (current-buffer)))
+(put 'nxhtml-vhm-change-mode 'permanent-local-hook t)
+
+(defun nxhtml-recheck-validation-header ()
+ "Just turn off and on again `nxhtml-validation-header-mode'.
+This will adjust the XHTML validation to the code currently in
+the buffer."
+ (interactive)
+ (nxhtml-validation-header-mode -1)
+ (nxhtml-validation-header-mode 1))
+
+(defun nxhtml-validation-header-empty (buffer)
+ "Turn off validation header mode.
+This is called because there was no validation header."
+ (with-current-buffer buffer
+ (unless nxhtml-current-validation-header
+ ;;(message "nxhtml-validation-header-empty")
+ (save-match-data ;; runs in timer
+ (nxhtml-validation-header-mode -1))
+ ;;(message "No validation header was needed")
+ )))
+
+(defun nxhtml-turn-on-validation-header-mode ()
+ "Turn on `nxhtml-validation-header-mode'."
+ (nxhtml-validation-header-mode 1))
+
+
+(defun nxhtml-vhm-mumamo-change-major ()
+ (put 'rngalt-validation-header 'permanent-local t)
+ (put 'nxhtml-validation-header-mode 'permanent-local t)
+ (put 'nxhtml-current-validation-header 'permanent-local t)
+ ;;(put 'nxhtml-validation-header-mode-major-mode 'permanent-local t)
+ ;;(setq nxhtml-validation-header-mode-major-mode mumamo-set-major-running)
+ )
+
+(defun nxhtml-vhm-mumamo-after-change-major ()
+ (put 'rngalt-validation-header 'permanent-local nil)
+ (put 'nxhtml-validation-header-mode 'permanent-local nil)
+ (put 'nxhtml-current-validation-header 'permanent-local nil)
+ ;;(put 'nxhtml-validation-header-mode-major-mode 'permanent-local nil)
+ )
+
+(defcustom nxhtml-validation-headers-check 'html
+ "Defines what check the function with the same name does.
+The function returns true if the condition here is met."
+ :type '(choice :tag "Add Fictive XHTML Validation Header if:"
+ (const :tag "If buffer contains html" html)
+ (const :tag "If buffer contains html or is empty" html-empty))
+ :group 'nxhtml)
+
+;; (defun nxhtml-validation-headers-check (buffer)
+;; "Return non-nil if buffer contains a html tag or is empty.
+;; This is for use with `nxhtml-validation-header-filenames'.
+
+;; The variable `nxhtml-validation-headers-check' determines how the
+;; check is made."
+;; (if (= 0 (buffer-size buffer))
+;; (eq 'html-empty nxhtml-validation-headers-check)
+;; (save-match-data
+;; (save-restriction
+;; (let ((here (point))
+;; (html nil))
+;; (goto-char (point-min))
+;; (setq html (re-search-forward "</?[a-z]+>" nil t))
+;; (goto-char here)
+;; html)))))
+
+;; (defcustom nxhtml-validation-header-filenames
+;; '(
+;; ("\.php\\'" nxhtml-validation-headers-check)
+;; ("\.rhtml\\'" nxhtml-validation-headers-check)
+;; ("\.jsp\\'" nxhtml-validation-headers-check)
+;; ("\.gsp\\'" nxhtml-validation-headers-check)
+;; )
+;; "Alist for turning on `nxhtml-validation-mode'.
+;; The entries in the list should have the form
+
+;; \(FILE-REGEXP CHECK-FUNCION)
+
+;; If buffer file name matches the regexp FILE-REGEXP and the
+;; function CHECK-FUNCTION returns non-nil when called with the
+;; buffer as an argument \(or CHECK-FUNCTION is nil) then
+;; `nxhtml-global-validation-header-mode' will turn on
+;; `nxhtml-validation-header-mode' in buffer.
+
+;; The function `nxhtml-validation-headers-check' may be a useful
+;; value for CHECK-FUNCTION.
+
+;; See also `nxhtml-maybe-turn-on-validation-header'."
+;; :type '(alist :key-type regexp :tag "File name regexp"
+;; :value-type (group (choice (const :tag "No more check" nil)
+;; (function :tag "Check buffer with"))))
+;; :group 'nxhtml)
+
+
+
+;; (defun nxhtml-maybe-turn-on-validation-header ()
+;; "Maybe turn on `nxhtml-validation-header-mode' in buffer.
+;; This is called by `nxhtml-global-validation-header-mode'.
+
+;; See `nxhtml-validation-header-filenames' for how the check
+;; is made."
+;; (or (and (or (and mumamo-mode
+;; (eq (mumamo-main-major-mode) 'nxhtml-mode))
+;; (eq major-mode 'nxhtml-mode))
+;; rngalt-validation-header
+;; nxhtml-current-validation-header
+;; nxhtml-validation-header-mode
+;; (progn
+;; ;;(lwarn 'maybe :warning "quick, buffer=%s" (current-buffer))
+;; (nxhtml-validation-header-mode 1)
+;; t))
+;; (when (buffer-file-name)
+;; (unless (or ;;nxhtml-validation-header-mode
+;; (minibufferp (current-buffer))
+;; (string= " " (substring (buffer-name) 0 1))
+;; (string= "*" (substring (buffer-name) 0 1))
+;; )
+;; (when (catch 'turn-on
+;; (save-match-data
+;; (dolist (rec nxhtml-validation-header-filenames)
+;; (when (string-match (car rec) (buffer-file-name))
+;; (let ((fun (nth 1 rec)))
+;; (if (not fun)
+;; (progn
+;; ;;(lwarn 't :warning "matched %s to %s, nil" (car rec) (buffer-file-name))
+;; (throw 'turn-on t))
+;; (when (funcall fun (current-buffer))
+;; ;;(lwarn 't :warning "matched %s to %s" (car rec) (buffer-file-name))
+;; (throw 'turn-on t))))))))
+;; ;;(lwarn 't :warning "turn on %s, buffer=%s" major-mode (current-buffer))
+;; (nxhtml-validation-header-mode 1))))))
+
+
+;; ;; Fix-me: Is this really the way to do it? Would it not be better to
+;; ;; tie this to mumamo-mode in the turn on hook there? After all
+;; ;; validation headers are probably not used unless mumamo-mode is on.
+;; (define-globalized-minor-mode nxhtml-global-validation-header-mode
+;; nxhtml-validation-header-mode
+;; nxhtml-maybe-turn-on-validation-header
+;; :group 'nxhtml)
+;; ;; The problem with global minor modes:
+;; (when (and nxhtml-global-validation-header-mode
+;; (not (boundp 'define-global-minor-mode-bug)))
+;; (nxhtml-global-validation-header-mode 1))
+
+
+(defcustom nxhtml-validation-header-mumamo-modes
+ '(nxhtml-mode)
+ "Main major modes for which to turn on validation header.
+Turn on Fictive XHTML Validation Header if main major mode for the
+used mumamo multi major mode is any of those in this list.
+
+See `mumamo-defined-turn-on-functions' for information about
+mumamo multi major modes."
+ :type '(repeat (function :tag "Main major mode in mumamo"))
+ :group 'nxhtml)
+
+(defun nxhtml-add-validation-header-if-mumamo ()
+ "Maybe turn on validation header.
+See `nxhtml-validation-header-if-mumamo' for more information."
+ ;;(nxhtml-validation-headers-check (current-buffer))
+ (when (and (fboundp 'mumamo-main-major-mode)
+ (memq (mumamo-main-major-mode) nxhtml-validation-header-mumamo-modes))
+ (nxhtml-validation-header-mode 1)))
+
+;;(define-toggle nxhtml-validation-header-if-mumamo nil
+(define-minor-mode nxhtml-validation-header-if-mumamo
+ "Add a fictive validation header when mumamo is used.
+If this variable is t then add a Fictive XHTML Validation Header
+\(see `nxhtml-validation-header-mode') in buffer when mumamo is
+used. However do this only if `mumamo-main-major-mode' is one of
+those in `nxhtml-validation-header-mumamo-modes'.
+
+Changing this variable through custom adds/removes the function
+`nxhtml-add-validation-header-if-mumamo' to
+`mumamo-turn-on-hook'."
+ :global t
+ :group 'nxhtml
+ (if nxhtml-validation-header-if-mumamo
+ (add-hook 'mumamo-turn-on-hook 'nxhtml-add-validation-header-if-mumamo)
+ (remove-hook 'mumamo-turn-on-hook 'nxhtml-add-validation-header-if-mumamo)))
+
+(defun nxhtml-validation-header-if-mumamo-toggle ()
+ "Toggle `nxhtml-validation-header-if-mumamo'."
+ (interactive)
+ (nxhtml-validation-header-if-mumamo (if nxhtml-validation-header-if-mumamo -1 1)))
+
+(defun nxhtml-warnings-are-visible ()
+ (get 'rng-error 'face))
+
+(defvar nxhtml-old-rng-error-face nil)
+(defun nxhtml-toggle-visible-warnings ()
+ "Toggle the red underline on validation errors.
+Those can be quite disturbing when using mumamo multi major modes
+because there will probably be many validation errors in for
+example a php buffer, since unfortunately the validation routines
+in `rng-validate-mode' from `nxml-mode' tries to validate the
+whole buffer as XHTML.
+
+Also, because of a \(normally unimportant) bug in Emacs 22,
+the red underline that marks an error will sometimes span several
+lines instead of just marking a single character as it
+should. \(This bug is a problem with overlays in Emacs 22.)"
+ (interactive)
+ (let ((face (get 'rng-error 'face)))
+ (if face
+ (progn
+ (setq nxhtml-old-rng-error-face (get 'rng-error 'face))
+ (put 'rng-error 'face nil))
+ (put 'rng-error 'face nxhtml-old-rng-error-face))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Bug corrections
+;; (defun nxml-indent-line ()
+;; "Indent current line as XML."
+;; (let ((indent (nxml-compute-indent))
+;; (from-end (- (point-max) (point))))
+;; (when indent
+;; (beginning-of-line)
+;; (let ((bol (point)))
+;; (skip-chars-forward " \t")
+;; ;; There is a problem with some lines, try a quick fix:
+;; (when (and (= 0 indent)
+;; (not (eq (char-after) ?<)))
+;; (save-excursion
+;; (save-match-data
+;; (when (re-search-backward "^<" nil t)
+;; (when (search-forward " ")
+;; (setq indent (current-column))))))
+;; (when (= 0 indent)
+;; (setq indent nxml-child-indent)))
+;; ;; And sometimes nxml-compute-indent get very upset, check for
+;; ;; that:
+;; (let ((here (point)))
+;; (beginning-of-line 0)
+;; (back-to-indentation)
+;; (when (and (= indent (current-column))
+;; (eq (char-after) ?\"))
+;; (setq indent 0))
+;; (goto-char here))
+;; (unless (= (current-column) indent)
+;; (delete-region bol (point))
+;; (indent-to indent)))
+;; (when (> (- (point-max) from-end) (point))
+;; (goto-char (- (point-max) from-end))))))
+
+
+;; FIX-ME: untag should be in nxml-mode.el since it is in no way
+;; specific to nxhtml-mode, but I do not want to change nxml-mode.el
+;; at the moment.
+
+(defcustom nxml-untag-select 'yes
+ "Decide whether to select an element untagged by `nxml-untag-element'.
+If this variable is 'yes the element is selected after untagging
+the element. The mark is set at the end of the element and point
+at the beginning of the element.
+
+If this variable is 'no then the element is not selected and
+point is not moved. If it is 'ask the user is asked what to do."
+ :type '(choice (const :tag "Yes" yes)
+ (const :tag "No" no)
+ (const :tag "Ask" ask))
+ :group 'nxml)
+
+(defun nxml-untag-element (arg)
+ "Remove start and end tag from current element.
+The mark is by default set to the end of the former element and
+point is moved to the beginning. Mark is also activated so that
+it is easy to surround the former element with a new tag.
+
+Whether to select the old element is controlled by
+`nxml-untag-select'. The meaning of the values 'yes and 'no for
+this variable is flipped by using a universal argument.
+
+Note: If you want to `undo' the untag and you use
+`transient-mark-mode' then you must first do something so that
+the region is not highlighted (for example C-g)."
+ (interactive "*P")
+ (let ((here (point-marker))
+ el-start
+ el-start-end
+ el-end
+ el-end-end
+ (select t))
+ (nxml-backward-up-element)
+ (setq el-start (point))
+ (nxml-forward-balanced-item)
+ (setq el-start-end (point))
+ (goto-char el-start)
+ (nxml-forward-element)
+ (setq el-end-end (point-marker))
+ (nxml-backward-single-balanced-item)
+ (setq el-end (point))
+ (delete-region el-end el-end-end)
+ (delete-region el-start el-start-end)
+ ;; Select the element or not?
+ (if (eq nxml-untag-select 'ask)
+ (setq select (y-or-n-p "Select the old element? "))
+ (when (eq nxml-untag-select 'no)
+ (setq select nil))
+ (when arg
+ (setq select (not select))))
+ (if (not select)
+ (goto-char here)
+ (goto-char el-end-end)
+ (push-mark nil t t)
+ (setq mark-active t)
+ (setq deactivate-mark nil)
+ (goto-char el-start))))
+
+(defun nxhtml-rollover-insert-2v ()
+ "Insert CSS rollover images.
+The upper half of the image will be used when mouse is out and
+the lower half when mouse is over the image.
+
+Only CSS is used for the rollover. The CSS code is written to the
+header part of the file if possible, otherwise it is copied to
+the kill ring/clipboard.
+
+The CSS code is built from a template file and the image size.
+
+This might be used for example for creating a menu with
+alternatives vertically or horizontally.
+
+Usage example:
+
+ If you want to make a small button style menu with images you
+ can start like this:
+
+ <div id=\"mylinks\">
+ <ul>
+ <li>
+ X <a href=\"news.html\">News and Notes</a>
+ </li>
+ <li>
+ <a href=\"doc.html\">Documentation</a>
+ </li>
+ <ul>
+ </div>
+
+ Then put point at the X above (this is just a mark, should not
+ be in your code) and call this function.
+
+ It will add some CSS code to in the header of your file. You
+ may want to tweak this a little bit, see below (or place it
+ somewhere else). It may look like this:
+
+ #mylinks a {
+ /* Image */
+ display: block;
+ background: transparent url(\"img/mybutton.png\") 0 0 no-repeat;
+ overflow: hidden;
+ width: 200px;
+ /* Text placement and size, etc */
+ text-align: center;
+ /* You may need to change top and bottom padding depending
+ on font size. */
+ padding-top: 11px;
+ font-size: 12px;
+ padding-bottom: 9px;
+ text-decoration: none;
+ white-space: nowrap;
+ border: none;
+ }
+ #mylinks a:hover {
+ background-position: 0 -35px;
+ }
+ #mylinks li {
+ display: inline;
+ padding: 0;
+ margin: 0;
+ float: none;
+ }
+
+For an example of usage see the file nxhtml.html that comes with
+nXhtml and can be opened from the nXhtml menu under
+
+ nXhtml / nXhtml Help and Setup / nXhtml version nn Overview"
+ (interactive)
+ ;; Fix-me: not quite ready yet, but should work OK."
+ (save-excursion
+ (let* ((tag (progn
+ (search-forward ">" nil t)
+ (unless (re-search-backward (rx "<"
+ (1+ (any "a-zA-Z:"))
+ (1+ (not (any ">")))
+ " id=\""
+ (submatch (+? anything))
+ "\"")
+ nil t)
+ (error "Can't find tag with id backwards"))
+ (match-string-no-properties 0)))
+ (tagid (match-string-no-properties 1))
+ (tagovl (let ((ovl (make-overlay
+ (match-beginning 0) (match-end 0))))
+ (overlay-put ovl 'face 'highlight)
+ ovl))
+ (head-end (save-excursion (search-backward "</head" nil t))))
+ (unless head-end
+ (error "Can't find end of head tag. Need this to insert css."))
+ (sit-for 1)
+ (unwind-protect
+ (condition-case err
+ (let* ((img-src (nxhtml-read-url
+ '(?f) nil 'nxhtml-image-url-predicate
+ (concat "Rollover image for \"" tag "\",")))
+ (img-sizes (when (file-exists-p img-src)
+ (image-size (create-image
+ (expand-file-name img-src))
+ t)))
+ (class (read-string
+ (concat
+ "Class name for rollover (empty to use id="
+ tagid "): ")))
+ (rollover-spec (if (< 0 (length class))
+ (concat "." class)
+ (concat "#" tagid)))
+ img-width img-height
+ img-h2
+ img-w2
+ padding-top
+ padding-bottom
+ (font-size (read-number "Font size (px): " 12))
+ (css-template-file (read-file-name
+ "CSS template file: "
+ (expand-file-name "etc/templates/" nxhtml-install-dir)
+ nil
+ t
+ "rollover-2v.css"
+ ))
+ (center-or-pad
+ (if (y-or-n-p "Do you want to center the text? ")
+ "text-align: center"
+ (format "padding: %spx" (/ font-size 2))))
+ (hor-or-ver
+ (if (y-or-n-p "Do you want the alternatives shown in a vertical list? ")
+ "float: none"
+ "float: left"))
+ (css-template-buffer (find-file-noselect
+ css-template-file))
+ (css-template (with-current-buffer css-template-buffer
+ ;; Do not widen, let user decide.
+ (buffer-substring-no-properties
+ (point-min) (point-max))))
+ (css css-template))
+ (unless (file-exists-p css-template-file)
+ (error "Can't find file %s" css-template-file))
+ (if img-sizes
+ (progn
+ (setq img-width (car img-sizes))
+ (setq img-height (cdr img-sizes)))
+ (setq img-width (read-number "Width: "))
+ (setq img-height (read-number "Width: ")))
+ (setq img-h2 (/ img-height 2))
+ (setq img-w2 (/ img-width 2))
+ (setq padding-top (/ (- img-h2 font-size) 2))
+ ;; Fix-me: I have no idea why I have to subtract 3
+ ;; from bottom, but inspection with Firebug seems to
+ ;; say so:
+ (setq padding-bottom (- img-h2 padding-top font-size 3))
+ (setq css (replace-regexp-in-string "ROLLOVER_SPEC" rollover-spec css t t))
+ (setq css (replace-regexp-in-string "IMG_WIDTH_2" (number-to-string img-h2) css t t))
+ (setq css (replace-regexp-in-string "IMG_HEIGHT_2" (number-to-string img-h2) css t t))
+ (setq css (replace-regexp-in-string "IMG_WIDTH" (number-to-string img-width) css t t))
+ (setq css (replace-regexp-in-string "IMG_HEIGHT" (number-to-string img-height) css t t))
+ (setq css (replace-regexp-in-string "IMG_URL" img-src css t t))
+ (setq css (replace-regexp-in-string "FONT_SIZE" (number-to-string font-size) css t t))
+ (setq css (replace-regexp-in-string "PADDING_TOP" (number-to-string padding-top) css t t))
+ (setq css (replace-regexp-in-string "PADDING_BOTTOM" (number-to-string padding-bottom) css t t))
+ (setq css (replace-regexp-in-string "CENTER_OR_PAD" center-or-pad css t t))
+ (setq css (replace-regexp-in-string "HOR_OR_VER" hor-or-ver css t t))
+ (if head-end
+ (let ((this-window (selected-window)))
+ (find-file-other-window buffer-file-name)
+ (goto-char head-end)
+ (beginning-of-line)
+ (insert "<style type=\"text/css\">\n"
+ css
+ "\n</style>\n")
+ (select-window this-window))
+ (kill-new css)
+ (message "No place to insert CSS, copied to clipboard instead"))))
+ (delete-overlay tagovl)
+ ))))
+
+;; Fix-me: image border 0
+;; Fix-me: SSI <!--#include file="file:///C|/EmacsW32/nxml/nxhtml/bug-tests/bug-080609.html" -->
+;; Fix-me: Better a tag completion, target etc.
+;; Fix-me: image map - is that possible now?
+;; Fix-me: Special chars - completing on &? Or popup? Use nxml-insert-named-char
+;; Fix-me: Quick table insert? A form?
+;; Fix-me: Quick object insert? (applet is depreceated)
+;; Fix-me: Better meta insert? Quick meta?
+;; Fix-me: Quick div! Better div completion with position: static,
+;; relative, absolute and fixed - with some explanations.
+;; Fix-me: Quick hr?
+;; Fix-me: Import CSS? Export CSS?
+;; Fix-me: Use nxhtml-js.el?
+;; Fix-me: Scroll bar colors etc? See 1stPage.
+;; body {
+;; scrollbar-arrow-color: #FF6699;
+;; scrollbar-3dlight-color: #00FF33;
+;; scrollbar-highlight-color: #66FFFF;
+;; scrollbar-face-color: #6699FF;
+;; scrollbar-shadow-color: #6633CC;
+;; scrollbar-darkshadow-color: #660099;
+;; scrollbar-track-color: #CC6633;
+;; }
+;; Fix-me: More quick menus: http://www.cssplay.co.uk/menus/
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(provide 'nxhtml-mode)
+
+;;; nxhtml-mode.el ends here
--- /dev/null
+;;; nxhtml-mumamo.el --- Multi major modes using nxhtml
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-03-10T19:04:20+0100 Mon
+(defconst nxhtml-mumamo:version "0.5")
+;; Last-Updated: 2009-01-06 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+ ;; `backquote', `bytecomp', `mumamo', `mumamo-fun'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'nxhtml nil t))
+(eval-when-compile (require 'nxhtml-base))
+(eval-when-compile (require 'nxhtml-mode))
+(eval-when-compile (require 'mumamo))
+(eval-and-compile (require 'mumamo-fun))
+(eval-when-compile (require 'rng-valid nil t))
+;;(mumamo-fun-require)
+
+;; (defgroup nxhtml-auto-val-head nil
+;; "Automatic turn on of XHTML validation headers."
+;; :group 'nxhtml)
+
+;; (defmacro define-fictive-validation-header-toggle (fun-sym default-value)
+;; (let* ((fun-name (symbol-name fun-sym))
+;; (custom-sym (intern (concat fun-name "-auto-val-head")))
+;; (hook-sym (intern-soft (concat fun-name "-hook")))
+;; (docstring
+;; (concat "Automatic XHTML validation header for `" fun-name "'.
+;; ´")))
+;; (assert hook-sym)
+;; `(defcustom ,custom-sym ,default-value
+;; ,docstring
+;; :type 'boolean
+;; :set (lambda (sym val)
+;; (set-default sym val)
+;; (if val
+;; (add-hook ',hook-sym 'nxhtml-turn-on-validation-header-mode)
+;; (remove-hook ',hook-sym 'nxhtml-turn-on-validation-header-mode)))
+;; :group 'nxhtml-auto-val-head)
+;; ))
+
+;; Fix-me: add chunk type attr string as last alternative. This will
+;; allow things like myattr="<?php echo ?>".
+
+;;;###autoload
+(define-mumamo-multi-major-mode nxhtml-mumamo-mode
+ "Turn on multiple major modes for (X)HTML with main mode `nxhtml-mode'.
+This covers inlined style and javascript and PHP.
+
+See also `mumamo-alt-php-tags-mode'."
+ ("nXhtml Family" nxhtml-mode
+ (mumamo-chunk-xml-pi
+ mumamo-chunk-alt-php
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+(add-hook 'nxhtml-mumamo-mode-hook 'mumamo-define-html-file-wide-keys)
+;;(define-fictive-validation-header-toggle nxhtml-mumamo-mode t)
+
+;;;###autoload
+(define-mumamo-multi-major-mode embperl-nxhtml-mumamo-mode
+ "Turn on multiple major modes for Embperl files with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+ ("Embperl nXhtml Family" nxhtml-mode
+ (mumamo-chunk-embperl-<-
+ mumamo-chunk-embperl-<+
+ mumamo-chunk-embperl-<!
+ mumamo-chunk-embperl-<$
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;###autoload
+(define-mumamo-multi-major-mode django-nxhtml-mumamo-mode
+ "Turn on multiple major modes for Django with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+ ("Django nXhtml Family" nxhtml-mode
+ (mumamo-chunk-django4
+ mumamo-chunk-django
+ mumamo-chunk-django2
+ mumamo-chunk-django3
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;###autoload
+(define-mumamo-multi-major-mode mason-nxhtml-mumamo-mode
+ "Turn on multiple major modes for Mason using main mode `nxhtml-mode'.
+This covers inlined style and javascript."
+ ("Mason nxhtml Family" nxhtml-mode
+ (
+ mumamo-chunk-mason-perl-line
+ mumamo-chunk-mason-perl-single
+ mumamo-chunk-mason-perl-block
+ mumamo-chunk-mason-perl-init
+ mumamo-chunk-mason-perl-once
+ mumamo-chunk-mason-perl-cleanup
+ mumamo-chunk-mason-perl-shared
+ mumamo-chunk-mason-simple-comp
+ mumamo-chunk-mason-compcont
+ mumamo-chunk-mason-args
+ mumamo-chunk-mason-doc
+ mumamo-chunk-mason-text
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+(add-hook 'mason-nxhtml-mumamo-mode-hook 'mumamo-define-html-file-wide-keys)
+;;(mumamo-inherit-sub-chunk-family-locally 'mason-nxhtml-mumamo-mode 'mason-nxhtml-mumamo-mode)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Genshi / kid
+
+(define-derived-mode nxhtml-genshi-mode nxhtml-mode "gXhtml"
+ "Like `nxhtml-mode' but with Genshi rnc.
+You should not use this! This is just a part of
+`genshi-nxhtml-mumamo-mode', use that instead."
+ (let* ((schema-dir (expand-file-name "etc/schema/" nxhtml-install-dir))
+ (genshi-rnc (expand-file-name "qtmstr-xhtml.rnc" schema-dir)))
+ ;;(message "nxhtml-src-dir =%s" nxhtml-src-dir)
+ (message "schema-dir =%s" schema-dir)
+ (when (or (not rng-current-schema-file-name)
+ (string= "xhtml.rnc" (file-name-nondirectory rng-current-schema-file-name)))
+ (condition-case err
+ (progn
+ (rng-set-schema-file-1 genshi-rnc)
+ (rng-what-schema)
+ ;;(rng-save-schema-location-1 t)
+ )
+ (nxml-file-parse-error
+ (nxml-display-file-parse-error err)))
+ (when rng-validate-mode
+ (rng-validate-mode -1)
+ (rng-validate-mode 1)))))
+
+;;;###autoload
+(define-mumamo-multi-major-mode genshi-nxhtml-mumamo-mode
+ "Turn on multiple major modes for Genshi with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+ ("Genshi HTML Family" nxhtml-genshi-mode
+ (;;mumamo-chunk-genshi%
+ mumamo-chunk-genshi$
+ mumamo-chunk-py:=
+ mumamo-chunk-py:match
+ mumamo-chunk-xml-pi
+ ;;mumamo-chunk-alt-php
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; MJT
+
+;; MJT is run in the browser. Some new tags and attributes are used.
+
+(define-derived-mode nxhtml-mjt-mode nxhtml-mode "mjtXhtml"
+ "Like `nxhtml-mode' but with genshi rnc.
+You should not use this! This is just a part of
+`mjt-nxhtml-mumamo-mode', use that instead."
+ (let* ((schema-dir (expand-file-name "etc/schema/" nxhtml-install-dir))
+ (genshi-rnc (expand-file-name "mjt.rnc" schema-dir)))
+ ;;(message "nxhtml-src-dir =%s" nxhtml-src-dir)
+ (message "schema-dir =%s" schema-dir)
+ (when (or (not rng-current-schema-file-name)
+ (string= "xhtml.rnc" (file-name-nondirectory rng-current-schema-file-name)))
+ (condition-case err
+ (progn
+ (rng-set-schema-file-1 genshi-rnc)
+ (rng-what-schema)
+ ;;(rng-save-schema-location-1 t)
+ )
+ (nxml-file-parse-error
+ (nxml-display-file-parse-error err)))
+ (when rng-validate-mode
+ (rng-validate-mode -1)
+ (rng-validate-mode 1)))))
+
+;;;###autoload
+(define-mumamo-multi-major-mode mjt-nxhtml-mumamo-mode
+ "Turn on multiple major modes for MJT with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+ ("MJT nXhtml Family" nxhtml-mjt-mode
+ (
+ mumamo-chunk-mjt$
+ mumamo-chunk-xml-pi
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Smarty
+
+;;;###autoload
+(define-mumamo-multi-major-mode smarty-nxhtml-mumamo-mode
+ "Turn on multiple major modes for Smarty with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+ ("Smarty nXhtml Family" nxhtml-mode
+ (mumamo-chunk-xml-pi
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ ;;mumamo-chunk-inlined-style
+ ;;mumamo-chunk-inlined-script
+ mumamo-chunk-smarty-literal
+ mumamo-chunk-smarty-t
+ mumamo-chunk-smarty-comment
+ mumamo-chunk-smarty
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; GSP
+
+;;;###autoload
+(define-mumamo-multi-major-mode gsp-nxhtml-mumamo-mode
+ "Turn on multiple major modes for GSP with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+ ("GSP nXhtml Family" nxhtml-mode
+ (mumamo-chunk-gsp
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; JSP
+
+;;;###autoload
+(define-mumamo-multi-major-mode jsp-nxhtml-mumamo-mode
+ "Turn on multiple major modes for JSP with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+ ("JSP nXhtml Family" nxhtml-mode
+ (mumamo-chunk-jsp
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; eRuby
+
+;;;###autoload
+(define-mumamo-multi-major-mode eruby-nxhtml-mumamo-mode
+ "Turn on multiple major modes for eRuby with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+ ("eRuby nXhtml Family" nxhtml-mode
+ (mumamo-chunk-eruby
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; ASP
+
+;;;###autoload
+(define-mumamo-multi-major-mode asp-nxhtml-mumamo-mode
+ "Turn on multiple major modes for ASP with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+ ("ASP nXhtml Family" nxhtml-mode
+ (mumamo-chunk-asp%
+ mumamo-asp-chunk-inlined-script
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Mako
+
+;;;###autoload
+(define-mumamo-multi-major-mode mako-nxhtml-mumamo-mode
+ "Turn on multiple major modes for Mako with main mode `nxhtml-mode'.
+This also covers inlined style and javascript."
+;; Fix-me: test case
+;;
+;; Fix-me: Add chunks for the tags, but make sure these are made
+;; invisible to nxml-mode parser.
+;;
+;; Fix-me: Maybe finally add that indentation support for one-line chunks?
+ ("Mako nXhtml Family" nxhtml-mode
+ (
+ mumamo-chunk-mako-one-line-comment
+ mumamo-chunk-mako-<%doc
+ mumamo-chunk-mako-<%include
+ mumamo-chunk-mako-<%inherit
+ mumamo-chunk-mako-<%namespace
+ mumamo-chunk-mako-<%page
+
+ ;;mumamo-chunk-mako-<%def
+ ;;mumamo-chunk-mako-<%call
+ ;;mumamo-chunk-mako-<%text
+
+ mumamo-chunk-mako-<%
+ mumamo-chunk-mako-%
+ mumamo-chunk-mako$
+
+ mumamo-chunk-xml-pi
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;; Fix-me: This caused mumamo to loop during fontification since
+;; fmode-replace-default-mode was not defined. Mumamo tried to load
+;; the function in mumamo-fetch-major-mode-setup in (funcall major)
+;; where major mode is php-mode.
+
+;;(eval-after-load 'php-mode '(fmode-replace-default-mode 'php-mode 'nxhtml-mumamo-mode))
+
+
+
+(provide 'nxhtml-mumamo)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtml-mumamo.el ends here
--- /dev/null
+;;; nxhtml-strval.el ---
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Wed Jun 06 12:42:09 2007
+(defconst nxhtml-strval:version "0.3") ;;Version:
+;; LXast-Updated: Sun Jun 10 14:52:50 2007 (7200 +0200)
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; FXeatures that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This is a workaround for a problem caused by that the parser from
+;; `nxml-mode' parses the whole buffer. This workaround handles things
+;; like
+;;
+;; <a href="<?php title(); ?>">...</a>
+;;
+;; where the string value is not valid XHTML (because of the <). When
+;; the minor mode `nxhtml-strval-mode' is on this construct will be
+;; replaced by text that are valid XHTML. When writing to file or
+;; copying/yanking this will be replaced with the intended text.
+;;
+;; For a long term solution the parser should be broken up, see also
+;;
+;; http://sourceforge.net/mailarchive/forum.php?thread_name=4638A428.9010408%40pareto.nl&forum_name=cedet-devel
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(define-minor-mode nxhtml-strval-mode
+ "Handle some useful, but not XHTML compliant attribute values.
+This is mainly for PHP and similar.
+
+Things like
+
+ <a href=\"<?php title(); ?>\">...</a>
+
+may be very useful in PHP. However the string value is not valid
+XHTML (because of the <). This makes it difficult to use XHTML
+completion and validation.
+
+This minor mode tries to take care of that by substituting the
+<?php and ?> in the buffer while editing with something else.
+The screen still shows <?php and ?> and when writing the buffer
+to a file the substitutes are reverted to <?php and ?>.
+
+Note that this is a workaround. See the comments in the source
+file. There are several \(I hope minor) problems with it. For
+example is the buffer marked as modified when turning on/off this
+minor mode.
+
+IMPORTANT: Do not edit the replaced string <? or ?>."
+ :lighter nil
+ :gropu 'nxhtml
+ (if nxhtml-strval-mode
+ (nxhtml-strval-mode-turn-on)
+ (nxhtml-strval-mode-turn-off)))
+(put 'nxhtml-strval-mode 'permanent-local t)
+
+(defcustom nxhtml-strval-replface 'nxhtml-strval-replface
+ "Face used to mark replaced characters in strings."
+ :type 'face
+ :group 'nxhtml)
+
+(defface nxhtml-strval-replface '((t :inherit font-lock-warning-face))
+ "Default face used to mark replaced characters in strings."
+ :group 'nxhtml)
+
+(defun nxthml-strval-add-ovl (start end)
+ (let ((ovl (make-overlay start end nil t nil)))
+ (overlay-put ovl 'nxhtml-strval t)
+ (overlay-put ovl 'face font-lock-warning-face)))
+ ;;(overlay-put ovl 'face 'highlight)))
+
+(defun nxhtml-strval-remove-all-ovls ()
+ (remove-overlays (point-min) (point-max) 'nxhtml-strval t))
+
+(defun nxhtml-strval-replace-match ()
+ (let ((s (compose-string "{" nil nil ?<)))
+ (replace-match s t t nil 1))
+ (put-text-property (1- (point)) (point) 'font-lock-face 'font-lock-warning-face)
+ (put-text-property (1- (point)) (point) 'nxhtml-strval-> t)
+ (nxthml-strval-add-ovl (1- (point)) (point))
+ (let ((s (compose-string "}" nil nil ?>)))
+ (replace-match s t t nil 2))
+ (nxthml-strval-add-ovl (1- (point)) (point))
+ (put-text-property (1- (point)) (point) 'font-lock-face 'font-lock-warning-face)
+ (put-text-property (1- (point)) (point) 'nxhtml-strval-> nil))
+
+(defun nxhtml-strval-revert-match ()
+ (replace-match "<" t t nil 1)
+ (put-text-property (1- (point)) (point) 'font-lock-face nil)
+ (put-text-property (1- (point)) (point) 'nxhtml-strval-> nil)
+ (replace-match ">" t t nil 2)
+ (put-text-property (1- (point)) (point) 'font-lock-face nil)
+ (put-text-property (1- (point)) (point) 'nxhtml-strval-> nil))
+
+(defconst nxhtml-strval-on-re "\"\\(<\\)[^>]*\\(>\\)\"")
+(defconst nxhtml-strval-off-re "\"\\({\\)[^>]*\\(}\\)\"")
+
+(defun nxhtml-strval-mode-turn-on ()
+ (unless (derived-mode-p 'nxml-mode 'php-mode)
+ (error "%s is not derived from nxml-mode" major-mode))
+ (add-hook 'write-contents-functions 'nxhtml-strval-write-contents nil t)
+ (make-local-variable 'buffer-substring-filters)
+ (add-to-list 'buffer-substring-filters 'nxhtml-strval-buffer-substring-filter)
+ (nxhtml-strval-replace-values)
+ (add-hook 'after-change-functions 'nxhtml-strval-after-change nil t))
+
+(defun nxhtml-strval-replace-values ()
+ (save-excursion
+ (save-match-data
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward nxhtml-strval-on-re nil t)
+ (nxhtml-strval-replace-match))))))
+
+(defun nxhtml-strval-mode-turn-off ()
+ (remove-hook 'after-change-functions 'nxhtml-strval-after-change t)
+ (nxhtml-strval-revert-values)
+ (remove-hook 'write-contents-functions 'nxhtml-strval-write-contents t)
+ (kill-local-variable 'buffer-substring-filters))
+
+(defun nxhtml-strval-revert-values ()
+ (save-excursion
+ (save-match-data
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward nxhtml-strval-off-re nil t)
+ (nxhtml-strval-revert-match))
+ (nxhtml-strval-remove-all-ovls)))))
+
+(defun nxhtml-strval-write-contents ()
+ (let ((nxhtml-strval-no-after-change t))
+ ;;(setq write-contents-functions (delq 'nxhtml-strval-write-contents write-contents-functions))
+ (remove-hook 'write-contents-functions 'nxhtml-strval-write-contents t)
+ (undo-boundary)
+ (nxhtml-strval-revert-values)
+ ;;(write-file (buffer-file-name))
+ (save-buffer)
+ ;; Fix-me: undo
+ ;;(nxhtml-strval-replace-values)
+ (undo-start)
+ (undo-more 1)
+ (add-hook 'write-contents-functions 'nxhtml-strval-write-contents nil t)
+ (set-buffer-modified-p nil)
+ t))
+
+;;; Clip board etc.
+(defun nxhtml-strval-buffer-substring-filter (orig-str)
+ (let ((str (replace-regexp-in-string "\"{" "\"<" orig-str)))
+ (setq str (replace-regexp-in-string "}\"" ">\"" str))
+ str
+ ))
+
+;;; Changes
+; after-change-functions
+(defun nxhtml-strval-after-change (beg end len)
+ (unless (and (boundp 'nxhtml-strval-no-after-change)
+ nxhtml-strval-no-after-change)
+ (let ((here (point))
+ (new-beg beg)
+ (new-end end))
+ (goto-char beg)
+ (setq new-beg (line-beginning-position))
+ (goto-char end)
+ (setq new-end (line-end-position))
+ ;; Fix-me: examine old replacements here
+ (remove-text-properties new-beg new-end '(nxhtml-strval-< nxhtml-strval->))
+ (goto-char new-beg)
+ (while (re-search-forward nxhtml-strval-on-re new-end t)
+ (nxhtml-strval-replace-match))
+ (goto-char here)
+ )))
+
+(provide 'nxhtml-strval)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtml-strval.el ends here
--- /dev/null
+;;; nxhtml.el --- Keeping nXhtml together
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-01-01 Thu
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'loadhist))
+(eval-when-compile (require 'nxhtml-base))
+(eval-and-compile (require 'nxhtml-menu nil t))
+
+;;;###autoload
+(defgroup nxhtml nil
+ "Customization of `nxhtml-mode'."
+ :group 'nxml)
+
+;;;###autoload
+(defun nxhtml-customize ()
+ "Customize nXhtml."
+ (interactive)
+ (customize-group 'nxhtml))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Features
+
+;; Fix-me: add help links
+(defvar nxhtml-req-features
+ (let ((req-features
+ '(
+ "XHTML/HTML"
+ (nxml-mode "XML Completion" "nxml-mode.el")
+ (nxhtml "Additional XHTML Completion" "nxhtml.el")
+ (mlinks "Live XHTML links" "mlinks.el" "0.28")
+ (tidy-xhtml "Run HTML tidy program" "tidy-xhtml.el" "2.24")
+ (xhtml-help "HTML+CSS help" "xhtml-help.el" "0.57")
+ (nxml-where "Shows XML path" "nxml-where.el" "0.52")
+ (html-imenu "Table of content in menus" "html-imenu.el" "0.9")
+ (html-pagetoc "Page TOC" "html-pagetoc.el" "0.85")
+ (html-site "Web sites you define" "html-site.el" "0.2")
+ (html-upl "Upload web sites" "html-upl.el" "0.2")
+ (html-chklnk "Checking links in site" "html-chklnk.el" "0.2")
+ (html-move "Moving files in web sites" "html-move.el" "0.31")
+ (html-toc "Web site TOC" "html-toc.el" "0.4")
+ (html-wtoc "Merge pages and web Site TOC" "html-wtoc.el" "0.2")
+ (html-write "Show <i> as italic etc" "html-write.el" "0.6")
+ "General"
+ (mumamo "Multiple major modes in buffer" "mumamo.el" "0.73")
+ (majmodpri "Major mode priorities" "majmodpri.el" "0.5")
+ (tabkey2 "Tab completion" "tabkey2.el" "1.12")
+ (fold-dwim "Folding on headers and tags" "fold-dwim.el" "1.3")
+ (appmenu "General popup menu" "appmenu.el" "0.53")
+ (appmenu-fold "Popup menu entries for folding" "appmenu-fold.el" "0.51" appmenu fold-dwim)
+ (winsize "Resizing and window handling" "winsize.el" "0.98")
+ (winsav "Save/restore for windows/frames" "winsav.el" "0.77")
+ (viper-tut "Viper try-out tutorial" "viper-tut.el" "0.2")
+ (ourcomments-util "Some minor utilities" "ourcomments-util.el" "0.25")
+ "External applications / Emacs as dito"
+ (as-external "Emacs as an external editor" "as-external.el" "0.5")
+ (sex-mode "Send to EXternal program" "sex-mode.el" "0.71")
+ (freemind "Export/import freemind maps" "freemind.el" "0.60")
+ (hfyview "Print with browser/copy to html" "hfyview.el" "0.63")
+ (mozadd "Mirroring in Firefox" "mozadd.el" "0.2")
+ "Images and Colors"
+ (gimpedit "Edit images with GIMP" "gimp.el" "0.3")
+ (inlimg "Inline images" "inlimg.el" "0.7")
+ (css-color "Css color help functions" "css-color.el" "0.02")
+ (chart "Easy google charts" "chart.el" "0.2")
+ "Fetching and using elisp from repositories"
+ (udev "Fetch and from elisp repostories" "udev.el" "0.5")
+ ;;(udev-cedet "CEDET fetcher and loader" "udev-cedet.el" "0.2")
+ (udev-ecb "ECB fetcher and loader" "udev-ecb.el" "0.2")
+ (udev-rinari "Rinari fetcher and loader" "udev-rinari.el" "0.2")
+ "Games and life"
+ (pause "Take a break! I wish you some fun!" "pause.el" "0.64")
+ (n-back "n-back game for fun and brain" "n-back.el" "0.5")
+ )
+ ))
+ req-features))
+
+(defun nxhtml-load-req-features ()
+ (dolist (extf nxhtml-req-features)
+ (unless (or (stringp extf)
+ (eq (car extf) 'nxhtml))
+ (require (car extf) nil t))))
+
+
+
+(defun nxhtml-make-library-link (beg end)
+ (let ((library (buffer-substring-no-properties beg end)))
+ (make-text-button beg end
+ 'action (lambda (button)
+ (find-library
+ (button-get button 'lib-name)))
+ 'lib-name library
+ 'face 'button)))
+
+(defun nxhtml-feature-insert (ok msg)
+ (put-text-property 0 (length msg)
+ 'face (if ok font-lock-type-face font-lock-warning-face)
+ msg)
+ (insert msg))
+
+(defun nxhtml-feature-check (feat-entry silent)
+ (require 'loadhist)
+ (let ((feature (nth 0 feat-entry))
+ (description (nth 1 feat-entry))
+ (file (nth 2 feat-entry))
+ (need-ver (nth 3 feat-entry))
+ (need-list (cddddr feat-entry))
+ (ok))
+ (if (featurep feature)
+ (let* (
+ (feat-versym (read (format "%s:version" feature)))
+ (feat-ver (condition-case err
+ (symbol-value feat-versym)
+ (error nil)))
+ (feat-vok (or (not need-ver)
+ (and feat-ver
+ (version<= need-ver feat-ver))))
+ (need-ok (or (not need-list)
+ (let ((has t))
+ (dolist (n need-list)
+ (unless (featurep n)
+ (setq has nil)))
+ has))))
+ (setq ok (and feat-vok need-ok))
+ (unless silent
+ (nxhtml-feature-insert
+ ok
+ (concat (format "%34s -- " description)
+ (if ok
+ (format "supported by %s%s\n"
+ file
+ (if (not need-ver)
+ ""
+ (if (string= feat-ver need-ver)
+ (format " (%s)" feat-ver)
+ (format " (%s/%s)" feat-ver need-ver))))
+ (concat "found " file
+ " but needs"
+ (if feat-vok ""
+ (format " version %s" need-ver))
+ (if (or feat-vok need-ok) "" " and")
+ (if need-ok ""
+ (format " also %s" need-list))
+ "\n"))))
+ (unless (string= (file-name-sans-extension file)
+ (file-name-sans-extension
+ (file-name-nondirectory (feature-file feature))))
+ (insert (make-string (+ 34 4) ?\ ) "** Bad file name: " file "\n"))))
+ (unless silent
+ (nxhtml-feature-insert
+ nil (format "%34s -- support missing, can't find %s\n"
+ description file))))
+ ok))
+
+;; Fix-me: move help here from `nxhtml-mode'?
+
+;;;###autoload
+(defun nxhtml-features-check ()
+ "Check if external modules used by nXhtml are found."
+ (interactive)
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'nxhtml-features-check) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (nxhtml-menu-mode 1)
+ (erase-buffer)
+ (let ((s (concat "Elisp modules used by nXhtml version " nxhtml-menu:version ":")))
+ (put-text-property 0 (length s)
+ 'face '( :weight bold :height 1.4)
+ s)
+ (insert s "\n\n"))
+ (nxhtml-load-req-features)
+ (nxhtml-load-req-features)
+ (nxhtml-load-req-features)
+ (nxhtml-load-req-features)
+ (dolist (feat-entry nxhtml-req-features)
+ (if (stringp feat-entry)
+ (insert "==== " (propertize feat-entry 'face 'font-lock-comment-face 'face '(:weight bold)) "\n")
+ (nxhtml-feature-check feat-entry nil)))
+ (goto-char (point-min))
+ (while (search-forward-regexp "[-a-zA-Z0-9]+\\.el" nil t)
+ (nxhtml-make-library-link
+ (match-beginning 0)
+ (match-end 0)))
+ (goto-char (point-min)))
+ (set-buffer-modified-p nil)))
+
+(defun nxhtml-all-features-found ()
+ (let ((all t))
+ (dolist (feat-entry nxhtml-req-features)
+ ;;(unless (featurep (car extf))
+ (unless (stringp feat-entry)
+ (unless (nxhtml-feature-check feat-entry t)
+ (setq all nil))))
+ all))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Link saving and pasting
+
+(defun nxhtml-find-base-href ()
+ "Return base href found in the current file."
+ (let ((base-href))
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not base-href)
+ (search-forward-regexp "<!--[^!]*-->\\|<base[[:space:]]" nil t))
+ (when (equal " " (char-to-string (char-before)))
+ (backward-char 6)
+ (when (looking-at "<base [^>]*href *= *\"\\(.*?\\)\"")
+ (setq base-href (match-string-no-properties 1))))))
+ base-href))
+
+
+(defvar nxhtml-saved-link-file nil
+ "Saved buffer file name for use in `nxhtml-paste-link'.")
+(defvar nxhtml-saved-link-anchor nil
+ "Saved anchor name for use in `nxhtml-paste-link'.")
+
+;; Fix-me: same line???
+(defun nxhtml-save-link-to-here ()
+ "Save buffer file name+anchor for `nxhtml-paste-link'."
+ (interactive)
+ (if (not buffer-file-name)
+ (message "Current buffer has no file name")
+ (setq nxhtml-saved-link-file (buffer-file-name))
+ (setq nxhtml-saved-link-anchor nil)
+ (save-excursion
+ (let ((here (point)))
+ (while (not (or (bolp) (looking-at "\\(?:id\\|name\\)[[:space:]]*=[[:space:]]*\".*?\"")))
+ (backward-char))
+ (when (and (looking-at "\\(?:id\\|name\\)[[:space:]]*=[[:space:]]*\"\\(.*?\\)\"")
+ (<= (match-beginning 0) here)
+ (< here (match-end 0)))
+ (setq nxhtml-saved-link-anchor (match-string-no-properties 1)))))
+ (message "Saved link: %s%s" nxhtml-saved-link-file
+ (if nxhtml-saved-link-anchor
+ (concat "#" nxhtml-saved-link-anchor)
+ ""))))
+
+(defun nxhtml-paste-link-as-a-tag ()
+ "Paste link saved by `nxhtml-save-link-to-here' as an <a> tag.
+Takes into account the relative position of the saved link."
+ (interactive)
+ (let ((paste-text (nxhtml-get-saved-link)))
+ (when paste-text
+ (let ((link-text (read-string "Link text: ")))
+ (insert "<a href=\"" paste-text "\">" link-text "</a>")))))
+
+(defun nxhtml-paste-link ()
+ "Paste link saved by `nxhtml-save-link-to-here'.
+Takes into account the relative position of the saved link."
+ (interactive)
+ (let ((paste-text (nxhtml-get-saved-link)))
+ (when paste-text
+ (insert paste-text))))
+
+(defun nxhtml-get-saved-link ()
+ (if nxhtml-saved-link-file
+ (let* (
+ (base-href (nxhtml-find-base-href))
+ (rel (file-relative-name nxhtml-saved-link-file
+ (if base-href
+ base-href
+ (file-name-directory (buffer-file-name)))))
+ (to-file (file-name-nondirectory (buffer-file-name)))
+ (anchor nxhtml-saved-link-anchor)
+ )
+ (when (equal to-file rel) (setq rel ""))
+ (when anchor (setq rel (concat rel "#" anchor)))
+ rel)
+ (message "There is no saved link")
+ nil))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Misc
+
+(defun nxhtml-update-mark-today (date-str)
+ "Update marks for today's date.
+The mark has this form
+
+ <!-- today -->zzz<!-- end today -->"
+ (interactive (list (format-time-string "%Y-%m-%d")))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward (rx
+ "<!-- today -->"
+ (submatch (0+ anything))
+ "<!-- end today -->")
+ nil t)
+ (replace-match date-str nil nil nil 1))))
+
+
+(provide 'nxhtml)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtml.el ends here
--- /dev/null
+;;; nxhtml-js.el --- Javascript support functions
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Sat Apr 28 2007
+;; Version: 0.1
+;; Last-Updated: 2008-12-28 Sun
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Fxeatures that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'nxhtml nil t))
+(eval-when-compile (require 'nxhtml-mode nil t))
+
+(defun nxhtml-add-link (type src silent)
+ ;;<script type="text/javascript" src="EmacsW32.js"></script>
+ (catch 'exit
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((here (point))
+ (link (cond
+ ((eq type 'js)
+ (concat "<script type=\"text/javascript\" src=\"" src "\"></script>\n"))
+ ((eq type 'css)
+ (concat "<link rel=\"stylesheet\" href=\"" src "\" type=\"text/css\" media=\"screen\"/>\n"))
+ (t
+ (error "Bad type=%s" type))
+ )))
+ (goto-char (point-min))
+ (when (search-forward link nil t)
+ (unless silent
+ (let ((temp-ovl (make-overlay (match-beginning 0)
+ (match-end 0)))
+ (after-string " <-- It is already here "))
+ (condition-case err
+ (progn
+ (put-text-property 0 (length after-string)
+ 'face '(:background "red")
+ after-string)
+ (overlay-put temp-ovl 'face '(:background "yellow"))
+ (overlay-put temp-ovl 'priority 100)
+ (overlay-put temp-ovl 'after-string after-string)
+ (redisplay t)
+ (sit-for 3))
+ (quit nil)
+ (error (message "%s" (error-message-string err))))
+ (delete-overlay temp-ovl))
+ (throw 'exit t)))
+ (unless (search-forward "</head>" nil t)
+ (goto-char here)
+ (unless (y-or-n-p "Can't find </head>, insert link to script here? ")
+ (throw 'exit nil)))
+ (beginning-of-line)
+ (insert link)
+ (beginning-of-line 0)
+ (indent-according-to-mode))))))
+
+(defun nxhtml-smoothgallery-add-base (silent)
+ "Add links to javascript and style sheets.
+This command add links to the javascript and style sheets that
+comes with SmoothGallery, see URL
+`http://smoothgallery.jondesign.net/'.
+
+* NOTICE: The files are not added to your project. Instead the
+files that comes with nXhtml are linked to directly."
+ (interactive (list nil))
+ (unless (buffer-file-name)
+ (error "Can't add SmoothGallery if buffer has no filename"))
+ (unless (memq major-mode '(html-mode nxhtml-mode))
+ (error "Wrong major mode"))
+ (let* ((libfile (locate-library "nxhtml"))
+ (jsdir-abs (expand-file-name "doc/js/smoothgallery/scripts/"
+ (file-name-directory libfile)))
+ (jsdir-rel (file-relative-name jsdir-abs (file-name-directory (buffer-file-name))))
+ (cssdir-abs (expand-file-name "doc/js/smoothgallery/css/"
+ (file-name-directory libfile)))
+ (cssdir-rel (file-relative-name cssdir-abs (file-name-directory (buffer-file-name)))))
+ (nxhtml-add-link 'js (concat jsdir-rel "mootools.js") silent)
+ (nxhtml-add-link 'js (concat jsdir-rel "jd.gallery.js") silent)
+ (nxhtml-add-link 'css (concat cssdir-rel "jd.gallery.css") silent)
+ (nxhtml-add-link 'css (concat cssdir-rel "layout.css") silent)
+ ))
+
+(defconst nxhtml-smoothgallery-mark "<!-- SmoothGallery -->")
+(defun nxhtml-smoothgallery-find ()
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (when (search-forward nxhtml-smoothgallery-mark nil t)
+ (back-to-indentation)
+ (when (looking-at
+ ;; (rx
+ ;; "<div id=\""
+ ;; (submatch
+ ;; (1+ (not (any ">")))
+ ;; )
+ ;; "\">" (eval nxhtml-smoothgallery-mark))
+ ;;(concat "<div id=\"\\([^>]+\\)\">" nxhtml-smoothgallery-mark)
+ (rx-to-string
+ `(and
+ "<div id=\""
+ (submatch
+ (1+ (not (any ">")))
+ )
+ "\">"
+ ,nxhtml-smoothgallery-mark))
+ )
+ (cons
+ (copy-marker (match-beginning 0))
+ (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1))))))))
+
+(defun nxhtml-smoothgallery-mk-jsmark (name)
+ (concat "new gallery($('" name "'), {"))
+
+(defun nxhtml-smoothgallery-find-script (name)
+ (let ((jsmark (nxhtml-smoothgallery-mk-jsmark name)))
+ (goto-char (point-min))
+ (search-forward jsmark nil t)))
+
+(defun nxhtml-smoothgallery-add (point-name)
+ (interactive "i")
+ (unless point-name
+ (setq point-name (nxhtml-smoothgallery-find))
+ (unless point-name
+ (setq point-name "myGallery")))
+ (let ((name (if (consp point-name)
+ (cdr point-name)
+ point-name))
+ (where (when (consp point-name)
+ (car point-name))))
+ (unless where
+ (goto-char (point-min))
+ (search-forward "<body")
+ (search-forward ">")
+ (insert "\n")
+ (setq where (point-marker))
+ (insert-and-indent "<div id=\"" name "\">" nxhtml-smoothgallery-mark
+ "\n</div>")
+ )
+ (unless (nxhtml-smoothgallery-find-script name)
+ (goto-char where)
+ (beginning-of-line)
+ (insert-and-indent "<script type=\"text/javascript\">
+ function startGallery() {
+ var myGallery = new gallery($('" name "'), {
+ timed: true,
+ delay: 9000,
+ embedLinks: false,
+ showArrows: true,
+ showCarousel: false,
+ showInfopane: true,
+ });
+ }
+ window.onDomReady(startGallery);
+ </script>")
+ (indent-according-to-mode))
+ (goto-char where)))
+
+(defun nxhtml-smoothgallery-add-img (imgsrc thumbsrc title description)
+ (interactive (let ((gallery (nxhtml-smoothgallery-find)))
+ (when gallery
+ (goto-char (car gallery)))
+ (list
+ (nxhtml-read-url nil nil 'nxhtml-image-url-predicate "Image")
+ (when (y-or-n-p "Include thumbnail? " )
+ (nxhtml-read-url nil nil 'nxhtml-image-url-predicate "Thumbnail"))
+ (read-string "Title: ")
+ (read-string "Description: ")
+ )))
+ (unless thumbsrc (setq thumbsrc imgsrc))
+ (let ((gallery (nxhtml-smoothgallery-find)))
+ (unless gallery
+ (setq gallery (nxhtml-smoothgallery-add nil)))
+ (goto-char (car gallery))
+ (end-of-line)
+ (insert-and-indent "
+ <div class=\"imageElement\">
+ <h3>" title "</h3>
+ <p>" description "</p>
+ <a href=\"#\" title=\"open image\" class=\"open\"></a>
+ <img src=\"" imgsrc "\" class=\"full\" alt=\"" title "\" />
+ <img src=\"" thumbsrc "\" class=\"thumbnail\" alt=\"" title " (thumbnail)\" />
+ </div>")
+;; (when (file-exists-p src)
+;; (let ((sizes (image-size (create-image src) t)))
+;; (insert
+;; " width=\"" (format "%d" (car sizes)) "\""
+;; " height=\"" (format "%d" (cdr sizes)) "\"")
+;; ))
+ ))
+
+(defun insert-and-indent (&rest lines)
+ (let ((lines (split-string (apply 'concat lines) "[\n\r]")))
+ (dolist (line lines)
+ (insert "\n" line)
+ (indent-according-to-mode))))
+
+
+(provide 'nxhtml-js)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtml-js.el ends here
--- /dev/null
+;;; nxml-where.el --- Show XML path
+;;
+;; Author: Lennart Borgman
+;; Maintainer:
+;; Created: Tue Dec 19 14:59:01 2006
+(defconst nxml-where:version "0.52");; Version:
+;; Lxast-Updated: Thu Mar 01 23:16:35 2007 (3600 +0100)
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `cl'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; This buffer is for notes you don't want to save, and for Lisp evaluation.
+;; If you want to create a file, visit that file with C-x C-f,
+;; then enter the text in that file's own buffer.
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'mumamo nil t))
+(eval-when-compile (require 'nxml-mode nil t))
+(eval-when-compile (require 'ourcomments-util nil t))
+;; (eval-when-compile
+;; (unless (featurep 'nxhtml-autostart)
+;; (let ((efn (expand-file-name "../autostart.el")))
+;; (load efn))
+;; (require 'nxml-mode)))
+
+(defun nxml-where-error-message (format-string &rest args)
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (let ((start (1+ (point-max))))
+ (apply 'message format-string args)
+ (goto-char (point-max))
+ (backward-char)
+ ;; fix-me: got some error here:
+ ;;(put-text-property start (point) 'face 'highlight)
+ )))
+
+(defvar nxml-where-last-point nil
+ "Where point was last time marking finished.
+Ie we should not restart marking if point is still there and no
+changes have occured.")
+(make-variable-buffer-local 'nxml-where-last-point)
+(put 'nxml-where-last-point 'permanent-local t)
+
+(defvar nxml-where-last-finished nil
+ "Non-nil then marking is finished.")
+(make-variable-buffer-local 'nxml-where-last-finished)
+(put 'nxml-where-last-finished 'permanent-local t)
+
+(defvar nxml-where-last-added nil)
+(make-variable-buffer-local 'nxml-where-last-added)
+(put 'nxml-where-last-added 'permanent-local t)
+
+(defvar nxml-where-path nil
+ "The current where path.
+This is a list where the records have the form
+
+ \(START END TAG-STR OVERLAY)")
+(make-variable-buffer-local 'nxml-where-path)
+(put 'nxml-where-path 'permanent-local t)
+
+(defvar nxml-where-new-path nil
+ "The new where path.
+This is a list where the records have the form
+
+ \(START END TAG-STR OVERLAY)")
+(make-variable-buffer-local 'nxml-where-new-path)
+(put 'nxml-where-new-path 'permanent-local t)
+
+(defvar nxml-where-once-update-timer nil)
+(make-variable-buffer-local 'nxml-where-once-update-timer)
+(put 'nxml-where-once-update-timer 'permanent-local t)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Custom options
+
+;;;###autoload
+(defgroup nxml-where nil
+ "Customization group for nxml-where."
+ :group 'nxhtml
+ :group 'nxml)
+
+;;(define-toggle nxml-where-only-inner nil
+(define-minor-mode nxml-where-only-inner
+ "Mark only inner-most tag."
+ :global t
+ :group 'nxml-where
+ (when (fboundp 'nxml-where-update-buffers)
+ (nxml-where-update-buffers)))
+
+(defun nxml-where-only-inner-toggle ()
+ "Toggle `nxml-where-only-inner'."
+ (interactive)
+ (nxml-where-only-inner (if nxml-where-only-inner -1 1)))
+
+;;(define-toggle nxml-where-header t
+(define-minor-mode nxml-where-header
+ "Show header with XML-path if non-nil."
+ :global t
+ :init-value t
+ :group 'nxml-where
+ (when (fboundp 'nxml-where-update-buffers)
+ (nxml-where-update-buffers)))
+
+(defun nxml-where-header-toggle ()
+ "Toggle `nxml-where-header'."
+ (interactive)
+ (nxml-where-header (if nxml-where-header -1 1)))
+
+;;(define-toggle nxml-where-tag+id t
+(define-minor-mode nxml-where-tag+id
+ "Show tags + id in path if non-nil.
+If nil show only tag names."
+ :global t
+ :init-value t
+ :group 'nxml-where
+ (when (fboundp 'nxml-where-update-buffers)
+ (nxml-where-update-buffers)))
+
+(defun nxml-where-tag+id-toggle ()
+ "Toggle `nxml-where-tag+id'."
+ (interactive)
+ (nxml-where-tag+id (if nxml-where-tag+id -1 1)))
+
+;;(define-toggle nxml-where-marks t
+(define-minor-mode nxml-where-marks
+ "Show marks in buffer for XML-path if non-nil."
+ :global t
+ :init-value t
+ :group 'nxml-where
+ (when (fboundp 'nxml-where-update-buffers)
+ (nxml-where-update-buffers)))
+
+(defun nxml-where-marks-toggle ()
+ "Toggle `nxml-where-marks'."
+ (interactive)
+ (nxml-where-marks (if nxml-where-marks -1 1)))
+
+;; Fix-me: implement this?
+;; (define-toggle nxml-where-only-tags-with-id t
+;; "Show only tags with id in the header line."
+;; :set (lambda (sym val)
+;; (set-default sym val)
+;; (when (fboundp 'nxml-where-update-buffers)
+;; (nxml-where-update-buffers)))
+;; :group 'nxml-where)
+
+(defface nxml-where-marking
+ '((t (:inherit secondary-selection)))
+ "The default face used for marking tags in path."
+ :group 'nxml-where)
+
+(defcustom nxml-where-marking 'nxml-where-marking
+ "Variable pointing to the face used for marking tags in path."
+ :type 'face
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (fboundp 'nxml-where-update-buffers)
+ (nxml-where-update-buffers)))
+ :group 'nxml-where)
+
+(defcustom nxml-where-header-attributes '("id" "name")
+ "List of attributes `nxml-where-header' should display."
+ :type '(repeat string)
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (fboundp 'nxml-where-update-buffers)
+ (nxml-where-update-buffers)))
+ :group 'nxml-where)
+
+(defcustom nxml-where-widen t
+ "If non-nil and narrowed widen before getting XML path."
+ :type 'boolean
+ :group 'nxml-where)
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Modes
+
+(defvar nxml-where-modes '(nxml-mode nxhtml-mode))
+
+(defun nxml-where-is-nxml ()
+ (or (derived-mode-p 'nxml-mode)
+ (and (featurep 'mumamo)
+ mumamo-multi-major-mode
+ (let ((major-mode (mumamo-main-major-mode)))
+ (derived-mode-p 'nxml-mode)))))
+
+(defun nxml-where-setup-updating ()
+ (nxml-where-clear-old-path 0 "setup")
+ (setq nxml-where-last-added nil)
+ (setq nxml-where-last-point nil)
+ (when (and nxml-where-header
+ (not nxml-where-only-inner))
+ (setq header-line-format "Started nxml-where-mode ..."))
+ ;;(nxml-where-restart-update)
+ (add-hook 'post-command-hook 'nxml-where-restart-update nil t))
+
+(defun nxml-where-mode-start ()
+ ;;(message "START")
+ (unless (nxml-where-is-nxml)
+ (error "Can't display XML path since major mode is not nxml-mode child."))
+ (add-hook 'after-change-major-mode-hook 'nxml-where-turn-off-unless-nxml nil t)
+ (add-hook 'after-change-functions 'nxml-where-after-change nil t)
+ (nxml-where-save-header-line-format)
+ (nxml-where-setup-updating))
+
+(defun nxml-where-mode-stop ()
+ ;;(message "STOP")
+ (remove-hook 'after-change-major-mode-hook 'nxml-where-turn-off-unless-nxml t)
+ (remove-hook 'after-change-functions 'nxml-where-after-change t)
+ (nxml-where-stop-updating)
+ (nxml-where-unmark-forward-element)
+ (nxml-where-restore-header-line-format)
+ (nxml-where-clear-old-path 0 "stop"))
+
+(defun nxml-where-turn-off-unless-nxml ()
+ (unless (nxml-where-is-nxml)
+ (nxml-where-mode-stop)))
+(put 'nxml-where-turn-off-unless-nxml 'permanent-local-hook t)
+
+;;;###autoload
+(define-minor-mode nxml-where-mode
+ "Shows path in mode line."
+ :global nil
+ :group 'nxml-where
+ (if nxml-where-mode
+ ;;Turn it on
+ (nxml-where-mode-start)
+ ;; Turn it off
+ (nxml-where-mode-stop)
+ ))
+(put 'nxml-where-mode 'permanent-local t)
+
+(defun nxml-where-turn-on-in-nxml-child ()
+ "Turn on `nxml-where-mode' if possible.
+This is possible if `major-mode' in the buffer is derived from
+`nxml-mode'."
+ (when (or (derived-mode-p 'nxml-mode)
+ (and mumamo-multi-major-mode
+ (let ((major-mode (mumamo-main-major-mode)))
+ (derived-mode-p 'nxml-mode))))
+ (unless nxml-where-mode
+ (nxml-where-mode 1))))
+
+;;;###autoload
+(define-globalized-minor-mode nxml-where-global-mode nxml-where-mode
+ nxml-where-turn-on-in-nxml-child
+ :group 'nxml-where)
+;; The problem with global minor modes:
+(when (and nxml-where-global-mode
+ (not (boundp 'define-global-minor-mode-bug)))
+ (nxml-where-global-mode 1))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Auto updating
+
+(defvar nxhtml-where-hook nil
+ "Normal hook run when marking has changed.")
+
+(defun nxml-where-start-update-in-timer (buffer)
+ "First checks post command."
+ ;;(message "nxml-where-start-update buffer=%s (bufferp buffer)=%s" buffer (bufferp buffer))
+ (when (and (bufferp buffer)
+ (buffer-live-p buffer))
+ (with-current-buffer buffer
+ (let ((here (point)))
+ (save-match-data
+ (condition-case err
+ (progn
+ ;;(unless nxml-where-marks (nxml-where-clear-old-path))
+ (unless (and nxml-where-header
+ (not nxml-where-only-inner))
+ (setq header-line-format nil))
+ (when (and nxml-where-mode
+ (or nxml-where-header nxml-where-marks))
+ (nxml-where-do-marking nil buffer)))
+ (error
+ (nxml-where-error-message
+ "nxml-where-start-update-in-timer error: %s" err)))
+ (goto-char here))))))
+
+(defun nxml-where-continue-marking-in-timer (this-point buffer)
+ "Continue unfinished marking after last restart.
+Ie we have run at least once post command."
+ ;;(message "continue-marking-in-timer %s %s" this-point buffer)
+ (with-current-buffer buffer
+ (let ((here (point)))
+ (condition-case err
+ (save-match-data ;; runs in timer
+ (nxml-where-do-marking this-point buffer))
+ (error
+ (nxml-where-error-message
+ "nxml-where-do-marking error: %s"
+ err)))
+ (goto-char here))))
+
+(defun nxml-where-start-continue-in-timer (next-point buffer)
+ ;;(message "start second")
+ (condition-case err
+ (setq nxml-where-once-update-timer
+ (run-with-idle-timer idle-update-delay
+ nil
+ 'nxml-where-continue-marking-in-timer
+ next-point
+ buffer))
+ (error
+ (nxml-where-error-message
+ "nxml-where-start-second error %s" err))))
+
+(defun nxml-where-restart-update ()
+ "Restart update, runs in `post-command-hook'."
+ ;;(message "restart-update")
+ (condition-case err
+ (save-match-data ;; runs in timer
+ (unless (and nxml-where-last-point
+ (= nxml-where-last-point (point)))
+ (setq nxml-where-last-point nil)
+ (setq nxml-where-last-finished nil)
+ (nxml-where-cancel-once)
+ (setq nxml-where-once-update-timer
+ (run-with-idle-timer
+ (* 0.2 idle-update-delay)
+ nil
+ 'nxml-where-start-update-in-timer
+ (current-buffer)))))
+ (error
+ (nxml-where-error-message
+ "%s" (error-message-string err)))))
+(put 'nxml-where-restart-update 'permanent-local-hook t)
+
+(defvar nxml-where-first-change-pos nil)
+(make-variable-buffer-local 'nxml-where-first-change-pos)
+(put 'nxml-where-first-change-pos 'permanent-local t)
+
+(defun nxml-where-after-change (beg end len)
+ (setq nxml-where-last-point nil)
+ (setq nxml-where-first-change-pos
+ (min beg
+ (or nxml-where-first-change-pos
+ beg))))
+
+(defun nxml-where-cancel-once ()
+ (when (timerp nxml-where-once-update-timer)
+ (cancel-timer nxml-where-once-update-timer)
+ (setq nxml-where-once-update-timer nil)))
+
+(defun nxml-where-update-buffers ()
+ (when (boundp 'nxml-where-mode)
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when nxml-where-mode
+ (nxml-where-mode -1)
+ (nxml-where-mode 1))))))
+
+(defun nxml-where-stop-updating ()
+ (remove-hook 'post-command-hook 'nxml-where-restart-update t))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Marking
+
+(defconst nxml-where-get-id-pattern
+ (rx-to-string
+ `(and
+ space
+ ,(cons 'or nxml-where-header-attributes)
+ (0+ space)
+ ?=
+ (0+ space)
+ ?\"
+ (0+ (not (any ?\")))
+ ?\")
+ t))
+
+(defvar nxml-where-tag+id-pattern
+ (rx ?<
+ (submatch
+ (1+ (char "-a-z0-9:"))
+ )
+ (0+ (1+ space)
+ (1+ (any "a-z"))
+ (0+ space)
+ ?=
+ (0+ space)
+ ?\"
+ (0+ (not (any ?\")))
+ ?\"
+ )
+ (0+ space)
+ (opt ?/)
+ ?>))
+
+
+(defvar nxml-where-forward-element nil)
+(make-variable-buffer-local 'nxml-where-forward-element)
+(put 'nxml-where-forward-element 'permanent-local t)
+
+(defun nxml-where-unmark-forward-element ()
+ "Unmark currently marked end tag."
+ (when nxml-where-forward-element
+ (let* ((ovl (nth 1 nxml-where-forward-element))
+ (str (when ovl (buffer-substring-no-properties (overlay-start ovl) (overlay-end ovl)))))
+ (when (overlayp ovl)
+ ;;(message "unmark-forward-element:delete-overlay %s %s" str ovl)
+ (delete-overlay ovl)))
+ (setq nxml-where-forward-element nil)))
+
+(defun nxml-where-mark-forward-element (start-tag)
+ "Mark the end tag matching START-TAG."
+ ;;(message "nxml-where-forward-element=%s" nxml-where-forward-element)
+ (unless (and start-tag
+ nxml-where-forward-element
+ (nth 1 nxml-where-forward-element)
+ (= (nth 0 nxml-where-forward-element)
+ start-tag))
+ ;;(message "before unmark")
+ (nxml-where-unmark-forward-element)
+ ;;(message "after unmark")
+ (when start-tag
+ (let ((here (point))
+ (end-of-narrow
+ (progn
+ (goto-char start-tag)
+ (line-end-position 4)))
+ start end ovl)
+ ;; Fix-me: Narrow how much?
+ (setq end-of-narrow (max (+ 4000 (window-end))
+ end-of-narrow))
+ (setq end-of-narrow (min (point-max)
+ end-of-narrow))
+ (save-restriction
+ (narrow-to-region start-tag end-of-narrow)
+ (condition-case err
+ (progn
+ (goto-char start-tag)
+ (nxml-forward-element)
+ (when (looking-back "</[a-z0-9]+>")
+ (setq start (match-beginning 0))
+ (setq end (point))
+ (setq ovl (make-overlay start end))
+ (overlay-put ovl 'nxml-where t)
+ (overlay-put ovl 'face nxml-where-marking)))
+ (error
+ (let ((msg (error-message-string err)))
+ (unless (string= msg "Start-tag has no end-tag")
+ (message "nxml-where-mark-forw: %s" msg))))))
+ (goto-char here)
+ ;;(message "point 2 = %s" (point))
+ (setq nxml-where-forward-element (list start-tag ovl))))))
+
+
+(defun nxml-where-make-rec (tag-start tag-end tag-str buf)
+ ;;(message "nxml-where-make-rec %s %s %s %s" tag-start tag-end tag-str buf)
+ (let ((ovls (overlays-at tag-start))
+ str)
+ (dolist (ovl ovls)
+ (when (overlay-get ovl 'nxml-where)
+ (setq str (buffer-substring-no-properties (overlay-start ovl) (overlay-end ovl)))
+ (message "==================================================")
+ (nxml-where-error-message "old ovl=%s %S" ovl str)
+ (message "old: nxml-where-path=%s" nxml-where-path)
+ (message "old: nxml-where-new-path=%s" nxml-where-new-path)
+ )))
+ (let ((ovl (when buf (make-overlay tag-start tag-end))))
+ (when ovl
+ (overlay-put ovl 'nxml-where t)
+ (overlay-put ovl 'face nxml-where-marking))
+ (list tag-start tag-end tag-str ovl)))
+
+(defun nxml-where-delete-rec (rec from)
+ (let* ((ovl (nth 3 rec))
+ (str (when ovl
+ (buffer-substring-no-properties (overlay-start ovl) (overlay-end ovl)))))
+ (when (and ovl (overlay-buffer ovl))
+ (assert (overlayp ovl) t)
+ ;;(message "delete-rec:delete-overlay %s %s (%s)" str ovl from)
+ (delete-overlay ovl)
+ ;;(message "after delete=%s" ovl)
+ )))
+
+
+(defun nxml-where-clear-old-path (end-of-interest from)
+ "Clear all marking below END-OF-INTEREST.
+Update `nxml-where-path accordingly."
+ (setq nxml-where-last-added nil)
+ ;;(message "++++++ clear A: %s (%s)" end-of-interest from)
+ (setq nxml-where-path (cons 'dummy nxml-where-path))
+ (let ((path nxml-where-path))
+ ;;(message "path 1=%s" path)
+ (while (cdr path)
+ ;;(message "path 2=%s" path)
+ (when (> (nth 1 (cadr path)) end-of-interest)
+ (dolist (p (cdr path))
+ (nxml-where-delete-rec p "clear"))
+ (setcdr path nil))
+ (setq path (cdr path))))
+ (setq nxml-where-path (cdr nxml-where-path)))
+
+(defun nxml-where-clear-new-path ()
+ (dolist (new nxml-where-new-path)
+ (nxml-where-delete-rec new "clear new"))
+ (setq nxml-where-new-path nil)
+ ;;(message "clear B:nxml-where-path=%s" nxml-where-path)
+ )
+
+
+(defun nxml-where-update-where-path (tag-start tag-end tag-str buffer)
+ "Update where path with given tag.
+The tag is between TAG-START and TAG-END and the string to
+display for it in the header-line is TAG-STR. This is in buffer
+BUFFER."
+ ;; Delete old marks below tag-start:
+ (nxml-where-clear-old-path (+ tag-end 0) (format "update-where-path, tag-start=%s" tag-start))
+ ;; Is this now the same as the old value?
+ (let ((last-old (last nxml-where-path))
+ new-rec
+ result)
+ ;;(message "update: %s %s %s %s, last-old=%s" tag-start tag-end tag-str buffer last-old)
+ (if (and last-old
+ (= tag-start (nth 0 (car last-old)))
+ (= tag-end (nth 1 (car last-old))))
+ (progn
+ (setq result 'ready))
+ (when nxml-where-only-inner
+ ;;(message "last-old=%S, nwp=%S, nwnp=%S" last-old nxml-where-path nxml-where-new-path)
+ (setq last-old (car (last nxml-where-path)))
+ (when last-old
+ (setq nxml-where-path nil)
+ (nxml-where-delete-rec last-old "only-inner")))
+ (setq new-rec (nxml-where-make-rec tag-start tag-end tag-str buffer))
+ (setq nxml-where-last-added new-rec)
+ (setq nxml-where-new-path (cons new-rec nxml-where-new-path))
+ (setq result 'continue))
+ result))
+
+(defun nxml-where-do-marking (this-point buffer)
+ "Do marking.
+If THIS-POINT is nil then it is the first marking post command in
+buffer BUFFER. In that case start from current point, otherwise
+from THIS-POINT.
+
+Go up to previous tag. Then check if this is the same tag where
+we started last time and ran to completion. If so just finish.
+
+Otherwise check this tag. If not ready after that then restart
+this command with arg THIS-POINT set to right before this tag."
+ ;;(message "****************nxml-where-do-marking %s %s, point=%s" this-point buffer (point))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-restriction
+ (when nxml-where-widen (widen))
+ (let ((here (point))
+ next-point
+ (is-first (not this-point))
+ (end-of-interest (if nxml-where-first-change-pos
+ (min (point) nxml-where-first-change-pos)
+ ;; Check for tag at point
+ (catch 'eoi
+ (let (ovl)
+ (dolist (ovl (overlays-at (point)))
+ (when (overlay-get ovl 'nxml-where)
+ (throw 'eoi (overlay-end ovl)))))
+ (point)))))
+ ;; If on beginning of tag step forward one char.
+ (unless (or (eobp)
+ this-point
+ (not (eq ?< (char-after))))
+ (forward-char))
+ (when this-point (goto-char this-point))
+ (setq next-point
+ (catch 'cnext-point
+ (progn
+ (condition-case err
+ (nxml-backward-up-element)
+ (error
+ (if (equal err '(error "No parent element"))
+ (let (rec)
+ ;;(message "------------ No parent element")
+ (dolist (rec nxml-where-path)
+ (nxml-where-delete-rec rec "no parent"))
+ (setq nxml-where-path nil)
+ (throw 'cnext-point nil)) ;; <---- remember...
+ (nxml-where-error-message "nxml-where error: %S" err)
+ (throw 'cnext-point "uh?"))))
+ ;; Is this the first call
+ ;;(message ";; Is this the first call, %s" is-first)
+ (when is-first
+ (when (and nxml-where-path
+ nxml-where-last-finished
+ (= (point) (caar (last nxml-where-path))))
+ (throw 'cnext-point 'same-as-last))
+ ;;(setq nxml-where-new-path nil)
+ (setq nxml-where-last-added nil)
+ ;; Delete those parts we can't trust or don't
+ ;; need any more. Fix-me, Note: this is different
+ ;; dependent on if some buffer changes occured.
+ (nxml-where-clear-old-path end-of-interest (format "is-first,p=%s" (point)))
+ (nxml-where-clear-new-path))
+ ;;(message "looking-at")
+ (when (looking-at nxml-where-tag+id-pattern)
+ (let ((start (point))
+ (end (match-end 0))
+ (tag (match-string-no-properties 1))
+ (all (match-string-no-properties 0)))
+ (when nxml-where-tag+id
+ (when (string-match nxml-where-get-id-pattern all)
+ (setq tag (concat tag (match-string 0 all)))))
+ (setq tag (concat "<" tag ">"))
+ (when (or (eq 'ready
+ (nxml-where-update-where-path start end tag t))
+ nxml-where-only-inner)
+ ;;(message "throw 'cp nil")
+ (throw 'cnext-point nil))))
+ (throw 'cnext-point (max (1- (point)) (point-min))))))
+ (goto-char here)
+ (if next-point
+ (cond
+ ((stringp next-point) (message "%s" next-point) ;; Some error
+ (when nxml-where-header (setq header-line-format next-point)))
+ ((eq 'same-as-last next-point)
+ nil)
+ (t
+ (unless nxml-where-only-inner
+ (setq nxml-where-once-update-timer
+ (run-with-timer (* 0.2 idle-update-delay)
+ nil
+ 'nxml-where-start-continue-in-timer
+ next-point (current-buffer))))))
+ (if nxml-where-path
+ (setcdr (last nxml-where-path) nxml-where-new-path)
+ (setq nxml-where-path nxml-where-new-path))
+ (setq nxml-where-new-path nil)
+ ;;(message "nxml-where-path=%s" nxml-where-path)
+ (nxml-where-mark-forward-element (caar (last nxml-where-path)))
+ (setq nxml-where-last-finished t)
+ (setq nxml-where-first-change-pos nil)
+ (run-hooks 'nxhtml-where-hook)
+ (setq nxml-where-last-point (point))
+ (when (and nxml-where-header
+ (not nxml-where-only-inner))
+ (nxml-where-insert-header))))))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Header path
+
+(defun nxml-where-insert-header ()
+ (let ((path (mapcar (lambda (elt)
+ (nth 2 elt))
+ nxml-where-path)))
+ (unless path
+ (setq path (list (if (looking-at "[[:space:]]*\\'")
+ "(After last tag)"
+ "(Before first tag)"))))
+ (if (null path)
+ (setq path " *Error* ")
+ ;; Throw away <html>
+ (let* ((first (car path))
+ (html "<html")
+ (hlen (length html)))
+ (when (and (> (length first) hlen)
+ (string= html (substring first 0 hlen)))
+ (setq path (cdr path))))
+ (unless path
+ (setq path (list "(At html start)"))))
+ (let* ((sp (substring (format "%s" path) 1 -1))
+ (label " Path: ")
+ (totlen (+ (length sp) (length label)))
+ header)
+ (when (> totlen (window-width))
+ (setq sp (concat "... "
+ (substring sp (+ (- totlen (window-width))
+ 4)))))
+ (setq header (concat label sp))
+ (when nxml-where-header
+ (setq header-line-format header)))))
+
+(defvar nxml-where-saved-header-line-format nil)
+(make-variable-buffer-local 'nxml-where-saved-header-line-format)
+(put 'nxml-where-saved-header-line-format 'permanent-local t)
+
+(defun nxml-where-save-header-line-format ()
+ (unless nxml-where-saved-header-line-format
+ (setq nxml-where-saved-header-line-format header-line-format)))
+
+(defun nxml-where-restore-header-line-format ()
+ (setq header-line-format nxml-where-saved-header-line-format))
+
+
+
+(provide 'nxml-where)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxml-where.el ends here
--- /dev/null
+;;; outline-magic.el --- outline mode extensions for Emacs
+
+;; Copyright (C) 2002 Carsten Dominik <dominik@science.uva.nl>
+
+;; Maintainer: Carsten Dominik <dominik@science.uva.nl>
+;; Version: 0.9
+;; Keywords: outlines
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file implements extensions for outline(-minor)-mode.
+;;
+;; - VISIBILITY CYCLING: A *single* command to replace the many
+;; outline commands for showing and hiding parts of a document.
+;;
+;; - STRUCTURE EDITING: Promotion, demotion and transposition of subtrees.
+;;
+;; Installation
+;; ============
+;;
+;; Byte-compile outline-magic.el, put it on the load path and copy the
+;; following into .emacs (adapting keybindings to your own preferences)
+;;
+;; (add-hook 'outline-mode-hook
+;; (lambda ()
+;; (require 'outline-cycle)))
+;;
+;; (add-hook 'outline-minor-mode-hook
+;; (lambda ()
+;; (require 'outline-magic)
+;; (define-key outline-minor-mode-map [(f10)] 'outline-cycle)))
+;;
+;; Usage
+;; =====
+;;
+;; Visibility cycling
+;; ------------------
+;;
+;; The command `outline-cycle' changes the visibility of text and headings
+;; in the buffer. Instead of using many different commands to show and
+;; hide buffer parts, `outline-cycle' cycles through the most important
+;; states of an outline buffer. In the major `outline-mode', it will be
+;; bound to the TAB key. In `outline-minor-mode', the user can choose a
+;; different keybinding. The action of the command depends on the current
+;; cursor location:
+;;
+;; 1. When point is at the beginning of the buffer, `outline-cycle'
+;; cycles the entire buffer through 3 different states:
+;; - OVERVIEW: Only top-level headlines are shown.
+;; - CONTENTS: All headlines are shown, but no body text.
+;; - SHOW ALL: Everything is shown.
+;;
+;; 2. When point in a headline, `outline-cycle' cycles the subtree started
+;; by this line through the following states:
+;; - FOLDED: Only the headline is shown.
+;; - CHILDREN: The headline and its direct children are shown. From
+;; this state, you can move to one of the children and
+;; zoom in further.
+;; - SUBTREE: The entire subtree under the heading is shown.
+;;
+;; 3. At other positions, `outline-cycle' jumps back to the current heading.
+;; It can also be configured to emulate TAB at those positions, see
+;; the option `outline-cycle-emulate-tab'.
+;;
+;; Structure editing
+;; -----------------
+;;
+;; Four commands are provided for structure editing. The commands work on
+;; the current subtree (the current headline plus all inferior ones). In
+;; addition to menu access, the commands are assigned to the four arrow
+;; keys pressed with a modifier (META by default) in the following way:
+;;
+;; move up
+;; ^
+;; promote <- | -> demote
+;; v
+;; move down
+;;
+;; Thus, M-left will promote a subtree, M-up will move it up
+;; vertically throught the structure. Configure the variable
+;; `outline-structedit-modifiers' to use different modifier keys.
+;;
+;; Moving subtrees
+;; - - - - - - - -
+;; The commands `outline-move-subtree-up' and `outline-move-subtree-down'
+;; move the entire current subtree (folded or not) past the next same-level
+;; heading in the given direction. The cursor moves with the subtree, so
+;; these commands can be used to "drag" a subtree to the wanted position.
+;; For example, `outline-move-subtree-down' applied with the cursor at the
+;; beginning of the "* Level 1b" line will change the tree like this:
+;;
+;; * Level 1a * Level 1a
+;; * Level 1b ===\ * Level 1c
+;; ** Level 2b ===/ * Level 1b
+;; * Level 1c ** Level 2b
+;;
+;; Promotion/Demotion
+;; - - - - - - - - - -
+;; The commands `outline-promote' and `outline-demote' change the current
+;; subtree to a different outline level - i.e. the level of all headings in
+;; the tree is decreased or increased. For example, `outline-demote'
+;; applied with the cursor at the beginning of the "* Level 1b" line will
+;; change the tree like this:
+;;
+;; * Level 1a * Level 1a
+;; * Level 1b ===\ ** Level 1b
+;; ** Level 2b ===/ *** Level 2
+;; * Level 1c * Level 1c
+;;
+;; The reverse operation is `outline-promote'. Note that the scope of
+;; "current subtree" may be changed after a promotion. To change all
+;; headlines in a region, use transient-mark-mode and apply the command to
+;; the region.
+;;
+;; NOTE: Promotion/Demotion in complex outline setups
+;; - - - - - - - - - - - - - - - - - - - - - - - - - -
+;; Promotion/demotion works easily in a simple outline setup where the
+;; indicator of headings is just a polymer of a single character (e.g. "*"
+;; in the default outline mode). It can also work in more complicated
+;; setups. For example, in LaTeX-mode, sections can be promoted to
+;; chapters and vice versa. However, the outline setup for the mode must
+;; meet two requirements:
+;;
+;; 1. `outline-regexp' must match the full text which has to be changed
+;; during promotion/demotion. E.g. for LaTeX, it must match "\chapter"
+;; and not just "\chap". Major modes like latex-mode, AUCTeX's
+;; latex-mode and texinfo-mode do this correctly.
+;;
+;; 2. The variable `outline-promotion-headings' must contain a sorted list
+;; of headings as matched by `outline-regexp'. Each of the headings in
+;; `outline-promotion-headings' must be matched by `outline-regexp'.
+;; `outline-regexp' may match additional things - those matches will be
+;; ignored by the promotion commands. If a mode has multiple sets of
+;; sectioning commands (for example the texinfo-mode with
+;; chapter...subsubsection and unnumbered...unnumberedsubsubsec), the
+;; different sets can all be listed in the same list, but must be
+;; separated by nil elements to avoid "promotion" accross sets.
+;; Examples:
+;;
+;; (add-hook 'latex-mode-hook ; or 'LaTeX-mode-hook for AUCTeX
+;; (lambda ()
+;; (setq outline-promotion-headings
+;; '("\\chapter" "\\section" "\\subsection"
+;; "\\subsubsection" "\\paragraph" "\\subparagraph"))))
+;;
+;; (add-hook 'texinfo-mode-hook
+;; (lambda ()
+;; (setq outline-promotion-headings
+;; '("@chapter" "@section" "@subsection" "@subsubsection" nil
+;; "@unnumbered" "@unnumberedsec" "@unnumberedsubsec"
+;; "@unnumberedsubsubsec" nil
+;; "@appendix" "@appendixsec" "@appendixsubsec"
+;; "@appendixsubsubsec" nil
+;; "@chapheading" "@heading" "@subheading" "@subsubheading"))))
+;;
+;; If people find this useful enough, maybe the maintainers of the
+;; modes can be persuaded to set `outline-promotion-headings'
+;; already as part of the mode setup.
+;;
+;; Compatibility:
+;; --------------
+;; outline-magic was developed to work with the new outline.el
+;; implementation which uses text properties instead of selective display.
+;; If you are using XEmacs which still has the old implementation, most
+;; commands will work fine. However, structure editing commands will
+;; require all relevant headlines to be visible.
+;;
+;; History
+;; -------
+;; - Before first header now works as at beginning of file
+;; - Two levels are shown for contents.
+;;
+;;; Code:
+
+(require 'outline)
+
+;;; Visibility cycling
+
+(defcustom outline-cycle-emulate-tab nil
+ "Where should `outline-cycle' emulate TAB.
+nil Never
+white Only in completely white lines
+t Everywhere except in headlines"
+ :group 'outlines
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Only in completely white lines" white)
+ (const :tag "Everywhere except in headlines" t)
+ ))
+
+(defvar outline-promotion-headings nil
+ "A sorted list of headings used for promotion/demotion commands.
+Set this to a list of headings as they are matched by `outline-regexp',
+top-level heading first. If a mode or document needs several sets of
+outline headings (for example numbered and unnumbered sections), list
+them set by set, separated by a nil element. See the example for
+`texinfo-mode' in the file commentary.")
+(make-variable-buffer-local 'outline-promotion-headings)
+
+(defun outline-cycle (&optional arg)
+ "Visibility cycling for outline(-minor)-mode.
+
+- When point is at the beginning of the buffer, or when called with a
+ C-u prefix argument, rotate the entire buffer through 3 states:
+ 1. OVERVIEW: Show only top-level headlines.
+ 2. CONTENTS: Show all headlines of all levels, but no body text.
+ 3. SHOW ALL: Show everything.
+
+- When point is at the beginning of a headline, rotate the subtree started
+ by this line through 3 different states:
+ 1. FOLDED: Only the main headline is shown.
+ 2. CHILDREN: The main headline and the direct children are shown. From
+ this state, you can move to one of the children and
+ zoom in further.
+ 3. SUBTREE: Show the entire subtree, including body text.
+
+- When point is not at the beginning of a headline, execute
+ `indent-relative', like TAB normally does."
+ (interactive "P")
+ (setq deactivate-mark t)
+ (cond
+
+ ((equal arg '(4))
+ ; Run `outline-cycle' as if at the top of the buffer.
+ (save-excursion
+ (goto-char (point-min))
+ (outline-cycle nil)))
+
+ (t
+ (cond
+ ((or (bobp) ;; Beginning of buffer: Global cycling
+ (let ((here (point))
+ (atbobp t))
+ (condition-case err
+ (progn
+ (outline-back-to-heading)
+ (setq atbobp nil))
+ (error nil))
+ atbobp))
+
+ (cond
+ ((eq last-command 'outline-cycle-overview)
+ ;; We just created the overview - now do table of contents
+ ;; This can be slow in very large buffers, so indicate action
+ (message "CONTENTS...")
+ (save-excursion
+ ;; Visit all headings and show their offspring
+ (goto-char (point-max))
+ (catch 'exit
+ (while (and (progn (condition-case nil
+ (outline-previous-visible-heading 1)
+ (error (goto-char (point-min))))
+ t)
+ (looking-at outline-regexp))
+ (show-branches)
+ (if (bobp) (throw 'exit nil))))
+ (message "CONTENTS...done"))
+ (setq this-command 'outline-cycle-toc))
+ ((eq last-command 'outline-cycle-toc)
+ ;; We just showed the table of contents - now show everything
+ (show-all)
+ (message "SHOW ALL")
+ (setq this-command 'outline-cycle-showall))
+ (t
+ ;; Default action: go to overview
+ ;; FIX-ME: variable sublevel here (for wikipedia for example):
+ (hide-sublevels 2)
+ (message "OVERVIEW")
+ (setq this-command 'outline-cycle-overview))))
+
+ ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
+ ;; At a heading: rotate between three different views
+ (outline-back-to-heading)
+ (let ((goal-column 0) beg eoh eol eos)
+ ;; First, some boundaries
+ (save-excursion
+ (outline-back-to-heading) (setq beg (point))
+ (save-excursion (outline-next-line) (setq eol (point)))
+ (outline-end-of-heading) (setq eoh (point))
+ (outline-end-of-subtree) (setq eos (point)))
+ ;; Find out what to do next and set `this-command'
+ (cond
+ ((= eos eoh)
+ ;; Nothing is hidden behind this heading
+ (message "EMPTY ENTRY"))
+ ((>= eol eos)
+ ;; Entire subtree is hidden in one line: open it
+ (show-entry)
+ (show-children)
+ (message "CHILDREN")
+ (setq this-command 'outline-cycle-children))
+ ((eq last-command 'outline-cycle-children)
+ ;; We just showed the children, now show everything.
+ (show-subtree)
+ (message "SUBTREE"))
+ (t
+ ;; Default action: hide the subtree.
+ (hide-subtree)
+ (message "FOLDED")))))
+
+ ;; TAB emulation
+ ((outline-cycle-emulate-tab)
+ (indent-relative))
+
+ (t
+ ;; Not at a headline: Do indent-relative
+ (outline-back-to-heading))))))
+
+(defun outline-cycle-emulate-tab ()
+ "Check if TAB should be emulated at the current position."
+ ;; This is called after the check for point in a headline,
+ ;; so we can assume we are not in a headline
+ (if (and (eq outline-cycle-emulate-tab 'white)
+ (save-excursion
+ (beginning-of-line 1) (looking-at "[ \t]+$")))
+ t
+ outline-cycle-emulate-tab))
+
+(defun outline-next-line ()
+ "Forward line, but mover over invisible line ends.
+Essentially a much simplified version of `next-line'."
+ (interactive)
+ (beginning-of-line 2)
+ (while (and (not (eobp))
+ (get-char-property (1- (point)) 'invisible))
+ (beginning-of-line 2)))
+
+;;; Vertical tree motion
+
+(defun outline-move-subtree-up (&optional arg)
+ "Move the currrent subtree up past ARG headlines of the same level."
+ (interactive "p")
+ (outline-move-subtree-down (- arg)))
+
+(defun outline-move-subtree-down (&optional arg)
+ "Move the currrent subtree down past ARG headlines of the same level."
+ (interactive "p")
+ (let ((re (concat "^" outline-regexp))
+ (movfunc (if (> arg 0) 'outline-get-next-sibling
+ 'outline-get-last-sibling))
+ (ins-point (make-marker))
+ (cnt (abs arg))
+ beg end txt)
+ ;; Select the tree
+ (outline-back-to-heading)
+ (setq beg (point))
+ (outline-end-of-subtree)
+ (if (= (char-after) ?\n) (forward-char 1))
+ (setq end (point))
+ ;; Find insertion point, with error handling
+ (goto-char beg)
+ (while (> cnt 0)
+ (or (funcall movfunc)
+ (progn (goto-char beg)
+ (error "Cannot move past superior level")))
+ (setq cnt (1- cnt)))
+ (if (> arg 0)
+ ;; Moving forward - still need to move over subtree
+ (progn (outline-end-of-subtree)
+ (if (= (char-after) ?\n) (forward-char 1))))
+ (move-marker ins-point (point))
+ (setq txt (buffer-substring beg end))
+ (delete-region beg end)
+ (insert txt)
+ (goto-char ins-point)
+ (move-marker ins-point nil)))
+
+;;; Promotion and Demotion
+
+(defun outline-promote (&optional arg)
+ "Decrease the level of an outline-structure by ARG levels.
+When the region is active in transient-mark-mode, all headlines in the
+region are changed. Otherwise the current subtree is targeted. Note that
+after each application of the command the scope of \"current subtree\"
+may have changed."
+ (interactive "p")
+ (outline-change-level (- arg)))
+
+
+(defun outline-demote (&optional arg)
+ "Increase the level of an outline-structure by ARG levels.
+When the region is active in transient-mark-mode, all headlines in the
+region are changed. Otherwise the current subtree is targeted. Note that
+after each application of the command the scope of \"current subtree\"
+may have changed."
+ (interactive "p")
+ (outline-change-level arg))
+
+(defun outline-change-level (delta)
+ "Workhorse for `outline-demote' and `outline-promote'."
+ (let* ((headlist (outline-headings-list))
+ (atom (outline-headings-atom headlist))
+ (re (concat "^" outline-regexp))
+ (transmode (and transient-mark-mode mark-active))
+ beg end)
+
+ ;; Find the boundaries for this operation
+ (save-excursion
+ (if transmode
+ (setq beg (min (point) (mark))
+ end (max (point) (mark)))
+ (outline-back-to-heading)
+ (setq beg (point))
+ (outline-end-of-heading)
+ (outline-end-of-subtree)
+ (setq end (point)))
+ (setq beg (move-marker (make-marker) beg)
+ end (move-marker (make-marker) end))
+
+ (let (head newhead level newlevel static)
+
+ ;; First a dry run to test if there is any trouble ahead.
+ (goto-char beg)
+ (while (re-search-forward re end t)
+ (outline-change-heading headlist delta atom 'test))
+
+ ;; Now really do replace the headings
+ (goto-char beg)
+ (while (re-search-forward re end t)
+ (outline-change-heading headlist delta atom))))))
+
+(defun outline-headings-list ()
+ "Return a list of relevant headings, either a user/mode defined
+list, or an alist derived from scanning the buffer."
+ (let (headlist)
+ (cond
+ (outline-promotion-headings
+ ;; configured by the user or the mode
+ (setq headlist outline-promotion-headings))
+
+ ((and (eq major-mode 'outline-mode) (string= outline-regexp "[*\^L]+"))
+ ;; default outline mode with original regexp
+ ;; this need special treatment because of the \f in the regexp
+ (setq headlist '(("*" . 1) ("**" . 2)))) ; will be extrapolated
+
+ (t ;; Check if the buffer contains a complete set of headings
+ (let ((re (concat "^" outline-regexp)) head level)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (save-excursion
+ (beginning-of-line 1)
+ (setq head (outline-cleanup-match (match-string 0))
+ level (funcall outline-level))
+ (add-to-list 'headlist (cons head level))))))
+ ;; Check for uniqueness of levels in the list
+ (let* ((hl headlist) entry level seen nonunique)
+ (while (setq entry (car hl))
+ (setq hl (cdr hl)
+ level (cdr entry))
+ (if (and (not (outline-static-level-p level))
+ (member level seen))
+ ;; We have two entries for the same level.
+ (add-to-list 'nonunique level))
+ (add-to-list 'seen level))
+ (if nonunique
+ (error "Cannot promote/demote: non-unique headings at level %s\nYou may want to configure `outline-promotion-headings'."
+ (mapconcat 'int-to-string nonunique ","))))))
+ ;; OK, return the list
+ headlist))
+
+(defun outline-change-heading (headlist delta atom &optional test)
+ "Change heading just matched by `outline-regexp' by DELTA levels.
+HEADLIST can be either an alist ((\"outline-match\" . level)...) or a
+straight list like `outline-promotion-headings'. ATOM is a character
+if all headlines are composed of a single character.
+If TEST is non-nil, just prepare the change and error if there are problems.
+TEST nil means, really replace old heading with new one."
+ (let* ((head (outline-cleanup-match (match-string 0)))
+ (level (save-excursion
+ (beginning-of-line 1)
+ (funcall outline-level)))
+ (newhead ; compute the new head
+ (cond
+ ((= delta 0) t)
+ ((outline-static-level-p level) t)
+ ((null headlist) nil)
+ ((consp (car headlist))
+ ;; The headlist is an association list
+ (or (car (rassoc (+ delta level) headlist))
+ (and atom
+ (> (+ delta level) 0)
+ (make-string (+ delta level) atom))))
+ (t
+ ;; The headlist is a straight list - grab the correct element.
+ (let* ((l (length headlist))
+ (n1 (- l (length (member head headlist)))) ; index old
+ (n2 (+ delta n1))) ; index new
+ ;; Careful checking
+ (cond
+ ((= n1 l) nil) ; head not found
+ ((< n2 0) nil) ; newlevel too low
+ ((>= n2 l) nil) ; newlevel too high
+ ((let* ((tail (nthcdr (min n1 n2) headlist))
+ (nilpos (- (length tail) (length (memq nil tail)))))
+ (< nilpos delta)) ; nil element between old and new
+ nil)
+ (t (nth n2 headlist)))))))) ; OK, we have a match!
+ (if (not newhead)
+ (error "Cannot shift level %d heading \"%s\" to level %d"
+ level head (+ level delta)))
+ (if (and (not test) (stringp newhead))
+ (save-excursion
+ (beginning-of-line 1)
+ (or (looking-at (concat "[ \t]*\\(" (regexp-quote head) "\\)"))
+ (error "Please contact maintainer"))
+ (replace-match newhead t t nil 1)))))
+
+(defun outline-headings-atom (headlist)
+ "Use the list created by `outline-headings-list' and check if all
+headings are polymers of a single character, e.g. \"*\".
+If yes, return this character."
+ (if (consp (car headlist))
+ ;; this is an alist - it makes sense to check for atomic structure
+ (let ((re (concat "\\`"
+ (regexp-quote (substring (car (car headlist)) 0 1))
+ "+\\'")))
+ (if (not (delq nil (mapcar (lambda (x) (not (string-match re (car x))))
+ headlist)))
+ (string-to-char (car (car headlist)))))))
+
+(defun outline-cleanup-match (s)
+ "Remove text properties and start/end whitespace from a string."
+ (set-text-properties 1 (length s) nil s)
+ (save-match-data
+ (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s)))
+ (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s))))
+ s)
+
+(defun outline-static-level-p (level)
+ "Test if a level should not be changed by level promotion/demotion."
+ (>= level 1000))
+
+;;; Key bindings
+
+(defcustom outline-structedit-modifiers '(meta)
+ "List of modifiers for outline structure editing with the arrow keys."
+ :group 'outlines
+ :type '(repeat symbol))
+
+(define-key outline-mode-map [(tab)] 'outline-cycle)
+(let ((keys '((left . outline-promote)
+ (right . outline-demote)
+ (up . outline-move-subtree-up)
+ (down . outline-move-subtree-down)))
+ key)
+ (while (setq key (pop keys))
+ (apply 'define-key outline-mode-map
+ (list
+ (vector (append outline-structedit-modifiers (list (car key))))
+ (cdr key)))))
+
+;;; Menu entries
+
+(define-key outline-mode-menu-bar-map [headings outline-move-subtree-down]
+ '("Move subtree down" . outline-move-subtree-down))
+(define-key outline-mode-menu-bar-map [headings outline-move-subtree-up]
+ '("Move subtree up" . outline-move-subtree-up))
+(define-key outline-mode-menu-bar-map [headings outline-demote]
+ '("Demote by 1 level" . outline-demote))
+(define-key outline-mode-menu-bar-map [headings outline-promote]
+ '("Promote by 1 level" . outline-promote))
+(define-key outline-mode-menu-bar-map [show outline-cycle]
+ '("Rotate visibility" . outline-cycle))
+(define-key outline-mode-menu-bar-map [hide outline-cycle]
+ '("Rotate visibility" . outline-cycle))
+
+;;; Finish up
+
+(provide 'outline-magic)
+
+;;; outline-magic.el ends here
--- /dev/null
+;;; rngalt.el --- Tools for making completion addition to nxml mode
+;;
+;; Author: Lennart Borgman
+;; Created: Wed Jan 10 17:17:18 2007
+(defconst rngalt:version "0.51") ;;Version:
+;; Last-Updated: 2008-03-08T03:33:56+0100 Sat
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `nxml-enc', `nxml-ns', `nxml-parse', `nxml-util',
+;; `ourcomments-util', `rng-dt', `rng-loc', `rng-match',
+;; `rng-parse', `rng-pttrn', `rng-uri', `rng-util', `rng-valid',
+;; `xmltok'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-and-compile (require 'rng-valid))
+(eval-when-compile (require 'rng-nxml))
+(eval-when-compile (unless load-file-name (require 'nxhtml-mode nil t)))
+
+(eval-when-compile
+ (let* ((this-file (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+ (this-dir (file-name-directory this-file))
+ (util-dir (expand-file-name "../util/" this-dir))
+ (load-path (cons util-dir load-path)))
+ (require 'ourcomments-util)))
+;;(require 'ourcomments-util)
+
+;; (setq x (macroexpand '(defcustom my-temp-opt t "doc" :type 'boolean)))
+;; (setq x (macroexpand '(define-minor-mode my-temp-mode "doc")))
+;; (setq x (macroexpand '(define-toggle my-temp-toggle t "doc")))
+;;(define-toggle rngalt-display-validation-header t
+(define-minor-mode rngalt-display-validation-header
+ "Display XML validation headers at the top of buffer when t.
+The validation header is only displayed in buffers where the main
+major mode is derived from `nxml-mode'."
+ :global t
+ :init-value t
+ :group 'relax-ng
+ :group 'nxhtml
+ (when (fboundp 'rngalt-update-validation-header-overlay-everywhere)
+ (rngalt-update-validation-header-overlay-everywhere)))
+
+(defun rngalt-display-validation-header-toggle ()
+ "Toggle `rngalt-display-validation-header'."
+ (interactive)
+ (rngalt-display-validation-header (if rngalt-display-validation-header -1 1)))
+
+;;(define-toggle rngalt-minimal-validation-header t
+(define-minor-mode rngalt-minimal-validation-header
+ "If non-nil display only a short informaion about the XML validation header.
+See also `rngalt-display-validation-header'."
+ :global t
+ :init-value t
+ :group 'relax-ng
+ :group 'nxhtml
+ (when (fboundp 'rngalt-update-validation-header-overlay-everywhere)
+ (rngalt-update-validation-header-overlay-everywhere)))
+
+(defun rngalt-minimal-validation-header-toggle ()
+ "Toggle `rngalt-minimal-validation-header'."
+ (interactive)
+ (rngalt-minimal-validation-header (if rngalt-minimal-validation-header -1 1)))
+
+(defface rngalt-validation-header-top
+ '((t (:foreground "RGB:87/CE/FA" :background "white")))
+ "Face first line of validation header."
+ :group 'nxhtml)
+
+(defface rngalt-validation-header-bottom
+ '((t (:foreground "white" :background "RGB:87/CE/FA")))
+ "Face first line of validation header."
+ :group 'nxhtml)
+
+;; FIX-ME: remember to clear these variable, but where?
+(defvar rngalt-validation-header nil)
+(make-variable-buffer-local 'rngalt-validation-header)
+(put 'rngalt-validation-header 'permanent-local t)
+
+(defvar rngalt-current-schema-file-name nil)
+(make-variable-buffer-local 'rngalt-current-schema-file-name)
+(put 'rngalt-current-schema-file-name 'permanent-local t)
+
+(defvar rngalt-validation-header-overlay nil)
+(make-variable-buffer-local 'rngalt-validation-header-overlay)
+(put 'rngalt-validation-header-overlay 'permanent-local t)
+
+(defvar rngalt-major-mode nil)
+(make-variable-buffer-local 'rngalt-major-mode)
+(put 'rngalt-major-mode 'permanent-local t)
+
+(defvar rngalt-complete-first-try nil
+ "First function to try for completion.
+If non-nil should be a function with no parameters. Used by
+`rngalt-complete'.")
+
+(defvar rngalt-complete-last-try nil
+ "Last function to try for completion.
+If non-nil should be a function with no parameters. Used by
+`rngalt-complete'.")
+
+(defvar rngalt-completing-read-tag nil
+ "Alternate function for completing tag name.
+If non-nil should be a function with the same parameters as
+`completing-read'. Used by `rngalt-complete'.")
+
+(defvar rngalt-completing-read-attribute-name nil
+ "Alternate function for completing attribute name.
+If non-nil should be a function with the same parameters as
+`completing-read'. Used by `rngalt-complete'.")
+
+(defvar rngalt-completing-read-attribute-value nil
+ "Alternate function for completing attribute value.
+If non-nil should be a function with the same parameters as
+`completing-read'. Used by `rngalt-complete'.")
+
+
+(defun rngalt-finish-element ()
+ "Finish the current element by inserting an end-tag.
+Like `nxml-finish-element' but takes `rngalt-validation-header'
+into account."
+ (interactive "*")
+ (rngalt-finish-element-1 nil))
+
+;; Fix-me: Check the other uses of `nxml-finish-element-1'. But this
+;; is maybe not necessary since the only other use is in
+;; `nxml-split-element' and that will anyway work - I believe ...
+(defun rngalt-finish-element-1 (startp)
+ "Insert an end-tag for the current element and optionally a start-tag.
+The start-tag is inserted if STARTP is non-nil. Return the position
+of the inserted start-tag or nil if none was inserted.
+
+This is like `nxml-finish-element-1' but takes
+`rngalt-validation-header' into account."
+ (interactive "*")
+ (let (token-end
+ start-tag-end
+ starts-line
+ ends-line
+ start-tag-indent
+ qname
+ inserted-start-tag-pos)
+ ;; Temporary insert the fictive validation header if any.
+ (let ((buffer-undo-list nil)
+ (here (point-marker)))
+ (when rngalt-validation-header
+ (let ((vh (nth 2 rngalt-validation-header)))
+ (set-marker-insertion-type here t)
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (insert vh)))
+ (goto-char here))
+ (setq token-end (nxml-token-before))
+ (setq start-tag-end
+ (save-excursion
+ (when (and (< (point) token-end)
+ (memq xmltok-type
+ '(cdata-section
+ processing-instruction
+ comment
+ start-tag
+ end-tag
+ empty-element)))
+ (error "Point is inside a %s"
+ (nxml-token-type-friendly-name xmltok-type)))
+ (nxml-scan-element-backward token-end t)))
+ (when start-tag-end
+ (setq starts-line
+ (save-excursion
+ (unless (eq xmltok-type 'start-tag)
+ (error "No matching start-tag"))
+ (goto-char xmltok-start)
+ (back-to-indentation)
+ (eq (point) xmltok-start)))
+ (setq ends-line
+ (save-excursion
+ (goto-char start-tag-end)
+ (looking-at "[ \t\r\n]*$")))
+ (setq start-tag-indent (save-excursion
+ (goto-char xmltok-start)
+ (current-column)))
+ (setq qname (xmltok-start-tag-qname)))
+
+ ;; Undo the insertion of the fictive header:
+ (undo-start)
+ (while (and (not (eq t pending-undo-list))
+ pending-undo-list)
+ (undo-more 1))
+ (goto-char here))
+
+ (unless start-tag-end (error "No more start tags"))
+
+ (when (and starts-line ends-line)
+ ;; start-tag is on a line by itself
+ ;; => put the end-tag on a line by itself
+ (unless (<= (point)
+ (save-excursion
+ (back-to-indentation)
+ (point)))
+ (insert "\n"))
+ (indent-line-to start-tag-indent))
+ (insert "</" qname ">")
+ (when startp
+ (when starts-line
+ (insert "\n")
+ (indent-line-to start-tag-indent))
+ (setq inserted-start-tag-pos (point))
+ (insert "<" qname ">")
+ (when (and starts-line ends-line)
+ (insert "\n")
+ (indent-line-to (save-excursion
+ (goto-char xmltok-start)
+ (forward-line 1)
+ (back-to-indentation)
+ (if (= (current-column)
+ (+ start-tag-indent nxml-child-indent))
+ (+ start-tag-indent nxml-child-indent)
+ start-tag-indent)))))
+ inserted-start-tag-pos))
+
+(defun rngalt-complete ()
+ "Complete the string before point using the current schema.
+Return non-nil if in a context it understands.
+
+This function should be added to `nxml-completion-hook' before
+`rng-complete'. By default it works just like this function, but
+you can add your own completion by setting the variables
+`rngalt-complete-first-try', `rngalt-completing-read-tag',
+`rngalt-completing-read-attribute-name',
+`rngalt-completing-read-attribute-value' and
+`rngalt-complete-last-try'."
+ (interactive)
+ (unless rng-validate-mode
+ (when (y-or-n-p
+ "XML Validation is not on. Do you want to turn it on? ")
+ (rng-validate-mode 1)))
+ (when rng-validate-mode
+ ;; schema file may mismatch if user sets it explicitly:
+ (rngalt-reapply-validation-header)
+ (when rng-current-schema-file-name
+ (rngalt-validate))
+ (or (when rngalt-complete-first-try
+ (funcall rngalt-complete-first-try))
+ (progn
+ (unless rng-current-schema-file-name
+ (when (eq major-mode 'nxhtml-mode)
+ (when (y-or-n-p
+ "There is currently no DTD specified for the buffer.
+This makes XHTML completion impossible. You can add a fictive
+XHTML validation header that sets the DTD to XHTML. This will
+not be inserted in the buffer but completion and XHTML validation
+will assume it is there so both error checking and completion
+will work.
+
+Do you want to add a fictive XHTML validation header? ")
+ (message "") ;; Get rid of the large minibuffer message window
+ (nxhtml-validation-header-mode)
+ )))
+ (let ((lt-pos (save-excursion (search-backward "<" nil t)))
+ xmltok-dtd)
+ (or (and lt-pos
+ (= (rng-set-state-after lt-pos) lt-pos)
+ (or (rngalt-complete-tag lt-pos)
+ (rng-complete-end-tag lt-pos)
+ (rngalt-complete-attribute-name lt-pos)
+ (rngalt-complete-attribute-value lt-pos)))
+ (when rngalt-complete-last-try
+ (funcall rngalt-complete-last-try))))))))
+
+(defun rngalt-validate ()
+ (unless (= (buffer-size) 0)
+ (let ((while-n1 0)
+ (maxn1 20))
+ (condition-case err
+ (while (and (> maxn1 (setq while-n1 (1+ while-n1)))
+ (rng-do-some-validation))
+ nil)
+ (error
+ ;; FIX-ME: for debugging:
+ ;;(lwarn 'rngalt-validate :error "%s" (error-message-string err))
+ (message "rngalt-validate: %s" (error-message-string err))
+ nil))
+ (when (>= while-n1 maxn1)
+ (error "rngalt-validate: Could not validate")))
+ (rng-validate-done)))
+
+(defvar rngalt-region-ovl nil)
+(defvar rngalt-region-prepared nil)
+(defun rngalt-complete-tag-region-prepare ()
+ (unless rngalt-region-prepared
+ (when rngalt-region-ovl
+ (when (overlayp rngalt-region-ovl)
+ (delete-overlay rngalt-region-ovl))
+ (setq rngalt-region-ovl nil))
+ (when (and mark-active
+ transient-mark-mode)
+ (let ((beginning (region-beginning))
+ (end (region-end)))
+ (unless (= (point) (region-beginning))
+ (goto-char beginning))
+ (when (save-excursion
+ (when (re-search-forward "\\=[^<]*\\(?:<[^<]*>\\)*[^>]*" end t)
+ (= end (point))))
+ (setq rngalt-region-ovl (make-overlay beginning end))
+ (overlay-put rngalt-region-ovl 'face 'region)
+ )))
+ (setq rngalt-region-prepared t)))
+
+(defun rngalt-complete-tag-region-cleanup ()
+ (when rngalt-region-prepared
+ (when (overlayp rngalt-region-ovl)
+ (delete-overlay rngalt-region-ovl))
+ (deactivate-mark)
+ (setq rngalt-region-prepared nil)))
+
+(defun rngalt-complete-tag-region-finish ()
+ (when (and rngalt-region-prepared
+ (overlayp rngalt-region-ovl))
+ (let ((here (point)))
+ (insert ">")
+ (goto-char (overlay-end rngalt-region-ovl))
+ (nxml-finish-element)
+ (rngalt-validate)
+ (goto-char here)))
+ (rngalt-complete-tag-region-cleanup))
+
+(defun rngalt-complete-tag (lt-pos)
+ "Like `rng-complete-tag' but with some additions.
+The additions are:
+- Alternate completion.
+- Complete around highlighted region.
+
+See also the variable `rngalt-completing-read-tag'."
+ (let (rng-complete-extra-strings)
+ (when (and (= lt-pos (1- (point)))
+ rng-complete-end-tags-after-<
+ rng-open-elements
+ (not (eq (car rng-open-elements) t))
+ (or rng-collecting-text
+ (rng-match-save
+ (rng-match-end-tag))))
+ (setq rng-complete-extra-strings
+ (cons (concat "/"
+ (if (caar rng-open-elements)
+ (concat (caar rng-open-elements)
+ ":"
+ (cdar rng-open-elements))
+ (cdar rng-open-elements)))
+ rng-complete-extra-strings)))
+ (when (save-excursion
+ (re-search-backward rng-in-start-tag-name-regex
+ lt-pos
+ t))
+ (and rng-collecting-text (rng-flush-text))
+ (rngalt-complete-tag-region-prepare)
+ (let ((completion
+ (let ((rng-complete-target-names
+ (rng-match-possible-start-tag-names))
+ (rng-complete-name-attribute-flag nil))
+ (rngalt-complete-before-point (1+ lt-pos)
+ 'rng-complete-qname-function
+ "Insert tag: "
+ nil
+ 'rng-tag-history
+ rngalt-completing-read-tag)))
+ name)
+ (when completion
+ (cond ((rng-qname-p completion)
+ (setq name (rng-expand-qname completion
+ t
+ 'rng-start-tag-expand-recover))
+ (when (and name
+ (rng-match-start-tag-open name)
+ (or (not (rng-match-start-tag-close))
+ ;; need a namespace decl on the root element
+ (and (car name)
+ (not rng-open-elements))))
+ ;; attributes are required
+ (insert " "))
+ (rngalt-complete-tag-region-finish)
+ (run-hook-with-args 'rngalt-complete-tag-hooks completion)
+ )
+ ((member completion rng-complete-extra-strings)
+ (insert ">")))))
+ (rngalt-complete-tag-region-finish)
+ t)))
+
+(defvar rngalt-complete-tag-hooks nil
+ "Hook run after completing a tag.
+Each function is called with the last name of the last tag
+completed.")
+
+(defun rngalt-complete-attribute-name (lt-pos)
+ "Like `rng-complete-attribute-name' but with alternate completion.
+See the variable `rngalt-completing-read-attribute-name'."
+ (when (save-excursion
+ (re-search-backward rng-in-attribute-regex lt-pos t))
+ (let ((attribute-start (match-beginning 1))
+ rng-undeclared-prefixes)
+ (and (rng-adjust-state-for-attribute lt-pos
+ attribute-start)
+ (let ((rng-complete-target-names
+ (rng-match-possible-attribute-names))
+ (rng-complete-extra-strings
+ (mapcar (lambda (prefix)
+ (if prefix
+ (concat "xmlns:" prefix)
+ "xmlns"))
+ rng-undeclared-prefixes))
+ (rng-complete-name-attribute-flag t)
+ completion)
+ (setq completion
+ (rngalt-complete-before-point attribute-start
+ 'rng-complete-qname-function
+ "Attribute: "
+ nil
+ 'rng-attribute-name-history
+ rngalt-completing-read-attribute-name))
+ (when (and completion
+ (< 0 (length completion)))
+ (insert "=\"")))))
+ t))
+
+(defun rngalt-complete-attribute-value (lt-pos)
+ "Like `rng-complete-attribute-value' but with alternate completion.
+See the variable `rngalt-completing-read-attribute-value'."
+ (when (save-excursion
+ (re-search-backward rng-in-attribute-value-regex lt-pos t))
+ (let ((name-start (match-beginning 1))
+ (name-end (match-end 1))
+ (colon (match-beginning 2))
+ (value-start (1+ (match-beginning 3))))
+ (and (rng-adjust-state-for-attribute lt-pos
+ name-start)
+ (if (string= (buffer-substring-no-properties name-start
+ (or colon name-end))
+ "xmlns")
+ (rngalt-complete-before-point
+ value-start
+ (rng-strings-to-completion-alist
+ (rng-possible-namespace-uris
+ (and colon
+ (buffer-substring-no-properties (1+ colon) name-end))))
+ "Namespace URI: "
+ nil
+ 'rng-namespace-uri-history
+ rngalt-completing-read-attribute-value) ;; fix-me
+ (rng-adjust-state-for-attribute-value name-start
+ colon
+ name-end)
+ (rngalt-complete-before-point
+ value-start
+ (rng-strings-to-completion-alist
+ (rng-match-possible-value-strings))
+ "Value: "
+ nil
+ 'rng-attribute-value-history
+ rngalt-completing-read-attribute-value))
+ (unless (eq (char-after) (char-before value-start))
+ (insert (char-before value-start)))))
+ t))
+
+(defun rngalt-complete-before-point (start table prompt &optional predicate hist altcompl)
+ "Complete text between START and point.
+Works like `rng-complete-before-point' if ALTCOMPL is nil. When
+ALTCOMPL is a function symbol and no completion alternative is
+available from table then this is called instead of
+`compleating-read' with the same parameters."
+ (let* ((orig (buffer-substring-no-properties start (point)))
+ (completion (try-completion orig table predicate))
+ (completing-fun (if altcompl altcompl 'completing-read))
+ (completion-ignore-case t))
+ (cond ((not (or completion completing-fun))
+ (if (string= orig "")
+ (message "No completions available")
+ (message "No completion for %s" (rng-quote-string orig)))
+ (ding)
+ nil)
+ ((eq completion t) orig)
+ ((and completion
+ (not (string= completion orig)))
+ (delete-region start (point))
+ (insert completion)
+ (cond ((not (rng-completion-exact-p completion table predicate))
+ (message "Incomplete")
+ nil)
+ ((eq (try-completion completion table predicate) t)
+ completion)
+ (t
+ (message "Complete but not unique")
+ nil)))
+ (t
+ (setq completion
+ (let ((saved-minibuffer-setup-hook
+ (default-value 'minibuffer-setup-hook)))
+ (add-hook 'minibuffer-setup-hook
+ 'minibuffer-completion-help
+ t)
+ (unwind-protect
+ (funcall completing-fun
+ prompt
+ table
+ predicate
+ nil
+ orig
+ hist)
+ (setq-default minibuffer-setup-hook
+ saved-minibuffer-setup-hook))))
+ (when completion
+ (delete-region start (point))
+ (insert completion))
+ completion))))
+
+(defun rngalt-get-missing-required-attr (single-tag)
+ "Get a list of missing required attributes.
+This is to be used when completing attribute names.
+SINGLE-TAG should be non-nil if the tag has no end tag.
+
+For a typical use see `nxhtml-completing-read-attribute-name' in
+nxhtml.el.
+"
+ ;; FIX-ME: This is a terrible cludge. One day I hope I will
+ ;; understand how to write this ;-)
+ ;;
+ ;; I currently fetch the missing tags from the error message in the
+ ;; error overlay set by rng validate.
+ (let ((here (point)))
+ (unless (save-match-data (looking-at "[^<]\\{,200\\}>"))
+ ;; We can probably add a >, so let us do it:
+ (when single-tag
+ (insert "/"))
+ (insert ">")
+ (rngalt-validate))
+ (goto-char here))
+ (let ((ovl (rng-error-overlay-message (or (rng-error-overlay-after (point))
+ (rng-error-overlay-after (1- (point)))))))
+ ;;(message "ovl=%s" ovl)(sit-for 1)
+ ;;(message "prop ovl=%s" (overlay-properties ovl))(sit-for 1)
+ (when (and ovl
+ (eq (overlay-get ovl 'category) 'rng-error))
+ ;;(message "rng-error")(sit-for 1)
+ (let ((msg (overlay-get ovl 'help-echo)))
+ ;;(message "msg=%s" msg);(sit-for 1)
+ (when (string-match "Missing attributes? \\(.*\\)" msg)
+ ;;(message "0=%s" (match-string 0 msg));(sit-for 1)
+ ;;(message "1=%s" (match-string 1 msg));(sit-for 1)
+ (let* ((matches (match-string 1 msg))
+ (lst (split-string (substring matches 1 (- (length matches) 1)) "\", \"")))
+ ;;(message "matches=%s" matches);(sit-for 2)
+ ;;(message "lst=%s" lst);(sit-for 1)
+ lst))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Validation start state
+
+(defun rngalt-after-change-major ()
+ (unless (and (boundp 'mumamo-set-major-running)
+ mumamo-set-major-running)
+ (setq rngalt-major-mode major-mode)
+ (when (and (derived-mode-p 'nxml-mode)
+ rngalt-validation-header)
+ (rngalt-reapply-validation-header))
+ (rngalt-update-validation-header-overlay)))
+
+(defvar rngalt-validation-header-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'rngalt-minimal-validation-header-toggle)
+ map))
+
+(defun rngalt-update-validation-header-overlay ()
+ (if (and (boundp 'rngalt-display-validation-header)
+ rngalt-display-validation-header
+ rngalt-validation-header
+ (or (derived-mode-p 'nxml-mode)
+ (let ((major-mode rngalt-major-mode))
+ (and major-mode
+ (derived-mode-p 'nxml-mode))))
+ )
+ (progn
+ (if rngalt-validation-header-overlay
+ (move-overlay rngalt-validation-header-overlay 1 1)
+ (setq rngalt-validation-header-overlay (make-overlay 1 1)))
+ (overlay-put rngalt-validation-header-overlay
+ 'priority 1000)
+ ;; Other properties should go to the 'before-string
+ (let* ((validation-header (nth 2 rngalt-validation-header))
+ (header
+ (if rngalt-minimal-validation-header
+ (propertize
+ (concat
+ "*** Fictive XHTML/XML Validation Header: ... "
+ (save-match-data
+ (if (string-match "\\(<[^[:space:]>]+\\)[^>]*>[^<>]*\\'"
+ validation-header)
+ (concat (match-string 1 validation-header) ">")
+ "Error"))
+ "\n")
+ 'face 'rngalt-validation-header-bottom)
+ (concat
+ (propertize "*** Fictive XHTML/XML Validation Header:\n"
+ 'face 'rngalt-validation-header-top)
+ (propertize (concat validation-header "\n")
+ 'face 'rngalt-validation-header-bottom)))))
+ (setq header
+ (propertize
+ header
+ 'help-echo
+ "Click to toggle full/minimal display of header"
+ 'keymap rngalt-validation-header-keymap))
+ (overlay-put rngalt-validation-header-overlay
+ 'before-string header)))
+ (when rngalt-validation-header-overlay
+ (delete-overlay rngalt-validation-header-overlay))))
+
+(defun rngalt-update-validation-header-overlay-everywhere ()
+ (dolist (b (buffer-list))
+ (when (buffer-live-p b)
+ (with-current-buffer b
+ (when rngalt-validation-header
+ (rngalt-update-validation-header-overlay))))))
+
+;; This is exactly the same as the original `rng-set-initial-state'
+;; except when `rngalt-validation-header' is non-nil."
+(defadvice rng-set-initial-state (around
+ rngalt-set-initial-state
+ activate
+ compile
+ )
+ (nxml-ns-init)
+ (rng-match-start-document)
+ (setq rng-open-elements nil)
+ (setq rng-pending-contents nil)
+ (when rngalt-validation-header
+ (let ((state (car rngalt-validation-header)))
+ (rng-restore-state state)))
+ (setq ad-return-value (goto-char (point-min))))
+
+;; (defun rng-new-validate-prepare ()
+;; "Prepare to do some validation, initializing point and the state.
+;; Return t if there is work to do, nil otherwise.
+
+;; This is exactly the same as the original-insert-directory
+;; `rng-validate-prepare' with the difference that the state at
+;; point 1 is set differently if `rngalt-validation-header' is
+;; non-nil.
+
+;; See also `rng-set-initial-state'."
+;; (cond ((= rng-validate-up-to-date-end 1)
+;; (rng-set-initial-state)
+;; t)
+;; ((= rng-validate-up-to-date-end (point-max))
+;; nil)
+;; (t (let ((state
+;; (if (and rngalt-validation-header
+;; (= rng-validate-up-to-date-end 1))
+;; (car rngalt-validation-header)
+;; (get-text-property (1- rng-validate-up-to-date-end)
+;; 'rng-state))))
+;; (cond (state
+;; (rng-restore-state state)
+;; (goto-char rng-validate-up-to-date-end))
+;; (t
+;; (let ((pos (previous-single-property-change
+;; rng-validate-up-to-date-end
+;; 'rng-state)))
+;; (cond (pos
+;; (rng-restore-state
+;; (or (get-text-property (1- pos) 'rng-state)
+;; (error "Internal error: state null")))
+;; (goto-char pos))
+;; (t (rng-set-initial-state))))))))))
+
+
+;; For as-external.el
+;;;###autoload
+(defun rngalt-set-validation-header (start-of-doc)
+ (let ((old-rvm rng-validate-mode))
+ (when old-rvm (rng-validate-mode -1))
+ (if start-of-doc
+ (progn
+ (add-hook 'after-change-major-mode-hook 'rngalt-after-change-major nil t)
+ (setq rngalt-validation-header (rngalt-get-state-after start-of-doc))
+ (rng-set-schema-file-1 (cadr rngalt-validation-header))
+ (setq rngalt-current-schema-file-name rng-current-schema-file-name)
+ (setq rng-compile-table nil)
+ (setq rng-ipattern-table nil)
+ (setq rng-last-ipattern-index nil))
+ (remove-hook 'after-change-major-mode-hook 'rngalt-after-change-major t)
+ (setq rngalt-validation-header nil)
+ (when old-rvm
+ (rng-set-vacuous-schema)
+ (rng-auto-set-schema)))
+ (when old-rvm
+ (rng-validate-mode 1)
+ (rngalt-update-validation-header-overlay)
+ (rngalt-update-validation-header-buffer))))
+
+(defun rngalt-reapply-validation-header ()
+ (when rngalt-validation-header
+ (when (or (not rng-current-schema-file-name)
+ (unless (string= rngalt-current-schema-file-name rng-current-schema-file-name)
+ (lwarn 'schema-mismatch :warning
+ "XHTML validation header schema %s reapplied (replaces %s)"
+ (file-name-nondirectory rngalt-current-schema-file-name)
+ (file-name-nondirectory rng-current-schema-file-name))
+ t))
+ (rngalt-set-validation-header (nth 2 rngalt-validation-header)))))
+
+;; (defun rngalt-clear-validation-header ()
+;; "Remove XML validation header from current buffer.
+;; For more information see `rngalt-show-validation-header'."
+;; (interactive)
+;; (rngalt-set-validation-header nil)
+;; (rng-auto-set-schema t))
+
+;; FIX-ME: Add edit header?
+
+(defun rngalt-get-validation-header-buffer ()
+ (let ((b (get-buffer " *XML Validation Header*")))
+ (unless b
+ (setq b (get-buffer-create " *XML Validation Header*"))
+ (with-current-buffer b
+ ;;(fundamental-mode)
+ (nxml-mode)))
+ b))
+
+(defun rngalt-get-state-after (start-of-doc)
+ ;; FIX-ME: better buffer name?
+ (let ((statebuf (rngalt-get-validation-header-buffer)))
+ (with-current-buffer statebuf
+ (when rng-validate-mode (rng-validate-mode -1))
+ (erase-buffer)
+ (insert start-of-doc)
+ ;; From rng-get-state
+ (setq rng-match-state nil)
+ (setq nxml-ns-state nil)
+ (setq rng-open-elements nil)
+ ;; From rng-match-init-buffer
+ (setq rng-compile-table nil)
+ (setq rng-ipattern-table nil)
+ (setq rng-last-ipattern-index nil)
+
+ (nxml-mode)
+ (rng-validate-mode 1)
+ (rngalt-validate)
+ (let* ((state (rng-get-state))
+ (cp-state (copy-tree state)))
+ ;;(if (equal state cp-state) (message "(equal state cp-state)=t") (message "(equal state cp-state)=nil"))
+ ;; Fix-me: is the copy-tree necessary here?
+ (list
+ cp-state
+ (rng-locate-schema-file)
+ start-of-doc)))))
+
+(defun rngalt-show-validation-header ()
+ "Show XML validation header used in current buffer.
+The XML validation header is used in `nxhtml-mode' to set a state
+for XML validation at the start of the buffer.
+
+The purpose is to make it possible to use `nxml-mode' completion
+in buffers where you do not actually have a full XML file. This
+could for example be a buffer with PHP code or a buffer with a
+blog entry.
+
+More techhnical info: This can be used by any mode derived from
+`nxml-mode'. To use it in other modes than `nxhtml-mode' replace
+`rng-complete' by `rngalt-complete' in `nxml-completion-hook'."
+ (interactive)
+ (unless (derived-mode-p 'nxml-mode)
+ (error "Buffer mode is not an nXml type major mode: %s" major-mode))
+ (rngalt-update-validation-header-buffer)
+ (display-buffer (rngalt-get-validation-header-buffer) t))
+
+(defun rngalt-update-validation-header-buffer ()
+ (let ((vh (nth 2 rngalt-validation-header))
+ (cb (current-buffer)))
+ (with-current-buffer (rngalt-get-validation-header-buffer)
+ (erase-buffer)
+ (if (not vh)
+ (setq header-line-format (concat " No XML validation header in buffer "
+ (buffer-name cb)))
+ (insert vh)
+ (setq header-line-format (concat " XML validation header in buffer "
+ (buffer-name cb)))))))
+
+;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+
+(provide 'rngalt)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; rngalt.el ends here
--- /dev/null
+;;; tidy-xhtml.el --- Interface to the HTML Tidy program
+
+;; Copyright (C) 2001, 2002, 2003, 2006, 2007 by Free Software
+;; Foundation, Inc.
+
+;; Emacs Lisp Archive Entry
+;; Ancestors filename: tidy.el
+;; Author: Kahlil (Kal) HODGSON <dorge@tpg.com.au>
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Original X-URL: http://www.emacswiki.org/elisp/tidy.el
+;; Last-Updated: 2008-03-09T13:10:06+0100 Sun
+(defconst tidy-xhtml:version "2.25")
+;; Keywords: languages
+
+;; This file is NOT part of GNU Emacs.
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;;; Commentary:
+
+;; Provides a simple interface to the HTML Tidy program -- a free
+;; utility that can fix common errors in your mark-up and clean up
+;; sloppy editing automatically. See
+;;
+;; <http://tidy.sourceforge.net/>
+;;
+;; for more details. This package provides the following functions:
+;;
+;; `tidy-buffer',
+;; `tidy-region',
+;; `tidy-tree',
+;; `tidy-html-site',
+;; `tidy-parse-config-file',
+;; `tidy-save-settings',
+;; `tidy-describe-options',
+;; `tidy-show-xhtml-options',
+;; `tidy-set-xhtml-options',
+;;
+;; These can be invoked interactively (using M-x) or via the menu-bar.
+;; The function `tidy-buffer' sends the current buffer to HTML Tidy,
+;; replacing the existing contents with a "tidied" version. If
+;; `tidy-buffer' is given a prefix argument, tidy operates on the
+;; current region, ignoring mark-up outside <BODY>...</BODY> tags
+;; (useful for writhing cgi scripts in Pearl). Warnings and errors
+;; are presented in a compilation buffer to facilitate tracking down
+;; necessary changes (e.g. C-x ` is bound to `next-error').
+;;
+;; This package also provides menu-bar support for setting Tidy's many
+;; options, and includes support for Tidy configuration files. The
+;; function `tidy-parse-config-file' will synchronise options
+;; displayed in the menu-bar with the settings in `tidy-config-file'.
+;; This is normally called by the load-hook for your HTML editing mode
+;; (see installation instructions below). The function
+;; `tidy-save-settings' will save the current option settings to your
+;; `tidy-config-file'. Finally `tidy-describe-options' allows you to
+;; browse the documentation strings associated with each option.
+
+;;;
+
+;;;; Installation:
+
+;; This package assumes you have and up-to-date HTML Tidy program
+;; installed on your system. See the URL above for instructions on
+;; how to do this. To set up this support package, first place the
+;; "tidy.el" file somewhere in your `load-path' and open it in Emacs.
+;; Byte-compile and load this package using the command
+;;
+;; M-x emacs-lisp-byte-compile-and-load <RET>
+;;
+;; Next customise the variables `tidy-config-file', `tidy-temp-dir'
+;; `tidy-shell-program', `tidy-menu-lock' and `tidy-menu-x-position'
+;;
+;; M-x customize-group <RET> tidy <RET>
+;;
+;; Now add the following autoloads to your ".emacs.el" file:
+;;
+;; (autoload 'tidy-buffer "tidy" "Run Tidy HTML parser on current buffer" t)
+;; (autoload 'tidy-parse-config-file "tidy" "Parse the `tidy-config-file'" t)
+;; (autoload 'tidy-save-settings "tidy" "Save settings to `tidy-config-file'" t)
+;; (autoload 'tidy-build-menu "tidy" "Install an options menu for HTML Tidy." t)
+;;
+;; If you use html-mode to edit HTML files then add something like
+;; this as well
+
+;; (defun my-html-mode-hook () "Customize my html-mode."
+;; (tidy-build-menu html-mode-map)
+;; (local-set-key [(control c) (control c)] 'tidy-buffer)
+;; (setq sgml-validate-command "tidy"))
+;;
+;; (add-hook 'html-mode-hook 'my-html-mode-hook)
+
+;; This will set up a "tidy" menu in the menu bar and bind the key
+;; sequence "C-c C-c" to `tidy-buffer' in html-mode (normally bound to
+;; `validate-buffer').
+;;
+;; For other modes (like html-helper-mode) simple change the variables
+;; `html-mode-hook' and `html-mode-map' to whatever is appropriate e.g.
+
+;; (defun my-html-mode-hook () "Customize my html-helper-mode."
+;; (tidy-build-menu html-helper-mode-map)
+;; (local-set-key [(control c) (control c)] 'tidy-buffer)
+;; (setq sgml-validate-command "tidy"))
+;;
+;; (add-hook 'html-helper-mode-hook 'my-html-mode-hook)
+
+;; Finally, restart Emacs and open an HTML file to test-drive the tidy
+;; package. For people new to HTML tidy check that the option "markup"
+;; under the "Input/Output" sub menu is set. You can read the
+;; documentation on this option via the menu item "Describe Options".
+;;
+;; Enjoy!
+
+;;;; New Features:
+;;
+;; 0. Now compatible with CVS version of Tidy as at 22 May 2003
+;; 1. Improved menu support to facillitate incorporting new options
+;; 2. Menu lock option makes menu stick when toggling options.
+;; 3. Now runs on XEmacs!!
+;; 4. Uses error file rather than std-error to retrieve errors (this
+;; fixes some odd pop up behaviour)
+;; 5. minor bug fix (empty config files)
+;; 6. handle buffer modified query in error buffer better
+;; 7. make it impossible to mark the error buffer as modified
+;; 8. Added the variable `tidy-temp-directory'.
+;; 9. Bugfix in tidy-buffer: call find-file-noselect with NOWARN
+;; 10. Removes ^M on w32.
+;; 11. Changed defcustom types to 'file and 'directory.
+;; 12. Added `tidy-set-xhtml-options'.
+;; 13. Tried to handle encodings.
+;; 14. Added the function `tidy-region'.
+;; 15. Added ediff support.
+;; 16. Added `tidy-tree'.
+;; 17. Added `tidy-html-site'.
+
+;;;; ToDo:
+;;
+;; 1. Automatically set "char-encoding" according to the buffer encoding
+;; 2. Should check value of HTML_TIDY environment variable.
+
+
+;;;; Bugs:
+
+;; Requires a version of HTML Tidy that understands the "-f"
+;; "-config" "--show-body-only" command line options e.g. source-forge
+;; pre-release.
+;;
+;; There may be a bug with setting doctypes. I don't use this feature
+;; yet and, well, don't really know how its supposed to work:-)
+;;
+;; Care with character encodings!!
+
+
+;;; History:
+
+;; 2006-05-09: New features 10-17 above.
+;; - Lennart Borgman
+;; 2006-05-24: Fixed some errors spotted by Andreas Roethler.
+
+
+;;;; Credits
+
+;; This code was inspired by an Emacs "tip" suggested by Pete Gelbman.
+;;
+;; Thanks to Hans-Michael Stahl for comments regarding XEmacs
+;; compatibility.
+;;
+;; Thanks to Thomas Baumann for bugfix's in `tidy-parse-config-file'
+;; and `tidy-buffer'.
+;;
+;; Thanks to Chris Lott for comments regarding installation and menu
+;; display
+;;
+;; Thanks to Jeroen Baekelandt for noting a problem with ange-ftp and
+;; inspiring `tidy-temp-directory'.
+
+;;;; Code:
+
+;;;;; Forward references (stuff which must come first)
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'ediff))
+(eval-when-compile (require 'mumamo nil t))
+(eval-when-compile (require 'ourcomments-util nil t))
+(eval-when-compile
+ (add-to-list 'load-path default-directory))
+(eval-when-compile (require 'html-site nil t))
+(require 'easymenu) ;; This makes menus so much easier!
+(require 'compile) ;; To make the error buffer more sexy
+(require 'cus-edit) ;; Just for face custom-button
+(require 'help-mode)
+
+;; The following two are functions so that the same compiled code will
+;; work in both situations (time cost is negligible)
+
+(defsubst tidy-xemacs-p ()
+ "Return t iff we are running XEmacs this session."
+ (not (null (string-match "^XEmacs.*" (emacs-version)))))
+
+(defsubst tidy-windows-p ()
+ "Return t iff we are running on a Windows system."
+ (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
+
+;; function definitions
+
+;; XEmacs
+(defalias 'tidy-x-event-function 'event-function)
+(defalias 'tidy-x-event-object 'event-object)
+(defalias 'tidy-x-find-menu-item 'find-menu-item)
+(defalias 'tidy-x-get-popup-menu-response 'get-popup-menu-response)
+(defalias 'tidy-x-make-event 'make-event)
+(defalias 'tidy-x-misc-user-event-p 'misc-user-event-p)
+
+;;;;; User Variables
+
+;;;###autoload
+(defgroup tidy nil
+ "Provides a simple interface to the HTML Tidy program -- a free
+utility that can fix common errors in your mark-up and clean up
+sloppy editing automatically. See
+
+ <http://tidy.sourceforge.net/>
+
+for more details. This package provides the following functions:
+
+ `tidy-buffer',
+ `tidy-parse-config-file',
+ `tidy-save-settings', and
+ `tidy-describe-options',
+
+These can be invoked interactively (using M-x) or via the menu-bar.
+The function `tidy-buffer' sends the current buffer to HTML Tidy,
+replacing the existing contents with a \"tidied\" version. If
+`tidy-buffer' is given a prefix argument, tidy operates on the
+current region, ignoring mark-up outside <BODY>...</BODY> tags
+\(useful for writhing cgi scripts in Pearl). Warnings and errors
+are presented in a compilation buffer to facilitate tracking down
+necessary changes (e.g. C-x ` is bound to `next-error').
+
+This package also provides menu-bar support for setting Tidy's many
+options, and includes support for Tidy configuration files. The
+function `tidy-parse-config-file' will synchronise options
+displayed in the menu-bar with the settings in `tidy-config-file'.
+This is normally called by the load-hook for your HTML editing mode
+\(see installation instructions below). The function
+`tidy-save-settings' will save the current option settings to your
+`tidy-config-file'. Finally `tidy-describe-options' allows you to
+browse the documentation strings associated with each option.
+"
+ :group 'nxhtml
+ :group 'hypermedia)
+
+;; (defcustom tidy-use-ediff nil
+;; "If non-nil call ediff in `tidy-buffer' instead of replacing."
+;; :group 'tidy
+;; :type 'boolean)
+
+(defvar tidy-warnings 0)
+(defvar tidy-errors 0)
+(defvar tidy-message nil)
+
+;;(defvar tidy-batch-buffer nil)
+(defvar tidy-batch-last-file nil)
+
+(defvar tidy-default-config-file "~/.tidyrc")
+
+(defvar tidy-config-file-parsed nil)
+
+(defcustom tidy-config-file tidy-default-config-file
+ "Path to your default tidy configuration file.
+
+This is used by `tidy-parse-config-file' to synchronise Tidy's behaviour
+inside Emacs with its behaviour outside, and by `tidy-save-settings' to
+set your configuration file from within Emacs. If you never want this to
+happen, set `tidy-config-file' to \"\"."
+ :group 'tidy
+ :type 'file
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (if (file-readable-p value)
+ ;; Just set the default values here:
+ ;;(tidy-parse-config-file)
+ ;; Just tell we need to parse:
+ (setq tidy-config-file-parsed nil)
+ (if (file-exists-p value)
+ (lwarn '(tidy-config-file)
+ :warning "Tidy config file not readable: %s" value)
+ (unless (string= value tidy-default-config-file)
+ (lwarn '(tidy-config-file)
+ :warning "Tidy config file not found: %s" value))))))
+
+
+(defcustom tidy-shell-program "tidy"
+ "The HTML program."
+ :group 'tidy
+ :type '(choice (file :must-match t)
+ (string :tag "File name (searched for in path): "))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (unless (string= value "tidy")
+ (or (file-executable-p value)
+ (executable-find value)
+ (lwarn '(tidy-shell-program)
+ :error "Tidy program not found: %s" value)))))
+
+(defcustom tidy-temp-directory temporary-file-directory
+ "Directory where tidy places its temp files. The default is the
+current directory which works fine unless you are operating on remote
+files via `ange-ftp' and its ilk, in which case it will try to place
+the temp files on the remote server (and will probably fail). If this
+is the case try setting this variable to something like \"/tmp/\" or
+\"/var/tmp/\"."
+ :group 'tidy
+ :type 'directory
+ :set-after '(temporary-file-directory))
+
+(defcustom tidy-menu-lock t
+ " *Non-nil means menu is locked (i.e. doesn't pop down) when
+selecting toggle and radio options.
+
+See also `tidy-menu-x-position'."
+ :type 'boolean
+ :group 'tidy)
+
+(defcustom tidy-menu-x-position 211
+ "Specify menu position height in pixels.
+
+This variable is used to set the horizontal position of the locked
+menu, so don't forget to adjust it if menu position is not ok.
+
+See also `tidy-menu-lock'."
+ :type 'integer
+ :group 'tidy)
+
+;;;;; Local Variables
+
+(defvar tidy-debug nil
+ "If t then we rebuild everything on reload. Useful for debugging.")
+
+;;(eval-when-compile (setq tidy-debug t))
+
+(defun tidy-toggle-debug ()
+ "Toggle value of tidy-debug."
+ (interactive)
+ (message "tidy-debug is %s" (setq tidy-debug (not tidy-debug))))
+
+;; (defun tidy-boolean-option-value (symbol)
+;; "Return t when the symbol's value is \"yes\"."
+;; (let ((name (symbol-name symbol)))
+;; (assert (string= "tidy-" (substring name 0 5)))
+;; (setq name (substring name 5))
+;; (let ((entry (assoc name tidy-options-alist)))
+;; (assert (string= "Boolean" (nth 2 entry)))))
+;; (when (symbol-value symbol)
+;; (string= (symbol-value symbol))))
+
+(defvar tidy-options-alist nil
+ "An alist containing all valid tidy options.
+Each element is a list of the form
+ (NAME, SUB-MENU, VALUE-TYPE, DEFAULT-VALUE, DOC-STRING).
+This is used to automatically construct variables and a menu bar.
+To add new or modify exiting options simply modify this list.")
+
+;; Fix-me: built the options list dynamically, point to
+;; http://tidy.sourceforge.net/docs/quickref.html for help
+(defun tidy-build-options-alist ()
+ (when (and tidy-shell-program
+ (executable-find tidy-shell-program))
+ (let ((outbuf (get-buffer-create "* Tidy options *")))
+ (call-process tidy-shell-program
+ nil ;; No input
+ outbuf ;; Output here
+ nil ;; Do not display
+ "-help-config")
+ (switch-to-buffer outbuf))))
+
+(when (or (null tidy-options-alist) tidy-debug)
+ (setq tidy-options-alist
+ '(
+ ("add-xml-decl" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should add the XML declaration when
+outputting XML or XHTML. Note that if the input already includes an <?xml
+... ?> declaration then this option will be ignored.")
+
+;; ("add-xml-pi" "Fix Markup" "Boolean" "no"
+;; "
+;; Type: Boolean
+;; Default: no
+;; Example: y/n, yes/no, t/f, true/false, 1/0
+
+;; This option is the same as the add-xml-decl option.")
+
+ ("add-xml-space" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should add xml:space=\"preserve\" to elements
+such as <PRE>, <STYLE> and <SCRIPT> when generating XML. This is needed if
+the whitespace in such elements is to be parsed appropriately without
+having access to the DTD.")
+
+ ("alt-text" "Fix Markup" "String" ""
+ "
+Type: String
+Default: -none-
+
+This option specifies the default \"alt=\" text Tidy uses for <IMG>
+attributes. This feature is dangerous as it suppresses further
+accessibility warnings. You are responsible for making your documents
+accessible to people who can not see the images!")
+
+ ("ascii-chars" "Fix Markup" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+Can be used to modify behavior of -c (--clean yes) option.
+Defaults to \"yes\" when using -c. Set to \"no\" to prevent
+converting &emdash;, ”, and other named character entities
+to their ascii equivalents.")
+
+ ("assume-xml-procins" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should change the parsing of processing
+instructions to require ?> as the terminator rather than >. This option is
+automatically set if the input is in XML.")
+
+ ("bare" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should strip Microsoft specific HTML from
+Word 2000 documents, and output spaces rather than non-breaking spaces
+where they exist in the input.")
+
+ ("break-before-br" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should output a line break before each <BR>
+element.")
+
+ ("char-encoding" "Encoding" "Encoding" "ascii"
+ "
+Type: Encoding
+Default: ascii
+Example: ascii, latin1, raw, utf8, iso2022, mac, win1252
+
+This option specifies the character encoding Tidy uses for both the input
+and output. Possible values are: ascii, latin1, raw, utf8, iso2022, mac,
+win1252. For ascii, Tidy will accept Latin-1 (ISO-8859-1) character
+values, but will use entities for all characters whose value > 127. For
+raw, Tidy will output values above 127 without translating them into
+entities. For latin1, characters above 255 will be written as
+entities. For utf8, Tidy assumes that both input and output is encoded as
+UTF-8. You can use iso2022 for files encoded using the ISO-2022 family of
+encodings e.g. ISO-2022-JP. For mac and win1252, Tidy will accept vendor
+specific character values, but will use entities for all characters whose
+value > 127.")
+
+ ("clean" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should strip out surplus presentational tags
+and attributes replacing them by style rules and structural markup as
+appropriate. It works well on the HTML saved by Microsoft Office products.")
+
+ ("doctype" "Fix Markup" "DocType" "auto"
+ "
+Type: DocType
+Default: auto
+Example: auto, omit, strict, loose, transitional, user specified fpi \(string\)
+
+This option specifies the DOCTYPE declaration generated by Tidy. If set to
+\"omit\" the output won't contain a DOCTYPE declaration. If set to \"auto\"
+\(the default\) Tidy will use an educated guess based upon the contents of
+the document. If set to \"strict\", Tidy will set the DOCTYPE to the strict
+DTD. If set to \"loose\", the DOCTYPE is set to the loose \(transitional\)
+DTD. Alternatively, you can supply a string for the formal public
+identifier \(FPI\). For example:
+
+ doctype: \"-//ACME//DTD HTML 3.14159//EN\"
+
+If you specify the FPI for an XHTML document, Tidy will set
+the system identifier to the empty string. Tidy leaves the DOCTYPE for
+generic XML documents unchanged.")
+
+ ("drop-empty-paras" "Fix Markup" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should discard empty paragraphs. If set to
+no, empty paragraphs are replaced by a pair of <BR> elements as HTML4
+precludes empty paragraphs.")
+
+ ("drop-font-tags" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should discard <FONT> and <CENTER> tags
+rather than creating the corresponding style rules, but only if the clean
+option is also set to yes.")
+
+ ("drop-proprietary-attributes" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should strip out proprietary attributes,
+such as MS data binding attributes.")
+
+ ("enclose-block-text" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should insert a <P> element to enclose any
+text it finds in any element that allows mixed content for HTML
+transitional but not HTML strict.")
+
+ ("enclose-text" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should enclose any text it finds in the body
+element within a <P> element. This is useful when you want to take
+existing HTML and use it with a style sheet.")
+
+;; ("error-file" "Omit" "String" "-none-"
+;; "
+;; Type: String
+;; Default: -none-
+
+;; This option specifies the error file Tidy uses for errors and
+;; warnings. Normally errors and warnings are output to \"stderr\".
+
+;; This is option is ignored in Emacs.")
+
+ ("escape-cdata" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should convert <![CDATA[]]> sections to
+normal text.")
+
+ ("fix-backslash" "Fix Markup" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should replace backslash characters \"\\\" in
+URLs by forward slashes \"/\".")
+
+ ("fix-bad-comments" "Fix Markup" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should replace unexpected hyphens with \"=\"
+characters when it comes across adjacent hyphens. The default is yes. This
+option is provided for users of Cold Fusion which uses the comment syntax:
+<!--- --->")
+
+ ("fix-uri" "Fix Markup" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should check attribute values that carry
+URIsfor illegal characters and if such are found, escape them as HTML 4
+recommends.")
+
+ ("force-output" "Input/Output" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should produce output even if errors are
+encountered. Use this option with care - if Tidy reports an error,
+this means Tidy was not able to, or is not sure how to, fix the error,
+so the resulting output may not reflect your intention.")
+
+;; ("gnu-emacs" "Omit" "Boolean" "no"
+;; "
+;; Type: Boolean
+;; Default: no
+;; Example: y/n, yes/no, t/f, true/false, 1/0
+
+;; This option specifies if Tidy should change the format for reporting
+;; errors and warnings to a format that is more easily parsed by GNU
+;; Emacs.
+
+;; This option is automatically set in Emacs." )
+
+ ("hide-comments" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should print out comments.")
+
+ ("hide-endtags" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should omit optional end-tags when
+generating the pretty printed markup. This option is ignored if you are
+outputting to XML.")
+
+ ("indent" "Indentation" "AutoBool" "no"
+ "
+Type: AutoBool
+Default: no
+Example: auto, y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should indent block-level tags. If set to
+\"auto\", this option causes Tidy to decide whether or not to indent the
+content of tags such as TITLE, H1-H6, LI, TD, TD, or P depending on whether
+or not the content includes a block-level element. You are advised to avoid
+setting indent to yes as this can expose layout bugs in some browsers.")
+
+ ("indent-attributes" "Indentation" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should begin each attribute on a new line.")
+
+ ("indent-cdata" "Indent" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should indent <![CDATA[]]> sections.")
+
+ ("indent-spaces" "Indentation" "Integer" "2"
+ "
+Type: Integer
+Default: 2
+Example: 0, 1, 2, ...
+
+This option specifies the number of spaces Tidy uses to indent content,
+when indentation is enabled.")
+
+ ("input-encoding" "Encoding" "Encoding" "latin1"
+ "
+Type: Encoding
+Default: ascii
+Example: ascii, latin1, raw, utf8, iso2022, mac, win1252
+
+This option specifies the character encoding Tidy uses for the input. See
+char-encoding for more info.")
+
+ ("input-xml" "Input/Output" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should use the XML parser rather than the
+error correcting HTML parser.")
+
+ ("join-classes" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should combine class names to generate a
+single new class name, if multiple class assignments are detected on an
+element.")
+
+ ("join-styles" "Fix Markup" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should combine styles to generate a single
+new style, if multiple style values are detected on an element.")
+
+ ("keep-time" "Preference" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should alter the last modified time for
+files it writes back to. The default is no, which allows you to tidy files
+without affecting which ones will be uploaded to a Web server when using a
+tool such as 'SiteCopy'. Note that this feature may not work on some
+platforms.")
+
+ ("literal-attributes" "Preference" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should ensure that whitespace characters
+within attribute values are passed through unchanged.")
+
+ ("logical-emphasis" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should replace any occurrence of <I> by <EM>
+and any occurrence of <B> by <STRONG>. In both cases, the attributes are
+preserved unchanged. This option can be set independently of the clean and
+drop-font-tags options.")
+
+ ("lower-literals" "Preference" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should convert the value of an attribute
+that takes a list of predefined values to lower case. This is required for
+XHTML documents.")
+
+ ("markup" "Input/Output" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should generate a pretty printed version of
+the markup. Note that Tidy won't generate a pretty printed version if it
+finds significant errors (see force-output).")
+
+ ("ncr" "Preference" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should allow numeric character references.")
+
+ ("newline" "Encoding" "Encoding" "LF"
+ "
+Type: Encoding
+Default: LF
+Example: LF, CRLF, CR
+
+Line ending style. \(Only used in batch operations here.\)")
+
+ ("new-blocklevel-tags" "Tags" "Tag names" ""
+ "
+Type: Tag names
+Default: -none-
+Example: tagX, tagY, ...
+
+This option specifies new block-level tags. This option takes a space or
+comma separated list of tag names. Unless you declare new tags, Tidy will
+refuse to generate a tidied file if the input includes previously unknown
+tags. Note you can't change the content model for elements such as
+<TABLE>, <UL>, <OL> and <DL>.")
+
+ ("new-empty-tags" "Tags" "Tag names" ""
+ "
+Type: Tag names
+Default: -none-
+Example: tagX, tagY, ...
+
+This option specifies new empty inline tags. This option takes a space or
+comma separated list of tag names. Unless you declare new tags, Tidy will
+refuse to generate a tidied file if the input includes previously unknown
+tags. Remember to also declare empty tags as either inline or blocklevel.")
+
+ ("new-inline-tags" "Tags" "Tag names" ""
+ "
+Type: Tag names
+Default: -none-
+Example: tagX, tagY, ...
+
+This option specifies new non-empty inline tags. This option takes a space
+or comma separated list of tag names. Unless you declare new tags, Tidy
+will refuse to generate a tidied file if the input includes previously
+unknown tags.")
+
+ ("new-pre-tags" "Tags" "Tag names" ""
+ "
+Type: Tag names
+Default: -none-
+Example: tagX, tagY, ...
+
+This option specifies new tags that are to be processed in exactly the
+same way as HTML's <PRE> element. This option takes a space or comma
+separated list of tag names. Unless you declare new tags, Tidy will refuse
+to generate a tidied file if the input includes previously unknown
+tags. Note you can not as yet add new CDATA elements (similar to
+<SCRIPT>).")
+
+ ("numeric-entities" "Preference" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should output entities other than the
+built-in HTML entities \(&, <, > and "\) in the numeric
+rather than the named entity form.")
+
+ ("output-bom" "Encoding" "AutoBool" "auto"
+ "
+Type: AutoBool
+Default: auto
+Example: auto, y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should write a Unicode Byte Order Mark
+character (BOM; also known as Zero Width No-Break Space; has value of
+U+FEFF) to the beginning of the output; only for UTF-8 and UTF-16 output
+encodings. If set to \"auto\", this option causes Tidy to write a BOM to the
+output only if a BOM was present at the beginning of the input. A BOM is
+always written for XML/XHTML output using UTF-16 output encodings.")
+
+ ("output-encoding" "Encoding" "Encoding" "ascii"
+ "
+Type: Encoding
+Default: ascii
+Example: ascii, latin1, raw, utf8, iso2022, mac, win1252
+
+This option specifies the character encoding Tidy uses for the output. See
+char-encoding for more info. May only be different from input-encoding for
+Latin encodings (ascii, latin1, mac, win1252).")
+
+ ("output-xhtml" "Input/Output" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should generate pretty printed output,
+writing it as extensible HTML. This option causes Tidy to set the DOCTYPE
+and default namespace as appropriate to XHTML. If a DOCTYPE or namespace
+is given they will checked for consistency with the content of the
+document. In the case of an inconsistency, the corrected values will
+appear in the output. For XHTML, entities can be written as named or
+numeric entities according to the setting of the \"numeric-entities\"
+option. The original case of tags and attributes will be preserved,
+regardless of other options.")
+
+ ("output-xml" "Input/Output" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should pretty print output, writing it as
+well-formed XML. Any entities not defined in XML 1.0 will be written as
+numeric entities to allow them to be parsed by a XML parser. The original
+case of tags and attributes will be preserved, regardless of other
+options.")
+
+ ("quiet" "Input/Output" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should output the summary of the numbers of
+errors and warnings, or the welcome or informational messages.")
+
+ ("quote-ampersand" "Preference" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should output unadorned & characters as
+&.")
+
+ ("quote-marks" "Preference" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should output \" characters as " as is
+preferred by some editing environments. The apostrophe character \' is
+written out as ' since many web browsers don't yet support '.")
+
+ ("quote-nbsp" "Preference" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should output non-breaking space characters
+as entities, rather than as the Unicode character value 160 (decimal).")
+
+ ("raw" "Omit" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0 char-encoding
+
+Currently not used, but this option would be the same as the
+char-encoding: raw option.")
+
+ ("repeated-attributes" "Fix Markup" ("keep-first" "keep-last") "keep-last"
+ "
+Type: -
+Default: keep-last
+Example: keep-first, keep-last
+
+This option specifies if Tidy should keep the first or last attribute, if
+an attribute is repeated, e.g. has two align attributes.")
+
+
+ ("replace-color" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should replace numeric values in color
+attributes by HTML/XHTML color names where defined, e.g. replace
+\"#ffffff\" with \"white\"." )
+
+ ("slide-style" "Omit" "String"
+ "
+Type: Name
+Default: -none-
+split Currently not used.")
+
+;; ("show-body-only" "Omit" "Boolean" "no"
+;; "
+;; Type: Boolean
+;; Default: no
+;; Example: y/n, yes/no, t/f, true/false, 1/0
+
+;; This option specifies if Tidy should print only the contents of the body
+;; tag as an HTML fragment. Useful for incorporating existing whole pages as
+;; a portion of another page.
+
+;; Emacs overrides this option.")
+
+ ("show-errors" "Input/Output" "Integer" "6"
+ "
+Type: Integer
+Default: 6
+Example: 0, 1, 2, ...
+
+This option specifies the number Tidy uses to determine if further errors
+should be shown. If set to 0, then no errors are shown.")
+
+ ("show-warnings" "Input/Output" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should suppress warnings. This can be useful
+when a few errors are hidden in a flurry of warnings.")
+
+ ("slide-style" "Omit" "String" ""
+ "
+Type: Name
+Default: -none-
+
+Currently not used.")
+
+ ("split" "Omit" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should create a sequence of slides from
+the input, splitting the markup prior to each successive <H2>. The
+slides are written to \"slide001.html\", \"slide002.html\" etc.
+
+There is currently no Emacs support for this option.")
+
+ ("tab-size" "Indentation" "Integer" "4"
+ "
+Type: Integer
+Default: 4
+Example: 0, 1, 2, ...
+
+This option specifies the number of columns that Tidy uses between
+successive tab stops. It is used to map tabs to spaces when reading the
+input. Tidy never outputs tabs.")
+
+ ("tidy-mark" "Preference" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should add a meta element to the document
+head to indicate that the document has been tidied. Tidy won't add a meta
+element if one is already present.")
+
+ ("uppercase-attributes" "Preference" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should output attribute names in upper
+case. The default is no, which results in lower case attribute names,
+except for XML input, where the original case is preserved.")
+
+ ("uppercase-tags" "Preference" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should output tag names in upper case. The
+default is no, which results in lower case tag names, except for XML
+input, where the original case is preserved.")
+
+ ("word-2000" "Fix Markup" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should go to great pains to strip out all
+the surplus stuff Microsoft Word 2000 inserts when you save Word documents
+as \"Web pages\". Doesn't handle embedded images or VML.")
+
+ ("wrap" "Line Wrapping" "Integer" "68"
+ "
+Type: Integer
+Default: 68
+Example: 0, 1, 2, ...
+
+This option specifies the right margin Tidy uses for line wrapping. Tidy
+tries to wrap lines so that they do not exceed this length. Set wrap to
+zero if you want to disable line wrapping.")
+
+ ("wrap-asp" "Line Wrapping" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should line wrap text contained within ASP
+pseudo elements, which look like: <% ... %>.")
+
+ ("wrap-attributes" "Line Wrapping" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should line wrap attribute values, for
+easier editing. This option can be set independently of
+wrap-script-literals.")
+
+ ("wrap-jste" "Line Wrapping" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should line wrap text contained within JSTE
+pseudo elements, which look like: <# ... #>.")
+
+ ("wrap-php" "Line Wrapping" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should line wrap text contained within PHP
+pseudo elements, which look like: <?php ... ?>.")
+
+ ("wrap-script-literals" "Line Wrapping" "Boolean" "no"
+ "
+Type: Boolean
+Default: no
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should line wrap string literals that appear
+in script attributes. Tidy wraps long script string literals by inserting
+a backslash character before the line break.")
+
+ ("wrap-sections" "Line Wrapping" "Boolean" "yes"
+ "
+Type: Boolean
+Default: yes
+Example: y/n, yes/no, t/f, true/false, 1/0
+
+This option specifies if Tidy should line wrap text contained within
+<![... ]> section tags.")
+
+;; ("write-back" "Omit" "Boolean" "no"
+;; "
+;; Type: Boolean
+;; Default: no
+;; Example: y/n, yes/no, t/f, true/false, 1/0
+
+;; This option specifies if Tidy should write back the tidied markup to
+;; the same file it read from. You are advised to keep copies of
+;; important files before tidying them, as on rare occasions the result
+;; may not be what you expect.
+
+;; This option is ignored by Emacs.")
+ ))
+ )
+
+;;;;; Create a variable for each option in `tidy-options-alist'"
+
+;; these variables are made buffer local so that different buffers can
+;; use a different set of options
+
+(let ((options-alist tidy-options-alist)
+ option name symbol docstring)
+
+ (while (setq option (car options-alist))
+ (setq name (nth 0 option)
+ docstring (nth 4 option)
+ symbol (intern (concat "tidy-" name)))
+ ;; create the variable on the fly
+ (put symbol 'variable-documentation docstring)
+ (make-variable-buffer-local symbol)
+ (set symbol nil) ;;default)
+ (setq options-alist (cdr options-alist))
+ )
+ )
+
+
+;;;;; Quick options setting
+
+(defvar tidy-xhtml-values
+ '(
+ (add-xml-decl "yes")
+ (add-xml-space "no")
+ (doctype "auto")
+ (escape-cdata "no")
+ (fix-backslash "yes")
+ (fix-bad-comments "yes")
+ (fix-uri "yes")
+ (indent "yes")
+ (indent-cdata "yes")
+ (indent-spaces "2")
+ (join-classes "yes")
+ (join-styles "yes")
+ (lower-literals "yes")
+ (newline "LF")
+ (output-xhtml "yes")
+ (output-xml "no")
+ (quote-ampersand "yes")
+ (quote-nbsp "yes")
+ (tidy-mark "no")
+ (uppercase-attributes "no")
+ (uppercase-tags "no")))
+
+(defun tidy-xhtml-options-ok ()
+ (let ((ok t))
+ (dolist (optval tidy-xhtml-values)
+ (let* ((opt (car optval))
+ (val (cadr optval))
+ (nam (symbol-name opt))
+ (ent (assoc nam tidy-options-alist))
+ (def (nth 3 ent))
+ (sym (intern (concat "tidy-" nam))))
+ (when (equal val def)
+ (setq val nil))
+ (unless (equal val (symbol-value sym))
+ (setq ok nil))))
+ ok))
+
+(defun tidy-show-xhtml-options ()
+ "List the settings set by `tidy-set-xhtml-options'."
+ (interactive)
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer (help-buffer)
+ (help-setup-xref (list #'tidy-show-xhtml-settings) (interactive-p))
+ (let ((inhibit-read-only t)
+ (point (point))
+ s)
+ (insert "Values that will be set by `tidy-set-xhtml-options'. ")
+ (setq s "Green")
+ (put-text-property 0 (length s)
+ 'face '(:foreground "green")
+ s)
+ (insert s " indicates that the local value in the current buffer")
+ (insert " is the value that would be set, ")
+ (setq s "red")
+ (put-text-property 0 (length s)
+ 'face '(:foreground "red")
+ s)
+ (insert s " indicates it is not.\n\n")
+ (fill-region point (point))
+ (dolist (optval tidy-xhtml-values)
+ (let* ((opt (car optval))
+ (val (cadr optval))
+ (nam (symbol-name opt))
+ (ent (assoc nam tidy-options-alist))
+ (def (nth 3 ent))
+ (cur (symbol-value (intern (concat "tidy-" nam))))
+ (show (copy-seq val))
+ )
+ (unless cur (setq cur def))
+ (put-text-property 0 (length show)
+ 'face
+ (if (equal val cur)
+ '(:foreground "green")
+ 'face '(:foreground "red"))
+ show)
+ (insert (format "%25s => %s\n" opt show))))))
+ (with-no-warnings (print-help-return-message))))
+
+(defun tidy-set-xhtml-options (&optional only-current-buffer)
+ "Set option necessary to convert to XHTML.
+To get a list of this settings use `tidy-show-xhtml-options'.
+
+Note that the option variables are buffer local. The default
+variable values are always set. If ONLY-CURRENT-BUFFER is nil set
+the buffer local variables in all buffers."
+ (interactive (list
+ (not (y-or-n-p "Set XHTML options in all buffers? "))))
+ (let ((buffers (if (not only-current-buffer)
+ (buffer-list)
+ (list (current-buffer)))))
+ (dolist (buffer buffers)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (dolist (optval tidy-xhtml-values)
+ (let* ((opt (car optval))
+ (val (cadr optval))
+ (nam (symbol-name opt))
+ (ent (assoc nam tidy-options-alist))
+ (def (nth 3 ent))
+ (symbol (intern (concat "tidy-" nam))))
+ (when (equal val def)
+ (setq val nil))
+ (set-default symbol val) ;; The least overhead I think
+ (unless (equal val (symbol-value symbol))
+ (set symbol val)))))))))
+
+
+;;;;; Menu Lock (adapted from printing.el)
+
+;; quite compiler
+(eval-when-compile
+ (progn
+ (or (boundp 'current-menubar)
+ (defvar current-menubar nil))
+ (or (fboundp 'tidy-menu-position)
+ (defun tidy-menu-position () ""))
+ (or (fboundp 'tidy-menu-lock)
+ (defun tidy-menu-lock (entry state path) ""))
+ (or (fboundp 'tidy-menu-lookup)
+ (defun tidy-menu-lookup (path) ""))
+ ))
+
+;; always define these
+(defvar tidy-menu nil "Menu used by tidy.")
+(defvar tidy-menu-position nil)
+(defvar tidy-menu-state nil)
+
+(cond
+ ((tidy-xemacs-p)
+ ;; XEmacs
+ (defun tidy-menu-position ()
+ (tidy-x-make-event
+ 'button-release
+ (list 'button 1
+ 'x tidy-menu-x-position
+ 'y -5
+ )))
+
+ ;; XEmacs
+ (defun tidy-menu-lock (entry state path)
+ (when (and (not (interactive-p)) tidy-menu-lock)
+ (or (and tidy-menu-position (eq state tidy-menu-state))
+ (setq tidy-menu-position (tidy-menu-position)
+ tidy-menu-state state))
+ (let* ((menu (tidy-menu-lookup path))
+ (result (tidy-x-get-popup-menu-response menu tidy-menu-position)))
+ (and (tidy-x-misc-user-event-p result)
+ (funcall (tidy-x-event-function result)
+ (tidy-x-event-object result))))
+ (setq tidy-menu-position nil)))
+
+ ;; XEmacs
+ (defun tidy-menu-lookup (path)
+ (car (tidy-x-find-menu-item current-menubar (cons "Tidy" path)))))
+
+ (t
+ ;; GNU Emacs
+ (defun tidy-menu-position ()
+ (let ()
+ (list (list tidy-menu-x-position '-5)
+ (selected-frame)))) ; frame
+
+ ;; GNU Emacs
+;; (defun tidy-menu-lock-old (entry state path)
+;; (when (and (not (interactive-p)) tidy-menu-lock)
+;; (or (and tidy-menu-position (eq state tidy-menu-state))
+;; (setq tidy-menu-position (tidy-menu-position )
+;; tidy-menu-state state))
+;; (let* ((menu (tidy-menu-lookup path))
+;; (result (x-popup-menu tidy-menu-position menu)))
+;; (and result
+;; (let ((command (lookup-key menu (vconcat result))))
+;; (if (fboundp command)
+;; (funcall command)
+;; (eval command)))))
+;; (setq tidy-menu-position nil)))
+ (defun tidy-menu-lock (entry state path)
+ (when (and (not (interactive-p)) tidy-menu-lock)
+ (or (and tidy-menu-position (eq state tidy-menu-state))
+ (setq tidy-menu-position (tidy-menu-position )
+ tidy-menu-state state))
+ ;;(popup-menu tidy-menu tidy-menu-position)))
+ (run-with-idle-timer 1 nil 'popup-menu tidy-menu tidy-menu-position)))
+
+ ;; GNU Emacs
+ (defun tidy-menu-lookup (dummy)
+ (lookup-key (current-local-map) [menu-bar Tidy])))
+ )
+
+;;;;; Define classes of menu items
+
+(defun tidy-set (var-sym value mess entry state &optional path)
+ "Set the value of the symbol VAR-SYM to VALUE giving a message
+derived from VALUE and MESS. Pass on menu data to `tidy-menu-lock'."
+ (set var-sym value)
+ (message "%s is %s" mess value)
+ (tidy-menu-lock entry state path))
+
+(defun tidy-boolean-entry (symbol name type default menu)
+ "Returns a menu entry that allows us to toggle the value of SYMBOL.
+SYMBOL refers to the option called NAME which has default value
+DEFAULT. TYPE should always have the value \"Boolean\". MENU refers
+to the sub-menu that this item belongs to and POSITION its position in
+that list."
+ (cond ((equal default "no")
+ (list (vector name
+ (list 'tidy-set (list 'quote symbol)
+ (list 'if symbol 'nil "yes")
+ name
+ (list 'quote menu)
+ '(quote toggle)
+ )
+ :style 'toggle
+ :selected (list 'if symbol 't 'nil))))
+
+ ((equal default "yes")
+ (list (vector name (list 'tidy-set (list 'quote symbol)
+ (list 'if symbol 'nil "no")
+ name
+ (list 'quote menu)
+ '(quote toggle)
+ )
+ :style 'toggle
+ :selected (list 'if symbol 'nil 't))))))
+
+(defun tidy-list-entry (symbol name type default menu)
+"Returns a menu entry that allows us to set via a radio button the
+value of SYMBOL. SYMBOL refers to the option called NAME which has
+default value DEFAULT. TYPE should be a list of the possible
+values. MENU refers to the sub-menu that this item belongs to and
+POSITION its position in that list."
+ (let (value element)
+ (while (setq value (car type))
+ (if (equal value default)
+ (setq element
+ (append element
+ (list
+ (vector
+ (concat name " is \"" value "\"")
+ (list 'tidy-set (list 'quote symbol)
+ (list 'if symbol 'nil value)
+ name
+ (list 'quote menu)
+ '(quote toggle)
+ )
+ :style 'radio
+ :selected (list 'if symbol 'nil 't)
+ ))))
+ (setq element
+ (append element
+ (list
+ (vector
+ (concat name " is \"" value "\"")
+
+ (list 'tidy-set (list 'quote symbol)
+ (list 'if symbol 'nil value)
+ name
+ (list 'quote menu)
+ '(quote toggle)
+ )
+
+ :style 'radio
+ :selected (list
+ 'if (list 'string-equal symbol value)
+ 't 'nil)
+ )))))
+ (setq type (cdr type)))
+ element))
+
+(defun tidy-set-string (symbol name default)
+ "Set the value of SYMBOL identified by name to VALUE,
+unless VALUE equals DEFAULT, in which case we set it to nil."
+ (interactive)
+ (let* ((last-value (symbol-value symbol))
+ (new-value
+ (if (tidy-xemacs-p)
+ (read-string (format "Set %s to: " name)
+ (or last-value default) nil) ;; no default arg
+ (read-string (format "Set %s to: " name)
+ (or last-value default) nil default))))
+ (set symbol (if (equal new-value default) nil new-value))))
+
+(defun tidy-set-integer (symbol name default)
+ "Set the value of SYMBOL identified by name to VALUE,
+unless VALUE = DEFAULT, in which case we set it to nil."
+ (interactive)
+ (let* ((last-value (symbol-value symbol))
+ ;; careful to interpret the string as a number
+ (new-value
+ (string-to-number
+ (if (tidy-xemacs-p)
+ (read-string (format "Set %s to: " name)
+ (or last-value default) nil)
+ (read-string (format "Set %s to: " name)
+ (or last-value default) nil default)
+ ))))
+ (set symbol (if (= new-value (string-to-number default)) nil
+ (number-to-string new-value)))))
+
+
+(defun tidy-string-entry (symbol name type default menu)
+ "Returns a menu entry that allows us to set the value of SYMBOL.
+SYMBOL refers to the option called NAME which has default value
+DEFAULT. TYPE should always be one of \"String\" \"Tags\", or
+\"DocType\". MENU and POSITION are not used in this case."
+
+ (list (vector (concat "set " name)
+ (list 'tidy-set-string
+ (list 'quote symbol)
+ name default))))
+
+(defun tidy-integer-entry (symbol name type default menu)
+"Returns a menu entry that allows us to set the value of SYMBOL.
+SYMBOL refers to the option called NAME which has default value
+DEFAULT. TYPE should always have the value \"Integer\". MENU and
+POSITION are not used in this case. "
+ (list (vector (concat "set " name)
+ (list 'tidy-set-integer
+ (list 'quote symbol)
+ name default))))
+
+(defun tidy-exe-found ()
+ (when tidy-shell-program
+ ;;(file-executable-p (car (split-string tidy-shell-program)))))
+ (or (file-executable-p tidy-shell-program)
+ (executable-find tidy-shell-program))))
+
+
+(defvar tidy-top-menu nil
+ "The first part of the menu.")
+(when (or (null tidy-top-menu) tidy-debug)
+ (setq tidy-top-menu
+ '("Tidy"
+ ["Tidy Buffer" tidy-buffer
+ :active (tidy-exe-found)]
+
+;; ["Tidy Region" tidy-region
+;; :active (and (mark)
+;; (tidy-exe-found))
+;; :keys "C-u \\[tidy-buffer]"]
+
+ ["Tidy Directory Tree" tidy-tree
+ :active (tidy-exe-found)]
+
+ ["Tidy Site" tidy-tree
+ :active (and (featurep 'html-site)
+ (tidy-exe-found))]
+
+ "----------------------------------------------"
+
+ ["Customize Tidy" (customize-group-other-window 'tidy)]
+
+;; ["Use Ediff" (lambda () (interactive)
+;; (setq tidy-use-ediff (not tidy-use-ediff)))
+;; :style toggle
+;; :selected tidy-use-ediff
+;; ]
+
+;; ["Load Settings" tidy-parse-config-file
+;; :active (and tidy-config-file (file-exists-p tidy-config-file))]
+
+;; ["Load Settings All Buffers" (lambda () (interactive)
+;; (tidy-parse-config-file t))
+;; :active (and tidy-config-file (file-readable-p tidy-config-file))]
+
+ ["Save Settings" tidy-save-settings
+ :active (and tidy-config-file (file-readable-p tidy-config-file))]
+
+ "----------------------------------------------"
+
+ )))
+
+(defvar tidy-newline-menu
+ '("Set newline"
+ ["LF" (tidy-set 'tidy-newline
+ nil
+ "newline"
+ 'newline
+ 'toggle)
+ :style radio
+ :selected (if (null tidy-newline) t nil)]
+
+ ["CRLF" (tidy-set 'tidy-newline
+ "CRLF"
+ "newline"
+ 'newline
+ 'toggle)
+ :style radio
+ :selected (if (equal tidy-newline "CRLF") t nil)]
+
+ ["CR" (tidy-set 'tidy-newline
+ "CR"
+ "newline"
+ 'newline
+ 'toggle)
+ :style radio
+ :selected (if (equal tidy-newline "CRLF") t nil)]
+ ))
+
+(defvar tidy-doctype-menu nil "The second to last sub-menu.")
+(when (or (null tidy-doctype-menu) tidy-debug)
+ (setq tidy-doctype-menu
+ '("Set doctype" ;; ==>
+
+ ["auto" (tidy-set 'tidy-doctype
+ nil
+ "doctype"
+ 'doctype
+ 'toggle)
+ :style radio
+ :selected (if (null tidy-doctype) t nil)]
+
+ ["omit" (tidy-set 'tidy-doctype
+ "omit"
+ "doctype"
+ 'doctype
+ 'toggle)
+ :style radio
+ :selected (if (equal tidy-doctype "omit") t nil)]
+
+ ["strict" (tidy-set 'tidy-doctype
+ "strict"
+ "doctype"
+ 'doctype
+ 'toggle)
+ :style radio
+ :selected (if (equal tidy-doctype "strict") t nil)]
+
+ ["loose" (tidy-set 'tidy-doctype
+ "loose"
+ "doctype"
+ 'doctype
+ 'toggle)
+ :style radio
+ :selected (if (equal tidy-doctype "loose") t nil)]
+
+ ["transitional" (tidy-set 'tidy-doctype
+ "transitional"
+ "doctype"
+ 'doctype
+ 'toggle)
+ :style radio
+ :selected (if (equal tidy-doctype "transitional") t nil)]
+
+ ["fpi" (null nil) ;; stub function
+ :style radio
+ :selected (if (or (null tidy-doctype)
+ (equal tidy-doctype "omit")
+ (equal tidy-doctype "strict")
+ (equal tidy-doctype "loose"))
+ nil t) ]
+
+ ["reset fpi" (tidy-set-string 'tidy-doctype "doctype" "" "")]
+ )))
+
+(defconst tidy-emacs-encoding-lbl "Use Emacs' encoding")
+
+(defun tidy-create-encoding-menu (label encoding-what msg-what)
+ (list label ;; ==>
+ (vector tidy-emacs-encoding-lbl (list 'tidy-set (list 'quote encoding-what)
+ tidy-emacs-encoding-lbl ;(list 'tidy-get-buffer-encoding)
+ msg-what
+ ''encoding
+ ''toggle)
+ :style 'radio
+ :selected (list 'if (list 'equal encoding-what tidy-emacs-encoding-lbl) t nil)
+ )
+
+ "----------------------------------------------"
+
+ (vector "ascii" (list 'tidy-set (list 'quote encoding-what)
+ nil
+ msg-what
+ ''encoding
+ ''toggle)
+ :style 'radio
+ :selected (list 'if (list 'null encoding-what) t nil) ;; default
+ )
+
+ (vector "raw" (list 'tidy-set (list 'quote encoding-what)
+ "raw"
+ msg-what
+ ''encoding
+ ''toggle)
+ :style 'radio
+ :selected (list 'if (list 'equal encoding-what "raw") t nil))
+
+ (vector "latin1" (list 'tidy-set (list 'quote encoding-what)
+ "latin1"
+ msg-what
+ ''encoding
+ ''toggle)
+ :style 'radio
+ :selected (list 'if (list 'equal encoding-what "latin1") t nil))
+
+ (vector "utf8" (list 'tidy-set (list 'quote encoding-what)
+ "utf8"
+ msg-what
+ ''encoding
+ ''toggle)
+ :style 'radio
+ :selected (list 'if (list 'equal encoding-what "utf8") t nil))
+
+ (vector "iso2022" (list 'tidy-set (list 'quote encoding-what)
+ "iso2022"
+ msg-what
+ ''encoding
+ ''toggle)
+ :style 'radio
+ :selected (list 'if (list 'equal encoding-what "iso2022") t nil))
+
+ (vector "mac" (list 'tidy-set (list 'quote encoding-what)
+ "mac"
+ msg-what
+ ''encoding
+ ''toggle)
+ :style 'radio
+ :selected (list 'if (list 'equal encoding-what "mac") t nil))
+
+ (vector "win1252" (list 'tidy-set (list 'quote encoding-what)
+ "win1252"
+ msg-what
+ ''encoding
+ ''toggle)
+ :style 'radio
+ :selected (list 'if (list 'equal encoding-what "win1252") t nil))
+
+ ))
+;; (defvar tidy-char-encoding-menu nil "The last sub-menu.")
+;; (when (or (null tidy-char-encoding-menu) tidy-debug)
+;; (setq tidy-char-encoding-menu
+;; (tidy-create-encoding-menu
+;; "Set char-encoding" 'tidy-char-encoding "char-encoding")))
+;; (defvar tidy-input-encoding-menu nil "The last sub-menu.")
+;; (when (or (null tidy-input-encoding-menu) tidy-debug)
+;; (setq tidy-input-encoding-menu
+;; (tidy-create-encoding-menu
+;; "Set input-encoding" 'tidy-input-encoding "input-encoding")))
+(defvar tidy-output-encoding-menu nil "The last sub-menu.")
+(when (or (null tidy-output-encoding-menu) tidy-debug)
+ (setq tidy-output-encoding-menu
+ (tidy-create-encoding-menu
+ "Set output-encoding" 'tidy-output-encoding "output-encoding")))
+
+;;;;; Create a menu item for each option that has a valid sub-menu
+;; field
+
+(when (or (null tidy-menu) tidy-debug)
+ (let ((options-alist tidy-options-alist)
+
+ ;; sub menus are divided into two parts with list type options
+ ;; coming first, followed by the rest
+
+ markup-menu-bool markup-menu-set
+ line-wrap-menu-bool line-wrap-menu-set
+ preference-menu-bool preference-menu-set
+ indent-menu-bool indent-menu-set
+ io-menu-bool io-menu-set
+ tags-menu-bool tags-menu-set
+
+ name sub-menu type default symbol entry entry-function option)
+
+ (while (setq option (car options-alist))
+ (setq name (nth 0 option)
+ sub-menu (nth 1 option)
+ type (nth 2 option)
+ default (nth 3 option)
+ symbol (intern (concat "tidy-" name))
+ entry nil)
+
+ (cond ((equal type "Boolean")
+ (setq entry-function 'tidy-boolean-entry))
+
+ ((equal type "AutoBool")
+ (setq entry-function 'tidy-list-entry)
+ (setq type '("auto" "yes" "no")))
+
+ ((equal type "DocType")
+ (setq entry '())) ;; handled below
+
+ ((equal type "Tag names")
+ (setq entry-function 'tidy-string-entry))
+
+ ((equal type "String")
+ (setq entry-function 'tidy-string-entry))
+
+ ((equal type "Integer")
+ (setq entry-function 'tidy-integer-entry))
+
+ ((equal type "Encoding")
+ (setq entry '()));; handled below
+
+ ((listp type)
+ (setq entry-function 'tidy-list-entry))
+ (t
+ (error (concat "Tidy: unhandled value type " type " for " name))))
+
+ (cond ((equal sub-menu "Fix Markup")
+ (setq entry (funcall
+ entry-function
+ symbol
+ name
+ type
+ default
+ 'markup))
+
+ (if (or (equal type "Boolean") (equal type "AutoBool") (listp type))
+ (setq markup-menu-bool (append markup-menu-bool entry))
+ (setq markup-menu-set (append markup-menu-set entry))))
+
+ ((equal sub-menu "Indentation")
+ (setq entry (funcall
+ entry-function
+ symbol
+ name
+ type
+ default
+ 'indent))
+
+ (if (or (equal type "Boolean") (equal type "AutoBool") (listp type))
+ (setq indent-menu-bool (append indent-menu-bool entry))
+ (setq indent-menu-set (append indent-menu-set entry))))
+
+ ((equal sub-menu "Line Wrapping")
+ (setq entry (funcall
+ entry-function
+ symbol
+ name
+ type
+ default
+ 'line-wrap))
+
+ (if (or (equal type "Boolean") (equal type "AutoBool") (listp type))
+ (setq line-wrap-menu-bool (append line-wrap-menu-bool entry))
+ (setq line-wrap-menu-set (append line-wrap-menu-set entry))))
+
+ ((equal sub-menu "Input/Output")
+ (setq entry (funcall
+ entry-function
+ symbol
+ name
+ type
+ default
+ 'io))
+
+ (if (or (equal type "Boolean") (equal type "AutoBool") (listp type))
+ (setq io-menu-bool (append io-menu-bool entry))
+ (setq io-menu-set (append io-menu-set entry))))
+
+ ((equal sub-menu "Preference")
+ (setq entry (funcall
+ entry-function
+ symbol
+ name
+ type
+ default
+ 'preference))
+
+ (if (or (equal type "Boolean") (equal type "AutoBool") (listp type))
+ (setq preference-menu-bool (append preference-menu-bool entry))
+ (setq preference-menu-set (append preference-menu-set entry))))
+
+ ((equal sub-menu "Tags")
+ (setq entry (funcall
+ entry-function
+ symbol
+ name
+ type
+ default
+ 'tags))
+
+ (if (or (equal type "Boolean") (equal type "AutoBool"))
+ (setq tags-menu-bool (append tags-menu-bool entry))
+ (setq tags-menu-set (append tags-menu-set entry))))
+ (t)) ;; we simple omit all other menus
+
+ (setq options-alist (cdr options-alist)))
+
+ (setq tidy-menu (append
+ tidy-top-menu
+ (list
+ (list "Quick Options Settings"
+ (vector "Set Options for XHTML"
+ 'tidy-set-xhtml-options
+ :style 'toggle
+ :selected '(tidy-xhtml-options-ok)
+ )
+ (vector "Show Options for XHTML"
+ 'tidy-show-xhtml-options
+ )
+ ))
+ (list (append (list "Advanced")
+
+
+;; "----------------------------------------------"
+
+;; ["Menu Lock" (tidy-set 'tidy-menu-lock
+;; (if tidy-menu-lock nil t)
+;; "Menu Lock"
+;; 'top
+;; 'toggle)
+;; :style toggle
+;; :selected (if tidy-menu-lock t nil)
+;; ]
+;; (vector "Menu Lock"
+;; 'tidy-menu-lock
+;; :style 'toggle
+;; :selected '(if tidy-menu-lock t nil)
+;; )
+ (list (vector "Menu Lock"
+ '(tidy-set 'tidy-menu-lock
+ (if tidy-menu-lock nil t)
+ "Menu Lock"
+ 'top
+ 'toggle
+ )
+ :style 'toggle
+ :selected '(if tidy-menu-lock t nil)
+ ))
+ (list (list "-------"))
+
+ (list (append (list "Fix Markup")
+ markup-menu-bool
+ markup-menu-set))
+ (list (append (list "Line Wrapping")
+ line-wrap-menu-bool
+ line-wrap-menu-set))
+ (list (append (list "Preference")
+ preference-menu-bool
+ preference-menu-set))
+ (list (append (list "Indentation")
+ indent-menu-bool
+ indent-menu-set))
+ (list (append (list "Input/Output")
+ io-menu-bool
+ io-menu-set))
+ (list (append (list "Tags")
+ tags-menu-bool
+ tags-menu-set))
+ (list tidy-doctype-menu)
+ (list tidy-output-encoding-menu)
+ (list tidy-newline-menu)
+ ))
+ '(["Describe Options" tidy-describe-options t])
+ (list (list "-------"))
+ '(["Tidy Home Page"
+ (lambda ()
+ "Open Tidy home page in your web browser."
+ (interactive)
+ (browse-url "http://tidy.sourceforge.net/"))
+ t])
+ ))
+ )
+)
+
+(defvar tidy-menu-symbol nil)
+;;(tidy-build-menu (&optional map)
+;;;###autoload
+(defun tidy-build-menu (&optional map)
+ "Set up the tidy menu in MAP.
+Used to set up a Tidy menu in your favourite mode."
+ (interactive) ;; for debugging
+ (unless tidy-menu-symbol
+ (unless tidy-config-file-parsed
+ (tidy-parse-config-file)
+ (setq tidy-config-file-parsed t))
+ ;;(or map (setq map (current-local-map)))
+ (easy-menu-remove tidy-menu)
+ (easy-menu-define tidy-menu-symbol map "Menu for Tidy" tidy-menu)
+ (setq tidy-menu-symbol (delete "Tidy" tidy-menu-symbol))
+ (easy-menu-add tidy-menu map))
+ t)
+
+;;;;; Option description support
+
+;; quiet FSF Emacs and XEmacs compilers
+(eval-when-compile
+ (progn (or (fboundp 'event-point) (defun event-point (dummy) ""))
+ (or (fboundp 'posn-point) (defun posn-point (dummy) ""))
+ (or (fboundp 'event-start) (defun event-start (dummy) ""))))
+
+(defun tidy-describe-this-option-mouse (click)
+ (interactive "e")
+ (let ((p (if (tidy-xemacs-p)
+ (event-point click)
+ (posn-point (event-start click)))))
+ (tidy-describe-this-option p)))
+
+(defun tidy-describe-this-option (&optional point)
+ "Describe variable associated with the text at point."
+ (interactive (list (point)))
+
+ (let* ((variable (get-text-property
+ point
+ 'tidy-variable))
+ value
+ buffer) ;; reuse the help buffer
+ (when variable
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'tidy-describe-this-option point) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (setq value (symbol-value variable))
+ (insert (substring (symbol-name variable) 5) ;; clip the `tidy-' prefix
+ " is set to ")
+ (if value (insert value) (insert "set to the default value"))
+ (insert "\n\n" (documentation-property variable 'variable-documentation))
+ (local-set-key [(q)] 'tidy-quit-describe-options)
+ (with-no-warnings (print-help-return-message)))))))
+
+(defun tidy-quit-describe-options ()
+ "Rid thyself of any display associated with Tidy's options."
+ (interactive)
+ (bury-buffer (get-buffer "*tidy-options*"))
+ (delete-windows-on (get-buffer "*tidy-options*"))
+ (bury-buffer (get-buffer "*Help*"))
+ (delete-windows-on (get-buffer "*Help*")))
+
+;; nicked this from cal-desk-calendar.el:-)
+(defun tidy-current-line ()
+ "Get the current line number (in the buffer) of point."
+ ;;(interactive)
+ (save-restriction
+ (widen)
+ (save-excursion
+ (beginning-of-line)
+ (1+ (count-lines 1 (point))))))
+
+(defun tidy-goto-line (line)
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))))
+
+(defun tidy-describe-options ()
+ "Interactively access documentation strings for `tidy-' variables."
+ (interactive)
+ (let ((buffer (get-buffer "*tidy-options*")))
+ (if buffer (pop-to-buffer buffer)
+ ;; else build it from scratch
+ (setq buffer (get-buffer-create "*tidy-options*"))
+ (let* ((start 0)
+ (end 0)
+ name
+ (count 0)
+ (option-alist tidy-options-alist)
+ (column2a (+ (length "drop-proprietary-attributes") 3))
+ (column2b (/ (window-width) 3))
+ (column2 (if (> column2a column2b) column2a column2b))
+ (column3 (* 2 column2))
+ (start-line 0)
+ (third-length 0)
+ (two-third-length 0))
+
+ (set-buffer buffer)
+
+ (setq buffer-read-only nil)
+ (delete-region (point-min) (point-max)) ;; empty the buffer
+
+ ;; set up local bindings
+ (if (tidy-xemacs-p)
+ (local-set-key [(button2)] 'tidy-describe-this-option-mouse)
+ (local-set-key [(mouse-2)] 'tidy-describe-this-option-mouse))
+
+ (local-set-key "\r" 'tidy-describe-this-option)
+ (local-set-key [(q)] 'tidy-quit-describe-options)
+
+ (insert "Press RET over option to see its description. "
+ "Type \"q\" to quit." "\n\n")
+
+ (setq start-line (tidy-current-line))
+ (setq third-length (1+ (/ (length option-alist) 3) ))
+ (setq two-third-length (1- (* 2 third-length)))
+
+ (while (setq name (car (car-safe option-alist)))
+ (setq option-alist (cdr option-alist))
+ (setq count (+ count 1))
+
+ (cond
+ ((< count third-length) ;; 0 <= count < third-length
+ (setq start (point))
+ (insert name)
+ (setq end (point))
+ (insert "\n"))
+ ((< count two-third-length) ;; third-length <= count < two-third-length
+ (if (= count third-length)
+ (tidy-goto-line start-line)
+ (forward-line 1))
+ (end-of-line)
+ (setq start (point))
+ (indent-to-column column2)
+ (setq end (point))
+ (put-text-property start end 'mouse-face 'default)
+ (setq start (point))
+ (insert name)
+ (setq end (point)))
+ (t ;; two-third-length <= count < length
+ (if (= count two-third-length)
+ (tidy-goto-line start-line)
+ (forward-line 1))
+ (end-of-line)
+ (setq start (point))
+ (indent-to-column column3)
+ (setq end (point))
+ (put-text-property start end 'mouse-face 'default)
+ (setq start (point))
+ (insert name)
+ (setq end (point))))
+
+ ;; make the strings funky
+ (put-text-property start end 'mouse-face 'highlight)
+ (put-text-property start end 'tidy-variable (intern (concat "tidy-" name)))
+ )
+ (setq buffer-read-only t)
+ ;;(beginning-of-buffer)
+ (goto-char (point-min))
+ (pop-to-buffer buffer)
+ ))))
+
+;;;;; Configuration file support
+
+(defun tidy-parse-config-file (&optional all-buffers)
+ "Parse `tidy-config-file' and set variables accordingly.
+If `tidy-config-file' is nil or \"\" do nothing. If the file does
+not exist just give a message.
+
+Note that the option variables are buffer local. The default
+variable values are always set. If ALL-BUFFERS is non-nil set the
+buffer local variables in all buffers."
+ (interactive (list
+ (y-or-n-p "Set Tidy config file values in all buffers? ")))
+ (tidy-set-xhtml-options all-buffers)
+ (when (and tidy-config-file
+ (not (string= "" tidy-config-file)))
+ (if (not (file-exists-p tidy-config-file))
+ (unless (string= tidy-config-file tidy-default-config-file)
+ (message "Could not find Tidy config file \"%s\"." tidy-config-file))
+ (message "Parsing config file...")
+ (let ((html-buffer (current-buffer))
+ (config-buffer (find-file-noselect tidy-config-file t))
+ config-variables)
+ (with-current-buffer config-buffer
+ (goto-char (point-min)) ;; unnecessary but pedantic
+
+ ;; delete all comments
+ (while (re-search-forward "//.*\n" nil t)
+ (replace-match "" nil nil))
+
+ (goto-char (point-min))
+ (while (re-search-forward "\\([a-z,-]+\\):\\s-*\\(.*\\)\\s-*" nil t)
+ ;; set the variable
+ ;; Thanks to Thomas Baumann for this bugfix
+ (let ((variable (concat "tidy-" (match-string 1)))
+ (value (match-string 2)))
+ ;;(set-default (intern variable value))
+ (set-default (intern variable) value)
+ (setq config-variables
+ (cons (cons variable value) config-variables))
+ (with-current-buffer html-buffer
+ (set (intern variable) value))
+ ))
+
+ (set-buffer-modified-p nil) ;; don't save changes
+ (kill-buffer config-buffer))
+ (when all-buffers
+ (dolist (buffer (buffer-list))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (dolist (optval config-variables)
+ (let* ((opt (car optval))
+ (val (cdr optval))
+ (sym (intern opt)))
+ (set sym val))))))))
+ (message "Parsing config file...done")
+ )))
+
+(defun tidy-save-settings (&optional config-file)
+ "Query saving the current settings to your `tidy-config-file'.
+The local values in the current buffer will be saved."
+ (interactive)
+ (or config-file (setq config-file tidy-config-file))
+ (when config-file
+
+ ;; should check for locks!
+ (if (or (not (interactive-p))
+ (y-or-n-p "Save settings to your tidy configuration file? "))
+
+ (let ((buffer (find-file-noselect config-file t))
+ (option-alist tidy-options-alist)
+ (outer-buffer (current-buffer))
+ option name symbol value)
+ (with-current-buffer buffer
+ (delete-region (point-min) (point-max)) ;; clear the buffer
+
+ ;; need this line so that config file is always non empty
+ (insert "// HTML Tidy configuration file \n")
+ (while (setq option (car option-alist))
+ (setq option-alist (cdr option-alist))
+ (setq name (nth 0 option)
+ symbol (intern (concat "tidy-" name)))
+ (with-current-buffer outer-buffer
+ (setq value (symbol-value symbol)))
+ (when (string= value tidy-emacs-encoding-lbl)
+ (setq value (tidy-get-buffer-encoding)))
+ (when value ;; nil iff default
+ (insert (car option) ": " value "\n")))
+
+ (save-buffer)
+ ;;(basic-save-buffer)
+ (kill-buffer buffer)
+ )))))
+
+
+;;;;; Main user function
+
+(eval-when-compile (defvar tidy-markup nil ""))
+
+(defun tidy-set-buffer-unmodified (dummy1 dummy2 dumm3)
+ "Used to prevent error buffer form being marked as modified."
+ (set-buffer-modified-p nil))
+
+;; See http://www.mhonarc.org/MHonArc/doc/resources/charsetaliases.html
+(defconst tidy-encodings-mime-charset-list
+ '(
+ ;; ("raw") ;; Same as ascii??
+ ("ascii" . "us-ascii")
+ ("latin0" . "iso-8859-15")
+ ("latin1" . "iso-8859-1")
+ ("iso2022" . "iso-2022-jp") ;; Correct? There are several iso-2022-..
+ ("utf8" . "utf-8")
+ ("mac" . "macintosh")
+ ("win1252" . "windows-1252")
+ ("ibm858" . "cp850")
+ ("utf16le" . "utf-16-le")
+ ("utf16be" . "utf-16-be")
+ ("utf16" . "utf-16")
+ ("big5" . "big5")
+ ("shiftjis" . "shift_jis")
+ )
+ "Encoding names used by Tidy and Emacs.
+First column is Tidy's name, second Emacs' name."
+ )
+
+(defun tidy-get-buffer-encoding ()
+ "Get Tidy's name for value of `buffer-file-coding-system'."
+ (tidy-get-tidy-encoding buffer-file-coding-system))
+
+(defun tidy-get-tidy-encoding (emacs-coding-system)
+ (let ((encoding (rassoc
+ (symbol-name
+ (coding-system-get emacs-coding-system 'mime-charset))
+ tidy-encodings-mime-charset-list)))
+ (if encoding
+ (setq encoding (car encoding))
+ (setq encoding "raw"))
+ encoding))
+
+(defun tidy-temp-config-file ()
+ (expand-file-name "temp-tidy-config"
+ tidy-temp-directory))
+
+(defconst tidy-output-buf-name "Tidy (X)HTML Output")
+
+(defvar tidy-tidied-buffer nil)
+(make-variable-buffer-local 'tidy-tidied-buffer)
+(put 'tidy-tidied-buffer 'permanent-local t)
+
+(defun tidy-check-is-tidied (orig-buf tidy-buf)
+ (with-current-buffer tidy-buf
+ (unless tidy-tidied-buffer
+ (error "%s is not a tidy output buffer" tidy-buf))
+ (unless (eq orig-buf tidy-tidied-buffer)
+ (error "Buffer does not contain tidied %s" orig-buf))))
+
+(defconst tidy-control-buffer-name "Tidy Control Buffer")
+
+(defvar tidy-output-encoding) ;; dyn var
+
+(defun tidy-buffer ()
+ "Run the HTML Tidy program on the current buffer.
+Show the errors in a buffer with buttons to:
+
+- show the original buffer
+- show the tidied output
+- copy tidied to original
+- run ediff
+
+This buffer also contains any error and warning messages and they
+link to the original source code.
+
+If the buffer to tidy contains a fictive XHTML validation header
+\(see `nxhtml-validation-header-mode') then the corresponding
+header is added before running tidy. This header is removed again
+after tidying, together with additions tidy might have done at
+the end of the buffer.
+
+You may tidy part of the buffer, either by narrowing the buffer
+or by selecting a region and having it visibly marked (`cua-mode'
+etc). A fictive XHTML validation header will apply as
+above. However if there is no such header then when you tidy part
+of the buffer still a hopefully suitable header is added before
+calling tidy."
+;; Fix-me: copy back parts outside visible region
+ (interactive)
+ (message "starting tidy-buffer")
+ (let* ((is-narrowed (buffer-narrowed-p))
+ (validation-header (when (boundp 'rngalt-validation-header)
+ (let ((header (nth 2 rngalt-validation-header)))
+ (when header (concat header "\n")))))
+ (region-restricted (and mark-active
+ transient-mark-mode
+ (or (< (point-min) (region-beginning))
+ (< (region-end) (point-max)))))
+ (partial (or validation-header
+ is-narrowed
+ region-restricted))
+ (start (if region-restricted (region-beginning) (point-min)))
+ (end (if region-restricted (region-end) (point-max)))
+ (region-header (when region-restricted
+ (when (< (point-min) (region-beginning))
+ (buffer-substring-no-properties
+ (point-min) (region-beginning)))))
+ (region-footer (when region-restricted
+ (when (< (region-end) (point-max))
+ (buffer-substring-no-properties
+ (region-end) (point-max)))))
+ (tidy-beg-mark "<!-- TIDY BEGIN MARK 142505535 -->\n")
+ (tidy-end-mark "<!-- TIDY END MARK 143345187 -->")
+ ;;(whole-file t) ;(and (= start 1) (= end (1+ (buffer-size)))))
+ (filename buffer-file-name)
+ ;;(orig-dir (file-name-directory filename))
+ (orig-buffer (current-buffer))
+ (work-buffer (get-buffer-create "* Tidy Temporary Work Buffer *"))
+ (line-header-offset nil)
+
+ ;; Gasp! We have to use temp files here because the command
+ ;; line would likely get too long!
+
+ (error-buf-name tidy-control-buffer-name)
+
+ (error-file (expand-file-name error-buf-name
+ tidy-temp-directory))
+
+ (error-buffer (get-buffer-create error-buf-name))
+
+ (output-buffer (get-buffer-create tidy-output-buf-name))
+
+ (config-file (tidy-temp-config-file))
+
+ ;;(eol (coding-system-eol-type buffer-file-coding-system))
+ ;;(encoding (coding-system-get buffer-file-coding-system 'mime-charset))
+ ;;(errors 0)
+ ;;(warnings 0)
+ (tidy-message "")
+ (seg-error nil)
+ ;;(use-ediff tidy-use-ediff)
+
+ (want-mumamo nil)
+ )
+
+;; (when (and use-ediff
+;; (not tidy-show-warnings)) ;; default "yes" hence inverted logic
+;; (setq use-ediff (y-or-n-p "Warning can not be shown when using ediff. Still use ediff? ")))
+ (unless buffer-file-name
+ (error "Can't tidy buffer with no file name"))
+
+ (when (buffer-modified-p orig-buffer)
+ (error "Can't tidy buffer because it is modified"))
+
+ (with-current-buffer error-buffer
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (setq tidy-tidied-buffer orig-buffer))
+
+ ;; OK do the tidy
+;; (message "coding-system: %s, %s, %s"
+;; (find-operation-coding-system
+;; 'call-process-region start end command)
+;; coding-system-for-write
+;; buffer-file-coding-system)
+ (let* ((coding-system-for-write buffer-file-coding-system)
+ (tidy-input-encoding (tidy-get-tidy-encoding coding-system-for-write)))
+
+ (let ((output-mode (if (not (featurep 'mumamo))
+ major-mode
+ (if (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)
+ mumamo-multi-major-mode
+ major-mode))))
+ (with-current-buffer output-buffer
+ (erase-buffer)
+ ;;(when (and (fboundp 'mumamo-mode) mumamo-mode) (setq want-mumamo t) (mumamo-mode 0))
+ (funcall output-mode)
+ (set (make-local-variable 'coding-system-for-read) coding-system-for-write)))
+
+ (let ((tidy-output-encoding tidy-output-encoding))
+ (unless tidy-output-encoding
+ (setq tidy-output-encoding tidy-input-encoding))
+ ;;(message "tidy-input-enc=%s, tidy-output-enc=%s" tidy-input-encoding tidy-output-encoding)
+ (tidy-save-settings config-file)
+ )
+
+ ;; Tidy does not replace the xml declaration so it must be removed:
+ ;(setq tidy-add-xml-decl "no")
+ (let (;(orig-min (point-min)) (orig-max (point-max))
+ )
+;; (when region-restricted
+;; ;; We have a visible region
+;; (setq orig-min (region-beginning))
+;; (setq orig-max (region-end)))
+ (with-current-buffer work-buffer
+ (erase-buffer)
+ (when validation-header
+ (insert validation-header))
+ (when partial
+ ;; Have to insert things to make tidy insert at correctt
+ ;; position. A bit of guessing here to keep it simple.
+ (let ((p "\n<p>TIDY</p>\n")
+ (b "\n<body>\n")
+ (he "\n<head><title></title></head>\n")
+ (ht (concat
+ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
+ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"\n"
+ "\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">\n"
+ "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n")))
+ (goto-char (point-min))
+ (if (re-search-forward "<body[^>]*>" nil t)
+ (insert p)
+ (if (search-forward "</head>" nil t)
+ (insert b p)
+ (if (re-search-forward "<html[^>]*>" nil t)
+ (insert he b p)
+ (insert ht he b p))))
+ (goto-char (point-max))
+ (insert "\n" tidy-beg-mark)))
+ (setq line-header-offset (line-number-at-pos))
+ (insert-buffer-substring orig-buffer start end) ;orig-min orig-max)
+ (when partial (insert "\n" tidy-end-mark "\n"))
+ (let ((args
+ (list
+ ;;start end
+ (point-min) (point-max)
+ tidy-shell-program
+ nil
+ output-buffer
+ t
+ "-config" config-file
+ "--error-file" error-file
+ "--write-back" "no"
+ ;;(if (not whole-file) "--show-body-only" "--show-body-only")
+ ;;(if (not whole-file) "yes" "no")
+ "--show-body-only" "no"
+ "--gnu-emacs" "yes"
+ "--gnu-emacs-file" (file-name-nondirectory filename)
+ ))
+ (default-directory (file-name-directory filename))
+ )
+ (apply 'call-process-region args)))
+ ))
+
+
+ ;; Since XEmacs can't grab the std error stream we use an error file
+ ;;(setq error-buffer (find-file-noselect error-file t))
+ (with-current-buffer error-buffer
+ (setq tidy-tidied-buffer orig-buffer)
+ (insert-file-contents error-file)
+ ;; Change the line numbers if a header was inserted
+ (when line-header-offset
+ (goto-char (point-min))
+ (while (re-search-forward ":\\([0-9]+\\):[0-9]+" nil t)
+ (let ((line (1+ (- (string-to-number (match-string-no-properties 1))
+ line-header-offset))))
+ (replace-match (number-to-string line) nil nil nil 1))))
+ )
+
+ ;; avoid leaving these guys lying around
+ (if (file-exists-p error-file) (delete-file error-file))
+ ;;(if (file-exists-p config-file) (delete-file config-file))
+
+ ;; scan the buffer for error strings
+ (with-current-buffer error-buffer
+ ;;(local-set-key [tab] 'tidy-errbuf-forward)
+ (goto-char (point-min))
+ (insert "\n")
+ (make-local-variable 'widget-button-face)
+ (setq widget-button-face custom-button)
+ (set (make-local-variable 'widget-push-button-prefix) "")
+ (set (make-local-variable 'widget-push-button-suffix) "")
+ (set (make-local-variable 'widget-link-prefix) "")
+ (set (make-local-variable 'widget-link-suffix) "")
+ (widget-create 'push-button
+ :tag " Show Source "
+ :keymap (make-sparse-keymap)
+ :arg-orig orig-buffer
+ :action (lambda (widget &optional event)
+ (let ((orig-buf (widget-get widget :arg-orig))
+ (curr-win (selected-window)))
+ (switch-to-buffer-other-window orig-buf)
+ (select-window curr-win))))
+ (insert " ")
+ (widget-create 'push-button
+ :tag " Show Tidied "
+ :keymap (make-sparse-keymap)
+ :arg-tidy output-buffer
+ :arg-orig orig-buffer
+ :action (lambda (widget &optional event)
+ (let ((tidy-buf (widget-get widget :arg-tidy))
+ (orig-buf (widget-get widget :arg-orig))
+ (curr-win (selected-window)))
+ (tidy-check-is-tidied orig-buf tidy-buf)
+ (switch-to-buffer-other-window tidy-buf)
+ (select-window curr-win))))
+
+
+ (insert " ")
+ (widget-create 'push-button
+ :tag " Use Tidied "
+ :keymap (make-sparse-keymap)
+ :arg-tidy output-buffer
+ :arg-orig orig-buffer
+ :action (lambda (widget &optional event)
+ (message "Copying ...")
+ (let* ((orig-buf (widget-get widget :arg-orig))
+ (tidy-buf (widget-get widget :arg-tidy))
+ (orig-buf-str
+ (save-restriction
+ (with-current-buffer orig-buf
+ (widen)
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ (tidy-buf-str
+ (save-restriction
+ (with-current-buffer tidy-buf
+ (widen)
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ )
+ (tidy-check-is-tidied orig-buf tidy-buf)
+ (kill-buffer (current-buffer))
+ (kill-buffer tidy-buf)
+ (if (string= orig-buf-str tidy-buf-str)
+ (message "Original buffer's and tidied buffer's contents are equal")
+ (with-current-buffer orig-buf
+ (erase-buffer)
+ (insert tidy-buf-str)
+ (goto-char (point-min))
+ (delete-window (selected-window))
+ (switch-to-buffer orig-buf)
+ (message "Copied to %s" orig-buf))))))
+ (insert " ")
+ (widget-create 'push-button
+ :tag " Ediff "
+ :keymap (make-sparse-keymap)
+ :arg-tidy output-buffer
+ :arg-orig orig-buffer
+ :action (lambda (widget &optional event)
+ (require 'ediff)
+ (let ((orig-buf (widget-get widget :arg-orig))
+ (tidy-buf (widget-get widget :arg-tidy))
+ ;; Fix-me: How should ediff-actual-options be set?
+ (old-ediff-actual-diff-options (default-value 'ediff-actual-diff-options))
+ (new-ediff-actual-diff-options " -a -b -w "))
+ (with-current-buffer orig-buf (setq ediff-actual-diff-options " -a -b -w "))
+ (with-current-buffer tidy-buf (setq ediff-actual-diff-options " -a -b -w "))
+ (tidy-check-is-tidied orig-buf tidy-buf)
+ (set-default 'ediff-actual-diff-options new-ediff-actual-diff-options)
+ (tidy-ediff-buffers orig-buf tidy-buf)
+ (set-default 'ediff-actual-diff-options old-ediff-actual-diff-options)
+ )))
+ ;;(widget-setup)
+
+ (insert "\n\n")
+ (when (re-search-forward (concat
+ "\\([0-9]+\\) warnings?, "
+ "\\([0-9]+\\) errors? were found!")
+ nil t)
+ (setq tidy-warnings (string-to-number (match-string 1)))
+ (setq tidy-errors (string-to-number (match-string 2)))
+ (setq tidy-message (match-string 0)))
+
+ (goto-char (point-min))
+ ;;(while (re-search-forward "stdin:" nil t) (replace-match (concat filename ":")))
+ (wab-compilation-mode)
+ (set-buffer-modified-p nil)
+ (goto-char (point-min))
+ ;; Fix-me: How should this be run? Some hook for compilation I
+ ;; guess, but what is the name of it?
+ ;; (wab-forward)
+ )
+
+
+ (when (buffer-live-p output-buffer)
+ ;; Catch segmentation violations
+ ;; Sometimes get this when editing files from Macs
+ ;; See the function at the bottom of the file
+ (with-current-buffer output-buffer
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (if (looking-at "Segmentation") ;; might work with XEmacs
+ (setq seg-error t))))
+ ;; Fix-me: add parts outside region
+ (when partial
+ (with-current-buffer output-buffer
+ (goto-char (point-min))
+ (when (search-forward tidy-beg-mark nil t)
+ (delete-region (point-min) (point)))
+ (when region-header (insert region-header))
+ (when (search-forward tidy-end-mark nil t)
+ (backward-char (length tidy-end-mark))
+ (delete-region (point) (point-max)))
+ (when region-footer (insert region-footer))))
+ )
+
+ (unless (or (> tidy-errors 0) seg-error)
+ ;; Do not know if the window stuff is needed?
+ (let* ((window (get-buffer-window (current-buffer)))
+ (top (window-start window)))
+
+ (unless tidy-markup ;; default is "yes" hence inverted logic
+ (when (eq system-type 'windows-nt)
+ (tidy-remove-ctrl-m output-buffer))
+ (with-current-buffer output-buffer
+ (setq tidy-tidied-buffer orig-buffer)
+ (delete-trailing-whitespace)
+ (indent-region (point-min) (point-max))
+ (goto-char (point-min))))
+
+ ;; Try not to move the window too much when we tidy the whole buffer
+ (set-window-start window top)))
+
+ (switch-to-buffer-other-window error-buffer)
+
+ (if seg-error
+ (message (concat "Tidy: Segmentation violation!!!"
+ " Check your character encoding."))
+ (message "%s" tidy-message))))
+
+(defun tidy-after-ediff ()
+ (run-with-idle-timer 0 nil 'remove-hook 'ediff-quit-hook 'tidy-after-ediff)
+ ;;(lwarn 't :warning "cb=%s, %s, %s" (current-buffer) ediff-buffer-A ediff-buffer-B)
+ (let ((sw (selected-window))
+ nw)
+ (select-window ediff-window-B)
+ (setq nw (split-window))
+ (set-window-buffer nw (get-buffer-create tidy-control-buffer-name))
+ (select-window sw))
+ nil)
+
+(defun tidy-ediff-buffers (buffer-a buffer-b &optional startup-hooks job-name)
+ (add-hook 'ediff-quit-hook 'tidy-after-ediff)
+ (ediff-buffers buffer-a buffer-b startup-hooks job-name))
+
+;; http://sf.net/tracker/index.php?func=detail&aid=1425219&group_id=27659&atid=390963
+(defun tidy-remove-ctrl-m (buffer)
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (let ((control-m (char-to-string ?\r)))
+ (while (search-forward control-m nil t)
+ (replace-match "" nil t)))))
+
+(defvar tidy-html-files-re "\.x?html?$")
+(defun tidy-is-html-file (filename)
+ (string-match tidy-html-files-re filename))
+
+(defun tidy-contains (dir file)
+ (let ((d (file-name-as-directory dir)))
+ (when (< (length d) (length file))
+ (string= d (substring file 0 (length d))))))
+
+
+
+(defvar tidy-tree-files nil)
+(defun tidy-tree-next ()
+ (let ((next-file (car tidy-tree-files))
+ file-buffer
+ ;;(tidy-use-ediff nil)
+ )
+ (if (not next-file)
+ ;;(setq tidy-batch-buffer nil)
+ nil
+ (setq tidy-tree-files (cdr tidy-tree-files))
+ (if (file-directory-p next-file)
+ (error "Uh?")
+ (tidy-batch next-file)))))
+
+(defun tidy-tree (root)
+ "Run Tidy on all files in the directory ROOT.
+The files are first opened in Emacs and then `tidy-buffer' is
+called."
+ (interactive "DDirectory tree: ")
+ (unless (file-directory-p root)
+ (error "tidy-tree called with non-directory arg: %s" root))
+ (setq tidy-tree-files (html-site-get-sub-files root html-site-files-re))
+ (dolist (f tidy-tree-files)
+ (let ((b (get-file-buffer f)))
+ (when (and b
+ (buffer-modified-p b))
+ (unless
+ (y-or-n-p (format "Modified buffer %s must be saved. Save it and continue? "
+ (buffer-name b)))
+ (error "Modified buffers prevent run with Tidy"))
+ (with-current-buffer b
+ (basic-save-buffer)))))
+ (setq tidy-batch-last-file nil)
+ (tidy-tree-next))
+
+(defun tidy-html-site ()
+ "Tidy the whole tree in the current site."
+ ;; Fix-me: document html-site better.
+ (interactive)
+ (unless (featurep 'html-site)
+ (error "html-site is not loaded"))
+ (html-site-current-ensure-site-defined)
+ (tidy-tree (html-site-current-site-dir)))
+
+(defun tidy-batch-sentinel (process event)
+ (with-current-buffer (process-buffer process)
+ (let ((inhibit-read-only t))
+ (insert "PROCESS-EVENT: " event "\n")))
+ (when (eq (process-status process) 'exit)
+ (when tidy-batch-last-file
+ (let ((b (get-file-buffer tidy-batch-last-file)))
+ (when b
+ (with-current-buffer b
+ (save-excursion
+ (widen)
+ (let ((old (buffer-substring-no-properties (point-min) (point-max)))
+ (new (with-temp-buffer
+ ;;(insert-file tidy-batch-last-file)
+ (insert-file-contents tidy-batch-last-file)
+ (buffer-substring-no-properties (point-min) (point-max))))
+ )
+ (unless (string= old new)
+ (erase-buffer)
+ (insert new))))))))
+ (tidy-tree-next)))
+
+(defun tidy-batch-output-filter (proc string)
+ (display-buffer (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let ((moving (= (point) (process-mark proc))))
+ (save-excursion
+ ;; Insert the text, advancing the process marker.
+ (goto-char (process-mark proc))
+ (let ((inhibit-read-only t))
+ ;; http://sf.net/tracker/index.php?func=detail&aid=1425219&group_id=27659&atid=390963
+ (setq string (replace-regexp-in-string "\r$" "" string))
+ (insert string))
+ (set-marker (process-mark proc) (point)))
+ (if moving (goto-char (process-mark proc))))))
+
+(defun tidy-batch (filename)
+ (interactive (list buffer-file-name)) ;; For testing
+ (setq tidy-batch-last-file filename)
+ (let* (;;(filename buffer-file-name)
+ (config-file (tidy-temp-config-file))
+ (command (list tidy-shell-program
+ ;; load configuration file first so that
+ ;; options are overridden by command line
+
+ "-config" config-file
+ ;;"--error-file" error-file
+ "--write-back" "yes"
+ ;;"--show-body-only" "no"
+ "--gnu-emacs" "yes"
+ "--gnu-emacs-file" filename
+ filename
+ ))
+ (procbuf (noshell-procbuf-setup "subprocess for Tidy"))
+ (start (with-current-buffer procbuf (point)))
+ proc
+ ;; This does not work at the moment (2006-05-16):
+ (coding-system-for-read 'undecided-dos)
+ (coding-system-for-write 'undecided-dos)
+ )
+ ;;(setq tidy-batch-buffer procbuf)
+ (tidy-save-settings config-file)
+ (unwind-protect
+ (setq proc (apply 'noshell-procbuf-run procbuf command))
+ (with-current-buffer procbuf
+ (set-process-sentinel proc 'tidy-batch-sentinel)
+ ;;(set-process-coding-system 'dos)
+ (set-process-filter proc 'tidy-batch-output-filter)
+ (let ((win (get-buffer-window procbuf)))
+ (when win
+ (set-window-point win (point-max))
+ ))
+ ))))
+
+;;;}}} +
+
+;;;}}}
+
+;; (with-temp-buffer
+;; (tidy-parse-config-file))
+
+(defun wab-compilation-button-at (pos)
+ (let ((old (point))
+ ret)
+ (goto-char pos)
+ (setq ret (eq 'compilation-button-map
+ (get-char-property pos 'keymap)))
+ (goto-char old)
+ ret))
+
+(defun wab-click (&optional event)
+ "Do the action that is tighed to the button."
+ (interactive (list last-input-event))
+ (if event (posn-set-point (event-end event)))
+ (let ((button (get-char-property (point) 'button))
+ done)
+ (condition-case nil
+ (progn
+ (compile-goto-error)
+ (setq done t))
+ (error nil))
+ (unless done
+ (when button
+ (if (widget-at)
+ ;;(widget-apply-action button event)
+ (widget-apply-action button)
+ (push-button))))))
+
+(defvar wab-errors-supress
+ '("No more buttons"
+ "Moved past last error"
+ "No buttons or fields found"
+ "Moved back before first error"
+ ))
+
+(defun wab-fb-errmsg (err)
+ (let ((s (error-message-string err)))
+ (unless (member s wab-errors-supress)
+ (message "%s" err)
+ (signal (car err) (cdr err)))))
+
+(defun wab-fb-helper (forward function check-at args)
+ (let (ret
+ (len (1+ (- (point-max) (point-min))))
+ (old (point)))
+ (condition-case err
+ (progn
+ (apply function args)
+ (when (funcall check-at (point))
+ (setq ret (point))))
+ (error (wab-fb-errmsg err)))
+ (unless ret
+ (if forward
+ (goto-char (point-min))
+ (goto-char (point-max)))
+ (condition-case err
+ (progn
+ (apply function args)
+ (when (funcall check-at (point))
+ (setq ret (point))))
+ (error (message "%s" (error-message-string err)))))
+ (goto-char old)
+ (when (and ret (= ret old))
+ (if forward
+ (setq ret (+ ret len))
+ (setq ret (- ret len))))
+ ;;(message "function=%s, ret=%s" function ret)
+ ret))
+(defvar wab-button-list
+ '(
+ (compilation-previous-error (1) compilation-next-error (1) wab-compilation-button-at)
+ (backward-button (1) forward-button (1) button-at)
+ (widget-backward (1) widget-forward (1) widget-at)
+ ))
+(defun wab-fb (forward)
+ ;;(message "==================")
+ (let* ((pos-list (mapcar (lambda (p)
+ (let ((prev-fun (nth 0 p))
+ (prev-arg (nth 1 p))
+ (next-fun (nth 2 p))
+ (next-arg (nth 3 p))
+ (test-fun (nth 4 p)))
+ (if forward
+ (wab-fb-helper t next-fun test-fun next-arg)
+ (wab-fb-helper nil prev-fun test-fun prev-arg))))
+ wab-button-list))
+ (len (1+ (- (point-max) (point-min))))
+ (defpos (if forward (* 2 len) (- len)))
+ (newpos defpos)
+ (here (point)))
+ ;;(message "pos-list=%s" pos-list)
+ (mapc (lambda (p) (when (and p
+ (if forward
+ (progn
+ (when (< p here)
+ (setq p (+ p len)))
+ (< p newpos))
+ (when (> p here)
+ (setq p (- p len)))
+ (> p newpos)))
+ (setq newpos p)))
+ pos-list)
+ (if (= newpos defpos)
+ (setq newpos here)
+ (setq newpos (mod newpos len)))
+ (goto-char newpos)))
+
+(defun wab-backward ()
+ "Go to next button or error link."
+ (interactive)
+ (wab-fb nil))
+
+(defun wab-forward ()
+ "Go to previous button or error link."
+ (interactive)
+ (wab-fb t))
+
+(define-compilation-mode wab-compilation-mode "WAB Compilation"
+ "Mode for tidy control buffer."
+ )
+(define-key wab-compilation-mode-map [tab] 'wab-forward)
+(define-key wab-compilation-mode-map [(shift tab)] 'wab-backward)
+(define-key wab-compilation-mode-map [backtab] 'wab-backward)
+(define-key wab-compilation-mode-map "\r" 'wab-click)
+(define-key wab-compilation-mode-map [mouse-1] 'wab-click)
+(define-key wab-compilation-mode-map [mouse-2] 'wab-click)
+
+(defvar tidy-menu-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; This did not work:
+ ;;(define-key map [menu-bar tidy-menu] (list 'menu-item "Tidy" '(lambda () (interactive) tidy-menu-symbol)))
+ map))
+
+(define-minor-mode tidy-menu-mode
+ "This mode just adds Tidy to the menu bar."
+ nil
+ nil
+ nil
+ (when tidy-menu-mode
+ (define-key tidy-menu-mode-map [menu-bar tidy-menu]
+ (list 'menu-item "Tidy" tidy-menu-symbol))))
+
+(provide 'tidy-xhtml)
+
+;;; tidy-xhtml.el ends here
--- /dev/null
+(require 'wid-edit)
+(require 'help-mode)
+
+(defun test-widget-formats ()
+ (interactive)
+ (let ((widget-button-prefix "<<<<")
+ (widget-button-suffix ""))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer (help-buffer)
+ (set (make-local-variable 'widget-push-button-prefix) "")
+ (set (make-local-variable 'widget-push-button-suffix) "")
+ (set (make-local-variable 'widget-link-prefix) "")
+ (set (make-local-variable 'widget-link-suffix) "")
+
+ (widget-create 'push-button
+ :action '(lambda (w &optional e) (message "1"))
+ :button-face 'emacsw32-link-face
+ :button-prefix ""
+ :button-suffix ""
+ "One"
+ )
+ (widget-create 'push-button
+ :action '(lambda (w &optional e) (message "2"))
+ :format "%[%v%]"
+ :value "two"
+ )
+ (widget-create 'push-button
+ :action '(lambda (w &optional e) (message "3"))
+ :format "%[%v%]"
+ :button-prefix ""
+ :button-suffix ""
+ "three"
+ )
+ (widget-create 'push-button
+ :action '(lambda (w &optional e) (message "4"))
+ :format "%v"
+ :button-prefix ""
+ :button-suffix ""
+ "four"
+ )
+ (widget-create 'push-button
+ :action '(lambda (w &optional e) (message "5"))
+ :format "%{%v%}"
+ :button-prefix ""
+ :button-suffix ""
+ "five"
+ )
+ (widget-create 'push-button
+ :action '(lambda (w &optional e) (message "6"))
+ ;;:format "%[[%v]%]"
+ :value "Six"
+ ;;:value-create 'widget-browse-value-create
+ :value-create (lambda (widget) (insert (widget-get widget :value)))
+ )
+ (widget-setup)
+ ))))
--- /dev/null
+;;; xhtml-help.el --- Browse XHTML reference sites
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2005-08-16
+;; Last-Updated: Wed Aug 01 14:24:07 2007 (7200 +0200)
+(defconst xhtml-help:version "0.57") ;; Version:
+;; Keywords: languages
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Use when editing XHTML file to get tag references or CSS property
+;; name references (like background-color) from web sources.
+;;
+;; Usage:
+;;
+;; (require 'fmode)
+;;
+;; Then call `xhtml-help-show-tag-ref' or `xhtml-help-show-css-ref'.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; History:
+;;
+;; 2005-12-02: Corrected fetching margin-*.
+;; 2006-01-08: Prompt for tag and property name before fetching help.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This file is not part of Emacs
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defun xhtml-help-css-prop-at-point ()
+ "Get possible css name property at point."
+ (save-excursion
+ (let ((ch (char-after))
+ (in-word))
+ (when (and (not (bolp))
+ (or (not ch)
+ (member ch '(10 9 32 ?\:))))
+ (backward-char)
+ (setq ch (char-after)))
+ (while (string-match "[a-z-]" (char-to-string ch))
+ (setq in-word t)
+ (backward-char)
+ (setq ch (char-after)))
+ (when in-word
+ (forward-char)
+ (when (looking-at "[a-z-]+")
+ (match-string-no-properties 0))))))
+
+;;;###autoload
+(defun xhtml-help-show-css-ref ()
+ "Show CSS reference for CSS property name at point."
+ (interactive)
+ (let ((css-prop (xhtml-help-css-prop-at-point)))
+ (setq css-prop (read-from-minibuffer "Get help for CSS property: " css-prop))
+ (when css-prop
+ (xhtml-help-browse-css css-prop))))
+
+;;;###autoload
+(defun xhtml-help-tag-at-point ()
+ "Get xhtml tag name at or before point."
+ (save-excursion
+ (when (eq (following-char) ?<)
+ (forward-char))
+ (when (and (search-backward "<" nil t)
+ (looking-at "</?\\([[:alnum:]]+\\)"))
+ (match-string-no-properties 1))))
+
+;;;###autoload
+(defun xhtml-help-show-tag-ref ()
+ "Show xhtml reference for tag name at or before point."
+ (interactive)
+ (let ((tag (xhtml-help-tag-at-point)))
+ (setq tag (read-from-minibuffer "Get help for tag name: " tag))
+ (when (< 0 (length tag))
+ (xhtml-help-browse-tag tag))))
+
+;;;###autoload
+(defgroup xhtml-help nil
+ "Customization group for xhtml-help."
+ :group 'nxhtml
+ :group 'hypermedia)
+
+(defcustom xhtml-help-refurl "http://www.w3.org/"
+ "Web url to get references from."
+ :type '(choice
+ (const "http://www.w3.org/")
+ (const "http://xhtml.com/")
+ (const "http://www.w3schools.com/")
+ ;;(const "http://learningforlife.fsu.edu/")
+ )
+ :group 'xhtml-help)
+
+(defcustom xhtml-help-query-refurl t
+ "Query for reference url.
+This is used in `xhtml-help-browse-tag' and `xhtml-help-browse-css'."
+ :type 'boolean
+ :group 'xhtml-help)
+
+(defun xhtml-help-query-refurl (prompt &optional notvalid)
+ (let ((choices (get 'xhtml-help-refurl 'custom-type))
+ (default xhtml-help-refurl))
+ (unless (eq 'choice (car choices))
+ (error "Custom type of xhtml-help-refurl is not choices"))
+ (setq choices (cdr choices))
+ (setq choices (mapcar (lambda (elt)
+ (car (cdr elt)))
+ choices))
+ (mapc (lambda (elt)
+ (setq choices (delete elt choices)))
+ notvalid)
+ (when (member default notvalid)
+ (setq default (car choices)))
+ (completing-read (concat "Fetch " prompt " reference from: ")
+ choices
+ nil
+ t
+ default
+ '(choices . 1))))
+
+(defun xhtml-match (target str)
+ (let ((len (length target)))
+ (when (<= len (length str))
+ (equal target (substring str 0 len)))))
+
+(defun xhtml-match-member (target str-list)
+ (let (m)
+ (mapc (lambda (elt)
+ (when (xhtml-match elt target)
+ (setq m t)))
+ str-list)
+ m))
+
+(defun xhtml-help-browse-css (css-prop)
+ (let* ((refurl (if xhtml-help-query-refurl
+ (xhtml-help-query-refurl (concat "CSS property '" css-prop "'")
+ (list "http://xhtml.com/"))
+ xhtml-help-refurl))
+ (url
+ (cond
+ ( (equal refurl "http://www.w3schools.com/")
+ (concat
+ refurl "css/pr_"
+ (cond
+ ( (member css-prop '("clear" "cursor" "display" "float" "position" "visibility"))
+ "class_")
+ ( (member css-prop '("height" "line-height" "max-width" "min-height" "min-width" "width"))
+ "dim_")
+ ( (xhtml-match "font-weight" css-prop)
+ (setq css-prop "") "font_weight")
+ ( (xhtml-match "font" css-prop)
+ "font_")
+ ( (member css-prop '("content" "counter-increment" "counter-reset" "quotes"))
+ "gen_")
+ ( (xhtml-match "list" css-prop)
+ "list_")
+ ( (xhtml-match "margin" css-prop)
+ "")
+ ( (xhtml-match "outline" css-prop)
+ "outline_")
+ ( (equal "padding" css-prop)
+ "")
+ ( (xhtml-match "padding" css-prop)
+ "padding_")
+ ( (member css-prop '("bottom" "clip" "left" "overflow" "right" "top"
+ "vertical-align" "z-index"))
+ "pos_")
+ ( (member css-prop '("border-collapse"))
+ "tab_")
+ ( (member css-prop '("color" "direction" "letter-spacing" "text-align"
+ "text-decoration" "text-indent" "text-transform"
+ "white-space" "word-spacing"))
+ "text_")
+ ( t ""))
+ css-prop ".asp"))
+ ;; ( (equal refurl "http://learningforlife.fsu.edu/")
+ ;; (let ((css-prop2 css-prop)
+ ;; (cc)
+ ;; (ii 0))
+ ;; (while (< ii (length css-prop))
+ ;; (setq cc (substring css-prop2 ii (1+ ii)))
+ ;; (when (equal cc "-")
+ ;; (store-substring css-prop2 ii "_"))
+ ;; (setq ii (1+ ii)))
+ ;; (concat
+ ;; refurl "webmaster/references/css/" css-prop2 ".cfm")))
+ ( (equal refurl "http://www.w3.org/")
+ (let ((properties "")
+ (prop-def ""))
+ (concat
+ refurl "TR/REC-CSS2/"
+ (cond
+ ( (xhtml-match-member css-prop '("margin" "padding" "border"))
+ "box.html#propdef-")
+ ( (member css-prop '("display" "position"
+ "top" "right" "bottom" "left"
+ "float" "clear"
+ "z-index"
+ "direction" "unicode-bidi"))
+ "visuren.html#propdef-")
+ ( (member css-prop '("width" "min-width" "max-width"
+ "height" "min-height" "max-height"
+ "line-height" "vertical-align"))
+ "visudet.html#propdef-")
+ ( (member css-prop '("overflow" "clip" "visibility"))
+ "visufx.html#propdef-")
+ ( (member css-prop '("content" "quotes"))
+ "generate.html#propdef-")
+ ( (or (xhtml-match css-prop "counter")
+ (member css-prop '("marker-offset")))
+ (setq css-prop "")
+ "generate.html#counters")
+ ( (xhtml-match-member css-prop '("list"))
+ "generate.html#propdef-")
+ ( (member css-prop '("size" "marks"
+ "page-break-before" "page-break-after" "page-break-inside"
+ "page"
+ "orphans" "widows"
+ ))
+ "page.html#propdef-")
+ ( (member css-prop '("color"
+ "background-color" "background-image" "background-repeat"
+ "background-attachment" "background-position" "background"
+ ))
+ "colors.html#propdef-")
+ ( (xhtml-match "font" css-prop)
+ "fonts.html#propdef-")
+ ( (xhtml-match "text" css-prop)
+ "text.html#")
+ ( (member css-prop '("letter-spacing" "word-spacing"))
+ "text.html#")
+ ;; Fix-me: tables???
+ ( (member css-prop '("cursor"))
+ "ui.html#propdef-")
+ ( (xhtml-match "outline" css-prop)
+ "ui.html#dynamic-outlines")
+ ( (or (xhtml-match "speak" css-prop)
+ (xhtml-match "pause" css-prop)
+ (xhtml-match "cue" css-prop)
+ (xhtml-match "pitch" css-prop)
+ (member css-prop '("volume" "play-during" "azimuth" "elevation"
+ "speech-rate" "voice-family" "richness")))
+ "aural.html#propdef-")
+ )
+ css-prop
+ )))
+ ( t (error "Bad value for xhtml-help-refurl: %s" refurl)))))
+ (browse-url url)))
+
+
+
+
+
+(defun xhtml-help-browse-tag (tag)
+ (let* ((refurl (if xhtml-help-query-refurl
+ (xhtml-help-query-refurl (concat "XHTML tag '" tag "'")
+ (list "http://www.w3.org/"))
+ xhtml-help-refurl))
+ (url
+ (cond
+ ( (equal refurl "http://xhtml.com/")
+ (concat
+ refurl "en/xhtml/reference/"
+ tag
+ "/")
+ )
+ ( (equal refurl "http://www.w3schools.com/")
+ (concat
+ refurl "tags/"
+ (cond
+ ( (member tag '("tt" "i" "b" "big" "small"))
+ "tag_font_style.asp")
+ ( (member tag '("em" "strong" "dfn" "code" "samp" "kbd" "var" "cite"))
+ "tag_phrase_elements.asp")
+ ( (member tag '("h1" "h2" "h3" "h4" "h5" "h6"))
+ "tag_hn.asp")
+ ( (member tag '("sub" "sup"))
+ "tag_sup.asp")
+ ( t
+ (concat "tag_" tag ".asp")
+ ))))
+ ;; ( (equal refurl "http://learningforlife.fsu.edu/")
+ ;; (concat
+ ;; refurl "webmaster/references/xhtml/tags/"
+ ;; (cond
+ ;; ( (member tag '("body" "head" "html" "title"))
+ ;; "structure/")
+ ;; ( (member tag '("abbr" "acronym" "address" "blockquote" "br" "cite"
+ ;; "code" "dfn" "div" "em" "h1" "h2" "h3" "h4" "h5" "h6"
+ ;; "kbd" "p" "pre" "q" "samp" "span" "strong" "var"))
+ ;; "text/")
+ ;; ( (member tag '("a"))
+ ;; "hypertext/")
+ ;; ( (member tag '("dl" "dd" "dt" "ol" "ul" "li"))
+ ;; "list/")
+ ;; ( (member tag '("object" "param"))
+ ;; "object/")
+ ;; ( (member tag '("b" "big" "hr" "i" "small" "sub" "sup" "tt"))
+ ;; "presentation/")
+ ;; ( (member tag '("del" "ins"))
+ ;; "edit/")
+ ;; ( (member tag '("bdo"))
+ ;; "bidirectional/")
+ ;; ( (member tag '("button" "fieldset" "form" "input" "label" "legend"
+ ;; "select" "optgroup" "option" "textarea"))
+ ;; "forms/")
+ ;; ( (member tag '("caption" "col" "colgroup" "table" "tbody" "td"
+ ;; "tfoot" "th" "thead" "tr"))
+ ;; "table/")
+ ;; ( (member tag '("img"))
+ ;; "image/")
+ ;; ( (member tag '("area" "map"))
+ ;; "client/")
+ ;; ( (member tag '("area" "map"))
+ ;; "client/")
+ ;; ( (member tag '("meta"))
+ ;; "meta/")
+ ;; ( (member tag '("noscript" "script"))
+ ;; "scripting/")
+ ;; ( (member tag '("style"))
+ ;; "stylesheet/")
+ ;; ( (member tag '("link"))
+ ;; "link/")
+ ;; ( (member tag '("base"))
+ ;; "base/")
+ ;; ( (member tag '("base"))
+ ;; "base/")
+ ;; ( (member tag '("ruby" "rbc" "rtc" "rb" "rt" "rp"))
+ ;; "ruby/")
+ ;; )
+ ;; tag ".cfm"))
+ ( t (error "Bad value for xhtml-help-refurl: %s" refurl))
+ )))
+ (browse-url url)))
+
+(defconst xhtml-help-mode-keymap
+ (let ((map (make-sparse-keymap "XHTML Help")))
+ (define-key map [menu-bar xh-help] (cons "XHTML Help" (make-sparse-keymap "second")))
+ (define-key map [menu-bar xh-help css-help] '("CSS Help" . xhtml-help-show-css-ref))
+ (define-key map [menu-bar xh-help tag-help] '("XHTML Tag Help" . xhtml-help-show-tag-ref))
+ map))
+
+(define-minor-mode xhtml-help-mode
+ "Minor mode that adds keys for accessing xhtml and css help."
+ :keymap xhtml-help-mode-keymap)
+
+(provide 'xhtml-help)
+
+;;; xhtml-help.el ends here
--- /dev/null
+;;; nxhtmlmaint.el --- Some maintenance helpers
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-09-27T15:29:35+0200 Sat
+;; Version: 0.6
+;; Last-Updated: 2010-01-18 Mon
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This module contains maintenance functions:
+;;
+;; `nxhtmlmaint-get-all-autoloads' (nxhtmlmaint-get-all-autoloads)
+;;
+;; `nxhtmlmaint-start-byte-compilation'
+;; `nxhtmlmaint-byte-uncompile-all'
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'advice))
+(eval-when-compile (require 'nxhtml-base))
+(eval-when-compile (require 'nxhtml-web-vcs nil t))
+(eval-when-compile (require 'web-vcs nil t))
+(eval-when-compile (require 'ourcomments-util))
+
+(defvar nxhtmlmaint-dir
+ ;;(file-name-directory (if load-file-name load-file-name buffer-file-name))
+ (file-name-directory (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+ "Maintenance directory for nXhtml.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Autoload helpers
+
+(defun nxhtmlmaint-autoloads-file ()
+ "Return autoload file name for nXhtml."
+ (file-truename (expand-file-name "nxhtml-loaddefs.el" nxhtmlmaint-dir)))
+
+(defun nxhtmlmaint-util-dir ()
+ "Return nXhtml util directory."
+ (file-truename (file-name-as-directory
+ (expand-file-name "util" nxhtmlmaint-dir))))
+
+(defvar nxhtmlmaint-autoload-default-directory (nxhtmlmaint-util-dir))
+
+(defvar generated-autoload-file)
+
+(defun nxhtmlmaint-initialize-autoloads-file ()
+ "Initialize nXhtml autoload file."
+ (with-current-buffer (find-file-noselect generated-autoload-file)
+ (when (= 0 (buffer-size))
+ (insert ";; Autoloads for nXthml
+;;
+;; This file should be updated by `nxhtmlmaint-get-file-autoloads',
+;; `nxhtmlmaint-get-dir-autoloads' or `nxhtmlmaint-get-all-autoloads'.
+\(eval-when-compile (require 'nxhtml-base))
+\(eval-when-compile (require 'web-vcs))")
+ (basic-save-buffer))))
+
+(defun nxmtmlmaint-advice-autoload (on)
+ "Activate advices if ON, otherwise turn them off."
+ (if on
+ (progn
+ (ad-activate 'autoload-file-load-name)
+ (ad-activate 'make-autoload))
+ (ad-deactivate 'autoload-file-load-name)
+ (ad-deactivate 'make-autoload)))
+
+(defun nxhtmlmaint-get-file-autoloads (file)
+ "Get autoloads for file FILE.
+Update nXhtml autoload file with them."
+ (interactive (list (buffer-file-name)))
+ (let* ((generated-autoload-file (nxhtmlmaint-autoloads-file))
+ (emacs-lisp-mode-hook nil)
+ (default-directory (nxhtmlmaint-util-dir)))
+ (nxhtmlmaint-initialize-autoloads-file)
+ ;; Get the autoloads using advice
+ (nxmtmlmaint-advice-autoload t)
+ (update-file-autoloads file nil)
+ (nxmtmlmaint-advice-autoload nil)
+ ;; Display
+ (display-buffer (find-file-noselect generated-autoload-file))))
+
+(defun nxhtmlmaint-get-dir-autoloads (dir)
+ "Get autoloads for directory DIR.
+Update nXhtml autoload file with them."
+ (interactive (list (or (when (buffer-file-name)
+ (file-name-directory (buffer-file-name)))
+ default-directory)))
+ (let* ((generated-autoload-file (nxhtmlmaint-autoloads-file))
+ (emacs-lisp-mode-hook nil)
+ (auto-buf (find-file-noselect generated-autoload-file)))
+ (nxhtmlmaint-initialize-autoloads-file)
+ ;; Get the autoloads using advice
+ (nxmtmlmaint-advice-autoload t)
+ ;; Fix-me: Loop instead, some files must be avoided.
+ (update-directory-autoloads dir)
+ (nxmtmlmaint-advice-autoload nil)
+ ;; Display
+ (display-buffer (find-file-noselect generated-autoload-file))))
+
+(defun nxhtmlmaint-get-tree-autoloads (root)
+ "Get autoloads for directory tree ROOT.
+Update nXhtml autoload file with them."
+ (interactive (list (or (when (buffer-file-name)
+ (file-name-directory (buffer-file-name)))
+ default-directory)))
+ (message "Getting autoloads in %s" root)
+ (nxhtmlmaint-get-dir-autoloads root)
+ (let* ((files (directory-files root))
+ (sub-dirs (mapcar (lambda (file)
+ (when (and (not (member file '("." "..")))
+ (not (member file '("nxml-mode-20041004" "old")))
+ (not (member file '("nxhtml-company-mode")))
+ (not (member file '("in")))
+ (file-directory-p (expand-file-name file root)))
+ file))
+ files)))
+ (setq sub-dirs (delq nil sub-dirs))
+ ;;(message "sub-dirs=%s" sub-dirs)
+ (dolist (dir sub-dirs)
+ (let ((full-dir (expand-file-name dir root)))
+ (unless (or (string= full-dir nxhtmlmaint-dir)
+ (string= dir "alts"))
+ (nxhtmlmaint-get-tree-autoloads full-dir))))))
+
+;;(nxhtmlmaint-get-all-autoloads)
+(defun nxhtmlmaint-get-all-autoloads ()
+ "Get all autoloads for nXhtml.
+Update nXhtml autoload file with them."
+ ;;(interactive)
+ (if nxhtml-autoload-web
+ (message "Skipping rebuilding autoloads, not possible when autoloading from web")
+ (let ((auto-buf (find-file-noselect (nxhtmlmaint-autoloads-file))))
+ (with-current-buffer auto-buf
+ (erase-buffer)
+ (basic-save-buffer))
+ (nxhtmlmaint-get-tree-autoloads nxhtmlmaint-dir)
+ ;; `nxhtml-mode' and `nxhtml-validation-header-mode' should only be
+ ;; autoloaded if nxml-mode if available.
+ (with-current-buffer auto-buf
+ (message "Fixing nxml autoloads")
+ (let ((frmt (if (= emacs-major-version 22)
+ "^(autoload (quote %s) "
+ "^(autoload '%s ")))
+ (dolist (nxmode '(nxhtml-mode nxhtml-validation-header-mode))
+ (goto-char (point-min))
+ (when (re-search-forward (format frmt nxmode) nil t)
+ (forward-line 0)
+ (insert "(when (fboundp 'nxml-mode)\n")
+ (forward-sexp)
+ (insert ")"))))
+ ;; Fix defcustom autoloads
+ (goto-char (point-min))
+ (let ((cus-auto "(\\(custom-autoload\\) +'.* +\\(\".*?\"\\)"))
+ (while (re-search-forward cus-auto nil t)
+ ;;(backward-char (1- (length cus-auto)))
+ ;;(insert "nxhtml-")
+ (let ((lib (match-string 2)))
+ ;; Change to symbol to fix autoloading. This works because
+ ;; custom-load-symbol does require on symbols.
+ (setq lib (concat "'" (substring lib 1 -1)))
+ (replace-match "nxhtml-custom-autoload" t t nil 1)
+ (replace-match lib t t nil 2))))
+ ;; Fix autoload calls
+ (goto-char (point-min))
+ (let ((auto "(autoload "))
+ (while (search-forward auto nil t)
+ (backward-char (1- (length auto)))
+ (insert "nxhtml-")))
+ ;; Fix autoload source
+ (goto-char (point-min))
+ (let* ((patt-src "^;;; Generated autoloads from \\(.*\\)$")
+ (patt-auto "^(nxhtml-autoload '[^ ]+ \\(\"[^\"]+\"\\)")
+ (patt-cust "^(nxhtml-custom-autoload '[^ ]+ \\(\"[^\"]+\"\\)")
+ (patt (concat "\\(?:" patt-src "\\)\\|\\(?:" patt-auto "\\)\\|\\(?:" patt-cust "\\)"))
+ curr-src)
+ (while (re-search-forward patt nil t)
+ (cond
+ ( (match-string 1)
+ (setq curr-src (match-string-no-properties 1))
+ ;; Remove .el
+ (setq curr-src (substring curr-src 0 -3))
+ ;; Setup up for web autoload
+ (let* ((src-name (file-name-nondirectory curr-src))
+ (feature (make-symbol src-name))
+ )
+ (end-of-line)
+ (insert "\n"
+ "(web-autoload-require '"
+ (symbol-name feature)
+ " 'lp"
+ " '(nxhtml-download-root-url nil)"
+ " \"" curr-src "\""
+ " nxhtml-install-dir"
+ " 'nxhtml-byte-compile-file"
+ ")\n"))
+ )
+ ( (match-string 3)
+ ;; (custom-autoload 'sym "lib" nil) is will give a
+ ;; (require 'lib) so everything is ok here.
+ nil)
+ ( (or (match-string 2)
+ (match-string 3)
+ )
+ (let* ((subexp (if (match-string 2) 2 3))
+ (file (match-string-no-properties subexp)))
+ (replace-match (concat "`(lp '(nxhtml-download-root-url nil)"
+ " \"" curr-src "\""
+ " nxhtml-install-dir)")
+ nil ;; fixedcase
+ nil ;; literal
+ nil ;; string
+ subexp ;; subexp
+ ))
+ )
+ (t (error "No match???")))))
+ ;; Save
+ (basic-save-buffer)))))
+
+
+(defun nxhtmlmaint-autoload-file-load-name (file)
+ "Return relative file name for FILE to autoload file directory."
+ (let ((name (if (and nxhtmlmaint-autoload-default-directory
+ (file-name-absolute-p file))
+ (file-relative-name
+ file nxhtmlmaint-autoload-default-directory)
+ (file-name-nondirectory file))))
+ (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
+ (substring name 0 (match-beginning 0))
+ name)))
+
+(defadvice autoload-file-load-name (around
+ nxhtmlmaint-advice-autoload-file-load-name
+ ;;activate
+ compile)
+ "Advice to return relative file name."
+ (setq ad-return-value (nxhtmlmaint-autoload-file-load-name (ad-get-arg 0))))
+
+(defun nxhtmlmaint-make-autoload (form file)
+ "Make autoload for multi major modes."
+ ;;(message "form=%S" form)
+ (if (or (not (listp form))
+ (not (eq 'define-mumamo-multi-major-mode (car form))))
+ ad-return-value
+ (if ad-return-value
+ ad-return-value
+ ;; Fix-me: Maybe expand??
+ (let ((name (nth 1 form))
+ (doc (nth 2 form)))
+ `(autoload ',name ,file ,doc t)
+ ))))
+
+(defadvice make-autoload (after
+ nxhtmlmaint-advice-make-autoload
+ ;;activate
+ compile)
+ "Make autoload for multi major modes."
+ (setq ad-return-value
+ (nxhtmlmaint-make-autoload (ad-get-arg 0)
+ (ad-get-arg 1))))
+
+;; (defun nxhtmlmaint-generate-library-autoloads (library)
+;; "Insert at point autoloads for Emacs library LIBRARY.
+;; Works like `generate-file-autoloads', but for a library."
+;; (interactive
+;; (list (completing-read "Generate autoloads for library: "
+;; 'locate-file-completion
+;; (cons load-path (get-load-suffixes)))))
+;; (let ((file (locate-library library)))
+;; ;; Fix-me: wasn't this defined???
+;; (generate-file-autoloads file)))
+
+;;;###autoload
+(defun nxhtmlmaint-start-byte-compilation ()
+ "Start byte compilation of nXhtml in new Emacs instance.
+Byte compiling in general makes elisp code run 5-10 times faster
+which is quite noticeable when you use nXhtml.
+
+This will also update the file nxhtml-loaddefs.el.
+
+You must restart Emacs to use the byte compiled files.
+
+If for some reason the byte compiled files does not work you can
+remove then with `nxhtmlmaint-byte-uncompile-all'."
+ (interactive)
+ ;; Fix-me: This message and redisplay seems only necessary sometimes.
+ (message "Preparing byte compilation of nXhtml ...") (redisplay t)
+ (let* ((this-file (expand-file-name "nxhtmlmaint.el" nxhtmlmaint-dir))
+ (auto-file (expand-file-name "autostart.el" nxhtmlmaint-dir))
+ (web-vcs-file (expand-file-name "nxhtml-web-vcs.el" nxhtmlmaint-dir))
+ (this-emacs (locate-file invocation-name
+ (list invocation-directory)
+ exec-suffixes))
+ (process-args `(,this-emacs nil 0 nil "-Q")))
+ (nxhtmlmaint-byte-uncompile-all)
+ (if (or noninteractive
+ (not window-system))
+ (nxhtmlmaint-byte-compile-all)
+ ;;(when noninteractive (setq process-args (append process-args '("-batch"))))
+ (setq process-args (append process-args
+ (list "-l" auto-file
+ "-l" web-vcs-file
+ "-l" this-file
+ "-f" "nxhtmlmaint-byte-compile-all")))
+ (message "process-args=%S" process-args)
+ (message "Starting new Emacs instance for byte compiling ...")
+ (apply 'call-process process-args))))
+
+;;(nxhtmlmaint-byte-compile-all)
+(defun nxhtmlmaint-byte-compile-all ()
+ "Byte recompile all files in nXhtml that needs it."
+ (message "nxhtmlmaint-byte-compile-all: nxhtmlmaint-dir=%S, exists=%s" nxhtmlmaint-dir (file-directory-p nxhtmlmaint-dir))
+ (let* ((load-path load-path)
+ (nxhtml-dir (file-name-as-directory
+ (expand-file-name "nxhtml"
+ nxhtmlmaint-dir)))
+ (util-dir (file-name-as-directory
+ (expand-file-name "util"
+ nxhtmlmaint-dir)))
+ ;; (nxhtml-company-dir (file-name-as-directory
+ ;; (expand-file-name "nxhtml-company-mode"
+ ;; util-dir)))
+ (related-dir (file-name-as-directory
+ (expand-file-name "related"
+ nxhtmlmaint-dir)))
+ (tests-dir (file-name-as-directory
+ (expand-file-name "tests"
+ nxhtmlmaint-dir)))
+ (emacsw32-dir (file-name-as-directory
+ (expand-file-name "../lisp"
+ nxhtmlmaint-dir)))
+ (default-dir nxhtml-dir)
+ )
+ (message "nxhtmlmaint-byte-compile-all: nxhtml-dir=%S, exists=%s" nxhtml-dir (file-directory-p nxhtml-dir))
+ (message "nxhtmlmaint-byte-compile-all: util-dir=%S, exists=%s" util-dir (file-directory-p util-dir))
+ (message "nxhtmlmaint-byte-compile-all: related-dir=%S, exists=%s" related-dir (file-directory-p related-dir))
+ (message "nxhtmlmaint-byte-compile-all: tests-dir=%S, exists=%s" tests-dir (file-directory-p tests-dir))
+ (add-to-list 'load-path nxhtml-dir)
+ (add-to-list 'load-path util-dir)
+ ;;(add-to-list 'load-path nxhtml-company-dir)
+ (add-to-list 'load-path related-dir)
+ (add-to-list 'load-path tests-dir)
+ (when (file-directory-p emacsw32-dir)
+ (add-to-list 'load-path emacsw32-dir))
+ (require 'cl) ;; This is run in a new Emacs. Fix-me: This might not be true any more.
+ (message "load-path=%s" load-path)
+ (let ((dummy-debug-on-error t))
+ (nxhtmlmaint-byte-compile-dir nxhtmlmaint-dir nil nil nil))
+ (web-vcs-message-with-face 'web-vcs-gold "Byte compiling nXhtml is ready, restart Emacs to use the compiled files")))
+
+;;;###autoload
+(defun nxhtmlmaint-byte-recompile ()
+ "Recompile or compile all nXhtml files in current Emacs."
+ (interactive)
+ (nxhtmlmaint-byte-compile-dir nxhtmlmaint-dir nil nil t)
+ (web-vcs-message-with-face 'web-vcs-gold "Byte recompiling nXhtml ready"))
+
+;;;###autoload
+(defun nxhtmlmaint-byte-uncompile-all ()
+ "Delete byte compiled files in nXhtml.
+This will also update the file nxhtml-loaddefs.el.
+
+See `nxhtmlmaint-start-byte-compilation' for byte compiling."
+ (interactive)
+ (nxhtmlmaint-get-all-autoloads)
+ (let ((dummy-debug-on-error t))
+ (nxhtmlmaint-byte-compile-dir nxhtmlmaint-dir t t nil))
+ (message "Byte uncompiling is ready, restart Emacs to use the elisp files"))
+
+(defconst nxhtmlmaint-nonbyte-compile-dirs
+ '("." ".." "alts" "nxml-mode-20041004" "old" "tests" "nxhtml-company-mode"))
+
+;; Fix-me: simplify this now that nxml is not included
+(defun nxhtmlmaint-byte-compile-dir (dir force del-elc load)
+ "Byte compile or uncompile directory tree DIR.
+If FORCE is non-nil byte recompile the elisp file even if the
+compiled file is newer.
+
+If DEL-ELC is nil then byte compile files. If DEL-ELC is non-nil
+then instead delete the compiled files."
+ ;;(directory-files (file-name-directory buffer-file-name) t "\.el\\'")
+ (dolist (el-src (directory-files dir t "\.el\\'"))
+ (let ((elc-dst (concat el-src "c")))
+ (if del-elc
+ (when (file-exists-p elc-dst)
+ (delete-file elc-dst)
+ (message "Deleted %s" elc-dst))
+ (setq debug-on-error t)
+ (when (or force (file-newer-than-file-p el-src elc-dst))
+ ;;(message "fn=%s" (file-name-nondirectory el-src))
+ (when t ;;(string= "nxhtml-menu.el" (file-name-nondirectory el-src))
+ ;;(message "(nxhtml-byte-compile-file %s)" el-src)
+ (unless (nxhtml-byte-compile-file el-src load)
+ (message "Couldn't compile %s" el-src)))))))
+ (dolist (f (directory-files dir t))
+ (when (file-directory-p f)
+ ;; Fix-me: Avoid some dirs
+ (let ((name (file-name-nondirectory f)))
+ (unless (member name nxhtmlmaint-nonbyte-compile-dirs)
+ (nxhtmlmaint-byte-compile-dir f force del-elc load))))))
+
+(provide 'nxhtmlmaint)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtmlmaint.el ends here
--- /dev/null
+<html>
+ <head>
+ </head>
+ <body>
+ </body>
+</html>
--- /dev/null
+;;; csharp-mode.el --- C# mode derived mode
+
+;; Author: Dylan R. E. Moonfire
+;; Maintainer: Dylan R. E. Moonfire <contact@mfgames.com>
+;; Created: Feburary 2005
+;; Modified: February 2010
+;; Version: 0.7.4 - Dino Chiesa <dpchiesa@hotmail.com>
+;; Keywords: c# languages oop mode
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; This is a separate mode to implement the C# constructs and
+;; font-locking. It is based on the java-mode example from cc-mode.
+;;
+;; csharp-mode requires CC Mode 5.30 or later. It works with
+;; cc-mode 5.31.3, which is current at this time.
+;;
+;; Features:
+;;
+;; - font-lock and indent of C# syntax including:
+;; all c# keywords and major syntax
+;; attributes that decorate methods, classes, fields, properties
+;; enum types
+;; #if/#endif #region/#endregion
+;; instance initializers
+;; anonymous functions and methods
+;; verbatim literal strings (those that begin with @)
+;; generics
+;;
+;; - automagic code-doc generation when you type three slashes.
+;;
+;; - intelligent inserttion of matched pairs of curly braces.
+;;
+;; - sets the compiler regex for next-error, for csc.exe output.
+;;
+;;
+
+
+;;; To use:
+;;
+;; put this in your .emacs:
+;;
+;; (autoload 'csharp-mode "csharp-mode" "Major mode for editing C# code." t)
+;;
+;; or:
+;;
+;; (require 'csharp-mode)
+;;
+;;
+;; AND:
+;;
+;; (setq auto-mode-alist
+;; (append '(("\\.cs$" . csharp-mode)) auto-mode-alist))
+;; (defun my-csharp-mode-fn ()
+;; "function that runs when csharp-mode is initialized for a buffer."
+;; ...insert your code here...
+;; ...most commonly, your custom key bindings ...
+;; )
+;; (add-hook 'csharp-mode-hook 'my-csharp-mode-fn t)
+;;
+;;
+
+
+;;; Bugs:
+;;
+;; Namespaces in the using statements are not fontified. Should do in
+;; c-basic-matchers-before or c-basic-matchers-after.
+;;
+;; Method names with a preceding attribute are not fontified.
+;;
+;; Field/Prop names inside object initializers are fontified only
+;; if the null constructor is used, with no parens.
+;;
+;; This code doesn't seem to work when you compile it, then
+;; load/require in the emacs file. You will get an error (error
+;; "`c-lang-defconst' must be used in a file") which happens because
+;; cc-mode doesn't think it is in a buffer while loading directly
+;; from the init. However, if you call it based on a file extension,
+;; it works properly. Interestingly enough, this doesn't happen if
+;; you don't byte-compile cc-mode.
+;;
+;;
+;;
+;; Todo:
+;;
+;; Get csharp-mode.el accepted as part of the emacs standard distribution.
+;; Must contact monnier at iro.umontreal.ca to make this happen.
+;;
+;;
+;;
+;; Acknowledgements:
+;;
+;; Thanks to Alan Mackenzie and Stefan Monnier for answering questions
+;; and making suggestions.
+;;
+;;
+
+;;; Versions:
+;;
+;; 0.1.0 - Initial release.
+;; 0.2.0 - Fixed the identification on the "enum" keyword.
+;; - Fixed the font-lock on the "base" keyword
+;; 0.3.0 - Added a regex to fontify attributes. It isn't the
+;; the best method, but it handles single-like attributes
+;; well.
+;; - Got "super" not to fontify as a keyword.
+;; - Got extending classes and interfaces to fontify as something.
+;; 0.4.0 - Removed the attribute matching because it broke more than
+;; it fixed.
+;; - Corrected a bug with namespace not being properly identified
+;; and treating the class level as an inner object, which screwed
+;; up formatting.
+;; - Added "partial" to the keywords.
+;; 0.5.0 - Found bugs with compiled cc-mode and loading from init files.
+;; - Updated the eval-when-compile to code to let the mode be
+;; compiled.
+;; 0.6.0 - Added the c-filter-ops patch for 5.31.1 which made that
+;; function in cc-langs.el unavailable.
+;; - Added a csharp-lineup-region for indention #region and
+;; #endregion block differently.
+;; 0.7.0 - Added autoload so update-directory-autoloads works
+;; (Thank you, Nikolaj Schumacher)
+;; - Fontified the entire #region and #endregion lines.
+;; - Initial work to get get, set, add, remove font-locked.
+;; 0.7.1 - Added option to indent #if/endif with code
+;; - Fixed c-opt-cpp-prefix defn (it must not include the BOL
+;; char (^).
+;; - proper fontification and indent of classes that inherit
+;; (previously the colon was confusing the parser)
+;; - reclassified namespace as a block beginner
+;; - removed $ as a legal symbol char - not legal in C#.
+;; - added struct to c-class-decl-kwds so indent is correct
+;; within a struct.
+;; 0.7.2 - Added automatic codedoc insertion.
+;; 0.7.3 - Instance initializers (new Type { ... } ) and
+;; (new Type() { ...} ) are now indented properly.
+;; - proper fontification and indent of enums as brace-list-*,
+;; including special treatment for enums that explicitly
+;; inherit from an int type. Previously the colon was
+;; confusing the parser.
+;; - proper fontification of verbatim literal strings,
+;; including those that end in slash. This edge case was not
+;; handled at all before; it is now handled correctly.
+;; - code cleanup and organization; removed the linefeed.
+;; - intelligent curly-brace insertion
+;; 0.7.4 - added a C# style
+;; - using is now a keyword and gets fontified
+;; - fixed a bug that had crept into the codedoc insertion
+;;
+
+
+(require 'cc-mode)
+
+(message (concat "Loading " load-file-name))
+
+
+;; ==================================================================
+;; c# upfront stuff
+;; ==================================================================
+
+;; This is a copy of the function in cc-mode which is used to handle
+;; the eval-when-compile which is needed during other times.
+(defun c-filter-ops (ops opgroup-filter op-filter &optional xlate)
+ ;; See cc-langs.el, a direct copy.
+ (unless (listp (car-safe ops))
+ (setq ops (list ops)))
+ (cond ((eq opgroup-filter t)
+ (setq opgroup-filter (lambda (opgroup) t)))
+ ((not (functionp opgroup-filter))
+ (setq opgroup-filter `(lambda (opgroup)
+ (memq opgroup ',opgroup-filter)))))
+ (cond ((eq op-filter t)
+ (setq op-filter (lambda (op) t)))
+ ((stringp op-filter)
+ (setq op-filter `(lambda (op)
+ (string-match ,op-filter op)))))
+ (unless xlate
+ (setq xlate 'identity))
+ (c-with-syntax-table (c-lang-const c-mode-syntax-table)
+ (delete-duplicates
+ (mapcan (lambda (opgroup)
+ (when (if (symbolp (car opgroup))
+ (when (funcall opgroup-filter (car opgroup))
+ (setq opgroup (cdr opgroup))
+ t)
+ t)
+ (mapcan (lambda (op)
+ (when (funcall op-filter op)
+ (let ((res (funcall xlate op)))
+ (if (listp res) res (list res)))))
+ opgroup)))
+ ops)
+ :test 'equal)))
+
+
+
+;; These are only required at compile time to get the sources for the
+;; language constants. (The cc-fonts require and the font-lock
+;; related constants could additionally be put inside an
+;; (eval-after-load "font-lock" ...) but then some trickery is
+;; necessary to get them compiled.)
+(eval-when-compile
+ (let ((load-path
+ (if (and (boundp 'byte-compile-dest-file)
+ (stringp byte-compile-dest-file))
+ (cons (file-name-directory byte-compile-dest-file) load-path)
+ load-path)))
+ (load "cc-mode" nil t)
+ (load "cc-fonts" nil t)
+ (load "cc-langs" nil t)))
+
+(eval-and-compile
+ ;; Make our mode known to the language constant system. Use Java
+ ;; mode as the fallback for the constants we don't change here.
+ ;; This needs to be done also at compile time since the language
+ ;; constants are evaluated then.
+ (c-add-language 'csharp-mode 'java-mode))
+
+;; ==================================================================
+;; end of c# upfront stuff
+;; ==================================================================
+
+
+
+
+
+;; ==================================================================
+;; csharp-mode utility and feature defuns
+;; ==================================================================
+
+;; Indention: csharp-mode follows normal indention rules except for
+;; when indenting the #region and #endregion blocks. This function
+;; defines a custom indention to indent the #region blocks properly
+;;
+
+(defun csharp-lineup-region (langelem)
+ "Indent all #region and #endregion blocks inline with code while
+retaining normal column-zero indention for #if and the other
+processing blocks.
+
+To use this indenting just put the following in your emacs file:
+ (c-set-offset 'cpp-macro 'csharp-lineup-region)
+
+An alternative is to use `csharp-lineup-if-and-region'.
+"
+
+ (save-excursion
+ (back-to-indentation)
+ (if (re-search-forward "#\\(end\\)?region" (c-point 'eol) [0]) 0 [0])))
+
+
+
+(defun csharp-lineup-if-and-region (langelem)
+
+"Indent all #region/endregion blocks and #if/endif blocks inline
+with code while retaining normal column-zero indention for any
+other processing blocks.
+
+To use this indenting just put the following in your emacs file:
+ (c-set-offset 'cpp-macro 'csharp-lineup-if-and-region)
+
+Another option is to use `csharp-lineup-region'.
+
+"
+ (save-excursion
+ (back-to-indentation)
+ (if (re-search-forward "#\\(\\(end\\)?\\(if\\|region\\)\\|else\\)" (c-point 'eol) [0]) 0 [0])))
+
+
+
+
+
+(defun csharp-insert-open-brace ()
+ "Intelligently insert a pair of curly braces. This fn is most
+often bound to the open-curly brace, with
+
+ (local-set-key (kbd \"{\") 'csharp-insert-open-brace)
+
+The default binding for an open curly brace in cc-modes is often
+`c-electric-brace' or `skeleton-pair-insert-maybe'. The former
+can be configured to insert newlines around braces in various
+syntactic positions. The latter inserts a pair of braces and
+then does not insert a newline, and does not indent.
+
+This fn provides another option, with some additional
+intelligence for csharp-mode. When you type an open curly, the
+appropriate pair of braces appears, with spacing and indent set
+in a context-sensitive manner.
+
+Within a string literal, you just get a pair of braces, and point
+is set between them. Following an equals sign, you get a pair of
+braces, with a semincolon appended. Otherwise, you
+get the open brace on a new line, with the closing brace on the
+line following.
+
+There may be another way to get this to happen appropriately just within emacs,
+but I could not figure out how to do it. So I wrote this alternative.
+"
+ (interactive)
+ (let
+ (tpoint
+ (in-string (string= (csharp-in-literal) "string"))
+ (preceding3
+ (save-excursion
+ (and
+ (skip-chars-backward " ")
+ (> (- (point) 2) (point-min))
+ (buffer-substring-no-properties (point) (- (point) 3)))))
+ (one-word-back
+ (save-excursion
+ (backward-word 2)
+ (thing-at-point 'word))))
+
+ (cond
+
+ ;; Case 1: inside a string literal?
+ ;; --------------------------------------------
+ ;; If so, then just insert a pair of braces and put the point
+ ;; between them. The most common case is a format string for
+ ;; String.Format() or Console.WriteLine().
+ (in-string
+ (self-insert-command 1)
+ (insert "}")
+ (backward-char))
+
+ ;; Case 2: the open brace starts an array initializer.
+ ;; --------------------------------------------
+ ;; When the last non-space was an equals sign or square brackets,
+ ;; then it's an initializer.
+ ((save-excursion
+ (backward-sexp)
+ (looking-at "\\(\\w+\\b *=\\|[[]]+\\)"))
+ (self-insert-command 1)
+ (insert " };")
+ (backward-char 3))
+
+ ;; Case 3: the open brace starts an instance initializer
+ ;; --------------------------------------------
+ ;; If one-word-back was "new", then it's an object initializer.
+ ((string= one-word-back "new")
+ (save-excursion
+ (message "object initializer")
+ (setq tpoint (point)) ;; prepare to indent-region later
+ (newline)
+ (self-insert-command 1)
+ (newline-and-indent)
+ (newline)
+ (insert "};")
+ (c-indent-region tpoint (point))
+ (previous-line)
+ (indent-according-to-mode)
+ (end-of-line)
+ (setq tpoint (point)))
+ (goto-char tpoint))
+
+ ;; Case 4: a lambda initialier.
+ ;; --------------------------------------------
+ ;; If the open curly follows =>, then it's a lambda initializer.
+ ((string= (substring preceding3 -2) "=>")
+ (message "lambda init")
+ (self-insert-command 1)
+ (insert " }")
+ (backward-char 2))
+
+ ;; else, it's a new scope. (if, while, class, etc)
+ (t
+ (save-excursion
+ (message "new scope")
+ (set-mark (point)) ;; prepare to indent-region later
+ ;; check if the prior sexp is on the same line
+ (if (save-excursion
+ (let ((curline (line-number-at-pos))
+ (aftline (progn
+ (backward-sexp)
+ (line-number-at-pos))))
+ (= curline aftline)))
+ (newline-and-indent))
+ (self-insert-command 1)
+ (c-indent-line-or-region)
+ (end-of-line)
+ (newline)
+ (insert "}")
+ ;;(c-indent-command) ;; not sure of the difference here
+ (c-indent-line-or-region)
+ (previous-line)
+ (end-of-line)
+ (newline-and-indent)
+ ;; point ends up on an empty line, within the braces, properly indented
+ (setq tpoint (point)))
+
+ (goto-char tpoint)))))
+
+
+
+
+;; ==================================================================
+;; end of csharp-mode utility and feature defuns
+;; ==================================================================
+
+
+
+
+
+
+;; ==================================================================
+;; c# values for "language constants" defined in cc-langs.el
+;; ==================================================================
+
+
+;; Java uses a series of regexes to change the font-lock for class
+;; references. The problem comes in because Java uses Pascal (leading
+;; space in names, SomeClass) for class and package names, but
+;; Camel-casing (initial lowercase, upper case in words,
+;; i.e. someVariable) for variables. The notation suggested by EMCA for C# is
+;; to use Pascal notation for everything, except inner variables. So,
+;; the Java regex and formatting produces very wrong results in C#.
+;;(error (byte-compile-dest-file))
+;;(error (c-get-current-file))
+(c-lang-defconst c-opt-after-id-concat-key
+ csharp (if (c-lang-const c-opt-identifier-concat-key)
+ (c-lang-const c-symbol-start)))
+
+(c-lang-defconst c-basic-matchers-before
+ csharp `(
+ ;;;; Font-lock the attributes by searching for the
+ ;;;; appropriate regex and marking it as TODO.
+ ;;,`(,(concat "\\(" csharp-attribute-regex "\\)")
+ ;; 0 font-lock-function-name-face)
+
+ ;; Put a warning face on the opener of unclosed strings that
+ ;; can't span lines. Later font
+ ;; lock packages have a `font-lock-syntactic-face-function' for
+ ;; this, but it doesn't give the control we want since any
+ ;; fontification done inside the function will be
+ ;; unconditionally overridden.
+ ,(c-make-font-lock-search-function
+ ;; Match a char before the string starter to make
+ ;; `c-skip-comments-and-strings' work correctly.
+ (concat ".\\(" c-string-limit-regexp "\\)")
+ '((c-font-lock-invalid-string)))
+
+ ;; Fontify keyword constants.
+ ,@(when (c-lang-const c-constant-kwds)
+ (let ((re (c-make-keywords-re nil
+ (c-lang-const c-constant-kwds))))
+ `((eval . (list ,(concat "\\<\\(" re "\\)\\>")
+ 1 c-constant-face-name)))))
+
+ ;; Fontify all keywords except the primitive types.
+ ,`(,(concat "\\<" (c-lang-const c-regular-keywords-regexp))
+ 1 font-lock-keyword-face)
+
+ ;; Fontify leading identifiers in fully qualified names like
+ ;; "Foo.Bar".
+ ,@(when (c-lang-const c-opt-identifier-concat-key)
+ `((,(byte-compile
+ `(lambda (limit)
+ (while (re-search-forward
+ ,(concat "\\(\\<" ; 1
+ "\\(" (c-lang-const c-symbol-key)
+ "\\)" ; 2
+ "[ \t\n\r\f\v]*"
+ (c-lang-const
+ c-opt-identifier-concat-key)
+ "[ \t\n\r\f\v]*"
+ "\\)"
+ "\\("
+ (c-lang-const
+ c-opt-after-id-concat-key)
+ "\\)")
+ limit t)
+ (unless (progn
+ (goto-char (match-beginning 0))
+ (c-skip-comments-and-strings limit))
+ (or (get-text-property (match-beginning 2) 'face)
+ (c-put-font-lock-face (match-beginning 2)
+ (match-end 2)
+ c-reference-face-name))
+ (goto-char (match-end 1)))))))))
+ ))
+
+
+
+;; C# does not allow a leading qualifier operator. It also doesn't
+;; allow the ".*" construct of Java. So, we redo this regex without
+;; the "\\|\\*" regex.
+(c-lang-defconst c-identifier-key
+ csharp (concat "\\(" (c-lang-const c-symbol-key) "\\)" ; 1
+ (concat "\\("
+ "[ \t\n\r\f\v]*"
+ (c-lang-const c-opt-identifier-concat-key)
+ "[ \t\n\r\f\v]*"
+ (concat "\\("
+ "\\(" (c-lang-const c-symbol-key) "\\)"
+ "\\)")
+ "\\)*")))
+
+;; C# has a few rules that are slightly different than Java for
+;; operators. This also removed the Java's "super" and replaces it
+;; with the C#'s "base".
+(c-lang-defconst c-operators
+ csharp `((prefix "base")))
+
+
+;; C# uses CPP-like prefixes to mark #define, #region/endregion,
+;; #if/else/endif, and #pragma. This regexp matches the prefix,
+;; not including the beginning-of-line (BOL), and not including
+;; the term after the prefix (define, pragma, etc). This regexp says
+;; whitespace, followed by the prefix, followed by maybe more whitespace.
+
+(c-lang-defconst c-opt-cpp-prefix
+ csharp "\\s *#\\s *")
+
+
+;; there are no message directives in C#
+(c-lang-defconst c-cpp-message-directives
+ csharp nil)
+
+(c-lang-defconst c-cpp-expr-directives
+ csharp '("if"))
+
+(c-lang-defconst c-opt-cpp-macro-define
+ csharp "define")
+
+;; $ is not a legal char in an identifier in C#. So we need to
+;; create a csharp-specific definition of this constant.
+(c-lang-defconst c-symbol-chars
+ csharp (concat c-alnum "_"))
+
+
+(c-lang-defconst c-colon-type-list-kwds
+ csharp '("class"))
+
+(c-lang-defconst c-block-prefix-disallowed-chars
+
+ ;; Allow ':' for inherit list starters.
+ csharp (set-difference (c-lang-const c-block-prefix-disallowed-chars)
+ '(?: ?,)))
+
+
+(c-lang-defconst c-assignment-operators
+ csharp '("=" "*=" "/=" "%=" "+=" "-=" ">>=" "<<=" "&=" "^=" "|="))
+
+(c-lang-defconst c-primitive-type-kwds
+ ;; ECMA-344, S8
+ csharp '("object" "string" "sbyte" "short" "int" "long" "byte"
+ "ushort" "uint" "ulong" "float" "double" "bool" "char"
+ "decimal" "void"))
+
+;; The keywords that define that the following is a type, such as a
+;; class definition.
+(c-lang-defconst c-type-prefix-kwds
+ ;; ECMA-344, S?
+ csharp '("class" "interface" "struct")) ;; no enum here.
+ ;; we want enum to be a brace list.
+
+
+;; Type modifier keywords. They appear anywhere in types, but modify
+;; instead of create one.
+(c-lang-defconst c-type-modifier-kwds
+ ;; EMCA-344, S?
+ csharp '("readonly" "const"))
+
+
+;; Tue, 20 Apr 2010 16:02
+;; need to vverify that this works for lambdas...
+(c-lang-defconst c-special-brace-lists
+ csharp '((?{ . ?}) ))
+
+
+
+;; dinoch
+;; Thu, 22 Apr 2010 18:54
+;;
+;; No idea why this isn't getting set properly in the first place.
+;; In cc-langs.el, it is set to the union of a bunch of things, none
+;; of which include "new", or "enum".
+;;
+;; But somehow both of those show up in the resulting derived regexp.
+;; This breaks indentation of instance initializers, such as
+;;
+;; var x = new Foo { ... };
+;;
+;; Based on my inspection, the existing c-lang-defconst should work!
+;; I don't know how to fix this c-lang-defconst, so I am re-setting this
+;; variable here, to provide the regex explicitly.
+;;
+(c-lang-defconst c-decl-block-key
+
+ csharp '"\\(namespace\\)\\([^[:alnum:]_]\\|$\\)\\|\\(class\\|interface\\|struct\\)\\([^[:alnum:]_]\\|$\\)"
+ )
+
+
+
+;; Thu, 22 Apr 2010 14:29
+;; I want this to handle var x = new Foo[] { ... };
+;; not sure if necessary.
+(c-lang-defconst c-inexpr-brace-list-kwds
+ csharp '("new"))
+
+
+;; ;;(c-lang-defconst c-inexpr-class-kwds
+;; ;; csharp '("new"))
+
+
+
+(c-lang-defconst c-class-decl-kwds
+ ;; EMCA-344, S?
+ csharp '("class" "interface" "struct" )) ;; no "enum"!!
+
+
+;; The various modifiers used for class and method descriptions.
+(c-lang-defconst c-modifier-kwds
+ csharp '("public" "partial" "private" "const" "abstract"
+ "protected" "ref" "out" "static" "virtual"
+ "override" "params" "internal"))
+
+
+;; Thu, 22 Apr 2010 23:02
+;; Based on inspection of the cc-mode code, the c-protection-kwds
+;; c-lang-const is used only for objective-c. So the value is
+;; irrelevant for csharp.
+(c-lang-defconst c-protection-kwds
+ csharp nil
+ ;; csharp '("private" "protected" "public" "internal")
+)
+
+
+;; Define the keywords that can have something following after them.
+(c-lang-defconst c-type-list-kwds
+ csharp '("struct" "class" "interface" "is" "as"
+ "delegate" "event" "set" "get" "add" "remove"))
+
+
+;; This allows the classes after the : in the class declartion to be
+;; fontified.
+(c-lang-defconst c-typeless-decl-kwds
+ csharp '(":"))
+
+;; Sets up the enum to handle the list properly, and also the new
+;; keyword to handle object initializers. This requires a modified
+;; c-basic-matchers-after (see above) in order to correctly fontify C#
+;; 3.0 object initializers.
+(c-lang-defconst c-brace-list-decl-kwds
+ csharp '("enum" "new"))
+
+
+;; Statement keywords followed directly by a substatement.
+;; catch is not one of them.
+(c-lang-defconst c-block-stmt-1-kwds
+ csharp '("do" "try" "finally"))
+
+
+;; Statement keywords followed by a paren sexp and then by a substatement.
+(c-lang-defconst c-block-stmt-2-kwds
+ csharp '("for" "if" "switch" "while" "catch" "foreach" "using"
+ "checked" "unchecked" "lock"))
+
+
+;; Statements that break out of braces
+(c-lang-defconst c-simple-stmt-kwds
+ csharp '("return" "continue" "break" "throw" "goto" ))
+
+;; Statements that allow a label
+;; TODO?
+(c-lang-defconst c-before-label-kwds
+ csharp nil)
+
+;; Constant keywords
+(c-lang-defconst c-constant-kwds
+ csharp '("true" "false" "null"))
+
+;; Keywords that start "primary expressions."
+(c-lang-defconst c-primary-expr-kwds
+ csharp '("this" "base"))
+
+;; Treat namespace as an outer block so class indenting
+;; works properly.
+(c-lang-defconst c-other-block-decl-kwds
+ csharp '("namespace"))
+
+(c-lang-defconst c-other-kwds
+ csharp '("in" "sizeof" "typeof" "is" "as" "yield"
+ "where" "select" "from"))
+
+(c-lang-defconst c-overloadable-operators
+ ;; EMCA-344, S14.2.1
+ csharp '("+" "-" "*" "/" "%" "&" "|" "^"
+ "<<" ">>" "==" "!=" ">" "<" ">=" "<="))
+
+
+;; This c-cpp-matchers stuff is used for fontification.
+;; see cc-font.el
+;;
+
+;; There's no preprocessor in C#, but there are still compiler
+;; directives to fontify: "#pragma", #region/endregion, #define, #undef,
+;; #if/else/endif. (The definitions for the extra keywords above are
+;; enough to incorporate them into the fontification regexps for types
+;; and keywords, so no additional font-lock patterns are required for
+;; keywords.)
+
+(c-lang-defconst c-cpp-matchers
+ csharp (cons
+ ;; Use the eval form for `font-lock-keywords' to be able to use
+ ;; the `c-preprocessor-face-name' variable that maps to a
+ ;; suitable face depending on the (X)Emacs version.
+ '(eval . (list "^\\s *\\(#pragma\\|undef\\|define\\)\\>\\(.*\\)"
+ (list 1 c-preprocessor-face-name)
+ '(2 font-lock-string-face)))
+ ;; There are some other things in `c-cpp-matchers' besides the
+ ;; preprocessor support, so include it.
+ (c-lang-const c-cpp-matchers)))
+
+(defcustom csharp-font-lock-extra-types nil
+ "*List of extra types (aside from the type keywords) to recognize in C# mode.
+Each list item should be a regexp matching a single identifier."
+ :type 'list :group 'csharp)
+
+(defconst csharp-font-lock-keywords-1 (c-lang-const c-matchers-1 csharp)
+ "Minimal highlighting for C# mode.")
+
+(defconst csharp-font-lock-keywords-2 (c-lang-const c-matchers-2 csharp)
+ "Fast normal highlighting for C# mode.")
+
+(defconst csharp-font-lock-keywords-3 (c-lang-const c-matchers-3 csharp)
+ "Accurate normal highlighting for C# mode.")
+
+(defvar csharp-font-lock-keywords csharp-font-lock-keywords-3
+ "Default expressions to highlight in C# mode.")
+
+(defvar csharp-mode-syntax-table nil
+ "Syntax table used in csharp-mode buffers.")
+(or csharp-mode-syntax-table
+ (setq csharp-mode-syntax-table
+ (funcall (c-lang-const c-make-mode-syntax-table csharp))))
+
+(defvar csharp-mode-abbrev-table nil
+ "Abbreviation table used in csharp-mode buffers.")
+(c-define-abbrev-table 'csharp-mode-abbrev-table
+ ;; Keywords that if they occur first on a line might alter the
+ ;; syntactic context, and which therefore should trig reindentation
+ ;; when they are completed.
+ '(("else" "else" c-electric-continued-statement 0)
+ ("while" "while" c-electric-continued-statement 0)
+ ("catch" "catch" c-electric-continued-statement 0)
+ ("finally" "finally" c-electric-continued-statement 0)))
+
+(defvar csharp-mode-map (let ((map (c-make-inherited-keymap)))
+ ;; Add bindings which are only useful for C#
+ map)
+ "Keymap used in csharp-mode buffers.")
+
+
+;; TODO
+;; Defines our constant for finding attributes.
+;;(defconst csharp-attribute-regex "\\[\\([XmlType]+\\)(")
+;;(defconst csharp-attribute-regex "\\[\\(.\\)")
+;; This doesn't work because the string regex happens before this point
+;; and getting the font-locking to work before and after is fairly difficult
+;;(defconst csharp-attribute-regex
+;; (concat
+;; "\\[[a-zA-Z][ \ta-zA-Z0-9.]+"
+;; "\\((.*\\)?"
+;;))
+
+
+;; ==================================================================
+;; end of c# values for "language constants" defined in cc-langs.el
+;; ==================================================================
+
+
+
+
+;; ==================================================================
+;; C# code-doc insertion magic
+;; ==================================================================
+;;
+;; In Visual Studio, if you type three slashes, it immediately expands into
+;; an inline code-documentation fragment. The following method does the
+;; same thing.
+;;
+;; This is the kind of thing that could be handled by YASnippet or
+;; another similarly flexible snippet framework. But I don't want to
+;; introduce a dependency on yasnippet to csharp-mode. So the capability
+;; must live within csharp-mode itself.
+
+(defun csharp-maybe-insert-codedoc (arg)
+
+ "Insert an xml code documentation template as appropriate, when
+typing slashes. This fn gets bound to / (the slash key), in
+csharp-mode. If the slash being inserted is not the third
+consecutive slash, the slash is inserted as normal. If it is the
+third consecutive slash, then a xml code documentation template
+may be inserted in some cases. For example,
+
+ a <summary> template is inserted if the prior line is empty,
+ or contains only an open curly brace;
+ a <remarks> template is inserted if the prior word
+ closes the <summary> element;
+ a <returns> template is inserted if the prior word
+ closes the <remarks> element;
+ an <example> template is inserted if the prior word closes
+ the <returns> element;
+ a <para> template is inserted if the prior word closes
+ a <para> element.
+
+In all other cases the slash is inserted as normal.
+
+If you want the default cc-mode behavior, which implies no automatic
+insertion of xml code documentation templates, then use this in
+your `csharp-mode-hook' function:
+
+ (local-set-key (kbd \"/\") 'c-electric-slash)
+
+ "
+ (interactive "*p")
+ ;;(message "csharp-maybe-insert-codedoc")
+ (let (
+ (cur-point (point))
+ (char last-command-char)
+ (cb0 (char-before (- (point) 0)))
+ (cb1 (char-before (- (point) 1)))
+ is-first-non-whitespace
+ did-auto-insert
+ )
+
+ ;; check if two prior chars were slash
+ (if (and
+ (= char ?/)
+ cb0 (= ?/ cb0)
+ cb1 (= ?/ cb1)
+ )
+
+ (progn
+ ;;(message "yes - this is the third consecutive slash")
+ (setq is-first-non-whitespace
+ (save-excursion
+ (back-to-indentation)
+ (= cur-point (+ (point) 2))))
+
+ (if is-first-non-whitespace
+ ;; This is a 3-slash sequence. It is the first non-whitespace text
+ ;; on the line. Now we need to examine the surrounding context
+ ;; in order to determine which xml cod doc template to insert.
+ (let (word-back char0 char1
+ word-fore char-0 char-1
+ text-to-insert ;; text to insert in lieu of slash
+ fn-to-call ;; func to call after inserting text
+ (preceding-line-is-empty (or
+ (= (line-number-at-pos) 1)
+ (save-excursion
+ (previous-line)
+ (beginning-of-line)
+ (looking-at "[ \t]*$\\|[ \t]*{[ \t]*$"))))
+ (flavor 0) ;; used only for diagnostic purposes
+ )
+
+ ;;(message "starting a 3-slash comment")
+ ;; get the prior word, and the 2 chars preceding it.
+ (backward-word)
+
+ (setq word-back (thing-at-point 'word)
+ char0 (char-before (- (point) 0))
+ char1 (char-before (- (point) 1)))
+
+ ;; restore prior position
+ (goto-char cur-point)
+
+ ;; get the following word, and the 2 chars preceding it.
+ (forward-word)
+ (backward-word)
+ (setq word-fore (thing-at-point 'word)
+ char-0 (char-before (- (point) 0))
+ char-1 (char-before (- (point) 1)))
+
+ ;; restore prior position again
+ (goto-char cur-point)
+
+ (cond
+ ;; The preceding line is empty, or all whitespace, or
+ ;; contains only an open-curly. In this case, insert a
+ ;; summary element pair.
+ (preceding-line-is-empty
+ (setq text-to-insert "/ <summary>\n/// \n/// </summary>"
+ flavor 1) )
+
+ ;; The preceding word closed a summary element. In this case,
+ ;; if the forward word does not open a remarks element, then
+ ;; insert a remarks element.
+ ((and (string-equal word-back "summary") (eq char0 ?/) (eq char1 ?<))
+ (if (not (and (string-equal word-fore "remarks") (eq char-0 ?<)))
+ (setq text-to-insert "/ <remarks>\n/// <para>\n/// \n/// </para>\n/// </remarks>"
+ flavor 2)))
+
+ ;; The preceding word closed the remarks section. In this case,
+ ;; insert an example element.
+ ((and (string-equal word-back "remarks") (eq char0 ?/) (eq char1 ?<))
+ (setq text-to-insert "/ <example>\n/// \n/// </example>"
+ flavor 3))
+
+ ;; The preceding word closed the example section. In this
+ ;; case, insert an returns element. This isn't always
+ ;; correct, because sometimes the xml code doc is attached to
+ ;; a class or a property, neither of which has a return
+ ;; value. A more intelligent implementation would inspect the
+ ;; syntax state and only inject a returns element if
+ ;; appropriate.
+ ((and (string-equal word-back "example") (eq char0 ?/) (eq char1 ?<))
+ (setq text-to-insert "/ <returns></returns>"
+ fn-to-call (lambda ()
+ (backward-word)
+ (backward-char)
+ (backward-char)
+ (c-indent-line-or-region)
+ )
+ flavor 4))
+
+ ;; The preceding word opened the remarks section, or it
+ ;; closed a para section. In this case, insert a para
+ ;; element, using appropriate indentation with respect to the
+ ;; prior tag.
+ ((or
+ (and (string-equal word-back "remarks") (eq char0 ?<) (or (eq char1 32) (eq char1 9)))
+ (and (string-equal word-back "para") (eq char0 ?/) (eq char1 ?<)))
+
+ (let (prior-point spacer)
+ (save-excursion
+ (backward-word)
+ (backward-char)
+ (backward-char)
+ (setq prior-point (point))
+ (skip-chars-backward "\t ")
+ (setq spacer (buffer-substring (point) prior-point))
+ ;;(message (format "pt(%d) prior(%d) spacer(%s)" (point) prior-point spacer))
+ )
+
+ (if (string-equal word-back "remarks")
+ (setq spacer (concat spacer " ")))
+
+ (setq text-to-insert (format "/%s<para>\n///%s \n///%s</para>"
+ spacer spacer spacer)
+ flavor 6)))
+
+ ;; The preceding word opened a para element. In this case, if
+ ;; the forward word does not close the para element, then
+ ;; close the para element.
+ ;; --
+ ;; This is a nice idea but flawed. Suppose I have a para element with some
+ ;; text in it. If I position the cursor at the first line, then type 3 slashes,
+ ;; I get a close-element, and that would be inappropriate. Not sure I can
+ ;; easily solve that problem, so the best thing might be to simply punt, and
+ ;; require people to close their own elements.
+ ;;
+ ;; ( (and (string-equal word-back "para") (eq char0 60) (or (eq char1 32) (eq char1 9)))
+ ;; (if (not (and (string-equal word-fore "para") (eq char-0 47) (eq char-1 60) ))
+ ;; (setq text-to-insert "/ \n/// </para>\n///"
+ ;; fn-to-call (lambda ()
+ ;; (previous-line)
+ ;; (end-of-line)
+ ;; )
+ ;; flavor 7) )
+ ;; )
+
+ ;; the default case - do nothing
+ (t nil))
+
+ (if text-to-insert
+ (progn
+ ;;(message (format "inserting special text (f(%d))" flavor))
+
+ ;; set the flag, that we actually inserted text
+ (setq did-auto-insert t)
+
+ ;; save point of beginning of insertion
+ (setq cur-point (point))
+
+ ;; actually insert the text
+ (insert text-to-insert)
+
+ ;; indent the inserted string, and re-position point, either through
+ ;; the case-specific fn, or via the default progn.
+ (if fn-to-call
+ (funcall fn-to-call)
+
+ (let ((newline-count 0) (pos 0) ix)
+
+ ;; count the number of newlines in the inserted string
+ (while (string-match "\n" text-to-insert pos)
+ (setq pos (match-end 0)
+ newline-count (+ newline-count 1) )
+ )
+
+ ;; indent what we just inserted
+ (c-indent-region cur-point (point) t)
+
+ ;; move up n/2 lines. This assumes that the
+ ;; inserted text is ~symmetric about the halfway point.
+ ;; The assumption holds if the xml code doc uses a
+ ;; begin-elt and end-elt on a new line all by themselves,
+ ;; and a blank line in between them where the point should be.
+ ;; A more intelligent implementation would use a specific
+ ;; marker string, like @@DOT, to note the desired point.
+ (previous-line (/ newline-count 2))
+ (end-of-line)))))))))
+
+ (if (not did-auto-insert)
+ (self-insert-command (prefix-numeric-value arg)))))
+
+;; ==================================================================
+;; end of c# code-doc insertion magic
+;; ==================================================================
+
+
+
+
+;; ==================================================================
+;; c# fontification extensions
+;; ==================================================================
+;; Commentary:
+;;
+;; The purpose of the following code is to fix font-lock for C#,
+;; specifically for the verbatim-literal strings. C# is a cc-mode
+;; language and strings are handled mostly like other c-based
+;; languages. The one exception is the verbatim-literal string, which
+;; uses the syntax @"...".
+;;
+;; `parse-partial-sexp' treats those strings as just regular strings,
+;; with the @ a non-string character. This is fine, except when the
+;; verblit string ends in a slash, in which case, font-lock breaks from
+;; that point onward in the buffer.
+;;
+;; This is an attempt to fix that.
+;;
+;; The idea is to scan the buffer in full for verblit strings, and apply the
+;; appropriate syntax-table text properties for verblit strings. Also setting
+;; `parse-sexp-lookup-properties' to t tells `parse-partial-sexp'
+;; to use the syntax-table text properties set up by the scan as it does
+;; its parse.
+;;
+;; Also need to re-scan after any changes in the buffer, but on a more
+;; limited region.
+;;
+
+
+;; ;; I don't remember what this is supposed to do,
+;; ;; or how I figured out the value.
+;; ;;
+;; (defconst csharp-font-lock-syntactic-keywords
+;; '(("\\(@\\)\\(\"\\)[^\"]*\\(\"\\)\\(\"\\)[^\"]*\\(\"\\)[^\"]"
+;; (1 '(6)) (2 '(7)) (3 '(1)) (4 '(1)) (5 '(7))
+;; ))
+;; "Highlighting of verbatim literal strings. See also the variable
+;; `font-lock-keywords'.")
+
+
+
+;; Allow this:
+;; (csharp-log 3 "csharp: scan...'%s'" state)
+
+(defvar csharp-log-level 0
+ "The current log level for CSharp-specific operations.
+This is used in particular by the verbatim-literal
+string scanning.
+
+Most other csharp functions are not instrumented.
+0 = NONE, 1 = Info, 2 = VERBOSE, 3 = DEBUG, 4 = SHUTUP ALREADY. ")
+
+(defun csharp-log (level text &rest args)
+ "Log a message at level LEVEL.
+If LEVEL is higher than `csharp-log-level', the message is
+ignored. Otherwise, it is printed using `message'.
+TEXT is a format control string, and the remaining arguments ARGS
+are the string substitutions (see `format')."
+ (if (<= level csharp-log-level)
+ (let* ((msg (apply 'format text args)))
+ (message "%s" msg)
+ )))
+
+
+
+(defun csharp-max-beginning-of-stmt ()
+ "Return the greater of `c-beginning-of-statement-1' and
+`c-beginning-of-statement' . I don't understand why both of
+these methods are necessary or why they differ. But they do."
+
+ (let (dash
+ nodash
+ (curpos (point)))
+
+ ;; I think this may need a save-excursion...
+ ;; Calling c-beginning-of-statement-1 resets the point!
+
+ (setq dash (progn (c-beginning-of-statement-1) (point)))
+ (csharp-log 3 "C#: max-bostmt dash(%d)" dash)
+ (goto-char curpos)
+
+ (setq nodash (progn (c-beginning-of-statement 1) (point)))
+ (csharp-log 3 "C#: max-bostmt nodash(%d)" nodash)
+ (goto-char curpos)
+
+ (max dash nodash)))
+
+
+(defun csharp-in-literal (&optional lim detect-cpp)
+ "Return the type of literal point is in, if any.
+Basically this works like `c-in-literal' except it doesn't
+use or fill the cache (`c-in-literal-cache').
+
+The return value is `c' if in a C-style comment, `c++' if in a C++
+style comment, `string' if in a string literal, `pound' if DETECT-CPP
+is non-nil and in a preprocessor line, or nil if somewhere else.
+Optional LIM is used as the backward limit of the search. If omitted,
+or nil, `c-beginning-of-syntax' is used.
+
+Note that this function might do hidden buffer changes. See the
+comment at the start of cc-engine.el for more info."
+
+ (let ((rtn
+ (save-excursion
+ (let* ((pos (point))
+ (lim (or lim (progn
+ (c-beginning-of-syntax)
+ (point))))
+ (state (parse-partial-sexp lim pos)))
+ (csharp-log 4 "C#: parse lim(%d) state: %s" lim (prin1-to-string state))
+ (cond
+ ((elt state 3)
+ (csharp-log 4 "C#: in literal string (%d)" pos)
+ 'string)
+ ((elt state 4)
+ (csharp-log 4 "C#: in literal comment (%d)" pos)
+ (if (elt state 7) 'c++ 'c))
+ ((and detect-cpp (c-beginning-of-macro lim)) 'pound)
+ (t nil))))))
+ rtn))
+
+
+(defun csharp-set-vliteral-syntax-table-properties (beg end)
+ "Scan the buffer text between BEG and END, a verbatim literal
+string, setting and clearing syntax-table text properties where
+necessary.
+
+We need to modify the default syntax-table text property in these cases:
+ (backslash) - is not an escape inside a verbatim literal string.
+ (double-quote) - can be a literal quote, when doubled.
+
+BEG is the @ delimiter. END is the 'old' position of the ending quote.
+
+see http://www.sunsite.ualberta.ca/Documentation/Gnu/emacs-lisp-ref-21-2.7/html_node/elisp_592.html
+for the list of syntax table numeric codes.
+
+"
+
+ (csharp-log 3 "C#: set-vlit-syntax-table: beg(%d) end(%d)" beg end)
+
+ (if (and (> beg 0) (> end 0))
+
+ (let ((curpos beg)
+ (state 0))
+
+ (c-clear-char-properties beg end 'syntax-table)
+
+ (while (<= curpos end)
+
+ (cond
+ ((= state 0)
+ (if (= (char-after curpos) ?@)
+ (progn
+ (c-put-char-property curpos 'syntax-table '(3)) ; (6) = expression prefix, (3) = symbol
+ ;;(message (format "C#: set-s-t: prefix pos(%d) chr(%c)" beg (char-after beg)))
+ )
+ )
+ (setq state (+ 1 state)))
+
+ ((= state 1)
+ (if (= (char-after curpos) ?\")
+ (progn
+ (c-put-char-property curpos 'syntax-table '(7)) ; (7) = string quote
+ ;;(message (format "C#: set-s-t: open quote pos(%d) chr(%c)"
+ ;; curpos (char-after curpos)))
+ ))
+ (setq state (+ 1 state)))
+
+ ((= state 2)
+ (cond
+ ;; handle backslash
+ ((= (char-after curpos) ?\\)
+ (c-put-char-property curpos 'syntax-table '(2)) ; (1) = punctuation, (2) = word
+ ;;(message (format "C#: set-s-t: backslash word pos(%d) chr(%c)" curpos (char-after curpos)))
+ )
+
+ ;; doubled double-quote
+ ((and
+ (= (char-after curpos) ?\")
+ (= (char-after (+ 1 curpos)) ?\"))
+ (c-put-char-property curpos 'syntax-table '(2)) ; (1) = punctuation, (2) = word
+ (c-put-char-property (+ 1 curpos) 'syntax-table '(2)) ; (1) = punctuation
+ ;;(message (format "C#: set-s-t: double doublequote pos(%d) chr(%c)" curpos (char-after curpos)))
+ (setq curpos (+ curpos 1))
+ )
+
+ ;; a single double-quote, which should be a string terminator
+ ((= (char-after curpos) ?\")
+ (c-put-char-property curpos 'syntax-table '(7)) ; (7) = string quote
+ ;;(message (format "C#: set-s-t: close quote pos(%d) chr(%c)" curpos (char-after curpos)))
+ ;;go no further
+ (setq state (+ 1 state)))
+
+ ;; everything else
+ (t
+ ;;(message (format "C#: set-s-t: none pos(%d) chr(%c)" curpos (char-after curpos)))
+ nil))))
+ ;; next char
+ (setq curpos (+ curpos 1))))))
+
+
+
+(defun csharp-end-of-verbatim-literal-string (&optional lim)
+ "Moves to and returns the position of the end quote of the verbatim literal
+string. When calling, point should be on the @ of the verblit string.
+If it is not, then no movement is performed and `point' is returned.
+
+This function ignores text properties. In fact it is the
+underlying scanner used to set the text properties in a C# buffer.
+"
+
+ (csharp-log 3 "C#: end-of-vlit-string: point(%d) c(%c)" (point) (char-after))
+
+ (let (curpos
+ (max (or lim (point-max))))
+
+ (if (not (looking-at "@\""))
+ (point)
+ (forward-char 2) ;; pass up the @ sign and first quote
+ (setq curpos (point))
+
+ ;; Within a verbatim literal string, a doubled double-quote
+ ;; escapes the double-quote."
+ (while (and ;; process characters...
+ (or ;; while...
+ (not (eq (char-after curpos) ?\")) ;; it's not a quote
+ (eq (char-after (+ curpos 1)) ?\")) ;; or, its a double (double) quote
+ (< curpos max)) ;; and we're not done yet
+
+ (cond
+ ((and (eq (char-after curpos) ?\") ;; it's a double-quote.
+ (eq (char-after (+ curpos 1)) ?\"))
+ (setq curpos (+ 2 curpos))) ;; Skip 2
+ (t ;; anything else
+ (setq curpos (+ 1 curpos))))) ;; skip fwd 1
+ curpos)))
+
+
+
+
+(defun csharp-scan-for-verbatim-literals-and-set-props (&optional beg end)
+
+"Scans the buffer, between BEG and END, for verbatim literal
+strings, and sets override text properties on each string to
+allow proper syntax highlighting, indenting, and cursor movement.
+
+BEG and END define the limits of the scan. When nil, they
+default to `point-min' and `point-max' respectively.
+
+Setting text properties generally causes the buffer to be marked
+as modified, but this fn suppresses that via the
+`c-buffer-save-state' macro, for any changes in text properties
+that it makes. This fn also ignores the read-only setting on a
+buffer, using the same macro.
+
+This fn is called when a csharp-mode buffer is loaded, with BEG
+and END set to nil, to do a full scan. It is also called on
+every buffer change, with the BEG and END set to the values for
+the change.
+
+The return value is nil if the buffer was not a csharp-mode
+buffer. Otherwise it is the last cursor position examined by the
+scan.
+"
+
+ (if (not (c-major-mode-is 'csharp-mode)) ;; don't scan if not csharp mode
+ nil
+ (save-excursion
+ (c-save-buffer-state
+ ((curpos (or beg (point-min)))
+ (lastpos (or end (point-max)))
+ (state 0) (start 0) (cycle 0)
+ literal eos limits)
+
+ (csharp-log 3 "C#: scan")
+ (goto-char curpos)
+
+ (while (and (< curpos lastpos) (< cycle 10000))
+ (cond
+
+ ;; Case 1: current char is a @ sign
+ ;; --------------------------------------------
+ ;; Check to see if it demarks the beginning of a verblit
+ ;; string.
+ ((= ?@ (char-after curpos))
+
+ ;; are we in a comment? a string? Maybe the @ is a prefix
+ ;; to allow the use of a reserved word as a symbol. Let's find out.
+
+ ;; not sure why I need both of the following.
+ (syntax-ppss-flush-cache 1)
+ (parse-partial-sexp 1 curpos)
+ (goto-char curpos)
+ (setq literal (csharp-in-literal))
+ (cond
+
+ ;; Case 1.A: it's a @ within a string.
+ ;; --------------------------------------------
+ ;; This should never happen, because this scanner hops over strings.
+ ;; But it might happen if the scan starts at an odd place.
+ ((eq literal 'string) nil)
+
+ ;; Case 1.B: The @ is within a comment. Hop over it.
+ ((and (memq literal '(c c++))
+ ;; This is a kludge for XEmacs where we use
+ ;; `buffer-syntactic-context', which doesn't correctly
+ ;; recognize "\*/" to end a block comment.
+ ;; `parse-partial-sexp' which is used by
+ ;; `c-literal-limits' will however do that in most
+ ;; versions, which results in that we get nil from
+ ;; `c-literal-limits' even when `c-in-literal' claims
+ ;; we're inside a comment.
+ ;;(setq limits (c-literal-limits start)))
+ (setq limits (c-literal-limits)))
+
+ ;; advance to the end of the comment
+ (if limits
+ (progn
+ (csharp-log 4 "C#: scan: jump end comment A (%d)" (cdr limits))
+ (setq curpos (cdr limits)))))
+
+
+ ;; Case 1.B: curpos is at least 2 chars before the last
+ ;; position to examine, and, the following char is a
+ ;; double-quote (ASCII 34).
+ ;; --------------------------------------------
+ ;; This looks like the beginning of a verbatim string
+ ;; literal.
+ ((and (< (+ 2 curpos) lastpos)
+ (= ?\" (char-after (+ 1 curpos))))
+
+ (setq eos (csharp-end-of-verbatim-literal-string))
+ ;; set override syntax properties on the verblit string
+ (csharp-set-vliteral-syntax-table-properties curpos eos)
+
+ (csharp-log 4 "C#: scan: jump end verblit string (%d)" eos)
+ (setq curpos eos))))
+
+
+ ;; Case 2: current char is a double-quote.
+ ;; --------------------------------------------
+ ;; If this is a string, we hop over it, on the assumption that
+ ;; this scanner need not bother with regular literal strings, which
+ ;; get the proper syntax with the generic approach.
+ ;; If in a comment, hop over the comment.
+ ((= ?\" (char-after curpos))
+ (goto-char curpos)
+ (setq literal (c-in-literal))
+ (cond
+
+ ;; Case 2.A: a quote within a string
+ ;; --------------------------------------------
+ ;; This shouldn't happen, because we hop over strings.
+ ;; But it might.
+ ((eq literal 'string) nil)
+
+ ;; Case 2.B: a quote within a comment
+ ;; --------------------------------------------
+ ((and (memq literal '(c c++))
+ ;; This is a kludge for XEmacs where we use
+ ;; `buffer-syntactic-context', which doesn't correctly
+ ;; recognize "\*/" to end a block comment.
+ ;; `parse-partial-sexp' which is used by
+ ;; `c-literal-limits' will however do that in most
+ ;; versions, which results in that we get nil from
+ ;; `c-literal-limits' even when `c-in-literal' claims
+ ;; we're inside a comment.
+ ;;(setq limits (c-literal-limits start)))
+ (setq limits (c-literal-limits)))
+
+ ;; advance to the end of the comment
+ (if limits
+ (progn
+ (setq curpos (cdr limits))
+ (csharp-log 3 "C#: scan: jump end comment B (%s)" curpos))))
+
+
+ ;; Case 2.C: Not in a comment, and not in a string.
+ ;; --------------------------------------------
+ ;; This is the beginning of a literal (but not verbatim) string.
+ (t
+ (forward-char 1) ;; pass up the quote
+ (if (consp (setq limits (c-literal-limits)))
+ (progn
+ (csharp-log 4 "C#: scan: jump end literal (%d)" (cdr limits))
+ (setq curpos (cdr limits))))))))
+
+ (setq cycle (+ 1 cycle))
+ (setq curpos (+ 1 curpos))
+ (c-safe (goto-char curpos)))))))
+
+
+(defun csharp-before-font-lock (beg end old-len)
+ "Adjust`syntax-table' properties on the region affected by the change
+in a csharp-mode buffer.
+
+This function is the C# value for `c-before-font-lock-function'.
+It intended to be called only by the cc-mode runtime.
+
+It prepares the buffer for font locking, hence must get called
+before `font-lock-after-change-function'.
+
+It does hidden buffer changes.
+
+BEG, END and OLD-LEN have the same meaning here as for any
+after-change function.
+
+Point is undefined both before and after this function call.
+The return value is meaningless, and is ignored by cc-mode.
+"
+ (let ((start-scan (progn
+ (c-beginning-of-statement 1)
+ (point))))
+ (csharp-scan-for-verbatim-literals-and-set-props start-scan end)))
+
+
+
+(c-lang-defconst c-before-font-lock-function
+ csharp 'csharp-before-font-lock)
+
+;; ==================================================================
+;; end of c# fontification extensions
+;; ==================================================================
+
+
+
+
+
+;; ==================================================================
+;; C#-specific optimizations of cc-mode funcs
+;; ==================================================================
+
+
+;; There's never a need to check for C-style macro definitions in
+;; a C# buffer.
+(defadvice c-beginning-of-macro (around
+ csharp-mode-advice-1
+ compile activate)
+ (if (c-major-mode-is 'csharp-mode)
+ nil
+ ad-do-it)
+ )
+
+
+;; There's never a need to move over an Obj-C directive in csharp mode
+(defadvice c-forward-objc-directive (around
+ csharp-mode-advice-2
+ compile activate)
+ (if (c-major-mode-is 'csharp-mode)
+ nil
+ ad-do-it)
+ )
+
+;; ==================================================================
+;; end of C#-specific optimizations of cc-mode funcs
+;; ==================================================================
+
+
+
+
+
+
+
+
+;; ==================================================================
+;; c# - monkey-patching of basic parsing logic
+;; ==================================================================
+;;
+;; Here, the model redefines two defuns to add special cases for csharp
+;; mode. These primarily deal with indentation of instance
+;; initializers, which are somewhat unique to C#. I couldn't figure out
+;; how to get cc-mode to do what C# needs, without modifying these
+;; defuns.
+;;
+
+(defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end)
+ ;; Return non-nil if we're looking at the beginning of a block
+ ;; inside an expression. The value returned is actually a cons of
+ ;; either 'inlambda, 'inexpr-statement or 'inexpr-class and the
+ ;; position of the beginning of the construct.
+ ;;
+ ;; LIM limits the backward search. CONTAINING-SEXP is the start
+ ;; position of the closest containing list. If it's nil, the
+ ;; containing paren isn't used to decide whether we're inside an
+ ;; expression or not. If both LIM and CONTAINING-SEXP are used, LIM
+ ;; needs to be farther back.
+ ;;
+ ;; If CHECK-AT-END is non-nil then extra checks at the end of the
+ ;; brace block might be done. It should only be used when the
+ ;; construct can be assumed to be complete, i.e. when the original
+ ;; starting position was further down than that.
+ ;;
+ ;; This function might do hidden buffer changes.
+
+ (save-excursion
+ (let ((res 'maybe) passed-paren
+ (closest-lim (or containing-sexp lim (point-min)))
+ ;; Look at the character after point only as a last resort
+ ;; when we can't disambiguate.
+ (block-follows (and (eq (char-after) ?{) (point))))
+
+ (while (and (eq res 'maybe)
+ (progn (c-backward-syntactic-ws)
+ (> (point) closest-lim))
+ (not (bobp))
+ (progn (backward-char)
+ (looking-at "[\]\).]\\|\\w\\|\\s_"))
+ (c-safe (forward-char)
+ (goto-char (scan-sexps (point) -1))))
+
+ (setq res
+ (if (looking-at c-keywords-regexp)
+ (let ((kw-sym (c-keyword-sym (match-string 1))))
+ (cond
+ ((and block-follows
+ (c-keyword-member kw-sym 'c-inexpr-class-kwds))
+ (and (not (eq passed-paren ?\[))
+
+ ;; dinoch Thu, 22 Apr 2010 18:20
+ ;; ============================================
+ ;; looking at new MyType() { ... }
+ ;; means this is a brace list, so, return nil,
+ ;; implying NOT looking-at-inexpr-block
+ (not
+ (and (c-major-mode-is 'csharp-mode)
+ (looking-at "new\s+\\([[:alnum:]_]+\\)\\b")))
+
+ (or (not (looking-at c-class-key))
+ ;; If the class instantiation is at the start of
+ ;; a statement, we don't consider it an
+ ;; in-expression class.
+ (let ((prev (point)))
+ (while (and
+ (= (c-backward-token-2 1 nil closest-lim) 0)
+ (eq (char-syntax (char-after)) ?w))
+ (setq prev (point)))
+ (goto-char prev)
+ (not (c-at-statement-start-p)))
+ ;; Also, in Pike we treat it as an
+ ;; in-expression class if it's used in an
+ ;; object clone expression.
+ (save-excursion
+ (and check-at-end
+ (c-major-mode-is 'pike-mode)
+ (progn (goto-char block-follows)
+ (zerop (c-forward-token-2 1 t)))
+ (eq (char-after) ?\())))
+ (cons 'inexpr-class (point))))
+ ((c-keyword-member kw-sym 'c-inexpr-block-kwds)
+ (when (not passed-paren)
+ (cons 'inexpr-statement (point))))
+ ((c-keyword-member kw-sym 'c-lambda-kwds)
+ (when (or (not passed-paren)
+ (eq passed-paren ?\())
+ (cons 'inlambda (point))))
+ ((c-keyword-member kw-sym 'c-block-stmt-kwds)
+ nil)
+ (t
+ 'maybe)))
+
+ (if (looking-at "\\s(")
+ (if passed-paren
+ (if (and (eq passed-paren ?\[)
+ (eq (char-after) ?\[))
+ ;; Accept several square bracket sexps for
+ ;; Java array initializations.
+ 'maybe)
+ (setq passed-paren (char-after))
+ 'maybe)
+ 'maybe))))
+
+ (if (eq res 'maybe)
+ (when (and c-recognize-paren-inexpr-blocks
+ block-follows
+ containing-sexp
+ (eq (char-after containing-sexp) ?\())
+ (goto-char containing-sexp)
+ (if (or (save-excursion
+ (c-backward-syntactic-ws lim)
+ (and (> (point) (or lim (point-min)))
+ (c-on-identifier)))
+ (and c-special-brace-lists
+ (c-looking-at-special-brace-list)))
+ nil
+ (cons 'inexpr-statement (point))))
+
+ res))))
+
+
+
+
+(defconst csharp-enum-decl-re
+ (concat
+ "\\<enum\\>\s+\\([[:alnum:]_]+\\)\s*:\s*"
+ "\\("
+ (c-make-keywords-re nil
+ (list "sbyte" "byte" "short" "ushort" "int" "uint" "long" "ulong"))
+ "\\)")
+ "Regex that captures an enum declaration in C#"
+ )
+
+
+
+(defun c-inside-bracelist-p (containing-sexp paren-state)
+ ;; return the buffer position of the beginning of the brace list
+ ;; statement if we're inside a brace list, otherwise return nil.
+ ;; CONTAINING-SEXP is the buffer pos of the innermost containing
+ ;; paren. PAREN-STATE is the remainder of the state of enclosing
+ ;; braces
+ ;;
+ ;; N.B.: This algorithm can potentially get confused by cpp macros
+ ;; placed in inconvenient locations. It's a trade-off we make for
+ ;; speed.
+ ;;
+ ;; This function might do hidden buffer changes.
+ (or
+ ;; This will pick up brace list declarations.
+ (c-safe
+ (save-excursion
+ (goto-char containing-sexp)
+ (c-forward-sexp -1)
+ (let (bracepos)
+ (if (and (or (looking-at c-brace-list-key)
+
+ (progn (c-forward-sexp -1)
+ (looking-at c-brace-list-key))
+
+ ;; dinoch Thu, 22 Apr 2010 18:20
+ ;; ============================================
+ ;; looking enum Foo : int
+ ;; means this is a brace list, so, return nil,
+ ;; implying NOT looking-at-inexpr-block
+
+ (and (c-major-mode-is 'csharp-mode)
+ (progn
+ (c-forward-sexp -1)
+ (looking-at csharp-enum-decl-re))))
+
+ (setq bracepos (c-down-list-forward (point)))
+ (not (c-crosses-statement-barrier-p (point)
+ (- bracepos 2))))
+ (point)))))
+ ;; this will pick up array/aggregate init lists, even if they are nested.
+ (save-excursion
+ (let ((class-key
+ ;; Pike can have class definitions anywhere, so we must
+ ;; check for the class key here.
+ (and (c-major-mode-is 'pike-mode)
+ c-decl-block-key))
+ bufpos braceassignp lim next-containing)
+ (while (and (not bufpos)
+ containing-sexp)
+ (when paren-state
+ (if (consp (car paren-state))
+ (setq lim (cdr (car paren-state))
+ paren-state (cdr paren-state))
+ (setq lim (car paren-state)))
+ (when paren-state
+ (setq next-containing (car paren-state)
+ paren-state (cdr paren-state))))
+ (goto-char containing-sexp)
+ (if (c-looking-at-inexpr-block next-containing next-containing)
+ ;; We're in an in-expression block of some kind. Do not
+ ;; check nesting. We deliberately set the limit to the
+ ;; containing sexp, so that c-looking-at-inexpr-block
+ ;; doesn't check for an identifier before it.
+ (setq containing-sexp nil)
+ ;; see if the open brace is preceded by = or [...] in
+ ;; this statement, but watch out for operator=
+ (setq braceassignp 'dontknow)
+ (c-backward-token-2 1 t lim)
+ ;; Checks to do only on the first sexp before the brace.
+ (when (and c-opt-inexpr-brace-list-key
+ (eq (char-after) ?\[))
+ ;; In Java, an initialization brace list may follow
+ ;; directly after "new Foo[]", so check for a "new"
+ ;; earlier.
+ (while (eq braceassignp 'dontknow)
+ (setq braceassignp
+ (cond ((/= (c-backward-token-2 1 t lim) 0) nil)
+ ((looking-at c-opt-inexpr-brace-list-key) t)
+ ((looking-at "\\sw\\|\\s_\\|[.[]")
+ ;; Carry on looking if this is an
+ ;; identifier (may contain "." in Java)
+ ;; or another "[]" sexp.
+ 'dontknow)
+ (t nil)))))
+ ;; Checks to do on all sexps before the brace, up to the
+ ;; beginning of the statement.
+ (while (eq braceassignp 'dontknow)
+ (cond ((eq (char-after) ?\;)
+ (setq braceassignp nil))
+ ((and class-key
+ (looking-at class-key))
+ (setq braceassignp nil))
+ ((eq (char-after) ?=)
+ ;; We've seen a =, but must check earlier tokens so
+ ;; that it isn't something that should be ignored.
+ (setq braceassignp 'maybe)
+ (while (and (eq braceassignp 'maybe)
+ (zerop (c-backward-token-2 1 t lim)))
+ (setq braceassignp
+ (cond
+ ;; Check for operator =
+ ((and c-opt-op-identifier-prefix
+ (looking-at c-opt-op-identifier-prefix))
+ nil)
+ ;; Check for `<opchar>= in Pike.
+ ((and (c-major-mode-is 'pike-mode)
+ (or (eq (char-after) ?`)
+ ;; Special case for Pikes
+ ;; `[]=, since '[' is not in
+ ;; the punctuation class.
+ (and (eq (char-after) ?\[)
+ (eq (char-before) ?`))))
+ nil)
+ ((looking-at "\\s.") 'maybe)
+ ;; make sure we're not in a C++ template
+ ;; argument assignment
+ ((and
+ (c-major-mode-is 'c++-mode)
+ (save-excursion
+ (let ((here (point))
+ (pos< (progn
+ (skip-chars-backward "^<>")
+ (point))))
+ (and (eq (char-before) ?<)
+ (not (c-crosses-statement-barrier-p
+ pos< here))
+ (not (c-in-literal))
+ ))))
+ nil)
+ (t t))))))
+ (if (and (eq braceassignp 'dontknow)
+ (/= (c-backward-token-2 1 t lim) 0))
+ (setq braceassignp nil)))
+ (if (not braceassignp)
+ (if (eq (char-after) ?\;)
+ ;; Brace lists can't contain a semicolon, so we're done.
+ (setq containing-sexp nil)
+ ;; Go up one level.
+ (setq containing-sexp next-containing
+ lim nil
+ next-containing nil))
+ ;; we've hit the beginning of the aggregate list
+ (c-beginning-of-statement-1
+ (c-most-enclosing-brace paren-state))
+ (setq bufpos (point))))
+ )
+ bufpos))
+ ))
+
+;; ==================================================================
+;; end of monkey-patching of basic parsing logic
+;; ==================================================================
+
+
+
+
+;;(easy-menu-define csharp-menu csharp-mode-map "C# Mode Commands"
+;; ;; Can use `csharp' as the language for `c-mode-menu'
+;; ;; since its definition covers any language. In
+;; ;; this case the language is used to adapt to the
+;; ;; nonexistence of a cpp pass and thus removing some
+;; ;; irrelevant menu alternatives.
+;; (cons "C#" (c-lang-const c-mode-menu csharp)))
+
+;;; Autoload mode trigger
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.cs$" . csharp-mode))
+
+
+
+(c-add-style "C#"
+ '("Java"
+ (c-basic-offset . 4)
+ (c-comment-only-line-offset . (0 . 0))
+ (c-offsets-alist . (
+ (access-label . -)
+ (arglist-close . c-lineup-arglist)
+ (arglist-cont . 0)
+ (arglist-cont-nonempty . c-lineup-arglist)
+ (arglist-intro . c-lineup-arglist-intro-after-paren)
+ (block-close . 0)
+ (block-open . 0)
+ (brace-entry-open . 0)
+ (brace-list-close . 0)
+ (brace-list-entry . 0)
+ (brace-list-intro . +)
+ (brace-list-open . +)
+ (c . c-lineup-C-comments)
+ (case-label . +)
+ (catch-clause . 0)
+ (class-close . 0)
+ (class-open . 0)
+ (comment-intro . c-lineup-comment)
+ (cpp-macro . 0)
+ (cpp-macro-cont . c-lineup-dont-change)
+ (defun-block-intro . +)
+ (defun-close . 0)
+ (defun-open . 0)
+ (do-while-closure . 0)
+ (else-clause . 0)
+ (extern-lang-close . 0)
+ (extern-lang-open . 0)
+ (friend . 0)
+ (func-decl-cont . +)
+ (inclass . +)
+ (inexpr-class . +)
+ (inexpr-statement . 0)
+ (inextern-lang . +)
+ (inher-cont . c-lineup-multi-inher)
+ (inher-intro . +)
+ (inlambda . c-lineup-inexpr-block)
+ (inline-close . 0)
+ (inline-open . 0)
+ (innamespace . +)
+ (knr-argdecl . 0)
+ (knr-argdecl-intro . 5)
+ (label . 0)
+ (lambda-intro-cont . +)
+ (member-init-cont . c-lineup-multi-inher)
+ (member-init-intro . +)
+ (namespace-close . 0)
+ (namespace-open . 0)
+ (statement . 0)
+ (statement-block-intro . +)
+ (statement-case-intro . +)
+ (statement-case-open . +)
+ (statement-cont . +)
+ (stream-op . c-lineup-streamop)
+ (string . c-lineup-dont-change)
+ (substatement . +)
+ (substatement-open . 0)
+ (template-args-cont c-lineup-template-args +)
+ (topmost-intro . 0)
+ (topmost-intro-cont . 0)
+ ))
+ ))
+
+
+
+
+;; Custom variables
+;;;###autoload
+(defcustom csharp-mode-hook nil
+ "*Hook called by `csharp-mode'."
+ :type 'hook
+ :group 'c)
+
+
+
+;;; The entry point into the mode
+;;;###autoload
+(defun csharp-mode ()
+ "Major mode for editing C# code. This mode is derived from CC Mode to
+support C#.
+
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `csharp-mode-hook'.
+
+This mode will automatically add a regexp for Csc.exe error and warning
+messages to the `compilation-error-regexp-alist'.
+
+Key bindings:
+\\{csharp-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (make-local-variable 'beginning-of-defun-function)
+ (make-local-variable 'end-of-defun-function)
+ (c-initialize-cc-mode t)
+ (set-syntax-table csharp-mode-syntax-table)
+
+ ;; define underscore as part of a word in the Csharp syntax table
+ (modify-syntax-entry ?_ "w" csharp-mode-syntax-table)
+
+ ;; define @ as an expression prefix in Csharp syntax table
+ (modify-syntax-entry ?@ "'" csharp-mode-syntax-table)
+
+ (setq major-mode 'csharp-mode
+ mode-name "C#"
+ local-abbrev-table csharp-mode-abbrev-table
+ abbrev-mode t)
+ (use-local-map csharp-mode-map)
+
+ ;; `c-init-language-vars' is a macro that is expanded at compile
+ ;; time to a large `setq' with all the language variables and their
+ ;; customized values for our language.
+ (c-init-language-vars csharp-mode)
+
+
+ ;; `c-common-init' initializes most of the components of a CC Mode
+ ;; buffer, including setup of the mode menu, font-lock, etc.
+ ;; There's also a lower level routine `c-basic-common-init' that
+ ;; only makes the necessary initialization to get the syntactic
+ ;; analysis and similar things working.
+ (c-common-init 'csharp-mode)
+
+
+ ;; csc.exe, the C# Compiler, produces errors like this:
+ ;; file.cs(6,18): error SC1006: Name of constructor must match name of class
+
+ (add-hook 'compilation-mode-hook
+ (lambda ()
+ (setq compilation-error-regexp-alist
+ (cons ' ("^[ \t]*\\([A-Za-z0-9][^(]+\\.cs\\)(\\([0-9]+\\)[,]\\([0-9]+\\)) ?: \\(error\\|warning\\) CS[0-9]+:" 1 2 3)
+ compilation-error-regexp-alist))))
+
+ ;; to allow next-error to work with csc.exe:
+ (setq compilation-scroll-output t)
+
+ ;; allow fill-paragraph to work on xml code doc
+ (set (make-local-variable 'paragraph-separate)
+ "[ \t]*\\(//+\\|\\**\\)\\([ \t]+\\|[ \t]+<.+?>\\)$\\|^\f")
+
+
+ (c-run-mode-hooks 'c-mode-common-hook 'csharp-mode-hook)
+
+
+ ;; Need the following for parse-partial-sexp to work properly with
+ ;; verbatim literal strings Setting this var to non-nil tells
+ ;; `parse-partial-sexp' to pay attention to the syntax text
+ ;; properties on the text in the buffer. If csharp-mode attaches
+ ;; text syntax to @"..." then, `parse-partial-sexp' will treat those
+ ;; strings accordingly.
+ (set (make-local-variable 'parse-sexp-lookup-properties)
+ t)
+
+ ;; scan the entire buffer for verblit strings
+ (csharp-scan-for-verbatim-literals-and-set-props nil nil)
+
+
+ (local-set-key (kbd "/") 'csharp-maybe-insert-codedoc)
+ (local-set-key (kbd "{") 'csharp-insert-open-brace)
+
+ (c-update-modeline))
+
+
+
+(message (concat "Done loading " load-file-name))
+
+
+(provide 'csharp-mode)
+
+;;; csharp-mode.el ends here
+;;MD5: 4EDCB2ECE38841F407C7ED3DA8354E15
--- /dev/null
+;;; django.el ---
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Sun Nov 18 18:29:41 2007
+;; Version: 0.3
+;; Last-Updated: 2008-08-08T13:22:19+0200 Fri
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Simple highlighting for Django for use with mumamo.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; Maybe there are something to get here?
+;; http://github.com/cosmin/emacs-utils/tree/85cc1d2bd447cb9b2fc98e27b5f8780453e5b978/django-html-mode.el
+
+(defconst django-indenting-keywords
+ '("block" "comment" "else"
+ "filter" "for" "if" "ifchanged" "ifequal"
+ "ifnotequal" "spaceless" "with"))
+
+;; (append '(or) django-indenting-keywords)
+(defconst django-font-lock-keywords
+ (list
+ (cons (rx-to-string
+ `(and
+ word-start
+ (or "as" "autoescape" "csrf_token" "cycle" "debug" "extends"
+ "firstof" "in" "include" "load" "now" "regroup" "ssi"
+ "templatetag" "url" "widthratio"
+ (seq
+ (opt "end")
+ ;; (or "autoescape" "block" "comment" "cycle" "debug" "else"
+ ;; "extends" "filter" "firstof" "for" "if" "ifchanged" "ifequal"
+ ;; "ifnotequal" "include" "load" "now" "regroup"
+ ;; "spaceless" "ssi" "templatetag" "url" "widthratio"
+ ;; "with")
+ ,(append '(or) django-indenting-keywords)
+ ))
+ word-end))
+ font-lock-keyword-face)
+ )
+ "Minimal highlighting expressions for Django mode")
+
+(defcustom django-indent-width 2
+ "Indentation width for Django."
+ :type 'integer
+ :group 'django)
+
+(defun django-indent-line ()
+ "Indent current line as Django code.
+Indent like the examples on URL
+`http://docs.djangoproject.com/en/1.1/ref/templates/builtins/'."
+ (save-match-data
+ (let* ((indent-re (rx-to-string `(and word-start
+ ,(append '(or "else") django-indenting-keywords))))
+ (deindent-re (rx-to-string `(and word-start
+ (or "else"
+ (seq
+ "end"
+ ,(append '(or) django-indenting-keywords))))))
+ (here (point-marker))
+ (this-indentation (current-indentation))
+ (this-line-start (progn (beginning-of-line) (point)))
+ (prev-line-start (progn (skip-chars-backward " \t\n\r\f")
+ (beginning-of-line)
+ (when (< (point) this-line-start)
+ (point))))
+ (prev-indentation (if prev-line-start (current-indentation) 0))
+ (shift-in (if (and prev-line-start
+ (re-search-forward indent-re (point-at-eol) t))
+ django-indent-width 0))
+ (shift-out (progn
+ (goto-char this-line-start)
+ (if (re-search-forward deindent-re (point-at-eol) t)
+ (- django-indent-width) 0)))
+ (new-indentation (max 0 (+ prev-indentation shift-in shift-out)))
+ )
+ (goto-char this-line-start)
+ (cond
+ ((> new-indentation this-indentation)
+ (skip-chars-forward " \t")
+ (indent-to new-indentation))
+ ((< new-indentation this-indentation)
+ (back-to-indentation)
+ (delete-region this-line-start (point))
+ (indent-to new-indentation)))
+ (goto-char here))))
+
+;;;###autoload
+(define-derived-mode django-mode nil "Django"
+ "Simple Django mode for use with mumamo.
+This mode only provides syntax highlighting."
+ (set (make-local-variable 'indent-line-function) 'django-indent-line)
+ (setq font-lock-defaults '(django-font-lock-keywords)))
+
+;;; Comments mode
+;; (defconst django-comment-font-lock-keywords
+;; (list
+;; (cons "\\(.*\\)" (list 1 font-lock-comment-face))
+;; ))
+
+;; (defvar django-comment-font-lock-defaults
+;; '(django-comment-font-lock-keywords t t))
+
+;; (define-derived-mode django-comment-mode nil "Django comment"
+;; "For django comment blocks."
+;; (set (make-local-variable 'font-lock-defaults) django-comment-font-lock-defaults))
+
+;;; Variables mode
+
+(defconst django-variable-font-lock-keywords
+ (list
+ ;; Built in filters:
+ (cons (rx
+ "|"
+ (submatch
+ (or "add" "addslashes" "capfirst" "center" "cut"
+ "date" "default" "default_if_none"
+ "dictsort" "dictsortreversed"
+ "divisibleby"
+ "escape"
+ "filesizeformat"
+ "first"
+ "fixampersands"
+ "floatformat"
+ "force_escape"
+ "iriencode"
+ "join"
+ "length" "length_is"
+ "linebreaks" "linebreaksbr" "linenumbers"
+ "ljust"
+ "lower"
+ "make_list"
+ "phone2numeric"
+ "pluralize"
+ "pprint"
+ "random"
+ "removetags"
+ "rjust"
+ "safe" "slice" "slugify" "stringformat" "striptags"
+ "time" "timesince" "timeuntil"
+ "title" "truncatewords" "truncatewords_html"
+ "unordered_list"
+ "upper" "urlencode" "urlize" "urlizetrunc"
+ "wordcount" "wordwrap" "yesno")))
+ (list 1 font-lock-builtin-face))
+ (cons (rx
+ "|"
+ (submatch
+ (0+ (any "a-z"))))
+ (list 1 font-lock-function-name-face))
+ (cons "\\([^|]*\\)" (list 1 font-lock-variable-name-face))
+ ))
+
+(defvar django-variable-font-lock-defaults
+ '(django-variable-font-lock-keywords
+ t t
+ ;; This still gives teh syntax symbol to |, why?
+ ((?| . ". "))
+ ))
+
+(define-derived-mode django-variable-mode nil "Django variable"
+ "For django comment blocks."
+ ;;(modify-syntax-entry ?| ?.)
+ (set (make-local-variable 'font-lock-defaults) django-variable-font-lock-defaults))
+
+(provide 'django)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; django.el ends here
--- /dev/null
+/*
+ * Simulated browser environment for Rhino
+ * By John Resig <http://ejohn.org/>
+ * Copyright 2007 John Resig, under the MIT License
+ */
+
+// The window Object
+var window = this;
+
+(function(){
+
+ // Browser Navigator
+
+ window.navigator = {
+ get userAgent(){
+ return "Mozilla/5.0 (Macintosh; U; Intel Mac OS X; en-US; rv:1.8.1.3) Gecko/20070309 Firefox/2.0.0.3";
+ }
+ };
+
+ var curLocation = (new java.io.File("./")).toURL();
+
+ window.__defineSetter__("location", function(url){
+ var xhr = new XMLHttpRequest();
+ xhr.open("GET", url);
+ xhr.onreadystatechange = function(){
+ curLocation = new java.net.URL( curLocation, url );
+ window.document = xhr.responseXML;
+
+ var event = document.createEvent();
+ event.initEvent("load");
+ window.dispatchEvent( event );
+ };
+ xhr.send();
+ });
+
+ window.__defineGetter__("location", function(url){
+ return {
+ get protocol(){
+ return curLocation.getProtocol() + ":";
+ },
+ get href(){
+ return curLocation.toString();
+ },
+ toString: function(){
+ return this.href;
+ }
+ };
+ });
+
+ // Timers
+
+ var timers = [];
+
+ window.setTimeout = function(fn, time){
+ var num;
+ return num = setInterval(function(){
+ fn();
+ clearInterval(num);
+ }, time);
+ };
+
+ window.setInterval = function(fn, time){
+ var num = timers.length;
+
+ timers[num] = new java.lang.Thread(new java.lang.Runnable({
+ run: function(){
+ while (true){
+ java.lang.Thread.currentThread().sleep(time);
+ fn();
+ }
+ }
+ }));
+
+ timers[num].start();
+
+ return num;
+ };
+
+ window.clearInterval = function(num){
+ if ( timers[num] ) {
+ timers[num].stop();
+ delete timers[num];
+ }
+ };
+
+ // Window Events
+
+ var events = [{}];
+
+ window.addEventListener = function(type, fn){
+ if ( !this.uuid || this == window ) {
+ this.uuid = events.length;
+ events[this.uuid] = {};
+ }
+
+ if ( !events[this.uuid][type] )
+ events[this.uuid][type] = [];
+
+ if ( events[this.uuid][type].indexOf( fn ) < 0 )
+ events[this.uuid][type].push( fn );
+ };
+
+ window.removeEventListener = function(type, fn){
+ if ( !this.uuid || this == window ) {
+ this.uuid = events.length;
+ events[this.uuid] = {};
+ }
+
+ if ( !events[this.uuid][type] )
+ events[this.uuid][type] = [];
+
+ events[this.uuid][type] =
+ events[this.uuid][type].filter(function(f){
+ return f != fn;
+ });
+ };
+
+ window.dispatchEvent = function(event){
+ if ( event.type ) {
+ if ( this.uuid && events[this.uuid][event.type] ) {
+ var self = this;
+
+ events[this.uuid][event.type].forEach(function(fn){
+ fn.call( self, event );
+ });
+ }
+
+ if ( this["on" + event.type] )
+ this["on" + event.type].call( self, event );
+ }
+ };
+
+ // DOM Document
+
+ window.DOMDocument = function(file){
+ this._file = file;
+ this._dom = Packages.javax.xml.parsers.
+ DocumentBuilderFactory.newInstance()
+ .newDocumentBuilder().parse(file);
+
+ if ( !obj_nodes.containsKey( this._dom ) )
+ obj_nodes.put( this._dom, this );
+ };
+
+ DOMDocument.prototype = {
+ createTextNode: function(text){
+ return makeNode( this._dom.createTextNode(
+ text.replace(/&/g, "&").replace(/</g, "<").replace(/>/g, ">")) );
+ },
+ createElement: function(name){
+ return makeNode( this._dom.createElement(name.toLowerCase()) );
+ },
+ getElementsByTagName: function(name){
+ return new DOMNodeList( this._dom.getElementsByTagName(
+ name.toLowerCase()) );
+ },
+ getElementById: function(id){
+ var elems = this._dom.getElementsByTagName("*");
+
+ for ( var i = 0; i < elems.length; i++ ) {
+ var elem = elems.item(i);
+ if ( elem.getAttribute("id") == id )
+ return makeNode(elem);
+ }
+
+ return null;
+ },
+ get body(){
+ return this.getElementsByTagName("body")[0];
+ },
+ get documentElement(){
+ return makeNode( this._dom.getDocumentElement() );
+ },
+ get ownerDocument(){
+ return null;
+ },
+ addEventListener: window.addEventListener,
+ removeEventListener: window.removeEventListener,
+ dispatchEvent: window.dispatchEvent,
+ get nodeName() {
+ return "#document";
+ },
+ importNode: function(node, deep){
+ return makeNode( this._dom.importNode(node._dom, deep) );
+ },
+ toString: function(){
+ return "Document" + (typeof this._file == "string" ?
+ ": " + this._file : "");
+ },
+ get innerHTML(){
+ return this.documentElement.outerHTML;
+ },
+
+ get defaultView(){
+ return {
+ getComputedStyle: function(elem){
+ return {
+ getPropertyValue: function(prop){
+ prop = prop.replace(/\-(\w)/g,function(m,c){
+ return c.toUpperCase();
+ });
+ var val = elem.style[prop];
+
+ if ( prop == "opacity" && val == "" )
+ val = "1";
+
+ return val;
+ }
+ };
+ }
+ };
+ },
+
+ createEvent: function(){
+ return {
+ type: "",
+ initEvent: function(type){
+ this.type = type;
+ }
+ };
+ }
+ };
+
+ function getDocument(node){
+ return obj_nodes.get(node);
+ }
+
+ // DOM NodeList
+
+ window.DOMNodeList = function(list){
+ this._dom = list;
+ this.length = list.getLength();
+
+ for ( var i = 0; i < this.length; i++ ) {
+ var node = list.item(i);
+ this[i] = makeNode( node );
+ }
+ };
+
+ DOMNodeList.prototype = {
+ toString: function(){
+ return "[ " +
+ Array.prototype.join.call( this, ", " ) + " ]";
+ },
+ get outerHTML(){
+ return Array.prototype.map.call(
+ this, function(node){return node.outerHTML;}).join('');
+ }
+ };
+
+ // DOM Node
+
+ window.DOMNode = function(node){
+ this._dom = node;
+ };
+
+ DOMNode.prototype = {
+ get nodeType(){
+ return this._dom.getNodeType();
+ },
+ get nodeValue(){
+ return this._dom.getNodeValue();
+ },
+ get nodeName() {
+ return this._dom.getNodeName();
+ },
+ cloneNode: function(deep){
+ return makeNode( this._dom.cloneNode(deep) );
+ },
+ get ownerDocument(){
+ return getDocument( this._dom.ownerDocument );
+ },
+ get documentElement(){
+ return makeNode( this._dom.documentElement );
+ },
+ get parentNode() {
+ return makeNode( this._dom.getParentNode() );
+ },
+ get nextSibling() {
+ return makeNode( this._dom.getNextSibling() );
+ },
+ get previousSibling() {
+ return makeNode( this._dom.getPreviousSibling() );
+ },
+ toString: function(){
+ return '"' + this.nodeValue + '"';
+ },
+ get outerHTML(){
+ return this.nodeValue;
+ }
+ };
+
+ // DOM Element
+
+ window.DOMElement = function(elem){
+ this._dom = elem;
+ this.style = {
+ get opacity(){ return this._opacity; },
+ set opacity(val){ this._opacity = val + ""; }
+ };
+
+ // Load CSS info
+ var styles = (this.getAttribute("style") || "").split(/\s*;\s*/);
+
+ for ( var i = 0; i < styles.length; i++ ) {
+ var style = styles[i].split(/\s*:\s*/);
+ if ( style.length == 2 )
+ this.style[ style[0] ] = style[1];
+ }
+ };
+
+ DOMElement.prototype = extend( new DOMNode(), {
+ get nodeName(){
+ return this.tagName.toUpperCase();
+ },
+ get tagName(){
+ return this._dom.getTagName();
+ },
+ toString: function(){
+ return "<" + this.tagName + (this.id ? "#" + this.id : "" ) + ">";
+ },
+ get outerHTML(){
+ var ret = "<" + this.tagName, attr = this.attributes;
+
+ for ( var i in attr )
+ ret += " " + i + "='" + attr[i] + "'";
+
+ if ( this.childNodes.length || this.nodeName == "SCRIPT" )
+ ret += ">" + this.childNodes.outerHTML +
+ "</" + this.tagName + ">";
+ else
+ ret += "/>";
+
+ return ret;
+ },
+
+ get attributes(){
+ var attr = {}, attrs = this._dom.getAttributes();
+
+ for ( var i = 0; i < attrs.getLength(); i++ )
+ attr[ attrs.item(i).nodeName ] = attrs.item(i).nodeValue;
+
+ return attr;
+ },
+
+ get innerHTML(){
+ return this.childNodes.outerHTML;
+ },
+ set innerHTML(html){
+ html = html.replace(/<\/?([A-Z]+)/g, function(m){
+ return m.toLowerCase();
+ });
+
+ var nodes = this.ownerDocument.importNode(
+ new DOMDocument( new java.io.ByteArrayInputStream(
+ (new java.lang.String("<wrap>" + html + "</wrap>"))
+ .getBytes("UTF8"))).documentElement, true).childNodes;
+
+ while (this.firstChild)
+ this.removeChild( this.firstChild );
+
+ for ( var i = 0; i < nodes.length; i++ )
+ this.appendChild( nodes[i] );
+ },
+
+ get textContent(){
+ return nav(this.childNodes);
+
+ function nav(nodes){
+ var str = "";
+ for ( var i = 0; i < nodes.length; i++ )
+ if ( nodes[i].nodeType == 3 )
+ str += nodes[i].nodeValue;
+ else if ( nodes[i].nodeType == 1 )
+ str += nav(nodes[i].childNodes);
+ return str;
+ }
+ },
+ set textContent(text){
+ while (this.firstChild)
+ this.removeChild( this.firstChild );
+ this.appendChild( this.ownerDocument.createTextNode(text));
+ },
+
+ style: {},
+ clientHeight: 0,
+ clientWidth: 0,
+ offsetHeight: 0,
+ offsetWidth: 0,
+
+ get disabled() {
+ var val = this.getAttribute("disabled");
+ return val != "false" && !!val;
+ },
+ set disabled(val) { return this.setAttribute("disabled",val); },
+
+ get checked() {
+ var val = this.getAttribute("checked");
+ return val != "false" && !!val;
+ },
+ set checked(val) { return this.setAttribute("checked",val); },
+
+ get selected() {
+ if ( !this._selectDone ) {
+ this._selectDone = true;
+
+ if ( this.nodeName == "OPTION" && !this.parentNode.getAttribute("multiple") ) {
+ var opt = this.parentNode.getElementsByTagName("option");
+
+ if ( this == opt[0] ) {
+ var select = true;
+
+ for ( var i = 1; i < opt.length; i++ )
+ if ( opt[i].selected ) {
+ select = false;
+ break;
+ }
+
+ if ( select )
+ this.selected = true;
+ }
+ }
+ }
+
+ var val = this.getAttribute("selected");
+ return val != "false" && !!val;
+ },
+ set selected(val) { return this.setAttribute("selected",val); },
+
+ get className() { return this.getAttribute("class") || ""; },
+ set className(val) {
+ return this.setAttribute("class",
+ val.replace(/(^\s*|\s*$)/g,""));
+ },
+
+ get type() { return this.getAttribute("type") || ""; },
+ set type(val) { return this.setAttribute("type",val); },
+
+ get value() { return this.getAttribute("value") || ""; },
+ set value(val) { return this.setAttribute("value",val); },
+
+ get src() { return this.getAttribute("src") || ""; },
+ set src(val) { return this.setAttribute("src",val); },
+
+ get id() { return this.getAttribute("id") || ""; },
+ set id(val) { return this.setAttribute("id",val); },
+
+ getAttribute: function(name){
+ return this._dom.hasAttribute(name) ?
+ new String( this._dom.getAttribute(name) ) :
+ null;
+ },
+ setAttribute: function(name,value){
+ this._dom.setAttribute(name,value);
+ },
+ removeAttribute: function(name){
+ this._dom.removeAttribute(name);
+ },
+
+ get childNodes(){
+ return new DOMNodeList( this._dom.getChildNodes() );
+ },
+ get firstChild(){
+ return makeNode( this._dom.getFirstChild() );
+ },
+ get lastChild(){
+ return makeNode( this._dom.getLastChild() );
+ },
+ appendChild: function(node){
+ this._dom.appendChild( node._dom );
+ },
+ insertBefore: function(node,before){
+ this._dom.insertBefore( node._dom, before ? before._dom : before );
+ },
+ removeChild: function(node){
+ this._dom.removeChild( node._dom );
+ },
+
+ getElementsByTagName: DOMDocument.prototype.getElementsByTagName,
+
+ addEventListener: window.addEventListener,
+ removeEventListener: window.removeEventListener,
+ dispatchEvent: window.dispatchEvent,
+
+ click: function(){
+ var event = document.createEvent();
+ event.initEvent("click");
+ this.dispatchEvent(event);
+ },
+ submit: function(){
+ var event = document.createEvent();
+ event.initEvent("submit");
+ this.dispatchEvent(event);
+ },
+ focus: function(){
+ var event = document.createEvent();
+ event.initEvent("focus");
+ this.dispatchEvent(event);
+ },
+ blur: function(){
+ var event = document.createEvent();
+ event.initEvent("blur");
+ this.dispatchEvent(event);
+ },
+ get elements(){
+ return this.getElementsByTagName("*");
+ },
+ get contentWindow(){
+ return this.nodeName == "IFRAME" ? {
+ document: this.contentDocument
+ } : null;
+ },
+ get contentDocument(){
+ if ( this.nodeName == "IFRAME" ) {
+ if ( !this._doc )
+ this._doc = new DOMDocument(
+ new java.io.ByteArrayInputStream((new java.lang.String(
+ "<html><head><title></title></head><body></body></html>"))
+ .getBytes("UTF8")));
+ return this._doc;
+ } else
+ return null;
+ }
+ });
+
+ // Helper method for extending one object with another
+
+ function extend(a,b) {
+ for ( var i in b ) {
+ var g = b.__lookupGetter__(i), s = b.__lookupSetter__(i);
+
+ if ( g || s ) {
+ if ( g )
+ a.__defineGetter__(i, g);
+ if ( s )
+ a.__defineSetter__(i, s);
+ } else
+ a[i] = b[i];
+ }
+ return a;
+ }
+
+ // Helper method for generating the right
+ // DOM objects based upon the type
+
+ var obj_nodes = new java.util.HashMap();
+
+ function makeNode(node){
+ if ( node ) {
+ if ( !obj_nodes.containsKey( node ) )
+ obj_nodes.put( node, node.getNodeType() ==
+ Packages.org.w3c.dom.Node.ELEMENT_NODE ?
+ new DOMElement( node ) : new DOMNode( node ) );
+
+ return obj_nodes.get(node);
+ } else
+ return null;
+ }
+
+ // XMLHttpRequest
+ // Originally implemented by Yehuda Katz
+
+ window.XMLHttpRequest = function(){
+ this.headers = {};
+ this.responseHeaders = {};
+ };
+
+ XMLHttpRequest.prototype = {
+ open: function(method, url, async, user, password){
+ this.readyState = 1;
+ if (async)
+ this.async = true;
+ this.method = method || "GET";
+ this.url = url;
+ this.onreadystatechange();
+ },
+ setRequestHeader: function(header, value){
+ this.headers[header] = value;
+ },
+ getResponseHeader: function(header){ },
+ send: function(data){
+ var self = this;
+
+ function makeRequest(){
+ var url = new java.net.URL(curLocation, self.url);
+
+ if ( url.getProtocol() == "file" ) {
+ if ( self.method == "PUT" ) {
+ var out = new java.io.FileWriter(
+ new java.io.File( new java.net.URI( url.toString() ) ) ),
+ text = new java.lang.String( data || "" );
+
+ out.write( text, 0, text.length() );
+ out.flush();
+ out.close();
+ } else if ( self.method == "DELETE" ) {
+ var file = new java.io.File( new java.net.URI( url.toString() ) );
+ file["delete"]();
+ } else {
+ var connection = url.openConnection();
+ connection.connect();
+ handleResponse();
+ }
+ } else {
+ var connection = url.openConnection();
+
+ connection.setRequestMethod( self.method );
+
+ // Add headers to Java connection
+ for (var header in self.headers)
+ connection.addRequestProperty(header, self.headers[header]);
+
+ connection.connect();
+
+ // Stick the response headers into responseHeaders
+ for (var i = 0; ; i++) {
+ var headerName = connection.getHeaderFieldKey(i);
+ var headerValue = connection.getHeaderField(i);
+ if (!headerName && !headerValue) break;
+ if (headerName)
+ self.responseHeaders[headerName] = headerValue;
+ }
+
+ handleResponse();
+ }
+
+ function handleResponse(){
+ self.readyState = 4;
+ self.status = parseInt(connection.responseCode) || undefined;
+ self.statusText = connection.responseMessage || "";
+
+ var stream = new java.io.InputStreamReader(connection.getInputStream()),
+ buffer = new java.io.BufferedReader(stream), line;
+
+ while ((line = buffer.readLine()) != null)
+ self.responseText += line;
+
+ self.responseXML = null;
+
+ if ( self.responseText.match(/^\s*</) ) {
+ try {
+ self.responseXML = new DOMDocument(
+ new java.io.ByteArrayInputStream(
+ (new java.lang.String(
+ self.responseText)).getBytes("UTF8")));
+ } catch(e) {}
+ }
+ }
+
+ self.onreadystatechange();
+ }
+
+ if (this.async)
+ (new java.lang.Thread(new java.lang.Runnable({
+ run: makeRequest
+ }))).start();
+ else
+ makeRequest();
+ },
+ abort: function(){},
+ onreadystatechange: function(){},
+ getResponseHeader: function(header){
+ if (this.readyState < 3)
+ throw new Error("INVALID_STATE_ERR");
+ else {
+ var returnedHeaders = [];
+ for (var rHeader in this.responseHeaders) {
+ if (rHeader.match(new Regexp(header, "i")))
+ returnedHeaders.push(this.responseHeaders[rHeader]);
+ }
+
+ if (returnedHeaders.length)
+ return returnedHeaders.join(", ");
+ }
+
+ return null;
+ },
+ getAllResponseHeaders: function(header){
+ if (this.readyState < 3)
+ throw new Error("INVALID_STATE_ERR");
+ else {
+ var returnedHeaders = [];
+
+ for (var header in this.responseHeaders)
+ returnedHeaders.push( header + ": " + this.responseHeaders[header] );
+
+ return returnedHeaders.join("\r\n");
+ }
+ },
+ async: true,
+ readyState: 0,
+ responseText: "",
+ status: 0
+ };
+})();
--- /dev/null
+;;; flymake-css.el --- Flymake setup for css files
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-11-21 Sat
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; See variable `flymake-css-validator-jar' for instructions for how
+;; to set this up.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+
+(require 'flymake)
+(require 'xml)
+
+
+(defcustom flymake-allowed-css-file-name-masks '(("\\.css\\'" flymake-css-init))
+ "Filename extensions that switch on js syntax checks."
+ :type '(repeat (list (regexp :tag "File name regexp")
+ (function :tag "Init function")
+ (choice (const :tag "No cleanup function" nil)
+ (function :tag "Cleanup function"))))
+ :group 'flymake)
+
+
+(defvar flymake-css-err-line-pattern-re '(("^file:\\([^:]+\\):\\([^:]+\\):\\(.*\\)" 1 2 nil 3))
+ "Regexp matching CSS error messages")
+
+(defcustom flymake-css-validator-jar "~/bin/css-validator.jar"
+ "Full path to css-validor.jar file.
+You need the css-validator.jar and some other files for flymake
+for CSS to work. The instructions below tell you how to get and
+install it. The instructions are copied from
+
+ http://www.emacswiki.org/emacs/FlymakeCSS
+
+Get http://www.w3.org/QA/Tools/css-validator/css-validator.jar
+create a directory named ‘lib’ in the same directory. Copy to the
+‘lib’ dir the following jars:
+
+ * commons-collections-3.2.1.jar
+ * jigsaw.jar
+ * velocity-1.6.1.jar
+ * xml-apis.jar
+ * commons-lang-2.4.jar
+ * tagsoup-1.2.jar
+ * xercesImpl.jar
+
+From:
+
+ URL `http://jigsaw.w3.org/Distrib/jigsaw_2.2.6.tar.gz'
+ URL `http://www.apache.org/dist/commons/collections/binaries/commons-collections-3.2.1-bin.tar.gz'
+ URL `http://www.apache.org/dist/commons/lang/binaries/commons-lang-2.4-bin.tar.gz'
+ URL `http://www.apache.org/dist/velocity/engine/1.6.1/velocity-1.6.1.tar.gz'
+ URL `http://www.apache.org/dist/xerces/j/Xerces-J-bin.2.9.1.tar.gz'
+ URL `http://home.ccil.org/~cowan/XML/tagsoup/tagsoup-1.2.jar'
+
+Test validating some CSS file by running:
+
+ java -jar css-validator.jar file:somecssfile.css"
+ :type 'file
+ :group 'flymake)
+;;(setq flymake-css-validator-jar "c:/dl/programs/css-valid/css-validator.jar")
+
+(defun flymake-css-init ()
+ (let* ((temp-file (flymake-init-create-temp-buffer-copy
+ 'flymake-create-temp-inplace))
+ (local-file (file-relative-name
+ temp-file
+ (file-name-directory buffer-file-name))))
+ (unless (file-exists-p flymake-css-validator-jar)
+ (error "Can't find css-validator.jar: %s\n\nPlease customize option flymake-css-validator-jar\n"
+ flymake-css-validator-jar))
+ (list "java"
+ (list "-jar" flymake-css-validator-jar
+ "-output" "gnu"
+ (concat "file:" local-file)))))
+
+;;;###autoload
+(defun flymake-css-load ()
+ (dolist (rec flymake-allowed-css-file-name-masks)
+ (add-to-list 'flymake-allowed-file-name-masks rec))
+ (dolist (rec flymake-css-err-line-pattern-re)
+ (add-to-list 'flymake-err-line-patterns rec)))
+
+
+;;(defun flymake-make-overlay (beg end tooltip-text face mouse-face)
+(defadvice flymake-make-overlay (before
+ flymake-css-ad-flymake-make-overlay
+ activate
+ compile)
+ (ad-set-arg 2 (xml-substitute-numeric-entities (ad-get-arg 2))))
+
+;; Fix-me: remove when this has been giving its proper place in Emacs.
+(eval-when-compile
+ (unless (fboundp 'xml-substitute-numeric-entities)
+ (message "Use Emacs 22 workaround for newsticker--decode-numeric-entities")
+ (defun xml-substitute-numeric-entities (string)
+ "Decode SGML numeric entities by their respective utf characters.
+This is just a copy of the function in newst-backen.el for Emacs
+22 users.
+
+This function replaces numeric entities in the input STRING and
+returns the modified string. For example \"*\" gets replaced
+by \"*\"."
+ (if (and string (stringp string))
+ (let ((start 0))
+ (while (string-match "&#\\([0-9]+\\);" string start)
+ (condition-case nil
+ (setq string (replace-match
+ (string (read (substring string
+ (match-beginning 1)
+ (match-end 1))))
+ nil nil string))
+ (error nil))
+ (setq start (1+ (match-beginning 0))))
+ string)
+ nil))
+ ))
+
+;;(eval-after-load 'css-mode (flymake-css-load))
+
+(provide 'flymake-css)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; flymake-css.el ends here
--- /dev/null
+;;; flymake-helpers.el --- Helper functions for flymake
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-07-21T14:30:20+0200 Mon
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'flymake))
+
+;; (flymake-create-temp-intemp buffer-file-name nil)
+(defun flymake-create-temp-intemp (file-name prefix)
+ "Return file name in temporary directory for checking FILE-NAME.
+This is a replacement for `flymake-create-temp-inplace'. The
+only difference is that it gives a file name in
+`temporary-file-directory' instead of the same directory as
+FILE-NAME.
+
+For the use of PREFIX see that function.
+
+Note that not making the temporary file in another directory
+\(like here) will not work if the file you are checking depends
+on relative paths to other files \(for the type of checks flymake
+makes)."
+ (unless (stringp file-name)
+ (error "Invalid file-name"))
+ (or prefix
+ (setq prefix "flymake"))
+ (let* ((prefix (concat
+ (file-name-nondirectory (file-name-sans-extension file-name))
+ "_" prefix))
+ (suffix (concat "." (file-name-extension file-name)))
+ (temp-name (make-temp-file prefix nil suffix)))
+ (flymake-log 3 "create-temp-intemp: file=%s temp=%s" file-name temp-name)
+ temp-name))
+
+
+(provide 'flymake-helpers)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; flymake-helpers.el ends here
--- /dev/null
+;;; flymake-java-1.el --- Flymake for single java files
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-12-02 Wed
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-and-compile (require 'flymake))
+
+(defun flymake-init-maybe-find-buildfile-dir (source-file-name buildfile-name)
+ "Find buildfile, store its dir in buffer data and return its dir, if found."
+ (let* ((buildfile-dir
+ (flymake-find-buildfile buildfile-name
+ (file-name-directory source-file-name))))
+ (if buildfile-dir
+ (setq flymake-base-dir buildfile-dir)
+ (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name)
+ nil)))
+
+(defun flymake-complex-make-init-impl-1 (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f)
+ "Create syntax check command line for a directly checked source file.
+Use CREATE-TEMP-F for creating temp copy."
+ (let* ((args nil)
+ (source-file-name buffer-file-name)
+ (buildfile-dir (flymake-init-maybe-find-buildfile-dir source-file-name build-file-name)))
+ (if buildfile-dir
+ (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)))
+ (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir
+ use-relative-base-dir use-relative-source
+ get-cmdline-f))))
+ args))
+
+(defun flymake-complex-java-init ()
+ (or (flymake-complex-make-init-impl-1 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline)
+ (flymake-complex-make-init-impl-1 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-make-cmdline)
+ (flymake-java-1-init)))
+
+(defcustom flymake-java-1-javac "c:/Sun/SDK/jdk/bin/javac.exe"
+ "Path to javac."
+ :group 'flymake)
+
+(defun flymake-java-1-init ()
+ (if (not (executable-find flymake-java-1-javac))
+ (message "Can't find javac. Please customize flymake-java-1-javac")
+ (list flymake-java-1-javac
+ (list (flymake-init-create-temp-buffer-copy
+ 'flymake-create-temp-with-folder-structure)))))
+
+;; (defun flymake-java-1-turn-on ()
+;; (interactive)
+;; (if (not (executable-find flymake-java-1-javac))
+;; (message "Can't find javac. Please customize flymake-java-1-javac")
+;; (let ((flymake-allowed-file-name-masks
+;; '(("\\.java\\'" flymake-java-1-init flymake-simple-cleanup))))
+;; (when flymake-mode (flymake-mode -1))
+;; (flymake-mode 1))))
+
+;;;###autoload
+(defun flymake-java-1-load ()
+ (let ((jrec (assoc "\\.java\\'" flymake-allowed-file-name-masks)))
+ (setq flymake-allowed-file-name-masks
+ (delete jrec flymake-allowed-file-name-masks))
+ (setq flymake-allowed-file-name-masks
+ (cons
+ '("\\.java\\'" flymake-complex-java-init flymake-simple-java-cleanup)
+ flymake-allowed-file-name-masks))))
+
+(provide 'flymake-java-1)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; flymake-java-1.el ends here
--- /dev/null
+;;; flymake-js.el --- Flymake setup for javascript files
+;;
+;; Author: Lennart Borgman
+;; Created: Sun Dec 02 07:52:52 2007
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This library provides basic setup for using `flymake-mode' with
+;; javascript files. To use this you must have a javascript
+;; installed. There are (at least) two free javascript engines (both
+;; from Mozill) you can use, Rhino (implemented in Java) or
+;; SpiderMonkey (implemented in C). Both are supported in this
+;; library.
+;;
+;; I have not been able to find binaries for SpiderMonkeys to
+;; download. However the Rhino engine seems fast enough and is easy to
+;; install. You find them at
+;;
+;; http://www.mozilla.org/rhino/
+;; http://www.mozilla.org/js/spidermonkey/
+;;
+;; Put this file in your Emacs `load-path' and then in .emacs
+;;
+;; (require 'flymake-js)
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; Flymake JS mode
+
+(require 'flymake)
+
+(defconst flymake-js-dir
+ (file-name-directory (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+ "Installation directory for flymake-js.")
+
+;;;###autoload
+(defgroup flymake-js nil
+ "Customization group for flymake for javascript."
+ :group 'flymake)
+
+(defcustom flymake-allowed-js-file-name-masks '(("\\.json\\'" flymake-js-init)
+ ("\\.js\\'" flymake-js-init))
+ "Filename extensions that switch on js syntax checks."
+ :type '(repeat (list (regexp :tag "File name regexp")
+ (function :tag "Init function")
+ (choice (const :tag "No cleanup function" nil)
+ (function :tag "Cleanup function"))))
+ :group 'flymake-js)
+
+
+(defvar flymake-js-err-line-pattern-re
+ '(;; These pattern are probably for Rhino:
+ ("^js: \"\\(.+\\)\", line \\([0-9]+\\): \\(.+\\)$" 1 2 nil 3)
+ ("^js: uncaught JavaScript \\(.+\\)$" nil nil nil 1)
+ ;; For Rhino with jslint.js
+ ("^Lint at line \\([[:digit:]]+\\) character \\([[:digit:]]+\\): \\(.+\\)$" nil 1 2 3)
+ ;; These pattern are probably for SpiderMonkey:
+ ("^\\(.+\\)\:\\([0-9]+\\)\: \\(SyntaxError\:.+\\)\:$" 1 2 nil 3)
+ ("^\\(.+\\)\:\\([0-9]+\\)\: \\(strict warning: trailing comma.+\\)\:$" 1 2 nil 3))
+ "Regexp matching JavaScript error messages")
+
+(defcustom flymake-js-rhino-jar "/path/to/js.jar"
+ "Path to Rihno jar file.
+Download and install Rhino JavaScript engine from
+
+ URL `http://www.mozilla.org/rhino/'
+
+This variable should point to the file js.jar that is in the top
+directory of the Rhino dir tree. \(It was differently named
+earlier and might perhaps be renamed again.)"
+ :type '(file :must-match t)
+ :group 'flymake-js)
+
+;;(setq flymake-log-level 3)
+;;(setq flymake-js-rhino-use-jslint nil)
+(defcustom flymake-js-rhino-use-jslint nil
+ "Use jslint.js if this is non-nil.
+jslint.js will give you warnings about style things like indentation too."
+ :type 'boolean
+ :group 'flymake-js)
+
+(defcustom flymake-js-rhino-js (expand-file-name "rhino.js" flymake-js-dir)
+ "Path to rhino.js.
+Only used if `flymake-js-rhino-use-jslint' is nil.
+
+This file and env.js must be placed in the same directory. Default
+is this directory.
+
+Those files comes with Rhino, see `flymake-js-rhino-jar'."
+ :type '(file :must-match t)
+ :group 'flymake-js)
+
+(defcustom flymake-js-rhino-jslint (expand-file-name "jslint.js" flymake-js-dir)
+ "Path to jslint.js.
+Only used if `flymake-js-rhino-use-jslint' is t.
+
+If you do not have this file you can download it from URL
+`http://www.jslint.com/rhino/jslint.js'. I had to change quit(2)
+to quit(0) in it \(which seems like a bug in `flymake-mode' to
+me)."
+ :type '(file :must-match t)
+ :group 'flymake-js)
+
+;;(flymake-js-check-rhino-js)
+(defun flymake-js-check-rhino-js ()
+ "Checks that the path to env.js is ok."
+ (with-current-buffer (find-file-noselect flymake-js-rhino-js)
+ (let* ((proj-folder (file-name-as-directory (file-name-directory (buffer-file-name))))
+ (proj-line (concat "var project_folder = 'file:///" proj-folder "';"))
+ (proj-line-re "^\\W*var\\W+project_folder\\W*=\\W*"))
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ (if (re-search-backward proj-line-re nil t)
+ (let ((beg (line-beginning-position))
+ (end (line-end-position)))
+ (unless (string= (buffer-substring-no-properties beg end)
+ proj-line)
+ (delete-region beg end)
+ (insert proj-line)
+ (basic-save-buffer)))
+ (goto-char (point-min))
+ (insert proj-line "\n")
+ (basic-save-buffer))))))
+
+(defcustom flymake-js-engine 'rhino
+ "Javascript engine to use.
+You may have to restart Emacs after changing this - if you can
+not figure out what buffers and processes to kill.
+
+I have only been able to test Rhino since I do not have
+SpiderMonkey."
+ :type '(choice (const :tag "Rhino" rhino)
+ (const :tag "SpiderMonkey" spidermonkey))
+ :group 'flymake-js)
+
+(defun flymake-js-init ()
+ (message "running flymake-js-init")
+ (let* ((temp-file (flymake-init-create-temp-buffer-copy
+ 'flymake-create-temp-inplace))
+ (local-file (file-relative-name
+ temp-file
+ (file-name-directory buffer-file-name))))
+ (flymake-js-check-has-engine)
+ (cond
+ ((eq flymake-js-engine 'rhino)
+ (list "java" (list "-jar" flymake-js-rhino-jar
+ (if flymake-js-rhino-use-jslint
+ flymake-js-rhino-jslint
+ flymake-js-rhino-js)
+ local-file)))
+ ((eq flymake-js-engine 'spidermonkey)
+ (list "js" (list "-s" local-file)))
+ (t
+ (error "Bad value: %s" flymake-js-engine)))))
+
+(defvar flymake-js-has-engine nil)
+
+(defun flymake-js-check-has-engine ()
+ "Check for the needed files."
+ (if flymake-js-has-engine
+ t
+ (cond
+ ;; Rhino
+ ((eq flymake-js-engine 'rhino)
+ (unless (executable-find "java")
+ (error "Could not find java executable"))
+ (unless (file-exists-p flymake-js-rhino-jar)
+ (error "Could not find file %s\n\nPlease customize flymake-js-rhino-jar\n"
+ flymake-js-rhino-jar))
+ (if flymake-js-rhino-use-jslint
+ (unless (file-exists-p flymake-js-rhino-jslint)
+ (error "Could not find file %s" flymake-js-rhino-jslint))
+ (unless (file-exists-p flymake-js-rhino-js)
+ (error "Could not find file %s" flymake-js-rhino-js))
+ (flymake-js-check-rhino-js)))
+ ;; SpiderMonkey
+ ((eq flymake-js-engine 'spidermonkey)
+ (unless (executable-find "js")
+ (error "Could not find js program")))
+ (t
+ (error "Bad value: %s" flymake-js-engine)))
+ (setq flymake-js-has-engine t)))
+
+;;;###autoload
+(defun flymake-js-load ()
+ (dolist (rec flymake-allowed-js-file-name-masks)
+ (add-to-list 'flymake-allowed-file-name-masks rec))
+ (dolist (rec flymake-js-err-line-pattern-re)
+ (add-to-list 'flymake-err-line-patterns rec)))
+
+;;(eval-after-load 'javascript (flymake-js-load))
+
+(provide 'flymake-js)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; flymake-js.el<2> ends here
--- /dev/null
+;;; flymakemsg.el --- Show flymake compile errors in echo area
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-11-21 Sat
+;; Version: 0.1
+;; Last-Updated: 2009-11-21 Sat
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+ ;; `backquote', `bytecomp'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Show flymake error messages in minibuffer when point is on a
+;; flymake error overlay.
+;;
+;; To use it just load this file. Put this in .emacs:
+;;
+;; (require 'flymakemsg)
+;;
+;; This file run `defadvice' on some functions in `flymake-mode'.
+;; This code started from an idea in a paste.
+;;
+;; Note: This code breaks Emacs conventions since it does the
+;; defadvising when you just loads this file.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'flymake))
+
+(defun flymakemsg-show-err-at-point ()
+ "If point is on a flymake error, show it in echo area.
+Protected to run in timers and hooks."
+ (condition-case err
+ (flymakemsg-show-err-at-point-1)
+ (error (message "%s" err))))
+
+(defvar flymakemsg-last-errovl nil)
+
+(defun flymakemsg-show-err-at-point-1 ()
+ "If point is on a flymake error, show it in echo area."
+ (interactive)
+ (when flymake-mode
+ (let ((flyovl (flymakemsg-get-errovl (point))))
+ (unless (eq flyovl flymakemsg-last-errovl)
+ (setq flymakemsg-last-errovl flyovl)
+ (when flyovl
+ (message "%s" (propertize
+ (overlay-get flyovl 'help-echo)
+ 'face 'flymake-errline)))))))
+
+(defun flymakemsg-get-errovl (POS)
+ "Get flymake error overlay at POS."
+ (catch 'errovl
+ (dolist (ovl (overlays-at POS))
+ (when (eq 'flymake-errline (overlay-get ovl 'face))
+ (throw 'errovl ovl)))))
+
+(defadvice flymake-mode (after
+ flymakemsg-ad-flymake-mode
+ activate compile)
+ "Turn on showing of flymake errors then point is on them.
+This shows the error in the echo area."
+ (if flymake-mode
+ nil ;;(add-hook 'post-command-hook 'flymakemsg-post-command t t)
+ (remove-hook 'post-command-hook 'flymakemsg-post-command t)))
+
+(defadvice flymake-log (after
+ flymakemsg-ad-flymake-log
+ activate compile)
+ "Display error on current line if any."
+ ;;(message "flymake-log defadvice called")
+ (if (not flymake-err-info)
+ (remove-hook 'post-command-hook 'flymakemsg-post-command t)
+ (add-hook 'post-command-hook 'flymakemsg-post-command t t)
+ ;; Wait, because there is another message first.
+ (flymakemsg-start-msg-timer 3.0)))
+
+(defun flymakemsg-post-command ()
+ ;; Wait to not disturb to much.
+ (flymakemsg-start-msg-timer 0.2))
+
+(defvar flymakemsg-msg-timer nil)
+
+(defun flymakemsg-cancel-msg-timer ()
+ (when (timerp flymakemsg-msg-timer)
+ (cancel-timer flymakemsg-msg-timer)))
+
+(defun flymakemsg-start-msg-timer (delay)
+ (flymakemsg-cancel-msg-timer)
+ (run-with-idle-timer delay nil 'flymakemsg-show-err-at-point))
+
+;;; I have no idea why it was done the way below. It was in the paste.
+;;; It seems very unnecessary but I keep it for now.
+;;
+;; (defun fly-pyflake-determine-message (err)
+;; "pyflake is flakey if it has compile problems, this adjusts the
+;; message to display, so there is one ;)"
+;; (cond ((not (or (eq major-mode 'Python) (eq major-mode 'python-mode) t)))
+;; ((null (flymake-ler-file err))
+;; ;; normal message do your thing
+;; (flymake-ler-text err))
+;; (t ;; could not compile err
+;; (format "compile error, problem on line %s" (flymake-ler-line err)))))
+
+;; (let ((line-no (line-number-at-pos)))
+;; (dolist (elem flymake-err-info)
+;; (if (eq (car elem) line-no)
+;; (let ((err (car (second elem))))
+;; (message "%s" (fly-pyflake-determine-message err))))))
+
+
+(provide 'flymakemsg)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; flymakemsg.el ends here
--- /dev/null
+;;; flymu.el --- Flymake for mumamo-mode
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Sun Dec 02 14:52:32 2007
+;; Version: 0.1
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Flymake syntax checks for mumamo chunks.
+;;
+;; Not ready yet!!!
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'flymake)
+
+;;(flymu-make-major-mode-alist)
+(defun flymu-make-major-mode-alist ()
+ "Grab values from `flymake-allowed-file-name-masks'.
+We need a list of major modes and the corresponding init and
+cleanup functions for flymake. This functions creates such a list
+from flymakes dito list for file names."
+ (let ((allowed nil))
+ (save-match-data
+ (dolist (regexp-init flymake-allowed-file-name-masks)
+ (let* ((regexp (car regexp-init))
+ (init (cdr regexp-init))
+ ;; Make it as simple as possible. First see if the same
+ ;; regexp is used:
+ (mode (let ((m (cdr (assoc regexp auto-mode-alist))))
+ ;; Don't use this if it is complicated:
+ (when (commandp m) m)))
+ (ext regexp))
+ (unless mode
+ ;; Try to make a simple file name, this could be made
+ ;; better but I do not know if that would be meaningful:
+ (setq ext (replace-regexp-in-string "\\\\\\." "." ext))
+ (setq ext (replace-regexp-in-string "\\\\'" "" ext))
+ (setq ext (replace-regexp-in-string "[\\$?+*]" "" ext))
+ ;; Next compare the filename against the entries in
+ ;; auto-mode-alist. The code is from `set-auto-mode'.
+ (let ((name ext)
+ (done nil))
+ (while name
+ ;; Find first matching alist entry.
+ (setq mode
+ (if (memq system-type '(vax-vms windows-nt cygwin))
+ ;; System is case-insensitive.
+ (let ((case-fold-search t))
+ (assoc-default name auto-mode-alist
+ 'string-match))
+ ;; System is case-sensitive.
+ (or
+ ;; First match case-sensitively.
+ (let ((case-fold-search nil))
+ (assoc-default name auto-mode-alist
+ 'string-match))
+ ;; Fallback to case-insensitive match.
+ (and auto-mode-case-fold
+ (let ((case-fold-search t))
+ (assoc-default name auto-mode-alist
+ 'string-match))))))
+ (if (and mode
+ (consp mode)
+ (cadr mode))
+ (setq name (substring name 0 (match-beginning 0)))
+ (setq name)))))
+ (when (and mode
+ ;; nxml-mode's do not need flymake:
+ (let ((major-mode mode))
+ (not (derived-mode-p 'nxml-mode))))
+ (let ((rec (append (list mode) init)))
+ (when (= (length rec) 2)
+ (setq rec (append rec (list nil))))
+ (add-to-list 'allowed rec))))))
+ allowed))
+
+(defcustom flymu-allowed-major-modes (flymu-make-major-mode-alist)
+ "Major modes syntax checking is allowed for."
+ :type '(repeat (list (function :tag "Major mode")
+ (function :tag "Init function")
+ (choice (const :tag "No cleanup function" nil)
+ (function :tag "Cleanup function"))))
+ :set-after '(flymake-allowed-file-name-masks)
+ :group 'flymu)
+
+(defvar flymu-mumamo-chunk nil)
+(make-variable-buffer-local 'flymu-mumamo-chunk)
+
+
+;; Fix-me: What to check? When? Make flymu-mumamo-chunk a function
+;; instead? Mark chunks for checking - let mumamo do that? Flymake
+;; should be able to mark a chunk to, even if it is not a whole
+;; line. What about line numbers?
+
+;; Advice these functions:
+(defadvice flymake-get-file-name-mode-and-masks (around
+ flymu-ad-flymake-get-file-name-mode-and-masks
+ (file-name))
+ "Make flymake init file selection according to mode."
+ (if flymu-mumamo-chunk
+ (let ((major (overlay-get ovl 'mumamo-major-mode))
+ (rec (assq major flymu-allowed-major-modes)))
+ (when rec
+ (setq ad-return-value (cdr rec))))
+ ad-do-it))
+(ad-activate 'flymake-get-file-name-mode-and-masks)
+
+;;(defun flymake-save-buffer-in-file (file-name)
+(defadvice flymake-save-buffer-in-file (around
+ flymu-ad-flymake-save-buffer-in-file
+ (file-name))
+ (if flymu-mumamo-chunk
+ (let ((min (overlay-start flymu-mumamo-chunk))
+ (max (overlay-end flymu-mumamo-chunk)))
+ (make-directory (file-name-directory file-name) 1)
+ (write-region min max file-name nil 566)
+ (flymake-log 3 "saved chunk %s:%s-%s in file %s" (buffer-name) min ma file-name))
+ ad-do-it))
+
+(provide 'flymu)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; flymu.el ends here
--- /dev/null
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; iss-mode.el --- Mode for InnoSetup install scripts
+
+;; Copyright (C) 2000-2007 by Stefan Reichoer
+
+;; Emacs Lisp Archive Entry
+;; Filename: iss-mode.el
+;; Author: Stefan Reichoer, <stefan@xsteve.at>
+;; Version: 1.1d
+
+;; iss-mode.el is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; iss-mode.el is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary
+
+;; InnoSetup is an Application Installer for Windows
+;; See: http://www.jrsoftware.org/isinfo.php
+;; This version of iss-mode.el is tested with InnoSetup v5.0
+
+;; iss-mode provides the following features:
+;; * Syntax coloring for InnoSetup scripts
+;; * Integration of the InnoSetup commandline compiler iscc.exe
+;; - Compilation via M-x iss-compile
+;; - Jump to compilation error via M-x next-error
+;; * Start Innosetup help via M-x iss-compiler-help
+;; * Test the installation via M-x iss-run-installer
+
+;; Of course you can bind this commands to keys (e.g. in the iss-mode-hook)
+
+;; My initialization for InnoSetup looks like this:
+;; (autoload 'iss-mode "iss-mode" "Innosetup Script Mode" t)
+;; (setq auto-mode-alist (append '(("\\.iss$" . iss-mode)) auto-mode-alist))
+;; (setq iss-compiler-path "c:/Programme/Inno Setup 5/")
+;; (add-hook 'iss-mode-hook 'xsteve-iss-mode-init)
+;; (defun xsteve-iss-mode-init ()
+;; (interactive)
+;; (define-key iss-mode-map [f6] 'iss-compile)
+;; (define-key iss-mode-map [(meta f6)] 'iss-run-installer)))
+
+;; The latest version of iss-mode.el can be found at:
+;; http://www.xsteve.at/prg/emacs/iss-mode.el
+
+;; Comments / suggestions welcome!
+
+;;; Change log:
+;;
+;; Version 1.1e:
+;;
+;; - Add some new flags to keywords
+
+;;; Code:
+
+(eval-and-compile (require 'compile))
+
+(defvar iss-compiler-path nil "Path to the iss compiler")
+
+;;; End of user settings
+
+(defvar iss-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ ;; ";" starts a comment
+ ;;(modify-syntax-entry ?\; "<" iss-mode-syntax-table)
+ (modify-syntax-entry ?\; ". 12" table)
+ ;; and \n and \^M end a comment
+ (modify-syntax-entry ?\n ">" table)
+ (modify-syntax-entry ?\^M ">" table)
+
+ (modify-syntax-entry ?\" "." table)
+
+ (modify-syntax-entry ?_ "w" table)
+ table)
+ "Syntax table in use in iss-mode buffers.")
+
+
+(defvar iss-font-lock-keywords
+ (list
+ (cons (concat "^;\.*")
+ 'font-lock-comment-face)
+ (cons (concat "\\sw+: ")
+ 'font-lock-keyword-face)
+ (cons "^[ \t]*\\[\.+\\]" 'font-lock-function-name-face) ;font-lock-constant-face)
+ (cons "^[ \t]*#include[ \t]*\".+\"" 'font-lock-preprocessor-face)
+ (cons (concat "^[ \t]*\\<\\(appname\\|appvername\\|appversion\\|appcopyright\\|appid\\|"
+ "appmutex\\|beveledlabel\\|defaultdirname\\|versioninfoversion"
+ "\\|defaultgroupname\\|minversion\\|outputdir\\|outputbasefilename\\|"
+ "allownoicons\\|uninstallfilesdir\\|"
+ "sourcedir\\|disableprogramgrouppage\\|alwayscreateuninstallicon\\)\\>")
+ 'font-lock-type-face)
+ (cons (concat "\\<\\(alwaysskipifsameorolder\\|uninsneveruninstall\\|"
+ "comparetimestampalso\\|restartreplace\\|isreadme\\|"
+ "unchecked\\|nowait\\|postinstall\\|skipifsilent\\|ignoreversion\\|"
+ "uninsdeletekeyifempty\\|uninsdeletekey\\|"
+ "runasoriginaluser\\|runascurrentuser"
+ "\\)\\>")
+ 'font-lock-variable-name-face)
+ (cons (concat "\\<\\(HKCU\\|HKLM\\|dirifempty\\|files\\|filesandordirs\\)\\>")
+ 'font-lock-constant-face)
+ (list 'iss-fontify-options '(1 'font-lock-variable-name-face) '(2 'font-lock-keyword-face))
+ )
+ "Expressions to highlight in iss mode.")
+
+(defun iss-fontify-options (bound)
+ (message "iss-fontify-options %s" bound)
+ (when (re-search-forward "^[ \t]*\\([^=]+\\)[ \t]*\\(=\\)" bound t)
+ (match-data)))
+
+(defvar iss-mode-map (make-sparse-keymap)
+ "Keymap used in iss-mode buffers.")
+
+(easy-menu-define
+ iss-menu
+ iss-mode-map
+ "InnoSetup script menu"
+ (list
+ "ISS"
+ ["Compile" (iss-compile) t]
+ ["Run Installer" (iss-run-installer) t]
+ ["InnoSetup Help" (iss-compiler-help) t]
+ ))
+(easy-menu-add iss-menu)
+
+(defvar compilation-file-regexp-alist) ;; silence compiler, don't know the var.
+
+;;;###autoload
+(defun iss-mode ()
+ "Major mode for editing InnoSetup script files. Upon startup iss-mode-hook is run."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map iss-mode-map)
+ (setq major-mode 'iss-mode)
+ (setq mode-name "iss")
+ (set-syntax-table iss-mode-syntax-table)
+ (set (make-local-variable 'comment-start) ";")
+ (set (make-local-variable 'comment-end) "")
+ (set (make-local-variable 'comment-multi-line) nil)
+
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ '(("\\(Error on line\\) \\([0-9]+\\):" nil 2)))
+ (set (make-local-variable 'compilation-file-regexp-alist)
+ '(("iscc \\(.*\\)$" 1)))
+
+ ;; Font lock support
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(iss-font-lock-keywords nil t))
+ (run-hooks 'iss-mode-hook))
+
+(defun iss-compiler-help ()
+ "Start the online documentation for the InnoSetup compiler"
+ (interactive)
+ (let ((default-directory (or iss-compiler-path default-directory)))
+ (w32-shell-execute 1 "ISetup.chm")))
+
+(defun iss-compile ()
+ "Compile the actual file with the InnoSetup compiler"
+ (interactive)
+ (let ((default-directory (or iss-compiler-path default-directory))
+ (compilation-process-setup-function 'iss-process-setup))
+ (compile (concat "iscc " (buffer-file-name)))))
+
+(defun iss-process-setup ()
+ "Set up `compilation-exit-message-function' for `iss-compile'."
+ (set (make-local-variable 'compilation-exit-message-function)
+ 'iss-compilation-exit-message-function))
+
+(defun iss-compilation-exit-message-function (process-status exit-status msg)
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ ;;scroll down one line, so that the compile command is parsed to:
+ ;; -> get the filename of the compiled file
+ (insert "\n")))
+ (cons msg exit-status))
+
+(defun iss-find-option (option)
+ (let ((search-regexp
+ (concat option "[ \t]*=[ \t]*\\(.*\\)$")))
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward-regexp search-regexp nil t)
+ (buffer-substring-no-properties (match-beginning 1) (match-end 1))))))
+
+(defun iss-run-installer ()
+ (interactive)
+ (let ((executable
+ (concat (or (iss-find-option "outputdir") "Output\\")
+ (or (iss-find-option "outputbasefilename") "setup")
+ ".exe")))
+ (w32-shell-execute 1 executable)))
+
+(provide 'iss-mode)
+
+;; arch-tag: b07b7119-d591-465e-927f-d0be0bcf7cab
--- /dev/null
+;;; iss-mumamo.el --- Defines multi major mode for Inno Setup files
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-08-09
+;; Version: 0.3
+;; Last-Updated: 2009-12-12 Sat
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+ ;; `comint', `compile', `iss-mode', `ring', `tool-bar'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'iss-mode)
+(require 'mumamo)
+
+(defun mumamo-chunk-iss-code (pos min max)
+ "Find [code]..., return range and `pascal-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX.
+
+Note that if this section is not the last"
+ (mumamo-quick-static-chunk pos min max "[code]" "{*** End of CODE **}" t 'pascal-mode t))
+
+;;;###autoload
+(define-mumamo-multi-major-mode iss-mumamo-mode
+ "Turn on multiple major modes Inno Setup .iss files.
+The main major mode will be `iss-mode'.
+The [code] section, if any, will be in `pascal-mode'."
+ ("Inno ISS Family" iss-mode
+ (mumamo-chunk-iss-code
+ )))
+
+(add-to-list 'auto-mode-alist '("\\.iss\\'" . iss-mumamo-mode))
+
+(provide 'iss-mumamo)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; iss-mumamo.el ends here
--- /dev/null
+
+ // I am testing
+
+ var x == 10;
--- /dev/null
+// (C)2002 Douglas Crockford
+// www.JSLint.com
+// Rhino Edition
+"use strict";var JSLINT=(function(){var adsafe_id,adsafe_may,adsafe_went,anonname,approved,atrule={media:true,'font-face':true,page:true},bang={'<':true,'<=':true,'==':true,'===':true,'!==':true,'!=':true,'>':true,'>=':true,'+':true,'-':true,'*':true,'/':true,'%':true},banned={'arguments':true,callee:true,caller:true,constructor:true,'eval':true,prototype:true,unwatch:true,valueOf:true,watch:true},boolOptions={adsafe:true,bitwise:true,browser:true,cap:true,css:true,debug:true,eqeqeq:true,evil:true,forin:true,fragment:true,immed:true,laxbreak:true,newcap:true,nomen:true,on:true,onevar:true,passfail:true,plusplus:true,regexp:true,rhino:true,undef:true,safe:true,sidebar:true,strict:true,sub:true,white:true,widget:true},browser={addEventListener:false,alert:false,blur:false,clearInterval:false,clearTimeout:false,close:false,closed:false,confirm:false,console:false,Debug:false,defaultStatus:false,document:false,event:false,focus:false,frames:false,getComputedStyle:false,history:false,Image:false,length:false,location:false,moveBy:false,moveTo:false,name:false,navigator:false,onbeforeunload:true,onblur:true,onerror:true,onfocus:true,onload:true,onresize:true,onunload:true,open:false,opener:false,opera:false,Option:false,parent:false,print:false,prompt:false,removeEventListener:false,resizeBy:false,resizeTo:false,screen:false,scroll:false,scrollBy:false,scrollTo:false,setInterval:false,setTimeout:false,status:false,top:false,XMLHttpRequest:false},cssAttributeData,cssAny,cssColorData={"aliceblue":true,"antiquewhite":true,"aqua":true,"aquamarine":true,"azure":true,"beige":true,"bisque":true,"black":true,"blanchedalmond":true,"blue":true,"blueviolet":true,"brown":true,"burlywood":true,"cadetblue":true,"chartreuse":true,"chocolate":true,"coral":true,"cornflowerblue":true,"cornsilk":true,"crimson":true,"cyan":true,"darkblue":true,"darkcyan":true,"darkgoldenrod":true,"darkgray":true,"darkgreen":true,"darkkhaki":true,"darkmagenta":true,"darkolivegreen":true,"darkorange":true,"darkorchid":true,"darkred":true,"darksalmon":true,"darkseagreen":true,"darkslateblue":true,"darkslategray":true,"darkturquoise":true,"darkviolet":true,"deeppink":true,"deepskyblue":true,"dimgray":true,"dodgerblue":true,"firebrick":true,"floralwhite":true,"forestgreen":true,"fuchsia":true,"gainsboro":true,"ghostwhite":true,"gold":true,"goldenrod":true,"gray":true,"green":true,"greenyellow":true,"honeydew":true,"hotpink":true,"indianred":true,"indigo":true,"ivory":true,"khaki":true,"lavender":true,"lavenderblush":true,"lawngreen":true,"lemonchiffon":true,"lightblue":true,"lightcoral":true,"lightcyan":true,"lightgoldenrodyellow":true,"lightgreen":true,"lightpink":true,"lightsalmon":true,"lightseagreen":true,"lightskyblue":true,"lightslategray":true,"lightsteelblue":true,"lightyellow":true,"lime":true,"limegreen":true,"linen":true,"magenta":true,"maroon":true,"mediumaquamarine":true,"mediumblue":true,"mediumorchid":true,"mediumpurple":true,"mediumseagreen":true,"mediumslateblue":true,"mediumspringgreen":true,"mediumturquoise":true,"mediumvioletred":true,"midnightblue":true,"mintcream":true,"mistyrose":true,"moccasin":true,"navajowhite":true,"navy":true,"oldlace":true,"olive":true,"olivedrab":true,"orange":true,"orangered":true,"orchid":true,"palegoldenrod":true,"palegreen":true,"paleturquoise":true,"palevioletred":true,"papayawhip":true,"peachpuff":true,"peru":true,"pink":true,"plum":true,"powderblue":true,"purple":true,"red":true,"rosybrown":true,"royalblue":true,"saddlebrown":true,"salmon":true,"sandybrown":true,"seagreen":true,"seashell":true,"sienna":true,"silver":true,"skyblue":true,"slateblue":true,"slategray":true,"snow":true,"springgreen":true,"steelblue":true,"tan":true,"teal":true,"thistle":true,"tomato":true,"turquoise":true,"violet":true,"wheat":true,"white":true,"whitesmoke":true,"yellow":true,"yellowgreen":true},cssBorderStyle,cssBreak,cssLengthData={'%':true,'cm':true,'em':true,'ex':true,'in':true,'mm':true,'pc':true,'pt':true,'px':true},cssOverflow,escapes={'\b':'\\b','\t':'\\t','\n':'\\n','\f':'\\f','\r':'\\r','"':'\\"','/':'\\/','\\':'\\\\'},funct,functionicity=['closure','exception','global','label','outer','unused','var'],functions,global,htmltag={a:{},abbr:{},acronym:{},address:{},applet:{},area:{empty:true,parent:' map '},b:{},base:{empty:true,parent:' head '},bdo:{},big:{},blockquote:{},body:{parent:' html noframes '},br:{empty:true},button:{},canvas:{parent:' body p div th td '},caption:{parent:' table '},center:{},cite:{},code:{},col:{empty:true,parent:' table colgroup '},colgroup:{parent:' table '},dd:{parent:' dl '},del:{},dfn:{},dir:{},div:{},dl:{},dt:{parent:' dl '},em:{},embed:{},fieldset:{},font:{},form:{},frame:{empty:true,parent:' frameset '},frameset:{parent:' html frameset '},h1:{},h2:{},h3:{},h4:{},h5:{},h6:{},head:{parent:' html '},html:{parent:'*'},hr:{empty:true},i:{},iframe:{},img:{empty:true},input:{empty:true},ins:{},kbd:{},label:{},legend:{parent:' fieldset '},li:{parent:' dir menu ol ul '},link:{empty:true,parent:' head '},map:{},menu:{},meta:{empty:true,parent:' head noframes noscript '},noframes:{parent:' html body '},noscript:{parent:' body head noframes '},object:{},ol:{},optgroup:{parent:' select '},option:{parent:' optgroup select '},p:{},param:{empty:true,parent:' applet object '},pre:{},q:{},samp:{},script:{empty:true,parent:' body div frame head iframe p pre span '},select:{},small:{},span:{},strong:{},style:{parent:' head ',empty:true},sub:{},sup:{},table:{},tbody:{parent:' table '},td:{parent:' tr '},textarea:{},tfoot:{parent:' table '},th:{parent:' tr '},thead:{parent:' table '},title:{parent:' head '},tr:{parent:' table tbody thead tfoot '},tt:{},u:{},ul:{},'var':{}},ids,implied,inblock,indent,jsonmode,lines,lookahead,member,membersOnly,nexttoken,noreach,option,predefined,prereg,prevtoken,rhino={defineClass:false,deserialize:false,gc:false,help:false,load:false,loadClass:false,print:false,quit:false,readFile:false,readUrl:false,runCommand:false,seal:false,serialize:false,spawn:false,sync:false,toint32:false,version:false},scope,sidebar={System:false},src,stack,standard={Array:false,Boolean:false,Date:false,decodeURI:false,decodeURIComponent:false,encodeURI:false,encodeURIComponent:false,Error:false,'eval':false,EvalError:false,Function:false,hasOwnProperty:false,isFinite:false,isNaN:false,JSON:false,Math:false,Number:false,Object:false,parseInt:false,parseFloat:false,RangeError:false,ReferenceError:false,RegExp:false,String:false,SyntaxError:false,TypeError:false,URIError:false},standard_member={E:true,LN2:true,LN10:true,LOG2E:true,LOG10E:true,PI:true,SQRT1_2:true,SQRT2:true,MAX_VALUE:true,MIN_VALUE:true,NEGATIVE_INFINITY:true,POSITIVE_INFINITY:true},strict_mode,syntax={},tab,token,urls,warnings,widget={alert:true,animator:true,appleScript:true,beep:true,bytesToUIString:true,Canvas:true,chooseColor:true,chooseFile:true,chooseFolder:true,closeWidget:true,COM:true,convertPathToHFS:true,convertPathToPlatform:true,CustomAnimation:true,escape:true,FadeAnimation:true,filesystem:true,Flash:true,focusWidget:true,form:true,FormField:true,Frame:true,HotKey:true,Image:true,include:true,isApplicationRunning:true,iTunes:true,konfabulatorVersion:true,log:true,md5:true,MenuItem:true,MoveAnimation:true,openURL:true,play:true,Point:true,popupMenu:true,preferenceGroups:true,preferences:true,print:true,prompt:true,random:true,Rectangle:true,reloadWidget:true,ResizeAnimation:true,resolvePath:true,resumeUpdates:true,RotateAnimation:true,runCommand:true,runCommandInBg:true,saveAs:true,savePreferences:true,screen:true,ScrollBar:true,showWidgetPreferences:true,sleep:true,speak:true,Style:true,suppressUpdates:true,system:true,tellWidget:true,Text:true,TextArea:true,Timer:true,unescape:true,updateNow:true,URL:true,Web:true,widget:true,Window:true,XMLDOM:true,XMLHttpRequest:true,yahooCheckLogin:true,yahooLogin:true,yahooLogout:true},xmode,xquote,ax=/@cc|<\/?|script|\]*s\]|<\s*!|</i,cx=/[\u0000-\u001f\u007f-\u009f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/,tx=/^\s*([(){}\[.,:;'"~\?\]#@]|==?=?|\/(\*(jslint|members?|global)?|=|\/)?|\*[\/=]?|\+[+=]?|-[\-=]?|%=?|&[&=]?|\|[|=]?|>>?>?=?|<([\/=!]|\!(\[|--)?|<=?)?|\^=?|\!=?=?|[a-zA-Z_$][a-zA-Z0-9_$]*|[0-9]+([xX][0-9a-fA-F]+|\.[0-9]*)?([eE][+\-]?[0-9]+)?)/,hx=/^\s*(['"=>\/&#]|<(?:\/|\!(?:--)?)?|[a-zA-Z][a-zA-Z0-9_\-]*|[0-9]+|--|.)/,nx=/[\u0000-\u001f&<"\/\\\u007f-\u009f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/,nxg=/[\u0000-\u001f&<"\/\\\u007f-\u009f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g,ox=/[>&]|<[\/!]?|--/,lx=/\*\/|\/\*/,ix=/^([a-zA-Z_$][a-zA-Z0-9_$]*)$/,jx=/^(?:javascript|jscript|ecmascript|vbscript|mocha|livescript)\s*:/i,ux=/&|\+|\u00AD|\.\.|\/\*|%[^;]|base64|url|expression|data|mailto/i,sx=/^\s*([{:#%.=,>+\[\]@()"';]|\*=?|\$=|\|=|\^=|~=|[a-zA-Z_][a-zA-Z0-9_\-]*|[0-9]+|<\/|\/\*)/,ssx=/^\s*([@#!"'};:\-%.=,+\[\]()*_]|[a-zA-Z][a-zA-Z0-9._\-]*|\/\*?|\d+(?:\.\d+)?|<\/)/,qx=/[^a-zA-Z0-9-_\/ ]/,dx=/[\[\]\/\\"'*<>.&:(){}+=#]/,rx={outer:hx,html:hx,style:sx,styleproperty:ssx};function F(){}
+if(typeof Object.create!=='function'){Object.create=function(o){F.prototype=o;return new F();};}
+function is_own(object,name){return Object.prototype.hasOwnProperty.call(object,name);}
+function combine(t,o){var n;for(n in o){if(is_own(o,n)){t[n]=o[n];}}}
+String.prototype.entityify=function(){return this.replace(/&/g,'&').replace(/</g,'<').replace(/>/g,'>');};String.prototype.isAlpha=function(){return(this>='a'&&this<='z\uffff')||(this>='A'&&this<='Z\uffff');};String.prototype.isDigit=function(){return(this>='0'&&this<='9');};String.prototype.supplant=function(o){return this.replace(/\{([^{}]*)\}/g,function(a,b){var r=o[b];return typeof r==='string'||typeof r==='number'?r:a;});};String.prototype.name=function(){if(ix.test(this)){return this;}
+if(nx.test(this)){return'"'+this.replace(nxg,function(a){var c=escapes[a];if(c){return c;}
+return'\\u'+('0000'+a.charCodeAt().toString(16)).slice(-4);})+'"';}
+return'"'+this+'"';};function assume(){if(!option.safe){if(option.rhino){combine(predefined,rhino);}
+if(option.browser||option.sidebar){combine(predefined,browser);}
+if(option.sidebar){combine(predefined,sidebar);}
+if(option.widget){combine(predefined,widget);}}}
+function quit(m,l,ch){throw{name:'JSLintError',line:l,character:ch,message:m+" ("+Math.floor((l/lines.length)*100)+"% scanned)."};}
+function warning(m,t,a,b,c,d){var ch,l,w;t=t||nexttoken;if(t.id==='(end)'){t=token;}
+l=t.line||0;ch=t.from||0;w={id:'(error)',raw:m,evidence:lines[l-1]||'',line:l,character:ch,a:a,b:b,c:c,d:d};w.reason=m.supplant(w);JSLINT.errors.push(w);if(option.passfail){quit('Stopping. ',l,ch);}
+warnings+=1;if(warnings>=option.maxerr){quit("Too many errors.",l,ch);}
+return w;}
+function warningAt(m,l,ch,a,b,c,d){return warning(m,{line:l,from:ch},a,b,c,d);}
+function error(m,t,a,b,c,d){var w=warning(m,t,a,b,c,d);quit("Stopping, unable to continue.",w.line,w.character);}
+function errorAt(m,l,ch,a,b,c,d){return error(m,{line:l,from:ch},a,b,c,d);}
+var lex=(function lex(){var character,from,line,s;function nextLine(){var at;if(line>=lines.length){return false;}
+character=1;s=lines[line];line+=1;at=s.search(/ \t/);if(at>=0){warningAt("Mixed spaces and tabs.",line,at+1);}
+s=s.replace(/\t/g,tab);at=s.search(cx);if(at>=0){warningAt("Unsafe character.",line,at);}
+if(option.maxlen&&option.maxlen<s.length){warningAt("Line too long.",line,s.length);}
+return true;}
+function it(type,value){var i,t;if(type==='(color)'){t={type:type};}else if(type==='(punctuator)'||(type==='(identifier)'&&is_own(syntax,value))){t=syntax[value]||syntax['(error)'];}else{t=syntax[type];}
+t=Object.create(t);if(type==='(string)'||type==='(range)'){if(jx.test(value)){warningAt("Script URL.",line,from);}}
+if(type==='(identifier)'){t.identifier=true;if(value==='__iterator__'||value==='__proto__'){errorAt("Reserved name '{a}'.",line,from,value);}else if(option.nomen&&(value.charAt(0)==='_'||value.charAt(value.length-1)==='_')){warningAt("Unexpected {a} in '{b}'.",line,from,"dangling '_'",value);}}
+t.value=value;t.line=line;t.character=character;t.from=from;i=t.id;if(i!=='(endline)'){prereg=i&&(('(,=:[!&|?{};'.indexOf(i.charAt(i.length-1))>=0)||i==='return');}
+return t;}
+return{init:function(source){if(typeof source==='string'){lines=source.replace(/\r\n/g,'\n').replace(/\r/g,'\n').split('\n');}else{lines=source;}
+line=0;nextLine();from=1;},range:function(begin,end){var c,value='';from=character;if(s.charAt(0)!==begin){errorAt("Expected '{a}' and instead saw '{b}'.",line,character,begin,s.charAt(0));}
+for(;;){s=s.slice(1);character+=1;c=s.charAt(0);switch(c){case'':errorAt("Missing '{a}'.",line,character,c);break;case end:s=s.slice(1);character+=1;return it('(range)',value);case xquote:case'\\':warningAt("Unexpected '{a}'.",line,character,c);}
+value+=c;}},token:function(){var b,c,captures,d,depth,high,i,l,low,q,t;function match(x){var r=x.exec(s),r1;if(r){l=r[0].length;r1=r[1];c=r1.charAt(0);s=s.substr(l);from=character+l-r1.length;character+=l;return r1;}}
+function string(x){var c,j,r='';if(jsonmode&&x!=='"'){warningAt("Strings must use doublequote.",line,character);}
+if(xquote===x||(xmode==='scriptstring'&&!xquote)){return it('(punctuator)',x);}
+function esc(n){var i=parseInt(s.substr(j+1,n),16);j+=n;if(i>=32&&i<=126&&i!==34&&i!==92&&i!==39){warningAt("Unnecessary escapement.",line,character);}
+character+=n;c=String.fromCharCode(i);}
+j=0;for(;;){while(j>=s.length){j=0;if(xmode!=='html'||!nextLine()){errorAt("Unclosed string.",line,from);}}
+c=s.charAt(j);if(c===x){character+=1;s=s.substr(j+1);return it('(string)',r,x);}
+if(c<' '){if(c==='\n'||c==='\r'){break;}
+warningAt("Control character in string: {a}.",line,character+j,s.slice(0,j));}else if(c===xquote){warningAt("Bad HTML string",line,character+j);}else if(c==='<'){if(option.safe&&xmode==='html'){warningAt("ADsafe string violation.",line,character+j);}else if(s.charAt(j+1)==='/'&&(xmode||option.safe)){warningAt("Expected '<\\/' and instead saw '</'.",line,character);}else if(s.charAt(j+1)==='!'&&(xmode||option.safe)){warningAt("Unexpected '<!' in a string.",line,character);}}else if(c==='\\'){if(xmode==='html'){if(option.safe){warningAt("ADsafe string violation.",line,character+j);}}else if(xmode==='styleproperty'){j+=1;character+=1;c=s.charAt(j);if(c!==x){warningAt("Escapement in style string.",line,character+j);}}else{j+=1;character+=1;c=s.charAt(j);switch(c){case xquote:warningAt("Bad HTML string",line,character+j);break;case'\\':case'\'':case'"':case'/':break;case'b':c='\b';break;case'f':c='\f';break;case'n':c='\n';break;case'r':c='\r';break;case't':c='\t';break;case'u':esc(4);break;case'v':c='\v';break;case'x':if(jsonmode){warningAt("Avoid \\x-.",line,character);}
+esc(2);break;default:warningAt("Bad escapement.",line,character);}}}
+r+=c;character+=1;j+=1;}}
+for(;;){if(!s){return it(nextLine()?'(endline)':'(end)','');}
+while(xmode==='outer'){i=s.search(ox);if(i===0){break;}else if(i>0){character+=1;s=s.slice(i);break;}else{if(!nextLine()){return it('(end)','');}}}
+t=match(rx[xmode]||tx);if(!t){if(xmode==='html'){return it('(error)',s.charAt(0));}else{t='';c='';while(s&&s<'!'){s=s.substr(1);}
+if(s){errorAt("Unexpected '{a}'.",line,character,s.substr(0,1));}}}else{if(c.isAlpha()||c==='_'||c==='$'){return it('(identifier)',t);}
+if(c.isDigit()){if(xmode!=='style'&&!isFinite(Number(t))){warningAt("Bad number '{a}'.",line,character,t);}
+if(xmode!=='style'&&xmode!=='styleproperty'&&s.substr(0,1).isAlpha()){warningAt("Missing space after '{a}'.",line,character,t);}
+if(c==='0'){d=t.substr(1,1);if(d.isDigit()){if(token.id!=='.'&&xmode!=='styleproperty'){warningAt("Don't use extra leading zeros '{a}'.",line,character,t);}}else if(jsonmode&&(d==='x'||d==='X')){warningAt("Avoid 0x-. '{a}'.",line,character,t);}}
+if(t.substr(t.length-1)==='.'){warningAt("A trailing decimal point can be confused with a dot '{a}'.",line,character,t);}
+return it('(number)',t);}
+switch(t){case'"':case"'":return string(t);case'//':if(src||(xmode&&xmode!=='script')){warningAt("Unexpected comment.",line,character);}else if(xmode==='script'&&/<\s*\//i.test(s)){warningAt("Unexpected <\/ in comment.",line,character);}else if((option.safe||xmode==='script')&&ax.test(s)){warningAt("Dangerous comment.",line,character);}
+s='';token.comment=true;break;case'/*':if(src||(xmode&&xmode!=='script'&&xmode!=='style'&&xmode!=='styleproperty')){warningAt("Unexpected comment.",line,character);}
+if(option.safe&&ax.test(s)){warningAt("ADsafe comment violation.",line,character);}
+for(;;){i=s.search(lx);if(i>=0){break;}
+if(!nextLine()){errorAt("Unclosed comment.",line,character);}else{if(option.safe&&ax.test(s)){warningAt("ADsafe comment violation.",line,character);}}}
+character+=i+2;if(s.substr(i,1)==='/'){errorAt("Nested comment.",line,character);}
+s=s.substr(i+2);token.comment=true;break;case'/*members':case'/*member':case'/*jslint':case'/*global':case'*/':return{value:t,type:'special',line:line,character:character,from:from};case'':break;case'/':if(prereg){depth=0;captures=0;l=0;for(;;){b=true;c=s.charAt(l);l+=1;switch(c){case'':errorAt("Unclosed regular expression.",line,from);return;case'/':if(depth>0){warningAt("Unescaped '{a}'.",line,from+l,'/');}
+c=s.substr(0,l-1);q={g:true,i:true,m:true};while(q[s.charAt(l)]===true){q[s.charAt(l)]=false;l+=1;}
+character+=l;s=s.substr(l);return it('(regexp)',c);case'\\':c=s.charAt(l);if(c<' '){warningAt("Unexpected control character in regular expression.",line,from+l);}else if(c==='<'){warningAt("Unexpected escaped character '{a}' in regular expression.",line,from+l,c);}
+l+=1;break;case'(':depth+=1;b=false;if(s.charAt(l)==='?'){l+=1;switch(s.charAt(l)){case':':case'=':case'!':l+=1;break;default:warningAt("Expected '{a}' and instead saw '{b}'.",line,from+l,':',s.charAt(l));}}else{captures+=1;}
+break;case'|':b=false;break;case')':if(depth===0){warningAt("Unescaped '{a}'.",line,from+l,')');}else{depth-=1;}
+break;case' ':q=1;while(s.charAt(l)===' '){l+=1;q+=1;}
+if(q>1){warningAt("Spaces are hard to count. Use {{a}}.",line,from+l,q);}
+break;case'[':c=s.charAt(l);if(c==='^'){l+=1;if(option.regexp){warningAt("Insecure '{a}'.",line,from+l,c);}}
+q=false;if(c===']'){warningAt("Empty class.",line,from+l-1);q=true;}
+klass:do{c=s.charAt(l);l+=1;switch(c){case'[':case'^':warningAt("Unescaped '{a}'.",line,from+l,c);q=true;break;case'-':if(q){q=false;}else{warningAt("Unescaped '{a}'.",line,from+l,'-');q=true;}
+break;case']':if(!q){warningAt("Unescaped '{a}'.",line,from+l-1,'-');}
+break klass;case'\\':c=s.charAt(l);if(c<' '){warningAt("Unexpected control character in regular expression.",line,from+l);}else if(c==='<'){warningAt("Unexpected escaped character '{a}' in regular expression.",line,from+l,c);}
+l+=1;q=true;break;case'/':warningAt("Unescaped '{a}'.",line,from+l-1,'/');q=true;break;case'<':if(xmode==='script'){c=s.charAt(l);if(c==='!'||c==='/'){warningAt("HTML confusion in regular expression '<{a}'.",line,from+l,c);}}
+q=true;break;default:q=true;}}while(c);break;case'.':if(option.regexp){warningAt("Insecure '{a}'.",line,from+l,c);}
+break;case']':case'?':case'{':case'}':case'+':case'*':warningAt("Unescaped '{a}'.",line,from+l,c);break;case'<':if(xmode==='script'){c=s.charAt(l);if(c==='!'||c==='/'){warningAt("HTML confusion in regular expression '<{a}'.",line,from+l,c);}}}
+if(b){switch(s.charAt(l)){case'?':case'+':case'*':l+=1;if(s.charAt(l)==='?'){l+=1;}
+break;case'{':l+=1;c=s.charAt(l);if(c<'0'||c>'9'){warningAt("Expected a number and instead saw '{a}'.",line,from+l,c);}
+l+=1;low=+c;for(;;){c=s.charAt(l);if(c<'0'||c>'9'){break;}
+l+=1;low=+c+(low*10);}
+high=low;if(c===','){l+=1;high=Infinity;c=s.charAt(l);if(c>='0'&&c<='9'){l+=1;high=+c;for(;;){c=s.charAt(l);if(c<'0'||c>'9'){break;}
+l+=1;high=+c+(high*10);}}}
+if(s.charAt(l)!=='}'){warningAt("Expected '{a}' and instead saw '{b}'.",line,from+l,'}',c);}else{l+=1;}
+if(s.charAt(l)==='?'){l+=1;}
+if(low>high){warningAt("'{a}' should not be greater than '{b}'.",line,from+l,low,high);}}}}
+c=s.substr(0,l-1);character+=l;s=s.substr(l);return it('(regexp)',c);}
+return it('(punctuator)',t);case'<!--':l=line;c=character;for(;;){i=s.indexOf('--');if(i>=0){break;}
+i=s.indexOf('<!');if(i>=0){errorAt("Nested HTML comment.",line,character+i);}
+if(!nextLine()){errorAt("Unclosed HTML comment.",l,c);}}
+l=s.indexOf('<!');if(l>=0&&l<i){errorAt("Nested HTML comment.",line,character+l);}
+character+=i;if(s[i+2]!=='>'){errorAt("Expected -->.",line,character);}
+character+=3;s=s.slice(i+3);break;case'#':if(xmode==='html'||xmode==='styleproperty'){for(;;){c=s.charAt(0);if((c<'0'||c>'9')&&(c<'a'||c>'f')&&(c<'A'||c>'F')){break;}
+character+=1;s=s.substr(1);t+=c;}
+if(t.length!==4&&t.length!==7){warningAt("Bad hex color '{a}'.",line,from+l,t);}
+return it('(color)',t);}
+return it('(punctuator)',t);default:if(xmode==='outer'&&c==='&'){character+=1;s=s.substr(1);for(;;){c=s.charAt(0);character+=1;s=s.substr(1);if(c===';'){break;}
+if(!((c>='0'&&c<='9')||(c>='a'&&c<='z')||c==='#')){errorAt("Bad entity",line,from+l,character);}}
+break;}
+return it('(punctuator)',t);}}}}};}());function addlabel(t,type){if(option.safe&&funct['(global)']&&typeof predefined[t]!=='boolean'){warning('ADsafe global: '+t+'.',token);}else if(t==='hasOwnProperty'){warning("'hasOwnProperty' is a really bad name.");}
+if(is_own(funct,t)&&!funct['(global)']){warning(funct[t]===true?"'{a}' was used before it was defined.":"'{a}' is already defined.",nexttoken,t);}
+funct[t]=type;if(funct['(global)']){global[t]=funct;if(is_own(implied,t)){warning("'{a}' was used before it was defined.",nexttoken,t);delete implied[t];}}else{scope[t]=funct;}}
+function doOption(){var b,obj,filter,o=nexttoken.value,t,v;switch(o){case'*/':error("Unbegun comment.");break;case'/*members':case'/*member':o='/*members';if(!membersOnly){membersOnly={};}
+obj=membersOnly;break;case'/*jslint':if(option.safe){warning("ADsafe restriction.");}
+obj=option;filter=boolOptions;break;case'/*global':if(option.safe){warning("ADsafe restriction.");}
+obj=predefined;break;default:}
+t=lex.token();loop:for(;;){for(;;){if(t.type==='special'&&t.value==='*/'){break loop;}
+if(t.id!=='(endline)'&&t.id!==','){break;}
+t=lex.token();}
+if(t.type!=='(string)'&&t.type!=='(identifier)'&&o!=='/*members'){error("Bad option.",t);}
+v=lex.token();if(v.id===':'){v=lex.token();if(obj===membersOnly){error("Expected '{a}' and instead saw '{b}'.",t,'*/',':');}
+if(t.value==='indent'&&o==='/*jslint'){b=+v.value;if(typeof b!=='number'||!isFinite(b)||b<=0||Math.floor(b)!==b){error("Expected a small integer and instead saw '{a}'.",v,v.value);}
+obj.white=true;obj.indent=b;}else if(t.value==='maxerr'&&o==='/*jslint'){b=+v.value;if(typeof b!=='number'||!isFinite(b)||b<=0||Math.floor(b)!==b){error("Expected a small integer and instead saw '{a}'.",v,v.value);}
+obj.maxerr=b;}else if(v.value==='true'){obj[t.value]=true;}else if(v.value==='false'){obj[t.value]=false;}else{error("Bad option value.",v);}
+t=lex.token();}else{if(o==='/*jslint'){error("Missing option value.",t);}
+obj[t.value]=false;t=v;}}
+if(filter){assume();}}
+function peek(p){var i=p||0,j=0,t;while(j<=i){t=lookahead[j];if(!t){t=lookahead[j]=lex.token();}
+j+=1;}
+return t;}
+function advance(id,t){switch(token.id){case'(number)':if(nexttoken.id==='.'){warning("A dot following a number can be confused with a decimal point.",token);}
+break;case'-':if(nexttoken.id==='-'||nexttoken.id==='--'){warning("Confusing minusses.");}
+break;case'+':if(nexttoken.id==='+'||nexttoken.id==='++'){warning("Confusing plusses.");}
+break;}
+if(token.type==='(string)'||token.identifier){anonname=token.value;}
+if(id&&nexttoken.id!==id){if(t){if(nexttoken.id==='(end)'){warning("Unmatched '{a}'.",t,t.id);}else{warning("Expected '{a}' to match '{b}' from line {c} and instead saw '{d}'.",nexttoken,id,t.id,t.line,nexttoken.value);}}else if(nexttoken.type!=='(identifier)'||nexttoken.value!==id){warning("Expected '{a}' and instead saw '{b}'.",nexttoken,id,nexttoken.value);}}
+prevtoken=token;token=nexttoken;for(;;){nexttoken=lookahead.shift()||lex.token();if(nexttoken.id==='(end)'||nexttoken.id==='(error)'){return;}
+if(nexttoken.type==='special'){doOption();}else{if(nexttoken.id!=='(endline)'){break;}}}}
+function parse(rbp,initial){var left;if(nexttoken.id==='(end)'){error("Unexpected early end of program.",token);}
+advance();if(option.safe&&typeof predefined[token.value]==='boolean'&&(nexttoken.id!=='('&&nexttoken.id!=='.')){warning('ADsafe violation.',token);}
+if(initial){anonname='anonymous';funct['(verb)']=token.value;}
+if(initial===true&&token.fud){left=token.fud();}else{if(token.nud){left=token.nud();}else{if(nexttoken.type==='(number)'&&token.id==='.'){warning("A leading decimal point can be confused with a dot: '.{a}'.",token,nexttoken.value);advance();return token;}else{error("Expected an identifier and instead saw '{a}'.",token,token.id);}}
+while(rbp<nexttoken.lbp){advance();if(token.led){left=token.led(left);}else{error("Expected an operator and instead saw '{a}'.",token,token.id);}}}
+return left;}
+function adjacent(left,right){left=left||token;right=right||nexttoken;if(option.white||xmode==='styleproperty'||xmode==='style'){if(left.character!==right.from&&left.line===right.line){warning("Unexpected space after '{a}'.",right,left.value);}}}
+function nospace(left,right){left=left||token;right=right||nexttoken;if(option.white&&!left.comment){if(left.line===right.line){adjacent(left,right);}}}
+function nonadjacent(left,right){if(option.white){left=left||token;right=right||nexttoken;if(left.line===right.line&&left.character===right.from){warning("Missing space after '{a}'.",nexttoken,left.value);}}}
+function nobreaknonadjacent(left,right){left=left||token;right=right||nexttoken;if(!option.laxbreak&&left.line!==right.line){warning("Bad line breaking before '{a}'.",right,right.id);}else if(option.white){left=left||token;right=right||nexttoken;if(left.character===right.from){warning("Missing space after '{a}'.",nexttoken,left.value);}}}
+function indentation(bias){var i;if(option.white&&nexttoken.id!=='(end)'){i=indent+(bias||0);if(nexttoken.from!==i){warning("Expected '{a}' to have an indentation at {b} instead at {c}.",nexttoken,nexttoken.value,i,nexttoken.from);}}}
+function nolinebreak(t){t=t||token;if(t.line!==nexttoken.line){warning("Line breaking error '{a}'.",t,t.value);}}
+function comma(){if(token.line!==nexttoken.line){if(!option.laxbreak){warning("Bad line breaking before '{a}'.",token,nexttoken.id);}}else if(token.character!==nexttoken.from&&option.white){warning("Unexpected space after '{a}'.",nexttoken,token.value);}
+advance(',');nonadjacent(token,nexttoken);}
+function symbol(s,p){var x=syntax[s];if(!x||typeof x!=='object'){syntax[s]=x={id:s,lbp:p,value:s};}
+return x;}
+function delim(s){return symbol(s,0);}
+function stmt(s,f){var x=delim(s);x.identifier=x.reserved=true;x.fud=f;return x;}
+function blockstmt(s,f){var x=stmt(s,f);x.block=true;return x;}
+function reserveName(x){var c=x.id.charAt(0);if((c>='a'&&c<='z')||(c>='A'&&c<='Z')){x.identifier=x.reserved=true;}
+return x;}
+function prefix(s,f){var x=symbol(s,150);reserveName(x);x.nud=(typeof f==='function')?f:function(){this.right=parse(150);this.arity='unary';if(this.id==='++'||this.id==='--'){if(option.plusplus){warning("Unexpected use of '{a}'.",this,this.id);}else if((!this.right.identifier||this.right.reserved)&&this.right.id!=='.'&&this.right.id!=='['){warning("Bad operand.",this);}}
+return this;};return x;}
+function type(s,f){var x=delim(s);x.type=s;x.nud=f;return x;}
+function reserve(s,f){var x=type(s,f);x.identifier=x.reserved=true;return x;}
+function reservevar(s,v){return reserve(s,function(){if(this.id==='this'||this.id==='arguments'){if(strict_mode&&funct['(global)']){warning("Strict violation.",this);}else if(option.safe){warning("ADsafe violation.",this);}}
+return this;});}
+function infix(s,f,p,w){var x=symbol(s,p);reserveName(x);x.led=function(left){if(!w){nobreaknonadjacent(prevtoken,token);nonadjacent(token,nexttoken);}
+if(typeof f==='function'){return f(left,this);}else{this.left=left;this.right=parse(p);return this;}};return x;}
+function relation(s,f){var x=symbol(s,100);x.led=function(left){nobreaknonadjacent(prevtoken,token);nonadjacent(token,nexttoken);var right=parse(100);if((left&&left.id==='NaN')||(right&&right.id==='NaN')){warning("Use the isNaN function to compare with NaN.",this);}else if(f){f.apply(this,[left,right]);}
+if(left.id==='!'){warning("Confusing use of '{a}'.",left,'!');}
+if(right.id==='!'){warning("Confusing use of '{a}'.",left,'!');}
+this.left=left;this.right=right;return this;};return x;}
+function isPoorRelation(node){return node&&((node.type==='(number)'&&+node.value===0)||(node.type==='(string)'&&node.value===' ')||node.type==='true'||node.type==='false'||node.type==='undefined'||node.type==='null');}
+function assignop(s,f){symbol(s,20).exps=true;return infix(s,function(left,that){var l;that.left=left;if(predefined[left.value]===false&&scope[left.value]['(global)']===true){warning('Read only.',left);}
+if(option.safe){l=left;do{if(typeof predefined[l.value]==='boolean'){warning('ADsafe violation.',l);}
+l=l.left;}while(l);}
+if(left){if(left.id==='.'||left.id==='['){if(!left.left||left.left.value==='arguments'){warning('Bad assignment.',that);}
+that.right=parse(19);return that;}else if(left.identifier&&!left.reserved){if(funct[left.value]==='exception'){warning("Do not assign to the exception parameter.",left);}
+that.right=parse(19);return that;}
+if(left===syntax['function']){warning("Expected an identifier in an assignment and instead saw a function invocation.",token);}}
+error("Bad assignment.",that);},20);}
+function bitwise(s,f,p){var x=symbol(s,p);reserveName(x);x.led=(typeof f==='function')?f:function(left){if(option.bitwise){warning("Unexpected use of '{a}'.",this,this.id);}
+this.left=left;this.right=parse(p);return this;};return x;}
+function bitwiseassignop(s){symbol(s,20).exps=true;return infix(s,function(left,that){if(option.bitwise){warning("Unexpected use of '{a}'.",that,that.id);}
+nonadjacent(prevtoken,token);nonadjacent(token,nexttoken);if(left){if(left.id==='.'||left.id==='['||(left.identifier&&!left.reserved)){parse(19);return that;}
+if(left===syntax['function']){warning("Expected an identifier in an assignment, and instead saw a function invocation.",token);}
+return that;}
+error("Bad assignment.",that);},20);}
+function suffix(s,f){var x=symbol(s,150);x.led=function(left){if(option.plusplus){warning("Unexpected use of '{a}'.",this,this.id);}else if((!left.identifier||left.reserved)&&left.id!=='.'&&left.id!=='['){warning("Bad operand.",this);}
+this.left=left;return this;};return x;}
+function optionalidentifier(){if(nexttoken.reserved){warning("Expected an identifier and instead saw '{a}' (a reserved word).",nexttoken,nexttoken.id);}
+if(nexttoken.identifier){advance();return token.value;}}
+function identifier(){var i=optionalidentifier();if(i){return i;}
+if(token.id==='function'&&nexttoken.id==='('){warning("Missing name in function statement.");}else{error("Expected an identifier and instead saw '{a}'.",nexttoken,nexttoken.value);}}
+function reachable(s){var i=0,t;if(nexttoken.id!==';'||noreach){return;}
+for(;;){t=peek(i);if(t.reach){return;}
+if(t.id!=='(endline)'){if(t.id==='function'){warning("Inner functions should be listed at the top of the outer function.",t);break;}
+warning("Unreachable '{a}' after '{b}'.",t,t.value,s);break;}
+i+=1;}}
+function statement(noindent){var i=indent,r,s=scope,t=nexttoken;if(t.id===';'){warning("Unnecessary semicolon.",t);advance(';');return;}
+if(t.identifier&&!t.reserved&&peek().id===':'){advance();advance(':');scope=Object.create(s);addlabel(t.value,'label');if(!nexttoken.labelled){warning("Label '{a}' on {b} statement.",nexttoken,t.value,nexttoken.value);}
+if(jx.test(t.value+':')){warning("Label '{a}' looks like a javascript url.",t,t.value);}
+nexttoken.label=t.value;t=nexttoken;}
+if(!noindent){indentation();}
+if(nexttoken.id==='new'){warning("'new' should not be used as a statement.");}
+r=parse(0,true);if(!t.block){if(!r||!r.exps){warning("Expected an assignment or function call and instead saw an expression.",token);}
+if(nexttoken.id!==';'){warningAt("Missing semicolon.",token.line,token.from+token.value.length);}else{adjacent(token,nexttoken);advance(';');nonadjacent(token,nexttoken);}}
+indent=i;scope=s;return r;}
+function use_strict(){if(nexttoken.value==='use strict'){advance();advance(';');strict_mode=true;return true;}else{return false;}}
+function statements(begin){var a=[],f,p;if(begin&&!use_strict()&&option.strict){warning('Missing "use strict" statement.',nexttoken);}
+if(option.adsafe){switch(begin){case'script':if(!adsafe_may){if(nexttoken.value!=='ADSAFE'||peek(0).id!=='.'||(peek(1).value!=='id'&&peek(1).value!=='go')){error('ADsafe violation: Missing ADSAFE.id or ADSAFE.go.',nexttoken);}}
+if(nexttoken.value==='ADSAFE'&&peek(0).id==='.'&&peek(1).value==='id'){if(adsafe_may){error('ADsafe violation.',nexttoken);}
+advance('ADSAFE');advance('.');advance('id');advance('(');if(nexttoken.value!==adsafe_id){error('ADsafe violation: id does not match.',nexttoken);}
+advance('(string)');advance(')');advance(';');adsafe_may=true;}
+break;case'lib':if(nexttoken.value==='ADSAFE'){advance('ADSAFE');advance('.');advance('lib');advance('(');advance('(string)');comma();f=parse(0);if(f.id!=='function'){error('The second argument to lib must be a function.',f);}
+p=f.funct['(params)'];p=p&&p.join(', ');if(p&&p!=='lib'){error("Expected '{a}' and instead saw '{b}'.",f,'(lib)','('+p+')');}
+advance(')');advance(';');return a;}else{error("ADsafe lib violation.");}}}
+while(!nexttoken.reach&&nexttoken.id!=='(end)'){if(nexttoken.id===';'){warning("Unnecessary semicolon.");advance(';');}else{a.push(statement());}}
+return a;}
+function block(f){var a,b=inblock,old_indent=indent,s=scope,t;inblock=f;scope=Object.create(scope);nonadjacent(token,nexttoken);t=nexttoken;if(nexttoken.id==='{'){advance('{');if(nexttoken.id!=='}'||token.line!==nexttoken.line){indent+=option.indent;while(!f&&nexttoken.from>indent){indent+=option.indent;}
+if(!f){use_strict();}
+a=statements();indent-=option.indent;indentation();}
+advance('}',t);indent=old_indent;}else{warning("Expected '{a}' and instead saw '{b}'.",nexttoken,'{',nexttoken.value);noreach=true;a=[statement()];noreach=false;}
+funct['(verb)']=null;scope=s;inblock=b;return a;}
+function idValue(){return this;}
+function countMember(m){if(membersOnly&&typeof membersOnly[m]!=='boolean'){warning("Unexpected /*member '{a}'.",token,m);}
+if(typeof member[m]==='number'){member[m]+=1;}else{member[m]=1;}}
+function note_implied(token){var name=token.value,line=token.line,a=implied[name];if(typeof a==='function'){a=false;}
+if(!a){a=[line];implied[name]=a;}else if(a[a.length-1]!==line){a.push(line);}}
+function cssName(){if(nexttoken.identifier){advance();return true;}}
+function cssNumber(){if(nexttoken.id==='-'){advance('-');adjacent();nolinebreak();}
+if(nexttoken.type==='(number)'){advance('(number)');return true;}}
+function cssString(){if(nexttoken.type==='(string)'){advance();return true;}}
+function cssColor(){var i,number;if(nexttoken.identifier){if(nexttoken.value==='rgb'){advance();advance('(');for(i=0;i<3;i+=1){if(i){advance(',');}
+number=nexttoken.value;if(nexttoken.type!=='(number)'||number<0){warning("Expected a positive number and instead saw '{a}'",nexttoken,number);advance();}else{advance();if(nexttoken.id==='%'){advance('%');if(number>100){warning("Expected a percentage and instead saw '{a}'",token,number);}}else{if(number>255){warning("Expected a small number and instead saw '{a}'",token,number);}}}}
+advance(')');return true;}else if(cssColorData[nexttoken.value]===true){advance();return true;}}else if(nexttoken.type==='(color)'){advance();return true;}
+return false;}
+function cssLength(){if(nexttoken.id==='-'){advance('-');adjacent();nolinebreak();}
+if(nexttoken.type==='(number)'){advance();if(nexttoken.type!=='(string)'&&cssLengthData[nexttoken.value]===true){adjacent();advance();}else if(+token.value!==0){warning("Expected a linear unit and instead saw '{a}'.",nexttoken,nexttoken.value);}
+return true;}
+return false;}
+function cssLineHeight(){if(nexttoken.id==='-'){advance('-');adjacent();}
+if(nexttoken.type==='(number)'){advance();if(nexttoken.type!=='(string)'&&cssLengthData[nexttoken.value]===true){adjacent();advance();}
+return true;}
+return false;}
+function cssWidth(){if(nexttoken.identifier){switch(nexttoken.value){case'thin':case'medium':case'thick':advance();return true;}}else{return cssLength();}}
+function cssMargin(){if(nexttoken.identifier){if(nexttoken.value==='auto'){advance();return true;}}else{return cssLength();}}
+function cssAttr(){if(nexttoken.identifier&&nexttoken.value==='attr'){advance();advance('(');if(!nexttoken.identifier){warning("Expected a name and instead saw '{a}'.",nexttoken,nexttoken.value);}
+advance();advance(')');return true;}
+return false;}
+function cssCommaList(){while(nexttoken.id!==';'){if(!cssName()&&!cssString()){warning("Expected a name and instead saw '{a}'.",nexttoken,nexttoken.value);}
+if(nexttoken.id!==','){return true;}
+comma();}}
+function cssCounter(){if(nexttoken.identifier&&nexttoken.value==='counter'){advance();advance('(');if(!nexttoken.identifier){}
+advance();if(nexttoken.id===','){comma();if(nexttoken.type!=='(string)'){warning("Expected a string and instead saw '{a}'.",nexttoken,nexttoken.value);}
+advance();}
+advance(')');return true;}
+if(nexttoken.identifier&&nexttoken.value==='counters'){advance();advance('(');if(!nexttoken.identifier){warning("Expected a name and instead saw '{a}'.",nexttoken,nexttoken.value);}
+advance();if(nexttoken.id===','){comma();if(nexttoken.type!=='(string)'){warning("Expected a string and instead saw '{a}'.",nexttoken,nexttoken.value);}
+advance();}
+if(nexttoken.id===','){comma();if(nexttoken.type!=='(string)'){warning("Expected a string and instead saw '{a}'.",nexttoken,nexttoken.value);}
+advance();}
+advance(')');return true;}
+return false;}
+function cssShape(){var i;if(nexttoken.identifier&&nexttoken.value==='rect'){advance();advance('(');for(i=0;i<4;i+=1){if(!cssLength()){warning("Expected a number and instead saw '{a}'.",nexttoken,nexttoken.value);break;}}
+advance(')');return true;}
+return false;}
+function cssUrl(){var c,url;if(nexttoken.identifier&&nexttoken.value==='url'){nexttoken=lex.range('(',')');url=nexttoken.value;c=url.charAt(0);if(c==='"'||c==='\''){if(url.slice(-1)!==c){warning("Bad url string.");}else{url=url.slice(1,-1);if(url.indexOf(c)>=0){warning("Bad url string.");}}}
+if(!url){warning("Missing url.");}
+advance();if(option.safe&&ux.test(url)){error("ADsafe URL violation.");}
+urls.push(url);return true;}
+return false;}
+cssAny=[cssUrl,function(){for(;;){if(nexttoken.identifier){switch(nexttoken.value.toLowerCase()){case'url':cssUrl();break;case'expression':warning("Unexpected expression '{a}'.",nexttoken,nexttoken.value);advance();break;default:advance();}}else{if(nexttoken.id===';'||nexttoken.id==='!'||nexttoken.id==='(end)'||nexttoken.id==='}'){return true;}
+advance();}}}];cssBorderStyle=['none','hidden','dotted','dashed','solid','double','ridge','inset','outset'];cssBreak=['auto','always','avoid','left','right'];cssOverflow=['auto','hidden','scroll','visible'];cssAttributeData={background:[true,'background-attachment','background-color','background-image','background-position','background-repeat'],'background-attachment':['scroll','fixed'],'background-color':['transparent',cssColor],'background-image':['none',cssUrl],'background-position':[2,[cssLength,'top','bottom','left','right','center']],'background-repeat':['repeat','repeat-x','repeat-y','no-repeat'],'border':[true,'border-color','border-style','border-width'],'border-bottom':[true,'border-bottom-color','border-bottom-style','border-bottom-width'],'border-bottom-color':cssColor,'border-bottom-style':cssBorderStyle,'border-bottom-width':cssWidth,'border-collapse':['collapse','separate'],'border-color':['transparent',4,cssColor],'border-left':[true,'border-left-color','border-left-style','border-left-width'],'border-left-color':cssColor,'border-left-style':cssBorderStyle,'border-left-width':cssWidth,'border-right':[true,'border-right-color','border-right-style','border-right-width'],'border-right-color':cssColor,'border-right-style':cssBorderStyle,'border-right-width':cssWidth,'border-spacing':[2,cssLength],'border-style':[4,cssBorderStyle],'border-top':[true,'border-top-color','border-top-style','border-top-width'],'border-top-color':cssColor,'border-top-style':cssBorderStyle,'border-top-width':cssWidth,'border-width':[4,cssWidth],bottom:[cssLength,'auto'],'caption-side':['bottom','left','right','top'],clear:['both','left','none','right'],clip:[cssShape,'auto'],color:cssColor,content:['open-quote','close-quote','no-open-quote','no-close-quote',cssString,cssUrl,cssCounter,cssAttr],'counter-increment':[cssName,'none'],'counter-reset':[cssName,'none'],cursor:[cssUrl,'auto','crosshair','default','e-resize','help','move','n-resize','ne-resize','nw-resize','pointer','s-resize','se-resize','sw-resize','w-resize','text','wait'],direction:['ltr','rtl'],display:['block','compact','inline','inline-block','inline-table','list-item','marker','none','run-in','table','table-caption','table-cell','table-column','table-column-group','table-footer-group','table-header-group','table-row','table-row-group'],'empty-cells':['show','hide'],'float':['left','none','right'],font:['caption','icon','menu','message-box','small-caption','status-bar',true,'font-size','font-style','font-weight','font-family'],'font-family':cssCommaList,'font-size':['xx-small','x-small','small','medium','large','x-large','xx-large','larger','smaller',cssLength],'font-size-adjust':['none',cssNumber],'font-stretch':['normal','wider','narrower','ultra-condensed','extra-condensed','condensed','semi-condensed','semi-expanded','expanded','extra-expanded'],'font-style':['normal','italic','oblique'],'font-variant':['normal','small-caps'],'font-weight':['normal','bold','bolder','lighter',cssNumber],height:[cssLength,'auto'],left:[cssLength,'auto'],'letter-spacing':['normal',cssLength],'line-height':['normal',cssLineHeight],'list-style':[true,'list-style-image','list-style-position','list-style-type'],'list-style-image':['none',cssUrl],'list-style-position':['inside','outside'],'list-style-type':['circle','disc','square','decimal','decimal-leading-zero','lower-roman','upper-roman','lower-greek','lower-alpha','lower-latin','upper-alpha','upper-latin','hebrew','katakana','hiragana-iroha','katakana-oroha','none'],margin:[4,cssMargin],'margin-bottom':cssMargin,'margin-left':cssMargin,'margin-right':cssMargin,'margin-top':cssMargin,'marker-offset':[cssLength,'auto'],'max-height':[cssLength,'none'],'max-width':[cssLength,'none'],'min-height':cssLength,'min-width':cssLength,opacity:cssNumber,outline:[true,'outline-color','outline-style','outline-width'],'outline-color':['invert',cssColor],'outline-style':['dashed','dotted','double','groove','inset','none','outset','ridge','solid'],'outline-width':cssWidth,overflow:cssOverflow,'overflow-x':cssOverflow,'overflow-y':cssOverflow,padding:[4,cssLength],'padding-bottom':cssLength,'padding-left':cssLength,'padding-right':cssLength,'padding-top':cssLength,'page-break-after':cssBreak,'page-break-before':cssBreak,position:['absolute','fixed','relative','static'],quotes:[8,cssString],right:[cssLength,'auto'],'table-layout':['auto','fixed'],'text-align':['center','justify','left','right'],'text-decoration':['none','underline','overline','line-through','blink'],'text-indent':cssLength,'text-shadow':['none',4,[cssColor,cssLength]],'text-transform':['capitalize','uppercase','lowercase','none'],top:[cssLength,'auto'],'unicode-bidi':['normal','embed','bidi-override'],'vertical-align':['baseline','bottom','sub','super','top','text-top','middle','text-bottom',cssLength],visibility:['visible','hidden','collapse'],'white-space':['normal','nowrap','pre','pre-line','pre-wrap','inherit'],width:[cssLength,'auto'],'word-spacing':['normal',cssLength],'word-wrap':['break-word','normal'],'z-index':['auto',cssNumber]};function styleAttribute(){var v;while(nexttoken.id==='*'||nexttoken.id==='#'||nexttoken.value==='_'){if(!option.css){warning("Unexpected '{a}'.",nexttoken,nexttoken.value);}
+advance();}
+if(nexttoken.id==='-'){if(!option.css){warning("Unexpected '{a}'.",nexttoken,nexttoken.value);}
+advance('-');if(!nexttoken.identifier){warning("Expected a non-standard style attribute and instead saw '{a}'.",nexttoken,nexttoken.value);}
+advance();return cssAny;}else{if(!nexttoken.identifier){warning("Excepted a style attribute, and instead saw '{a}'.",nexttoken,nexttoken.value);}else{if(is_own(cssAttributeData,nexttoken.value)){v=cssAttributeData[nexttoken.value];}else{v=cssAny;if(!option.css){warning("Unrecognized style attribute '{a}'.",nexttoken,nexttoken.value);}}}
+advance();return v;}}
+function styleValue(v){var i=0,n,once,match,round,start=0,vi;switch(typeof v){case'function':return v();case'string':if(nexttoken.identifier&&nexttoken.value===v){advance();return true;}
+return false;}
+for(;;){if(i>=v.length){return false;}
+vi=v[i];i+=1;if(vi===true){break;}else if(typeof vi==='number'){n=vi;vi=v[i];i+=1;}else{n=1;}
+match=false;while(n>0){if(styleValue(vi)){match=true;n-=1;}else{break;}}
+if(match){return true;}}
+start=i;once=[];for(;;){round=false;for(i=start;i<v.length;i+=1){if(!once[i]){if(styleValue(cssAttributeData[v[i]])){match=true;round=true;once[i]=true;break;}}}
+if(!round){return match;}}}
+function styleChild(){if(nexttoken.id==='(number)'){advance();if(nexttoken.value==='n'&&nexttoken.identifier){adjacent();advance();if(nexttoken.id==='+'){adjacent();advance('+');adjacent();advance('(number)');}}
+return;}else{switch(nexttoken.value){case'odd':case'even':if(nexttoken.identifier){advance();return;}}}
+warning("Unexpected token '{a}'.",nexttoken,nexttoken.value);}
+function substyle(){var v;for(;;){if(nexttoken.id==='}'||nexttoken.id==='(end)'||xquote&&nexttoken.id===xquote){return;}
+while(nexttoken.id===';'){warning("Misplaced ';'.");advance(';');}
+v=styleAttribute();advance(':');if(nexttoken.identifier&&nexttoken.value==='inherit'){advance();}else{if(!styleValue(v)){warning("Unexpected token '{a}'.",nexttoken,nexttoken.value);advance();}}
+if(nexttoken.id==='!'){advance('!');adjacent();if(nexttoken.identifier&&nexttoken.value==='important'){advance();}else{warning("Expected '{a}' and instead saw '{b}'.",nexttoken,'important',nexttoken.value);}}
+if(nexttoken.id==='}'||nexttoken.id===xquote){warning("Missing '{a}'.",nexttoken,';');}else{advance(';');}}}
+function styleSelector(){if(nexttoken.identifier){if(!is_own(htmltag,nexttoken.value)){warning("Expected a tagName, and instead saw {a}.",nexttoken,nexttoken.value);}
+advance();}else{switch(nexttoken.id){case'>':case'+':advance();styleSelector();break;case':':advance(':');switch(nexttoken.value){case'active':case'after':case'before':case'checked':case'disabled':case'empty':case'enabled':case'first-child':case'first-letter':case'first-line':case'first-of-type':case'focus':case'hover':case'last-of-type':case'link':case'only-of-type':case'root':case'target':case'visited':advance();break;case'lang':advance();advance('(');if(!nexttoken.identifier){warning("Expected a lang code, and instead saw :{a}.",nexttoken,nexttoken.value);}
+advance(')');break;case'nth-child':case'nth-last-child':case'nth-last-of-type':case'nth-of-type':advance();advance('(');styleChild();advance(')');break;case'not':advance();advance('(');if(nexttoken.id===':'&&peek(0).value==='not'){warning("Nested not.");}
+styleSelector();advance(')');break;default:warning("Expected a pseudo, and instead saw :{a}.",nexttoken,nexttoken.value);}
+break;case'#':advance('#');if(!nexttoken.identifier){warning("Expected an id, and instead saw #{a}.",nexttoken,nexttoken.value);}
+advance();break;case'*':advance('*');break;case'.':advance('.');if(!nexttoken.identifier){warning("Expected a class, and instead saw #.{a}.",nexttoken,nexttoken.value);}
+advance();break;case'[':advance('[');if(!nexttoken.identifier){warning("Expected an attribute, and instead saw [{a}].",nexttoken,nexttoken.value);}
+advance();if(nexttoken.id==='='||nexttoken.value==='~='||nexttoken.value==='$='||nexttoken.value==='|='||nexttoken.id==='*='||nexttoken.id==='^='){advance();if(nexttoken.type!=='(string)'){warning("Expected a string, and instead saw {a}.",nexttoken,nexttoken.value);}
+advance();}
+advance(']');break;default:error("Expected a CSS selector, and instead saw {a}.",nexttoken,nexttoken.value);}}}
+function stylePattern(){var name;if(nexttoken.id==='{'){warning("Expected a style pattern, and instead saw '{a}'.",nexttoken,nexttoken.id);}else if(nexttoken.id==='@'){advance('@');name=nexttoken.value;if(nexttoken.identifier&&atrule[name]===true){advance();return name;}
+warning("Expected an at-rule, and instead saw @{a}.",nexttoken,name);}
+for(;;){styleSelector();if(nexttoken.id==='</'||nexttoken.id==='{'||nexttoken.id==='(end)'){return'';}
+if(nexttoken.id===','){comma();}}}
+function styles(){var i;while(nexttoken.id==='@'){i=peek();if(i.identifier&&i.value==='import'){advance('@');advance();if(!cssUrl()){warning("Expected '{a}' and instead saw '{b}'.",nexttoken,'url',nexttoken.value);advance();}
+advance(';');}else{break;}}
+while(nexttoken.id!=='</'&&nexttoken.id!=='(end)'){stylePattern();xmode='styleproperty';if(nexttoken.id===';'){advance(';');}else{advance('{');substyle();xmode='style';advance('}');}}}
+function doBegin(n){if(n!=='html'&&!option.fragment){if(n==='div'&&option.adsafe){error("ADSAFE: Use the fragment option.");}else{error("Expected '{a}' and instead saw '{b}'.",token,'html',n);}}
+if(option.adsafe){if(n==='html'){error("Currently, ADsafe does not operate on whole HTML documents. It operates on <div> fragments and .js files.",token);}
+if(option.fragment){if(n!=='div'){error("ADsafe violation: Wrap the widget in a div.",token);}}else{error("Use the fragment option.",token);}}
+option.browser=true;assume();}
+function doAttribute(n,a,v){var u,x;if(a==='id'){u=typeof v==='string'?v.toUpperCase():'';if(ids[u]===true){warning("Duplicate id='{a}'.",nexttoken,v);}
+if(option.adsafe){if(adsafe_id){if(v.slice(0,adsafe_id.length)!==adsafe_id){warning("ADsafe violation: An id must have a '{a}' prefix",nexttoken,adsafe_id);}else if(!/^[A-Z]+_[A-Z]+$/.test(v)){warning("ADSAFE violation: bad id.");}}else{adsafe_id=v;if(!/^[A-Z]+_$/.test(v)){warning("ADSAFE violation: bad id.");}}}
+x=v.search(dx);if(x>=0){warning("Unexpected character '{a}' in {b}.",token,v.charAt(x),a);}
+ids[u]=true;}else if(a==='class'||a==='type'||a==='name'){x=v.search(qx);if(x>=0){warning("Unexpected character '{a}' in {b}.",token,v.charAt(x),a);}
+ids[u]=true;}else if(a==='href'||a==='background'||a==='content'||a==='data'||a.indexOf('src')>=0||a.indexOf('url')>=0){if(option.safe&&ux.test(v)){error("ADsafe URL violation.");}
+urls.push(v);}else if(a==='for'){if(option.adsafe){if(adsafe_id){if(v.slice(0,adsafe_id.length)!==adsafe_id){warning("ADsafe violation: An id must have a '{a}' prefix",nexttoken,adsafe_id);}else if(!/^[A-Z]+_[A-Z]+$/.test(v)){warning("ADSAFE violation: bad id.");}}else{warning("ADSAFE violation: bad id.");}}}else if(a==='name'){if(option.adsafe&&v.indexOf('_')>=0){warning("ADsafe name violation.");}}}
+function doTag(n,a){var i,t=htmltag[n],x;src=false;if(!t){error("Unrecognized tag '<{a}>'.",nexttoken,n===n.toLowerCase()?n:n+' (capitalization error)');}
+if(stack.length>0){if(n==='html'){error("Too many <html> tags.",token);}
+x=t.parent;if(x){if(x.indexOf(' '+stack[stack.length-1].name+' ')<0){error("A '<{a}>' must be within '<{b}>'.",token,n,x);}}else if(!option.adsafe&&!option.fragment){i=stack.length;do{if(i<=0){error("A '<{a}>' must be within '<{b}>'.",token,n,'body');}
+i-=1;}while(stack[i].name!=='body');}}
+switch(n){case'div':if(option.adsafe&&stack.length===1&&!adsafe_id){warning("ADSAFE violation: missing ID_.");}
+break;case'script':xmode='script';advance('>');indent=nexttoken.from;if(a.lang){warning("lang is deprecated.",token);}
+if(option.adsafe&&stack.length!==1){warning("ADsafe script placement violation.",token);}
+if(a.src){if(option.adsafe&&(!adsafe_may||!approved[a.src])){warning("ADsafe unapproved script source.",token);}
+if(a.type){warning("type is unnecessary.",token);}}else{if(adsafe_went){error("ADsafe script violation.",token);}
+statements('script');}
+xmode='html';advance('</');if(!nexttoken.identifier&&nexttoken.value!=='script'){warning("Expected '{a}' and instead saw '{b}'.",nexttoken,'script',nexttoken.value);}
+advance();xmode='outer';break;case'style':xmode='style';advance('>');styles();xmode='html';advance('</');if(!nexttoken.identifier&&nexttoken.value!=='style'){warning("Expected '{a}' and instead saw '{b}'.",nexttoken,'style',nexttoken.value);}
+advance();xmode='outer';break;case'input':switch(a.type){case'radio':case'checkbox':case'button':case'reset':case'submit':break;case'text':case'file':case'password':case'file':case'hidden':case'image':if(option.adsafe&&a.autocomplete!=='off'){warning("ADsafe autocomplete violation.");}
+break;default:warning("Bad input type.");}
+break;case'applet':case'body':case'embed':case'frame':case'frameset':case'head':case'iframe':case'noembed':case'noframes':case'object':case'param':if(option.adsafe){warning("ADsafe violation: Disallowed tag: "+n);}
+break;}}
+function closetag(n){return'</'+n+'>';}
+function html(){var a,attributes,e,n,q,t,v,w=option.white,wmode;xmode='html';xquote='';stack=null;for(;;){switch(nexttoken.value){case'<':xmode='html';advance('<');attributes={};t=nexttoken;if(!t.identifier){warning("Bad identifier {a}.",t,t.value);}
+n=t.value;if(option.cap){n=n.toLowerCase();}
+t.name=n;advance();if(!stack){stack=[];doBegin(n);}
+v=htmltag[n];if(typeof v!=='object'){error("Unrecognized tag '<{a}>'.",t,n);}
+e=v.empty;t.type=n;for(;;){if(nexttoken.id==='/'){advance('/');if(nexttoken.id!=='>'){warning("Expected '{a}' and instead saw '{b}'.",nexttoken,'>',nexttoken.value);}
+break;}
+if(nexttoken.id&&nexttoken.id.substr(0,1)==='>'){break;}
+if(!nexttoken.identifier){if(nexttoken.id==='(end)'||nexttoken.id==='(error)'){error("Missing '>'.",nexttoken);}
+warning("Bad identifier.");}
+option.white=true;nonadjacent(token,nexttoken);a=nexttoken.value;option.white=w;advance();if(!option.cap&&a!==a.toLowerCase()){warning("Attribute '{a}' not all lower case.",nexttoken,a);}
+a=a.toLowerCase();xquote='';if(is_own(attributes,a)){warning("Attribute '{a}' repeated.",nexttoken,a);}
+if(a.slice(0,2)==='on'){if(!option.on){warning("Avoid HTML event handlers.");}
+xmode='scriptstring';advance('=');q=nexttoken.id;if(q!=='"'&&q!=="'"){error("Missing quote.");}
+xquote=q;wmode=option.white;option.white=false;advance(q);statements('on');option.white=wmode;if(nexttoken.id!==q){error("Missing close quote on script attribute.");}
+xmode='html';xquote='';advance(q);v=false;}else if(a==='style'){xmode='scriptstring';advance('=');q=nexttoken.id;if(q!=='"'&&q!=="'"){error("Missing quote.");}
+xmode='styleproperty';xquote=q;advance(q);substyle();xmode='html';xquote='';advance(q);v=false;}else{if(nexttoken.id==='='){advance('=');v=nexttoken.value;if(!nexttoken.identifier&&nexttoken.id!=='"'&&nexttoken.id!=='\''&&nexttoken.type!=='(string)'&&nexttoken.type!=='(number)'&&nexttoken.type!=='(color)'){warning("Expected an attribute value and instead saw '{a}'.",token,a);}
+advance();}else{v=true;}}
+attributes[a]=v;doAttribute(n,a,v);}
+doTag(n,attributes);if(!e){stack.push(t);}
+xmode='outer';advance('>');break;case'</':xmode='html';advance('</');if(!nexttoken.identifier){warning("Bad identifier.");}
+n=nexttoken.value;if(option.cap){n=n.toLowerCase();}
+advance();if(!stack){error("Unexpected '{a}'.",nexttoken,closetag(n));}
+t=stack.pop();if(!t){error("Unexpected '{a}'.",nexttoken,closetag(n));}
+if(t.name!==n){error("Expected '{a}' and instead saw '{b}'.",nexttoken,closetag(t.name),closetag(n));}
+if(nexttoken.id!=='>'){error("Missing '{a}'.",nexttoken,'>');}
+xmode='outer';advance('>');break;case'<!':if(option.safe){warning("ADsafe HTML violation.");}
+xmode='html';for(;;){advance();if(nexttoken.id==='>'||nexttoken.id==='(end)'){break;}
+if(nexttoken.value.indexOf('--')>=0){warning("Unexpected --.");}
+if(nexttoken.value.indexOf('<')>=0){warning("Unexpected <.");}
+if(nexttoken.value.indexOf('>')>=0){warning("Unexpected >.");}}
+xmode='outer';advance('>');break;case'(end)':return;default:if(nexttoken.id==='(end)'){error("Missing '{a}'.",nexttoken,'</'+stack[stack.length-1].value+'>');}else{advance();}}
+if(stack&&stack.length===0&&(option.adsafe||!option.fragment||nexttoken.id==='(end)')){break;}}
+if(nexttoken.id!=='(end)'){error("Unexpected material after the end.");}}
+type('(number)',idValue);type('(string)',idValue);syntax['(identifier)']={type:'(identifier)',lbp:0,identifier:true,nud:function(){var v=this.value,s=scope[v],f;if(typeof s==='function'){s=undefined;}else if(typeof s==='boolean'){f=funct;funct=functions[0];addlabel(v,'var');s=funct;funct=f;}
+if(funct===s){switch(funct[v]){case'unused':funct[v]='var';break;case'label':warning("'{a}' is a statement label.",token,v);break;}}else if(funct['(global)']){if(option.undef&&predefined[v]!=='boolean'){warning("'{a}' is not defined.",token,v);}
+note_implied(token);}else{switch(funct[v]){case'closure':case'function':case'var':case'unused':warning("'{a}' used out of scope.",token,v);break;case'label':warning("'{a}' is a statement label.",token,v);break;case'outer':case'global':break;default:if(s===true){funct[v]=true;}else if(s===null){warning("'{a}' is not allowed.",token,v);note_implied(token);}else if(typeof s!=='object'){if(option.undef){warning("'{a}' is not defined.",token,v);}else{funct[v]=true;}
+note_implied(token);}else{switch(s[v]){case'function':case'var':case'unused':s[v]='closure';funct[v]=s['(global)']?'global':'outer';break;case'closure':case'parameter':funct[v]=s['(global)']?'global':'outer';break;case'label':warning("'{a}' is a statement label.",token,v);}}}}
+return this;},led:function(){error("Expected an operator and instead saw '{a}'.",nexttoken,nexttoken.value);}};type('(regexp)',function(){return this;});delim('(endline)');delim('(begin)');delim('(end)').reach=true;delim('</').reach=true;delim('<!');delim('<!--');delim('-->');delim('(error)').reach=true;delim('}').reach=true;delim(')');delim(']');delim('"').reach=true;delim("'").reach=true;delim(';');delim(':').reach=true;delim(',');delim('#');delim('@');reserve('else');reserve('case').reach=true;reserve('catch');reserve('default').reach=true;reserve('finally');reservevar('arguments');reservevar('eval');reservevar('false');reservevar('Infinity');reservevar('NaN');reservevar('null');reservevar('this');reservevar('true');reservevar('undefined');assignop('=','assign',20);assignop('+=','assignadd',20);assignop('-=','assignsub',20);assignop('*=','assignmult',20);assignop('/=','assigndiv',20).nud=function(){error("A regular expression literal can be confused with '/='.");};assignop('%=','assignmod',20);bitwiseassignop('&=','assignbitand',20);bitwiseassignop('|=','assignbitor',20);bitwiseassignop('^=','assignbitxor',20);bitwiseassignop('<<=','assignshiftleft',20);bitwiseassignop('>>=','assignshiftright',20);bitwiseassignop('>>>=','assignshiftrightunsigned',20);infix('?',function(left,that){that.left=left;that.right=parse(10);advance(':');that['else']=parse(10);return that;},30);infix('||','or',40);infix('&&','and',50);bitwise('|','bitor',70);bitwise('^','bitxor',80);bitwise('&','bitand',90);relation('==',function(left,right){if(option.eqeqeq){warning("Expected '{a}' and instead saw '{b}'.",this,'===','==');}else if(isPoorRelation(left)){warning("Use '{a}' to compare with '{b}'.",this,'===',left.value);}else if(isPoorRelation(right)){warning("Use '{a}' to compare with '{b}'.",this,'===',right.value);}
+return this;});relation('===');relation('!=',function(left,right){if(option.eqeqeq){warning("Expected '{a}' and instead saw '{b}'.",this,'!==','!=');}else if(isPoorRelation(left)){warning("Use '{a}' to compare with '{b}'.",this,'!==',left.value);}else if(isPoorRelation(right)){warning("Use '{a}' to compare with '{b}'.",this,'!==',right.value);}
+return this;});relation('!==');relation('<');relation('>');relation('<=');relation('>=');bitwise('<<','shiftleft',120);bitwise('>>','shiftright',120);bitwise('>>>','shiftrightunsigned',120);infix('in','in',120);infix('instanceof','instanceof',120);infix('+',function(left,that){var right=parse(130);if(left&&right&&left.id==='(string)'&&right.id==='(string)'){left.value+=right.value;left.character=right.character;if(jx.test(left.value)){warning("JavaScript URL.",left);}
+return left;}
+that.left=left;that.right=right;return that;},130);prefix('+','num');infix('-','sub',130);prefix('-','neg');infix('*','mult',140);infix('/','div',140);infix('%','mod',140);suffix('++','postinc');prefix('++','preinc');syntax['++'].exps=true;suffix('--','postdec');prefix('--','predec');syntax['--'].exps=true;prefix('delete',function(){var p=parse(0);if(!p||(p.id!=='.'&&p.id!=='[')){warning("Expected '{a}' and instead saw '{b}'.",nexttoken,'.',nexttoken.value);}
+this.first=p;return this;}).exps=true;prefix('~',function(){if(option.bitwise){warning("Unexpected '{a}'.",this,'~');}
+parse(150);return this;});prefix('!',function(){this.right=parse(150);this.arity='unary';if(bang[this.right.id]===true){warning("Confusing use of '{a}'.",this,'!');}
+return this;});prefix('typeof','typeof');prefix('new',function(){var c=parse(155),i;if(c&&c.id!=='function'){if(c.identifier){c['new']=true;switch(c.value){case'Object':warning("Use the object literal notation {}.",token);break;case'Array':if(nexttoken.id!=='('){warning("Use the array literal notation [].",token);}else{advance('(');if(nexttoken.id===')'){warning("Use the array literal notation [].",token);}else{i=parse(0);c.dimension=i;if((i.id==='(number)'&&/[.+\-Ee]/.test(i.value))||(i.id==='-'&&!i.right)||i.id==='(string)'||i.id==='['||i.id==='{'||i.id==='true'||i.id==='false'||i.id==='null'||i.id==='undefined'||i.id==='Infinity'){warning("Use the array literal notation [].",token);}
+if(nexttoken.id!==')'){error("Use the array literal notation [].",token);}}
+advance(')');}
+this.first=c;return this;case'Number':case'String':case'Boolean':case'Math':case'JSON':warning("Do not use {a} as a constructor.",token,c.value);break;case'Function':if(!option.evil){warning("The Function constructor is eval.");}
+break;case'Date':case'RegExp':break;default:if(c.id!=='function'){i=c.value.substr(0,1);if(option.newcap&&(i<'A'||i>'Z')){warning("A constructor name should start with an uppercase letter.",token);}}}}else{if(c.id!=='.'&&c.id!=='['&&c.id!=='('){warning("Bad constructor.",token);}}}else{warning("Weird construction. Delete 'new'.",this);}
+adjacent(token,nexttoken);if(nexttoken.id!=='('){warning("Missing '()' invoking a constructor.");}
+this.first=c;return this;});syntax['new'].exps=true;infix('.',function(left,that){adjacent(prevtoken,token);var m=identifier();if(typeof m==='string'){countMember(m);}
+that.left=left;that.right=m;if(!option.evil&&left&&left.value==='document'&&(m==='write'||m==='writeln')){warning("document.write can be a form of eval.",left);}else if(option.adsafe){if(left&&left.value==='ADSAFE'){if(m==='id'||m==='lib'){warning("ADsafe violation.",that);}else if(m==='go'){if(xmode!=='script'){warning("ADsafe violation.",that);}else if(adsafe_went||nexttoken.id!=='('||peek(0).id!=='(string)'||peek(0).value!==adsafe_id||peek(1).id!==','){error("ADsafe violation: go.",that);}
+adsafe_went=true;adsafe_may=false;}}}
+if(!option.evil&&(m==='eval'||m==='execScript')){warning('eval is evil.');}else if(option.safe){for(;;){if(banned[m]===true){warning("ADsafe restricted word '{a}'.",token,m);}
+if(typeof predefined[left.value]!=='boolean'||nexttoken.id==='('){break;}
+if(standard_member[m]===true){if(nexttoken.id==='.'){warning("ADsafe violation.",that);}
+break;}
+if(nexttoken.id!=='.'){warning("ADsafe violation.",that);break;}
+advance('.');token.left=that;token.right=m;that=token;m=identifier();if(typeof m==='string'){countMember(m);}}}
+return that;},160,true);infix('(',function(left,that){adjacent(prevtoken,token);nospace();var n=0,p=[];if(left){if(left.type==='(identifier)'){if(left.value.match(/^[A-Z]([A-Z0-9_$]*[a-z][A-Za-z0-9_$]*)?$/)){if(left.value!=='Number'&&left.value!=='String'&&left.value!=='Boolean'&&left.value!=='Date'){if(left.value==='Math'){warning("Math is not a function.",left);}else if(option.newcap){warning("Missing 'new' prefix when invoking a constructor.",left);}}}}else if(left.id==='.'){if(option.safe&&left.left.value==='Math'&&left.right==='random'){warning("ADsafe violation.",left);}}}
+if(nexttoken.id!==')'){for(;;){p[p.length]=parse(10);n+=1;if(nexttoken.id!==','){break;}
+comma();}}
+advance(')');if(option.immed&&left.id==='function'&&nexttoken.id!==')'){warning("Wrap the entire immediate function invocation in parens.",that);}
+nospace(prevtoken,token);if(typeof left==='object'){if(left.value==='parseInt'&&n===1){warning("Missing radix parameter.",left);}
+if(!option.evil){if(left.value==='eval'||left.value==='Function'||left.value==='execScript'){warning("eval is evil.",left);}else if(p[0]&&p[0].id==='(string)'&&(left.value==='setTimeout'||left.value==='setInterval')){warning("Implied eval is evil. Pass a function instead of a string.",left);}}
+if(!left.identifier&&left.id!=='.'&&left.id!=='['&&left.id!=='('&&left.id!=='&&'&&left.id!=='||'&&left.id!=='?'){warning("Bad invocation.",left);}}
+that.left=left;return that;},155,true).exps=true;prefix('(',function(){nospace();var v=parse(0);advance(')',this);nospace(prevtoken,token);if(option.immed&&v.id==='function'){if(nexttoken.id==='('){warning("Move the invocation into the parens that contain the function.",nexttoken);}else{warning("Do not wrap function literals in parens unless they are to be immediately invoked.",this);}}
+return v;});infix('[',function(left,that){nospace();var e=parse(0),s;if(e&&e.type==='(string)'){if(option.safe&&banned[e.value]===true){warning("ADsafe restricted word '{a}'.",that,e.value);}else if(!option.evil&&(e.value==='eval'||e.value==='execScript')){warning("eval is evil.",that);}else if(option.safe&&(e.value.charAt(0)==='_'||e.value.charAt(0)==='-')){warning("ADsafe restricted subscript '{a}'.",that,e.value);}
+countMember(e.value);if(!option.sub&&ix.test(e.value)){s=syntax[e.value];if(!s||!s.reserved){warning("['{a}'] is better written in dot notation.",e,e.value);}}}else if(!e||e.type!=='(number)'||e.value<0){if(option.safe){warning('ADsafe subscripting.');}}
+advance(']',that);nospace(prevtoken,token);that.left=left;that.right=e;return that;},160,true);prefix('[',function(){var b=token.line!==nexttoken.line;this.first=[];if(b){indent+=option.indent;if(nexttoken.from===indent+option.indent){indent+=option.indent;}}
+while(nexttoken.id!=='(end)'){while(nexttoken.id===','){warning("Extra comma.");advance(',');}
+if(nexttoken.id===']'){break;}
+if(b&&token.line!==nexttoken.line){indentation();}
+this.first.push(parse(10));if(nexttoken.id===','){comma();if(nexttoken.id===']'){warning("Extra comma.",token);break;}}else{break;}}
+if(b){indent-=option.indent;indentation();}
+advance(']',this);return this;},160);(function(x){x.nud=function(){var b,i,s,seen={};b=token.line!==nexttoken.line;if(b){indent+=option.indent;if(nexttoken.from===indent+option.indent){indent+=option.indent;}}
+for(;;){if(nexttoken.id==='}'){break;}
+if(b){indentation();}
+i=optionalidentifier(true);if(!i){if(nexttoken.id==='(string)'){i=nexttoken.value;if(ix.test(i)){s=syntax[i];}
+advance();}else if(nexttoken.id==='(number)'){i=nexttoken.value.toString();advance();}else{error("Expected '{a}' and instead saw '{b}'.",nexttoken,'}',nexttoken.value);}}
+if(seen[i]===true){warning("Duplicate member '{a}'.",nexttoken,i);}
+seen[i]=true;countMember(i);advance(':');nonadjacent(token,nexttoken);parse(10);if(nexttoken.id===','){comma();if(nexttoken.id===','||nexttoken.id==='}'){warning("Extra comma.",token);}}else{break;}}
+if(b){indent-=option.indent;indentation();}
+advance('}',this);return this;};x.fud=function(){error("Expected to see a statement and instead saw a block.",token);};}(delim('{')));function varstatement(prefix){var id,name,value;if(funct['(onevar)']&&option.onevar){warning("Too many var statements.");}else if(!funct['(global)']){funct['(onevar)']=true;}
+this.first=[];for(;;){nonadjacent(token,nexttoken);id=identifier();if(funct['(global)']&&predefined[id]===false){warning("Redefinition of '{a}'.",token,id);}
+addlabel(id,'unused');if(prefix){break;}
+name=token;this.first.push(token);if(nexttoken.id==='='){nonadjacent(token,nexttoken);advance('=');nonadjacent(token,nexttoken);if(peek(0).id==='='&&nexttoken.identifier){error("Variable {a} was not declared correctly.",nexttoken,nexttoken.value);}
+value=parse(0);name.first=value;}
+if(nexttoken.id!==','){break;}
+comma();}
+return this;}
+stmt('var',varstatement).exps=true;function functionparams(){var i,t=nexttoken,p=[];advance('(');nospace();if(nexttoken.id===')'){advance(')');nospace(prevtoken,token);return;}
+for(;;){i=identifier();p.push(i);addlabel(i,'parameter');if(nexttoken.id===','){comma();}else{advance(')',t);nospace(prevtoken,token);return p;}}}
+function doFunction(i){var s=scope;scope=Object.create(s);funct={'(name)':i||'"'+anonname+'"','(line)':nexttoken.line,'(context)':funct,'(breakage)':0,'(loopage)':0,'(scope)':scope};token.funct=funct;functions.push(funct);if(i){addlabel(i,'function');}
+funct['(params)']=functionparams();block(false);scope=s;funct['(last)']=token.line;funct=funct['(context)'];}
+blockstmt('function',function(){if(inblock){warning("Function statements cannot be placed in blocks. Use a function expression or move the statement to the top of the outer function.",token);}
+var i=identifier();adjacent(token,nexttoken);addlabel(i,'unused');doFunction(i);if(nexttoken.id==='('&&nexttoken.line===token.line){error("Function statements are not invocable. Wrap the whole function invocation in parens.");}
+return this;});prefix('function',function(){var i=optionalidentifier();if(i){adjacent(token,nexttoken);}else{nonadjacent(token,nexttoken);}
+doFunction(i);if(funct['(loopage)']&&nexttoken.id!=='('){warning("Be careful when making functions within a loop. Consider putting the function in a closure.");}
+return this;});blockstmt('if',function(){var t=nexttoken;advance('(');nonadjacent(this,t);nospace();parse(20);if(nexttoken.id==='='){warning("Expected a conditional expression and instead saw an assignment.");advance('=');parse(20);}
+advance(')',t);nospace(prevtoken,token);block(true);if(nexttoken.id==='else'){nonadjacent(token,nexttoken);advance('else');if(nexttoken.id==='if'||nexttoken.id==='switch'){statement(true);}else{block(true);}}
+return this;});blockstmt('try',function(){var b,e,s;if(option.adsafe){warning("ADsafe try violation.",this);}
+block(false);if(nexttoken.id==='catch'){advance('catch');nonadjacent(token,nexttoken);advance('(');s=scope;scope=Object.create(s);e=nexttoken.value;if(nexttoken.type!=='(identifier)'){warning("Expected an identifier and instead saw '{a}'.",nexttoken,e);}else{addlabel(e,'exception');}
+advance();advance(')');block(false);b=true;scope=s;}
+if(nexttoken.id==='finally'){advance('finally');block(false);return;}else if(!b){error("Expected '{a}' and instead saw '{b}'.",nexttoken,'catch',nexttoken.value);}
+return this;});blockstmt('while',function(){var t=nexttoken;funct['(breakage)']+=1;funct['(loopage)']+=1;advance('(');nonadjacent(this,t);nospace();parse(20);if(nexttoken.id==='='){warning("Expected a conditional expression and instead saw an assignment.");advance('=');parse(20);}
+advance(')',t);nospace(prevtoken,token);block(true);funct['(breakage)']-=1;funct['(loopage)']-=1;return this;}).labelled=true;reserve('with');blockstmt('switch',function(){var t=nexttoken,g=false;funct['(breakage)']+=1;advance('(');nonadjacent(this,t);nospace();this.condition=parse(20);advance(')',t);nospace(prevtoken,token);nonadjacent(token,nexttoken);t=nexttoken;advance('{');nonadjacent(token,nexttoken);indent+=option.indent;this.cases=[];for(;;){switch(nexttoken.id){case'case':switch(funct['(verb)']){case'break':case'case':case'continue':case'return':case'switch':case'throw':break;default:warning("Expected a 'break' statement before 'case'.",token);}
+indentation(-option.indent);advance('case');this.cases.push(parse(20));g=true;advance(':');funct['(verb)']='case';break;case'default':switch(funct['(verb)']){case'break':case'continue':case'return':case'throw':break;default:warning("Expected a 'break' statement before 'default'.",token);}
+indentation(-option.indent);advance('default');g=true;advance(':');break;case'}':indent-=option.indent;indentation();advance('}',t);if(this.cases.length===1||this.condition.id==='true'||this.condition.id==='false'){warning("This 'switch' should be an 'if'.",this);}
+funct['(breakage)']-=1;funct['(verb)']=undefined;return;case'(end)':error("Missing '{a}'.",nexttoken,'}');return;default:if(g){switch(token.id){case',':error("Each value should have its own case label.");return;case':':statements();break;default:error("Missing ':' on a case clause.",token);}}else{error("Expected '{a}' and instead saw '{b}'.",nexttoken,'case',nexttoken.value);}}}}).labelled=true;stmt('debugger',function(){if(!option.debug){warning("All 'debugger' statements should be removed.");}
+return this;}).exps=true;(function(){var x=stmt('do',function(){funct['(breakage)']+=1;funct['(loopage)']+=1;this.first=block(true);advance('while');var t=nexttoken;nonadjacent(token,t);advance('(');nospace();parse(20);if(nexttoken.id==='='){warning("Expected a conditional expression and instead saw an assignment.");advance('=');parse(20);}
+advance(')',t);nospace(prevtoken,token);funct['(breakage)']-=1;funct['(loopage)']-=1;return this;});x.labelled=true;x.exps=true;}());blockstmt('for',function(){var f=option.forin,s,t=nexttoken;funct['(breakage)']+=1;funct['(loopage)']+=1;advance('(');nonadjacent(this,t);nospace();if(peek(nexttoken.id==='var'?1:0).id==='in'){if(nexttoken.id==='var'){advance('var');varstatement(true);}else{switch(funct[nexttoken.value]){case'unused':funct[nexttoken.value]='var';break;case'var':break;default:warning("Bad for in variable '{a}'.",nexttoken,nexttoken.value);}
+advance();}
+advance('in');parse(20);advance(')',t);s=block(true);if(!f&&(s.length>1||typeof s[0]!=='object'||s[0].value!=='if')){warning("The body of a for in should be wrapped in an if statement to filter unwanted properties from the prototype.",this);}
+funct['(breakage)']-=1;funct['(loopage)']-=1;return this;}else{if(nexttoken.id!==';'){if(nexttoken.id==='var'){advance('var');varstatement();}else{for(;;){parse(0,'for');if(nexttoken.id!==','){break;}
+comma();}}}
+nolinebreak(token);advance(';');if(nexttoken.id!==';'){parse(20);if(nexttoken.id==='='){warning("Expected a conditional expression and instead saw an assignment.");advance('=');parse(20);}}
+nolinebreak(token);advance(';');if(nexttoken.id===';'){error("Expected '{a}' and instead saw '{b}'.",nexttoken,')',';');}
+if(nexttoken.id!==')'){for(;;){parse(0,'for');if(nexttoken.id!==','){break;}
+comma();}}
+advance(')',t);nospace(prevtoken,token);block(true);funct['(breakage)']-=1;funct['(loopage)']-=1;return this;}}).labelled=true;stmt('break',function(){var v=nexttoken.value;if(funct['(breakage)']===0){warning("Unexpected '{a}'.",nexttoken,this.value);}
+nolinebreak(this);if(nexttoken.id!==';'){if(token.line===nexttoken.line){if(funct[v]!=='label'){warning("'{a}' is not a statement label.",nexttoken,v);}else if(scope[v]!==funct){warning("'{a}' is out of scope.",nexttoken,v);}
+this.first=nexttoken;advance();}}
+reachable('break');return this;}).exps=true;stmt('continue',function(){var v=nexttoken.value;if(funct['(breakage)']===0){warning("Unexpected '{a}'.",nexttoken,this.value);}
+nolinebreak(this);if(nexttoken.id!==';'){if(token.line===nexttoken.line){if(funct[v]!=='label'){warning("'{a}' is not a statement label.",nexttoken,v);}else if(scope[v]!==funct){warning("'{a}' is out of scope.",nexttoken,v);}
+this.first=nexttoken;advance();}}
+reachable('continue');return this;}).exps=true;stmt('return',function(){nolinebreak(this);if(nexttoken.id==='(regexp)'){warning("Wrap the /regexp/ literal in parens to disambiguate the slash operator.");}
+if(nexttoken.id!==';'&&!nexttoken.reach){nonadjacent(token,nexttoken);this.first=parse(20);}
+reachable('return');return this;}).exps=true;stmt('throw',function(){nolinebreak(this);nonadjacent(token,nexttoken);this.first=parse(20);reachable('throw');return this;}).exps=true;reserve('void');reserve('class');reserve('const');reserve('enum');reserve('export');reserve('extends');reserve('import');reserve('super');reserve('let');reserve('yield');reserve('implements');reserve('interface');reserve('package');reserve('private');reserve('protected');reserve('public');reserve('static');function jsonValue(){function jsonObject(){var o={},t=nexttoken;advance('{');if(nexttoken.id!=='}'){for(;;){if(nexttoken.id==='(end)'){error("Missing '}' to match '{' from line {a}.",nexttoken,t.line);}else if(nexttoken.id==='}'){warning("Unexpected comma.",token);break;}else if(nexttoken.id===','){error("Unexpected comma.",nexttoken);}else if(nexttoken.id!=='(string)'){warning("Expected a string and instead saw {a}.",nexttoken,nexttoken.value);}
+if(o[nexttoken.value]===true){warning("Duplicate key '{a}'.",nexttoken,nexttoken.value);}else if(nexttoken.value==='__proto__'){warning("Stupid key '{a}'.",nexttoken,nexttoken.value);}else{o[nexttoken.value]=true;}
+advance();advance(':');jsonValue();if(nexttoken.id!==','){break;}
+advance(',');}}
+advance('}');}
+function jsonArray(){var t=nexttoken;advance('[');if(nexttoken.id!==']'){for(;;){if(nexttoken.id==='(end)'){error("Missing ']' to match '[' from line {a}.",nexttoken,t.line);}else if(nexttoken.id===']'){warning("Unexpected comma.",token);break;}else if(nexttoken.id===','){error("Unexpected comma.",nexttoken);}
+jsonValue();if(nexttoken.id!==','){break;}
+advance(',');}}
+advance(']');}
+switch(nexttoken.id){case'{':jsonObject();break;case'[':jsonArray();break;case'true':case'false':case'null':case'(number)':case'(string)':advance();break;case'-':advance('-');if(token.character!==nexttoken.from){warning("Unexpected space after '-'.",token);}
+adjacent(token,nexttoken);advance('(number)');break;default:error("Expected a JSON value.",nexttoken);}}
+var itself=function(s,o){var a,i;JSLINT.errors=[];predefined=Object.create(standard);if(o){a=o.predef;if(a instanceof Array){for(i=0;i<a.length;i+=1){predefined[a[i]]=true;}}
+if(o.adsafe){o.safe=true;}
+if(o.safe){o.browser=false;o.css=false;o.debug=false;o.eqeqeq=true;o.evil=false;o.forin=false;o.nomen=true;o.on=false;o.rhino=false;o.safe=true;o.sidebar=false;o.strict=true;o.sub=false;o.undef=true;o.widget=false;predefined.Date=null;predefined['eval']=null;predefined.Function=null;predefined.Object=null;predefined.ADSAFE=false;predefined.lib=false;}
+option=o;}else{option={};}
+option.indent=option.indent||4;option.maxerr=option.maxerr||50;adsafe_id='';adsafe_may=false;adsafe_went=false;approved={};if(option.approved){for(i=0;i<option.approved.length;i+=1){approved[option.approved[i]]=option.approved[i];}}else{approved.test='test';}
+tab='';for(i=0;i<option.indent;i+=1){tab+=' ';}
+indent=1;global=Object.create(predefined);scope=global;funct={'(global)':true,'(name)':'(global)','(scope)':scope,'(breakage)':0,'(loopage)':0};functions=[funct];ids={};urls=[];src=false;xmode=false;stack=null;member={};membersOnly=null;implied={};inblock=false;lookahead=[];jsonmode=false;warnings=0;lex.init(s);prereg=true;strict_mode=false;prevtoken=token=nexttoken=syntax['(begin)'];assume();try{advance();if(nexttoken.value.charAt(0)==='<'){html();if(option.adsafe&&!adsafe_went){warning("ADsafe violation: Missing ADSAFE.go.",this);}}else{switch(nexttoken.id){case'{':case'[':option.laxbreak=true;jsonmode=true;jsonValue();break;case'@':case'*':case'#':case'.':case':':xmode='style';advance();if(token.id!=='@'||!nexttoken.identifier||nexttoken.value!=='charset'||token.line!==1||token.from!==1){error('A css file should begin with @charset "UTF-8";');}
+advance();if(nexttoken.type!=='(string)'&&nexttoken.value!=='UTF-8'){error('A css file should begin with @charset "UTF-8";');}
+advance();advance(';');styles();break;default:if(option.adsafe&&option.fragment){error("Expected '{a}' and instead saw '{b}'.",nexttoken,'<div>',nexttoken.value);}
+statements('lib');}}
+advance('(end)');}catch(e){if(e){JSLINT.errors.push({reason:e.message,line:e.line||nexttoken.line,character:e.character||nexttoken.from},null);}}
+return JSLINT.errors.length===0;};function is_array(o){return Object.prototype.toString.apply(o)==='[object Array]';}
+function to_array(o){var a=[],k;for(k in o){if(is_own(o,k)){a.push(k);}}
+return a;}
+itself.data=function(){var data={functions:[]},fu,globals,implieds=[],f,i,j,members=[],n,unused=[],v;if(itself.errors.length){data.errors=itself.errors;}
+if(jsonmode){data.json=true;}
+for(n in implied){if(is_own(implied,n)){implieds.push({name:n,line:implied[n]});}}
+if(implieds.length>0){data.implieds=implieds;}
+if(urls.length>0){data.urls=urls;}
+globals=to_array(scope);if(globals.length>0){data.globals=globals;}
+for(i=1;i<functions.length;i+=1){f=functions[i];fu={};for(j=0;j<functionicity.length;j+=1){fu[functionicity[j]]=[];}
+for(n in f){if(is_own(f,n)&&n.charAt(0)!=='('){v=f[n];if(is_array(fu[v])){fu[v].push(n);if(v==='unused'){unused.push({name:n,line:f['(line)'],'function':f['(name)']});}}}}
+for(j=0;j<functionicity.length;j+=1){if(fu[functionicity[j]].length===0){delete fu[functionicity[j]];}}
+fu.name=f['(name)'];fu.param=f['(params)'];fu.line=f['(line)'];fu.last=f['(last)'];data.functions.push(fu);}
+if(unused.length>0){data.unused=unused;}
+members=[];for(n in member){if(typeof member[n]==='number'){data.member=member;break;}}
+return data;};itself.report=function(option){var data=itself.data();var a=[],c,e,err,f,i,k,l,m='',n,o=[],s;function detail(h,s){if(s){o.push('<div><i>'+h+'</i> '+
+s.sort().join(', ')+'</div>');}}
+if(data.errors||data.implieds||data.unused){err=true;o.push('<div id=errors><i>Error:</i>');if(data.errors){for(i=0;i<data.errors.length;i+=1){c=data.errors[i];if(c){e=c.evidence||'';o.push('<p>Problem'+(isFinite(c.line)?' at line '+
+c.line+' character '+c.character:'')+': '+c.reason.entityify()+'</p><p class=evidence>'+
+(e&&(e.length>80?e.slice(0,77)+'...':e).entityify())+'</p>');}}}
+if(data.implieds){s=[];for(i=0;i<data.implieds.length;i+=1){s[i]='<code>'+data.implieds[i].name+'</code> <i>'+
+data.implieds[i].line+'</i>';}
+o.push('<p><i>Implied global:</i> '+s.join(', ')+'</p>');}
+if(data.unused){s=[];for(i=0;i<data.unused.length;i+=1){s[i]='<code><u>'+data.unused[i].name+'</u></code> <i>'+
+data.unused[i].line+'</i> <code>'+
+data.unused[i]['function']+'</code>';}
+o.push('<p><i>Unused variable:</i> '+s.join(', ')+'</p>');}
+if(data.json){o.push('<p>JSON: bad.</p>');}
+o.push('</div>');}
+if(!option){o.push('<br><div id=functions>');if(data.urls){detail("URLs<br>",data.urls,'<br>');}
+if(data.json&&!err){o.push('<p>JSON: good.</p>');}else if(data.globals){o.push('<div><i>Global</i> '+
+data.globals.sort().join(', ')+'</div>');}else{o.push('<div><i>No new global variables introduced.</i></div>');}
+for(i=0;i<data.functions.length;i+=1){f=data.functions[i];o.push('<br><div class=function><i>'+f.line+'-'+
+f.last+'</i> '+(f.name||'')+'('+
+(f.param?f.param.join(', '):'')+')</div>');detail('<big><b>Unused</b></big>',f.unused);detail('Closure',f.closure);detail('Variable',f['var']);detail('Exception',f.exception);detail('Outer',f.outer);detail('Global',f.global);detail('Label',f.label);}
+if(data.member){a=to_array(data.member);if(a.length){a=a.sort();m='<br><pre id=members>/*members ';l=10;for(i=0;i<a.length;i+=1){k=a[i];n=k.name();if(l+n.length>72){o.push(m+'<br>');m=' ';l=1;}
+l+=n.length+2;if(data.member[k]===1){n='<i>'+n+'</i>';}
+if(i<a.length-1){n+=', ';}
+m+=n;}
+o.push(m+'<br>*/</pre>');}
+o.push('</div>');}}
+return o.join('');};itself.jslint=itself;itself.edition='2009-10-04';return itself;}());(function(a){var e,i,input;if(!a[0]){print("Usage: jslint.js file.js");quit(1);}
+input=readFile(a[0]);if(!input){print("jslint: Couldn't open file '"+a[0]+"'.");quit(1);}
+if(!JSLINT(input,{bitwise:true,eqeqeq:true,immed:true,newcap:true,nomen:true,onevar:true,plusplus:true,regexp:true,rhino:true,undef:true,white:true})){for(i=0;i<JSLINT.errors.length;i+=1){e=JSLINT.errors[i];if(e){print('Lint at line '+e.line+' character '+
+e.character+': '+e.reason);print((e.evidence||'').replace(/^\s*(\S*(\s+\S+)*)\s*$/,"$1"));print('');}}
+quit(0);}else{print("jslint: No problems found in "+a[0]);quit();}}(arguments));
--- /dev/null
+;;; moz.el --- Lets current buffer interact with inferior mozilla.
+
+;; URL: http://github.com/bard/mozrepl/raw/master/chrome/content/moz.el
+
+;; Copyright (C) 2006 by Massimiliano Mirra
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+;;
+;; Author: Massimiliano Mirra, <bard [at] hyperstruct [dot] net>
+;; Contributors:
+;; - Lennart Borgman
+
+;;; Commentary:
+;;
+;; This file implements communication with Firefox via MozRepl
+;; (http://hyperstruct.net/projects/mozrepl). It is a slightly
+;; modified version of the file moz.el that comes with MozLab. To use
+;; it you have to install the MozRepl addon in Firefox.
+;;
+;; This file contains
+;;
+;; * a major mode for direct interaction in a buffer (as with
+;; telnet) with MozRepl, `inferior-moz-mode'.
+;; * a minor mode for sending code portions or whole files from
+;; other buffers to MozRepl, `moz-minor-mode'.
+;;
+;; Assuming you want to use javascript-mode to edit Javascript files,
+;; enter the following in your .emacs initialization file (from Emacs
+;; integration in the help text):
+;;
+;; (add-to-list 'auto-mode-alist '("\\.js$" . javascript-mode))
+;; (autoload 'inferior-moz-mode "moz" "MozRepl Inferior Mode" t)
+;; (autoload 'moz-minor-mode "moz" "MozRepl Minor Mode" t)
+;; (add-hook 'javascript-mode-hook 'javascript-moz-setup)
+;; (defun javascript-moz-setup () (moz-minor-mode 1))
+;;
+;; Replace javascript-mode above with the name of your favorite
+;; javascript mode.
+;;
+;; If you got this with nXhtml the setup above is already done for
+;; you.
+;;
+;; *Note 1* You have to start the MozRepl server in Firefox (or
+;; whatever Mozilla browser you use). From the menus do
+;;
+;; Tools - MozRepl - Start
+;;
+;; *Note 2* For clearness and brevity the documentation says Firefox
+;; where the correct term should rather be "your Mozilla web
+;; browser".
+
+;;; Change log:
+;;
+;; 2008-07-20: Lennart Borgman
+;; - Add `moz-minor-mode-map'.
+;; - Add `inferior-moz-insert-moz-repl'.
+;; - Add `inferior-moz-mode-map'.
+;; - Add doc strings to interactive functions.
+;; - Make minor enhancements to documentation etc.
+;; - Change Mozilla to Firefox/MozRepl for clarity and brevity.
+;; - Add error handling when starting MozRepl.
+
+;;; Code:
+
+(require 'comint)
+(require 'cc-cmds)
+
+;; Maybe fix-me: C-c control-char are reserved for major modes. But
+;; this minor mode is used in only one major mode (or one family of
+;; major modes) so it complies I think ...
+(defvar moz-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-s" 'run-mozilla)
+ (define-key map "\C-\M-x" 'moz-send-defun)
+ (define-key map "\C-c\C-c" 'moz-send-defun-and-go)
+ (define-key map "\C-c\C-r" 'moz-send-region)
+ (define-key map "\C-c\C-l" 'moz-save-buffer-and-send)
+ map))
+
+;;;###autoload
+(define-minor-mode moz-minor-mode
+ "MozRepl minor mode for interaction with Firefox.
+With no argument, this command toggles the mode.
+Non-null prefix argument turns on the mode.
+Null prefix argument turns off the mode.
+
+When this minor mode is enabled, some commands become available
+to send current code area \(as understood by c-mark-function) or
+region or buffer to an inferior MozRepl process (which will be
+started as needed).
+
+The following keys are bound in this minor mode:
+
+\\{moz-minor-mode-map}"
+ nil
+ " Moz"
+ :keymap moz-minor-mode-map
+ :group 'moz)
+
+(defalias 'run-mozilla 'inferior-moz-switch-to-mozilla)
+
+(defvar moz-repl-name "repl"
+ "The current name of the repl.")
+
+(defvar moz-input-separator "\n--end-remote-input\n")
+
+(defvar moz-repl-host "localhost")
+
+(defvar moz-repl-port 4242)
+
+(defvar moz-temporary-file nil)
+
+(defun moz-temporary-file ()
+ (if (and moz-temporary-file
+ (file-readable-p moz-temporary-file))
+ moz-temporary-file
+ (setq moz-temporary-file (make-temp-file "emacs-mozrepl"))))
+
+(defun moz-send-region (start end)
+ "Send the region to Firefox via MozRepl."
+ (interactive "r")
+ (comint-send-string (inferior-moz-process)
+ (concat moz-repl-name ".pushenv('printPrompt', 'inputMode'); "
+ moz-repl-name ".setenv('printPrompt', false); "
+ moz-repl-name ".setenv('inputMode', 'multiline'); "
+ "undefined; \n"))
+ ;; Give the previous line a chance to be evaluated on its own. If
+ ;; it gets concatenated to the following ones, we are doomed.
+ (sleep-for 0 1)
+ (comint-send-region (inferior-moz-process)
+ start end)
+ (comint-send-string (inferior-moz-process)
+ "\n--end-remote-input\n")
+ (comint-send-string (inferior-moz-process)
+ (concat moz-repl-name ".popenv('inputMode', 'printPrompt'); "
+ "undefined; \n"))
+ (comint-send-string (inferior-moz-process)
+ "\n--end-remote-input\n")
+ (display-buffer (process-buffer (inferior-moz-process))))
+
+(defun moz-send-defun ()
+ "Send the current function to Firefox via MozRepl.
+Curent function is the one recognized by c-mark-function."
+ (interactive)
+ (save-excursion
+ (c-mark-function)
+ (moz-send-region (point) (mark))))
+
+(defun moz-send-defun-and-go ()
+ "Send the current function to Firefox via MozRepl.
+Also switch to the interaction buffer."
+ (interactive)
+ (moz-send-defun)
+ (inferior-moz-switch-to-mozilla nil))
+
+(defun moz-save-buffer-and-send ()
+ "Save the current buffer and load it in Firefox via MozRepl."
+ (interactive)
+ (save-buffer)
+ (comint-send-string (inferior-moz-process)
+ (concat moz-repl-name ".pushenv('printPrompt', 'inputMode'); "
+ moz-repl-name ".setenv('inputMode', 'line'); "
+ moz-repl-name ".setenv('printPrompt', false); undefined; "))
+ (comint-send-string (inferior-moz-process)
+ (concat moz-repl-name ".load('file://localhost/" (buffer-file-name) "');\n"
+ moz-repl-name ".popenv('inputMode', 'printPrompt'); undefined;\n"))
+ (display-buffer (process-buffer (inferior-moz-process))))
+
+;;; Inferior Mode
+
+(defvar inferior-moz-buffer nil
+ "The buffer in which the inferior process is running.")
+
+(defun inferior-moz-insert-moz-repl ()
+ "Insert value of `moz-repl-name' and a dot (.)."
+ (interactive) (insert moz-repl-name "."))
+
+(defvar inferior-moz-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Note: changed from C-c c which is reserved for users.
+ (define-key map "\C-c\C-c" 'inferior-moz-insert-moz-repl)
+ map))
+
+;;;###autoload
+(define-derived-mode inferior-moz-mode comint-mode "Inf-MozRepl"
+ "Major mode for interacting with Firefox via MozRepl."
+ (setq comint-input-sender 'inferior-moz-input-sender)
+ (add-hook 'comint-output-filter-functions 'inferior-moz-track-repl-name nil t))
+
+(defun inferior-moz-track-repl-name (comint-output)
+ (save-match-data
+ (when (string-match "\\(\\w+\\)> $" comint-output)
+ (setq moz-repl-name (match-string 1 comint-output)))))
+
+(defun inferior-moz-self-insert-or-repl-name ()
+ (interactive)
+ (if (looking-back "\\(\\w+\\)> $")
+ (insert moz-repl-name ".")
+ (insert last-command-event)))
+
+(defun inferior-moz-input-sender (proc string)
+ "Custom function to send input with comint-send-input.
+Instead of sending input and newline separately like in
+comint-simple-send, here we *first* concatenate input and
+newline, then send it all together. This prevents newline to be
+interpreted on its own."
+ (comint-send-string proc (concat string "\n")))
+
+(defun inferior-moz-switch-to-mozilla (arg)
+ "Switch to the inferior MozRepl buffer.
+Create the buffer and start the MozRepl process and connect to
+Firefox if needed.
+
+See also `inferior-moz-start-process'."
+ (interactive "P")
+ (when arg
+ (setq moz-repl-host (read-string "Host: " "localhost"))
+ (setq moz-repl-port (read-number "Port: " 4242)))
+ (pop-to-buffer (process-buffer (inferior-moz-process)))
+ (goto-char (process-mark (inferior-moz-process))))
+
+(defun inferior-moz-process ()
+ "Return inferior MozRepl process. Start it if necessary.
+See also `inferior-moz-start-process'."
+ (or (if (buffer-live-p inferior-moz-buffer)
+ (get-buffer-process inferior-moz-buffer))
+ (progn
+ (inferior-moz-start-process)
+ (inferior-moz-process))))
+
+(defvar mozrepl-home-page "http://hyperstruct.net/projects/mozrepl")
+
+(defun inferior-moz-start-process ()
+ "Start an inferior Mozrepl process and connect to Firefox.
+It runs the hook `inferior-moz-hook' after starting the process
+and setting up the inferior Firefox buffer.
+
+Note that you have to start the MozRepl server from Firefox."
+ (interactive)
+ (condition-case err
+ (progn
+ (setq inferior-moz-buffer
+ (apply 'make-comint "MozRepl" (cons moz-repl-host moz-repl-port) nil nil))
+ (sleep-for 0 100)
+ (with-current-buffer inferior-moz-buffer
+ (inferior-moz-mode)
+ (run-hooks 'inferior-moz-hook)))
+ (file-error
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'describe-function 'inferior-moz-start-process) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert "Can't start MozRepl, the error message was:\n\n "
+ (error-message-string err)
+ "\n"
+ "\nA possible reason is that you have not installed"
+ "\nthe MozRepl add-on to Firefox or that you have not"
+ "\nstarted it. You start it from the menus in Firefox:"
+ "\n\n Tools / MozRepl / Start"
+ "\n"
+ "\nSee ")
+ (insert-text-button
+ "MozRepl home page"
+ 'action (lambda (button)
+ (browse-url mozrepl-home-page))
+ 'help-echo mozrepl-home-page
+ 'face 'button)
+ (insert
+ " for more information."
+ "\n"
+ "\nMozRepl is also available directly from Firefox add-on"
+ "\npages, but is updated less frequently there.")
+ ))
+ (error "Can't start MozRepl"))))
+
+(provide 'moz)
+
+;;; moz.el ends here
--- /dev/null
+;;; mozadd.el --- Additional functionality for MozRepl
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-07-22 Wed
+(defconst mozadd:version "0.2") ;; Version:
+;; Last-Updated: 2009-08-04 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+ ;; `cc-cmds', `cc-defs', `cc-engine', `cc-vars', `comint', `json',
+ ;; `moz', `regexp-opt', `ring'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Live tracking of editing changes, see
+;; `mozadd-mirror-mode'
+;; `mozadd-refresh-edited-on-save-mode'
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'moz)
+(require 'json)
+
+(defun mozadd-warning (format-string &rest args)
+ (let ((str (apply 'format format-string args)))
+ (message "%s" (propertize str 'face 'secondary-selection))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Refresh Firefox after save etc
+
+;; Partly after an idea on EmacsWiki
+
+(defvar mozadd-edited-buffer nil)
+(setq mozadd-edited-buffer nil)
+
+;;;###autoload
+(define-minor-mode mozadd-refresh-edited-on-save-mode
+ "Refresh mozadd edited file in Firefox when saving file.
+The mozadd edited file is the file in the last buffer visited in
+`mozadd-mirror-mode'.
+
+You can use this for example when you edit CSS files.
+
+The mozadd edited file must be shown in Firefox and visible."
+ :lighter "MozRefresh"
+ (if mozadd-refresh-edited-on-save-mode
+ (add-hook 'after-save-hook 'mozadd-queue-reload-mozilla-edited-file nil t)
+ (remove-hook 'after-save-hook 'mozadd-queue-reload-mozilla-edited-file t)))
+(put 'mozadd-refresh-edited-on-save-mode 'permanent-local t)
+
+;;;###autoload
+(define-globalized-minor-mode global-mozadd-refresh-edited-on-save-mode
+ mozadd-refresh-edited-on-save-mode
+ (lambda ()
+ (when (or (derived-mode-p 'css-mode)
+ (mozadd-html-buffer-file-p))
+ (mozadd-refresh-edited-on-save-mode 1))))
+
+(defun mozadd-queue-reload-mozilla-edited-file ()
+ "Reload edited file."
+ (when (buffer-live-p mozadd-edited-buffer)
+ (if (buffer-modified-p mozadd-edited-buffer)
+ (mozadd-warning "Mozadd: Edited buffer %s is not saved, can't reload browser."
+ (buffer-name mozadd-edited-buffer))
+ (mozadd-add-queue-get-mirror-location)
+ (mozadd-add-task-1 'mozadd-send-refresh-edited-to-mozilla))))
+
+(defun mozadd-send-refresh-edited-to-mozilla ()
+ "Update the remote mozrepl instance"
+ (with-current-buffer mozadd-edited-buffer
+ (if (not (mozadd-edited-file-is-shown))
+ (mozadd-warning "Mozadd: Edited buffer %s is not shown, can't reload browser."
+ (buffer-name mozadd-edited-buffer))
+ (comint-send-string (inferior-moz-process)
+ "setTimeout(BrowserReload(), \"1000\");")))
+ (mozadd-exec-next))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Mirror html buffer in Firefox
+
+;; Partly after an idea on
+;; http://people.internetconnection.net/2009/02/interactive-html-development-in-emacs/
+
+;; Fun, it kind of works, but is perhaps totally useless .... - slow
+;; and maybe scrolling... - but the file I am testing with have 3000
+;; lines...
+
+;; Fix-me: How do you get the currently shown page in Firefox?
+
+(defun mozadd-perhaps-start ()
+ "Start if MozRepl if not running. Return message if not ok."
+ (unless (buffer-live-p inferior-moz-buffer)
+ (condition-case err
+ (progn
+ (inferior-moz-start-process)
+ nil)
+ (error (error-message-string err)))))
+
+(defvar mozadd-mirror-location nil)
+(make-variable-buffer-local 'mozadd-mirror-location)
+(put 'mozadd-mirror-location 'permanent-local t)
+
+(defvar mozadd-initial-mirror-location nil)
+(make-variable-buffer-local 'mozadd-initial-mirror-location)
+(put 'mozadd-initial-mirror-location 'permanent-local t)
+
+;;(mozadd-get-comint-string-part "\"hi\" there")
+(defun mozadd-get-comint-string-part (comint-output)
+ (save-match-data
+ (if (string-match "^\".*?\"" comint-output)
+ (match-string 0 comint-output)
+ comint-output)))
+
+(defun mozadd-get-initial-mirror-location (comint-output)
+ ;;(message "mozadd-get-initial-mirror-location %S" comint-output)
+ (with-current-buffer mozadd-edited-buffer
+ (setq mozadd-initial-mirror-location (mozadd-get-comint-string-part comint-output)))
+ (mozadd-exec-next)
+ comint-output)
+
+(defun mozadd-get-mirror-location (comint-output)
+ ;;(message "mozadd-get-mirror-location %S" comint-output)
+ (with-current-buffer mozadd-edited-buffer
+ (setq mozadd-mirror-location (mozadd-get-comint-string-part comint-output)))
+ (mozadd-exec-next)
+ comint-output)
+
+(defun mozadd-add-queue-get-mirror-location ()
+ (mozadd-add-task "content.location.href" 'mozadd-get-mirror-location))
+
+(defun mozadd-skip-output-until-prompt (comint-output)
+ ;;(message "mozadd-skip-output-until-prompt %S" comint-output)
+ (if (not (string-match-p "\\(\\w+\\)> $" comint-output))
+ ""
+ ;;(message "done recieve %s" (current-time-string))
+ (mozadd-exec-next)
+ comint-output
+ ""
+ ))
+
+(defun mozadd-queue-send-buffer-content-to-mozilla (buffer)
+ (mozadd-add-queue-get-mirror-location)
+ (setq mozadd-edited-buffer buffer)
+ (mozadd-add-task-1 'mozadd-send-buffer-content-to-mozilla))
+
+(defun mozadd-edited-file-is-shown ()
+ (with-current-buffer mozadd-edited-buffer
+ (string= mozadd-mirror-location mozadd-initial-mirror-location)))
+
+(defvar mozadd-xml-path-outline-style "2px solid red")
+(defun mozadd-send-buffer-content-to-mozilla ()
+ "Update the remote mozrepl instance"
+ (with-current-buffer mozadd-edited-buffer
+ (if (mozadd-edited-file-is-shown)
+ (mozadd-requeue-me-as-task
+ (concat "content.document.body.innerHTML="
+ (json-encode
+ (save-restriction
+ (widen)
+ (let ((where-points nil)
+ (str "")
+ (p1 (point-min))
+ p2)
+ ;; If nxml-where-mode is on add corresponding outline style.
+ (when (and (boundp 'nxml-where-mode) nxml-where-mode)
+ (mapc (lambda (ovl)
+ (when (overlay-get ovl 'nxml-where)
+ (when (/= ?/ (1+ (char-after (overlay-start ovl))))
+ (push (1- (overlay-end ovl)) where-points))))
+ (overlays-in (point-min) (point-max)))
+ (setq where-points (sort where-points '<)))
+ (dolist (p2 where-points)
+ (setq str (concat str
+ (buffer-substring-no-properties p1
+ p2)))
+ (setq str (concat str
+ " style=\"outline: "
+ mozadd-xml-path-outline-style
+ "\""))
+ (setq p1 p2)
+ )
+ (setq str (concat str
+ (buffer-substring-no-properties p1
+ (point-max))))
+ str))
+ )
+ ";")
+ 'mozadd-skip-output-until-prompt)
+ (mozadd-skip-current-task))
+ ;; Timer to avoid looping
+ (run-with-idle-timer 0 nil 'mozadd-maybe-exec-next)
+ ))
+
+(defvar mozadd-current-task nil)
+(setq mozadd-current-task nil)
+
+(defvar mozadd-task-queue nil)
+(setq mozadd-task-queue nil)
+;;(mozadd-add-task "content.location.href" 'mozadd-get-initial-mirror-location)
+;;(mozadd-add-task "hi" 1)
+;;(mozadd-add-task "hm" 2)
+
+(defun mozadd-clear-exec-queue ()
+ (setq mozadd-current-task nil)
+ (setq mozadd-task-queue nil)
+ (when (buffer-live-p inferior-moz-buffer)
+ (with-current-buffer inferior-moz-buffer
+ (dolist (fun (buffer-local-value 'comint-preoutput-filter-functions (current-buffer)))
+ (remove-hook 'comint-preoutput-filter-functions fun t)))))
+
+(defun mozadd-add-task (input task)
+ (mozadd-add-task-1 (list input task)))
+
+(defun mozadd-add-task-1 (task)
+ (setq mozadd-task-queue (cons task mozadd-task-queue))
+ (setq mozadd-task-queue (reverse mozadd-task-queue))
+ ;;(message "add-task: mozadd-task-queue=%S, current=%s" mozadd-task-queue mozadd-current-task)
+ (mozadd-maybe-exec-next))
+
+(defun mozadd-maybe-exec-next ()
+ ;;(message "mozadd-maybe-exec-next, current=%s" mozadd-current-task)
+ (unless mozadd-current-task
+ (mozadd-exec-next)))
+
+(defun mozadd-exec-next ()
+ (when mozadd-current-task
+ (let* ((old-task mozadd-current-task) ;;(pop mozadd-task-queue))
+ (old-filter (when (listp old-task) (nth 1 old-task))))
+ (when (and old-filter (buffer-live-p inferior-moz-buffer))
+ (with-current-buffer inferior-moz-buffer
+ (remove-hook 'comint-preoutput-filter-functions old-filter t)))))
+ (setq mozadd-current-task nil)
+ (when mozadd-task-queue
+ (let* ((this (pop mozadd-task-queue))
+ (input (when (listp this) (nth 0 this)))
+ (task (when (listp this) (nth 1 this)))
+ )
+ (setq mozadd-current-task this)
+ ;;(message "EXEC: %s" this)
+ (if (not (listp this))
+ (funcall this)
+ (when (buffer-live-p inferior-moz-buffer)
+ (with-current-buffer inferior-moz-buffer
+ (add-hook 'comint-preoutput-filter-functions task nil t)))
+ (comint-send-string (inferior-moz-process) input)))))
+
+(defun mozadd-skip-current-task ()
+ ;;(message "mozadd-skip-current-task")
+ ;;(pop mozadd-task-queue)
+ (setq mozadd-current-task nil))
+
+(defun mozadd-requeue-me-as-task (input task)
+ (mozadd-skip-current-task)
+ ;;(message "mozadd-requeue-me-as-task %S %S" input task)
+ (setq mozadd-task-queue (cons (list input task) mozadd-task-queue)))
+
+(defcustom mozadd-browseable-file-extensions
+ '("html" "htm" "xhtml")
+ "File extensions possibly viewable in a web browser."
+ :type '(repeat (string :tag "File extension (without leading dot)"))
+ :group 'mozadd)
+
+(defun mozadd-html-buffer-file-p ()
+ "Return non-nil if buffer file is viewable in a web browser."
+ (when (buffer-file-name)
+ (member (file-name-extension (buffer-file-name))
+ mozadd-browseable-file-extensions)))
+
+;;;###autoload
+(define-minor-mode mozadd-mirror-mode
+ "Mirror content of current file buffer immediately in Firefox.
+When you turn on this mode the file will be opened in Firefox.
+Every change you make in the buffer will trigger a redraw in
+Firefox - regardless of if you save the file or not.
+
+For the mirroring to work the edited file must be shown in
+Firefox and visible.
+
+If `nxml-where-mode' is on the marks will also be shown in
+Firefox as CSS outline style. You can customize the style
+through the option `mozadd-xml-path-outline-style'.
+
+See also `mozadd-refresh-edited-on-save-mode'."
+ nil
+ :lighter " MozMirror"
+ :group 'mozadd
+ (if mozadd-mirror-mode
+ (unless (catch 'ok
+ (unless (mozadd-html-buffer-file-p)
+ (mozadd-warning "You can only mirror html file buffers")
+ (throw 'ok nil))
+ (when (buffer-modified-p)
+ (mozadd-warning "Please save buffer first")
+ (throw 'ok nil))
+ (let ((msg (mozadd-perhaps-start)))
+ (when msg
+ (mozadd-warning msg)
+ (throw 'ok nil)))
+ (mozadd-clear-exec-queue)
+ (setq mozadd-edited-buffer (current-buffer))
+ (mozadd-add-task (concat "content.location.href = "
+ "\"file:///" (buffer-file-name) "\";")
+ 'mozadd-get-initial-mirror-location)
+ (add-hook 'after-change-functions 'mozadd-update-mozilla t t)
+ (add-hook 'nxhtml-where-hook 'mozadd-update-mozilla t t)
+ (add-hook 'post-command-hook 'mozadd-edited-buffer-post-command)
+ t)
+ (setq mozadd-mirror-mode nil))
+ (setq mozadd-edited-buffer nil)
+ (remove-hook 'post-command-hook 'mozadd-edited-buffer-post-command)
+ (remove-hook 'nxhtml-where-hook 'mozadd-update-mozilla t)
+ (remove-hook 'after-change-functions 'mozadd-update-mozilla t)))
+(put 'mozadd-mirror-mode 'permanent-local t)
+
+;;;###autoload
+(define-globalized-minor-mode global-mozadd-mirror-mode mozadd-mirror-mode
+ (lambda ()
+ (when (mozadd-html-buffer-file-p)
+ (mozadd-mirror-mode 1))))
+
+(defun mozadd-edited-buffer-post-command ()
+ "Check if we are in a new edited buffer."
+ (when mozadd-mirror-mode
+ (setq mozadd-edited-buffer (current-buffer))))
+
+
+(defvar mozadd-buffer-content-to-mozilla-timer nil)
+
+(defun mozadd-update-mozilla (&rest ignored)
+ (when (timerp mozadd-buffer-content-to-mozilla-timer)
+ (cancel-timer mozadd-buffer-content-to-mozilla-timer))
+ (setq mozadd-buffer-content-to-mozilla-timer
+ (run-with-idle-timer 1 nil 'mozadd-queue-send-buffer-content-to-mozilla (current-buffer))))
+(put 'mozadd-update-mozilla 'permanent-local-hook t)
+
+
+(provide 'mozadd)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; mozadd.el ends here
--- /dev/null
+;;; php-imenu.el --- object-oriented, hierarchical imenu for PHP
+;;;
+;;; Maintainer: Marcel Cary <marcel-cary of care2.com>
+;;; Keywords: php languages oop
+;;; Created: 2008-06-23
+;;; Modified: 2008-07-18
+;;; X-URL: http://www.oak.homeunix.org/~marcel/blog/articles/2008/07/14/nested-imenu-for-php
+;;;
+;;; Copyright (C) 2008 Marcel Cary
+;;;
+;;; License
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;;
+;;; Usage
+;;;
+;;; Rename this file to php-imenu.el if it isn't already then place it in
+;;; your Emacs lisp path (eg. site-lisp) and add to your .emacs file:
+;;;
+;;;--------------cut here-------------------------------------------
+; ;; Load the php-imenu index function
+; (autoload 'php-imenu-create-index "php-imenu" nil t)
+; ;; Add the index creation function to the php-mode-hook
+; (add-hook 'php-mode-user-hook 'php-imenu-setup)
+; (defun php-imenu-setup ()
+; (setq imenu-create-index-function (function php-imenu-create-index))
+; ;; uncomment if you prefer speedbar:
+; ;(setq php-imenu-alist-postprocessor (function reverse))
+; (imenu-add-menubar-index)
+; )
+;;;----------------end here--------------------------------------------
+;;;
+;;; Commentary
+;;;
+;;; Refines php-mode's imenu support. Imenu provides a menubar entry called
+;;; "Index" that allows you to jump to a structural element of a file. While
+;;; php-mode generates separate lists of functions and classes in imenu,
+;;; php-imenu.el (this code) generates a tree of class and function
+;;; definitions. It lists functions under the classes in which they're
+;;; defined. The hierarchical display of functions within their classes makes
+;;; the "Index" menu far more useful in understanding the high-level structure
+;;; of a file, and it makes it easier to find a method when a file contains
+;;; multiple by the same name.
+;;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'imenu)
+(require 'thingatpt)
+
+;;; Alas, speedbar shows menu items in reverse, but only below the top level.
+;;; Provide a way to fix it. See sample configuration in file comment.
+(defvar php-imenu-alist-postprocessor (function identity))
+
+;;; Want to see properties or defines? Add an entry for them here.
+(defvar php-imenu-patterns nil)
+(setq php-imenu-patterns
+ (list
+ ;; types: classes and interfaces
+ (list
+ ;; for some reason [:space:] and \s- aren't matching \n
+ (concat "^\\s-*"
+ "\\(\\(abstract[[:space:]\n]+\\)?class\\|interface\\)"
+ "[[:space:]\n]+"
+ "\\([a-zA-Z0-9_]+\\)[[:space:]\n]*" ; class/iface name
+ "\\([a-zA-Z0-9_[:space:]\n]*\\)" ; extends / implements clauses
+ "[{]")
+ (lambda ()
+ (message "%S %S"
+ (match-string-no-properties 3)
+ (match-string-no-properties 1))
+ (concat (match-string-no-properties 3)
+ " - "
+ (match-string-no-properties 1)))
+ (lambda ()
+ (save-excursion
+ (backward-up-list 1)
+ (forward-sexp)
+ (point))))
+ ;; functions
+ (list
+ (concat "^[[:space:]\n]*"
+ "\\(\\(public\\|protected\\|private\\|"
+ "static\\|abstract\\)[[:space:]\n]+\\)*"
+ "function[[:space:]\n]*&?[[:space:]\n]*"
+ "\\([a-zA-Z0-9_]+\\)[[:space:]\n]*" ; function name
+ "[(]")
+ (lambda ()
+ (concat (match-string-no-properties 3) "()"))
+ (lambda ()
+ (save-excursion
+ (backward-up-list 1)
+ (forward-sexp)
+ (when (not (looking-at "\\s-*;"))
+ (forward-sexp))
+ (point))))
+ ))
+
+;;; Global variable to pass to imenu-progress-message in multiple functions
+(defvar php-imenu-prev-pos nil)
+
+;;; An implementation of imenu-create-index-function
+(defun php-imenu-create-index ()
+ (let (prev-pos)
+ (imenu-progress-message php-imenu-prev-pos 0)
+ (let ((result (php-imenu-create-index-helper (point-min) (point-max) nil)))
+ ;(message "bye %S" result)
+ (imenu-progress-message php-imenu-prev-pos 100)
+ result)))
+
+(defun php-imenu-create-index-helper (min max name)
+ (let ((combined-pattern
+ (concat "\\("
+ (mapconcat
+ (function (lambda (pat) (first pat)))
+ php-imenu-patterns "\\)\\|\\(")
+ "\\)"))
+ (index-alist '()))
+ (goto-char min)
+ (save-match-data
+ (while (re-search-forward combined-pattern max t)
+ (let ((pos (set-marker (make-marker) (match-beginning 0)))
+ (min (match-end 0))
+ (pat (save-excursion
+ (goto-char (match-beginning 0))
+ (find-if (function
+ (lambda (pat) (looking-at (first pat))))
+ php-imenu-patterns))))
+ (when (not pat)
+ (message "php-imenu: How can no pattern get us here! %S" pos))
+ (when (and pat
+ (not (php-imenu-in-string-p))
+ )
+ (let* ((name (funcall (second pat)))
+ (max (funcall (third pat)))
+ (children (php-imenu-create-index-helper min max name)))
+ ;; should validate max: what happens if unmatched curly?
+ ;(message "%S %S %S" nm name (mapcar (function first) children))
+ (if (equal '() children)
+ (push (cons name pos) index-alist)
+ (push (cons name
+ (funcall php-imenu-alist-postprocessor
+ (cons (cons "*go*" pos)
+ children)))
+ index-alist))
+ ))
+ (imenu-progress-message php-imenu-prev-pos nil)
+ )))
+ (reverse index-alist)))
+
+;;; Recognize when in quoted strings or heredoc-style string literals
+(defun php-imenu-in-string-p ()
+ (save-match-data
+ (or (in-string-p)
+ (let ((pt (point)))
+ (save-excursion
+ (and (re-search-backward "<<<\\([A-Za-z0-9_]+\\)$" nil t)
+ (not (re-search-forward (concat "^"
+ (match-string-no-properties 1)
+ ";$")
+ pt t))))))))
--- /dev/null
+;;; php-mode.el --- major mode for editing PHP code
+
+;; Copyright (C) 1999, 2000, 2001, 2003, 2004 Turadg Aleahmad
+;; 2008 Aaron S. Hawley
+
+;; Maintainer: Aaron S. Hawley <ashawley at users.sourceforge.net>
+;; Author: Turadg Aleahmad, 1999-2004
+;; Keywords: php languages oop
+;; Created: 1999-05-17
+;; Modified: 2008-11-28 Fri
+;; X-URL: http://php-mode.sourceforge.net/
+
+(defconst php-mode-version-number "1.5.0-nxhtml-1.94"
+ "PHP Mode version number.")
+
+;;; License
+
+;; This file is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 3
+;; of the License, or (at your option) any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this file; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Usage
+
+;; Put this file in your Emacs lisp path (eg. site-lisp) and add to
+;; your .emacs file:
+;;
+;; (require 'php-mode)
+
+;; To use abbrev-mode, add lines like this:
+;; (add-hook 'php-mode-hook
+;; '(lambda () (define-abbrev php-mode-abbrev-table "ex" "extends")))
+
+;; To make php-mode compatible with html-mode, see http://php-mode.sf.net
+
+;; Many options available under Help:Customize
+;; Options specific to php-mode are in
+;; Programming/Languages/Php
+;; Since it inherits much functionality from c-mode, look there too
+;; Programming/Languages/C
+
+;;; Commentary:
+
+;; PHP mode is a major mode for editing PHP 3 and 4 source code. It's
+;; an extension of C mode; thus it inherits all C mode's navigation
+;; functionality. But it colors according to the PHP grammar and indents
+;; according to the PEAR coding guidelines. It also includes a couple
+;; handy IDE-type features such as documentation search and a source
+;; and class browser.
+
+;;; Contributors: (in chronological order)
+
+;; Juanjo, Torsten Martinsen, Vinai Kopp, Sean Champ, Doug Marcey,
+;; Kevin Blake, Rex McMaster, Mathias Meyer, Boris Folgmann, Roland
+;; Rosenfeld, Fred Yankowski, Craig Andrews, John Keller, Ryan
+;; Sammartino, ppercot, Valentin Funk, Stig Bakken, Gregory Stark,
+;; Chris Morris, Nils Rennebarth, Gerrit Riessen, Eric Mc Sween,
+;; Ville Skytta, Giacomo Tesio, Lennart Borgman, Stefan Monnier,
+;; Aaron S. Hawley, Ian Eure, Bill Lovett, Dias Badekas, David House
+
+;;; Changelog:
+
+;; 1.5.0-nxhtml-1.88 (Lennart Borgman)
+;; Don't indent heredoc end mark
+;; 1.5.0-nxhtml-1.61 (Lennart Borgman)
+;; Added php-mode-to-use.
+;; Made underscore be part of identifiers.
+;; Remove php-mode-to.
+;; Make the indentation check only on current line.
+;; Warn only once per session about indentation.
+;; Tell if can't complete in `php-complete-function'.
+;; Move back point after checking indentation in
+;; `php-check-html-for-indentation'.
+;; Add `c-at-vsemi-p-fn' etc after advice from Alan Mackenzie.
+;;
+;; 1.5
+;; Support function keywords like public, private and the ampersand
+;; character for function-based commands. Support abstract, final,
+;; static, public, private and protected keywords in Imenu. Fix
+;; reversed order of Imenu entries. Use font-lock-preprocessor-face
+;; for PHP and ASP tags. Make php-mode-modified a literal value
+;; rather than a computed string. Add date and time constants of
+;; PHP. (Dias Badekas) Fix false syntax highlighting of keywords
+;; because of underscore character. Change HTML indentation warning
+;; to match only HTML at the beginning of the line. Fix
+;; byte-compiler warnings. Clean-up whitespace and audited style
+;; consistency of code. Remove conditional bindings and XEmacs code
+;; that likely does nothing.
+;;
+;; 1.4
+;; Updated GNU GPL to version 3. Ported to Emacs 22 (CC mode
+;; 5.31). M-x php-mode-version shows version. Provide end-of-defun
+;; beginning-of-defun functionality. Support add-log library.
+;; Fix __CLASS__ constant (Ian Eure). Allow imenu to see visibility
+;; declarations -- "private", "public", "protected". (Bill Lovett)
+;;
+;; 1.3
+;; Changed the definition of # using a tip from Stefan
+;; Monnier to correct highlighting and indentation. (Lennart Borgman)
+;; Changed the highlighting of the HTML part. (Lennart Borgman)
+;;
+;; See the ChangeLog file included with the source package.
+
+
+;;; Code:
+
+(require 'add-log)
+(require 'speedbar)
+(require 'font-lock)
+(require 'cc-mode)
+(require 'cc-langs)
+(require 'custom)
+(require 'etags)
+(eval-when-compile
+ (require 'regexp-opt))
+\f
+;; Local variables
+;;;###autoload
+(defgroup php nil
+ "Major mode `php-mode' for editing PHP code."
+ :prefix "php-"
+ :group 'languages)
+
+(defcustom php-default-face 'default
+ "Default face in `php-mode' buffers."
+ :type 'face
+ :group 'php)
+
+(defcustom php-speedbar-config t
+ "When set to true automatically configures Speedbar to observe PHP files.
+Ignores php-file patterns option; fixed to expression \"\\.\\(inc\\|php[s34]?\\)\""
+ :type 'boolean
+ :set (lambda (sym val)
+ (set-default sym val)
+ (if (and val (boundp 'speedbar))
+ (speedbar-add-supported-extension
+ "\\.\\(inc\\|php[s34]?\\|phtml\\)")))
+ :group 'php)
+
+(defcustom php-mode-speedbar-open nil
+ "Normally `php-mode' starts with the speedbar closed.
+Turning this on will open it whenever `php-mode' is loaded."
+ :type 'boolean
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when val
+ (speedbar 1)))
+ :group 'php)
+
+(defvar php-imenu-generic-expression
+ '(
+ ("Private Methods"
+ "^\\s-*\\(?:\\(?:abstract\\|final\\)\\s-+\\)?private\\s-+\\(?:static\\s-+\\)?function\\s-+\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(" 1)
+ ("Protected Methods"
+ "^\\s-*\\(?:\\(?:abstract\\|final\\)\\s-+\\)?protected\\s-+\\(?:static\\s-+\\)?function\\s-+\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(" 1)
+ ("Public Methods"
+ "^\\s-*\\(?:\\(?:abstract\\|final\\)\\s-+\\)?public\\s-+\\(?:static\\s-+\\)?function\\s-+\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(" 1)
+ ("Classes"
+ "^\\s-*class\\s-+\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*" 1)
+ ("All Functions"
+ "^\\s-*\\(?:\\(?:abstract\\|final\\|private\\|protected\\|public\\|static\\)\\s-+\\)*function\\s-+\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(" 1)
+ )
+ "Imenu generic expression for PHP Mode. See `imenu-generic-expression'."
+ )
+
+(defcustom php-manual-url "http://www.php.net/manual/en/"
+ "URL at which to find PHP manual.
+You can replace \"en\" with your ISO language code."
+ :type 'string
+ :group 'php)
+
+(defcustom php-search-url "http://www.php.net/"
+ "URL at which to search for documentation on a word."
+ :type 'string
+ :group 'php)
+
+(defcustom php-completion-file ""
+ "Path to the file which contains the function names known to PHP."
+ :type 'string
+ :group 'php)
+
+(defcustom php-manual-path ""
+ "Path to the directory which contains the PHP manual."
+ :type 'string
+ :group 'php)
+
+;;;###autoload
+(defcustom php-file-patterns '("\\.php[s34]?\\'" "\\.phtml\\'" "\\.inc\\'")
+ "List of file patterns for which to automatically invoke `php-mode'."
+ :type '(repeat (regexp :tag "Pattern"))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (let ((php-file-patterns-temp val))
+ (while php-file-patterns-temp
+ (add-to-list 'auto-mode-alist
+ (cons (car php-file-patterns-temp) 'php-mode))
+ (setq php-file-patterns-temp (cdr php-file-patterns-temp)))))
+ :group 'php)
+
+(defcustom php-mode-hook nil
+ "List of functions to be executed on entry to `php-mode'."
+ :type 'hook
+ :group 'php)
+
+(defcustom php-mode-pear-hook nil
+ "Hook called when a PHP PEAR file is opened with `php-mode'."
+ :type 'hook
+ :group 'php)
+
+(defcustom php-mode-force-pear nil
+ "Normally PEAR coding rules are enforced only when the filename contains \"PEAR.\"
+Turning this on will force PEAR rules on all PHP files."
+ :type 'boolean
+ :group 'php)
+\f
+(defconst php-mode-modified "2009-08-12"
+ "PHP Mode build date.")
+
+(defun php-mode-version ()
+ "Display string describing the version of PHP mode."
+ (interactive)
+ (message "PHP mode %s of %s"
+ php-mode-version-number php-mode-modified))
+
+(defconst php-beginning-of-defun-regexp
+ "^\\s-*\\(?:\\(?:abstract\\|final\\|private\\|protected\\|public\\|static\\)\\s-+\\)*function\\s-+&?\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*("
+ "Regular expression for a PHP function.")
+
+(defun php-beginning-of-defun (&optional arg)
+ "Move to the beginning of the ARGth PHP function from point.
+Implements PHP version of `beginning-of-defun-function'."
+ (interactive "p")
+ (let ((arg (or arg 1)))
+ (while (> arg 0)
+ (re-search-backward php-beginning-of-defun-regexp
+ nil 'noerror)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (end-of-line 1)
+ (let ((opoint (point)))
+ (beginning-of-defun 1)
+ (forward-list 2)
+ (forward-line 1)
+ (if (eq opoint (point))
+ (re-search-forward php-beginning-of-defun-regexp
+ nil 'noerror))
+ (setq arg (1+ arg))))))
+
+(defun php-end-of-defun (&optional arg)
+ "Move the end of the ARGth PHP function from point.
+Implements PHP befsion of `end-of-defun-function'
+
+See `php-beginning-of-defun'."
+ (interactive "p")
+ (php-beginning-of-defun (- (or arg 1))))
+
+\f
+(defvar php-warned-bad-indent nil)
+;;(make-variable-buffer-local 'php-warned-bad-indent)
+
+;; Do it but tell it is not good if html tags in buffer.
+(defun php-check-html-for-indentation ()
+ (let ((html-tag-re "^\\s-*</?\\sw+.*?>")
+ (here (point)))
+ (goto-char (line-beginning-position))
+ (if (or (when (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ ;; Fix-me: no idea how to check for mmm or multi-mode
+ (save-match-data
+ (not (or (re-search-forward html-tag-re (line-end-position) t)
+ (re-search-backward html-tag-re (line-beginning-position) t)))))
+ (progn
+ (goto-char here)
+ t)
+ (goto-char here)
+ (setq php-warned-bad-indent t)
+ ;;(setq php-warned-bad-indent nil)
+ (let* ((known-multi-libs '(("mumamo" mumamo (lambda () (nxhtml-mumamo)))
+ ("mmm-mode" mmm-mode (lambda () (mmm-mode 1)))
+ ("multi-mode" multi-mode (lambda () (multi-mode 1)))))
+ (known-names (mapcar (lambda (lib) (car lib)) known-multi-libs))
+ (available-multi-libs (delq nil
+ (mapcar
+ (lambda (lib)
+ (when (locate-library (car lib)) lib))
+ known-multi-libs)))
+ (available-names (mapcar (lambda (lib) (car lib)) available-multi-libs))
+ (base-msg
+ (concat
+ "Indentation fails badly with mixed HTML/PHP in the HTML part in
+plaín `php-mode'. To get indentation to work you must use an
+Emacs library that supports 'multiple major modes' in a buffer.
+Parts of the buffer will then be in `php-mode' and parts in for
+example `html-mode'. Known such libraries are:\n\t"
+ (mapconcat 'identity known-names ", ")
+ "\n"
+ (if available-multi-libs
+ (concat
+ "You have these available in your `load-path':\n\t"
+ (mapconcat 'identity available-names ", ")
+ "\n\n"
+ "Do you want to turn any of those on? ")
+ "You do not have any of those in your `load-path'.")))
+ (is-using-multi
+ (catch 'is-using
+ (dolist (lib available-multi-libs)
+ (when (and (boundp (cadr lib))
+ (symbol-value (cadr lib)))
+ (throw 'is-using t))))))
+ (unless is-using-multi
+ (if available-multi-libs
+ (if (not (y-or-n-p base-msg))
+ (message "Did not do indentation, but you can try again now if you want")
+ (let* ((name
+ (if (= 1 (length available-multi-libs))
+ (car available-names)
+ ;; Minibuffer window is more than one line, fix that first:
+ (message "")
+ (completing-read "Choose multiple major mode support library: "
+ available-names nil t
+ (car available-names)
+ '(available-names . 1)
+ )))
+ (mode (when name
+ (caddr (assoc name available-multi-libs)))))
+ (when mode
+ ;; Minibuffer window is more than one line, fix that first:
+ (message "")
+ (load name)
+ (funcall mode))))
+ (lwarn 'php-indent :warning base-msg)))
+ nil))))
+
+(defun php-cautious-indent-region (start end &optional quiet)
+ (if (or php-warned-bad-indent
+ (php-check-html-for-indentation))
+ (funcall 'c-indent-region start end quiet)))
+
+(defun php-cautious-indent-line ()
+ (if (or php-warned-bad-indent
+ (php-check-html-for-indentation))
+ (let ((here (point))
+ doit)
+ (move-beginning-of-line nil)
+ ;; Don't indent heredoc end mark
+ (save-match-data
+ (unless (looking-at "[a-zA-Z0-9_]+;\n")
+ (setq doit t)))
+ (goto-char here)
+ (when doit
+ (funcall 'c-indent-line)))))
+
+(defconst php-tags '("<?php" "?>" "<?" "<?="))
+(defconst php-tags-key (regexp-opt php-tags))
+
+(defconst php-block-stmt-1-kwds '("do" "else" "finally" "try"))
+(defconst php-block-stmt-2-kwds
+ '("for" "if" "while" "switch" "foreach" "elseif" "catch all"))
+
+(defconst php-block-stmt-1-key
+ (regexp-opt php-block-stmt-1-kwds))
+(defconst php-block-stmt-2-key
+ (regexp-opt php-block-stmt-2-kwds))
+
+(defconst php-class-decl-kwds '("class" "interface"))
+
+(defconst php-class-key
+ (concat
+ "\\(" (regexp-opt php-class-decl-kwds) "\\)\\s-+"
+ (c-lang-const c-symbol-key c) ;; Class name.
+ "\\(\\s-+extends\\s-+" (c-lang-const c-symbol-key c) "\\)?" ;; Name of superclass.
+ "\\(\\s-+implements\\s-+[^{]+{\\)?")) ;; List of any adopted protocols.
+
+
+(defun php-c-at-vsemi-p (&optional pos)
+ "Return t on html lines (including php region border), otherwise nil.
+POS is a position on the line in question.
+
+This is was done due to the problem reported here:
+
+ URL `https://answers.launchpad.net/nxhtml/+question/43320'"
+ (setq pos (or pos (point)))
+ (let ((here (point))
+ ret)
+ (save-match-data
+ (goto-char pos)
+ (beginning-of-line)
+ (setq ret (looking-at
+ (rx
+ (or (seq
+ bol
+ (0+ space)
+ "<"
+ (in "a-z\\?"))
+ (seq
+ ;;(0+ anything)
+ (0+ not-newline)
+ (in "a-z\\?")
+ ">"
+ (0+ space)
+ eol))))))
+ (goto-char here)
+ ret))
+
+(defun php-c-vsemi-status-unknown-p ()
+ "See `php-c-at-vsemi-p'."
+ )
+
+;;;###autoload
+(define-derived-mode php-mode c-mode "PHP"
+ "Major mode for editing PHP code.\n\n\\{php-mode-map}"
+ (c-add-language 'php-mode 'c-mode)
+
+;; PHP doesn't have C-style macros.
+;; HACK: Overwrite this syntax with rules to match <?php and others.
+;; (c-lang-defconst c-opt-cpp-start php php-tags-key)
+;; (c-lang-defvar c-opt-cpp-start (c-lang-const c-opt-cpp-start))
+ (set (make-local-variable 'c-opt-cpp-start) php-tags-key)
+;; (c-lang-defconst c-opt-cpp-start php php-tags-key)
+;; (c-lang-defvar c-opt-cpp-start (c-lang-const c-opt-cpp-start))
+ (set (make-local-variable 'c-opt-cpp-prefix) php-tags-key)
+
+ (c-set-offset 'cpp-macro 0)
+
+;; (c-lang-defconst c-block-stmt-1-kwds php php-block-stmt-1-kwds)
+;; (c-lang-defvar c-block-stmt-1-kwds (c-lang-const c-block-stmt-1-kwds))
+ (set (make-local-variable 'c-block-stmt-1-key) php-block-stmt-1-key)
+
+;; (c-lang-defconst c-block-stmt-2-kwds php php-block-stmt-2-kwds)
+;; (c-lang-defvar c-block-stmt-2-kwds (c-lang-const c-block-stmt-2-kwds))
+ (set (make-local-variable 'c-block-stmt-2-key) php-block-stmt-2-key)
+
+ ;; Specify that cc-mode recognize Javadoc comment style
+ (set (make-local-variable 'c-doc-comment-style)
+ '((php-mode . javadoc)))
+
+;; (c-lang-defconst c-class-decl-kwds
+;; php php-class-decl-kwds)
+ (set (make-local-variable 'c-class-key) php-class-key)
+
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults
+ '((php-font-lock-keywords-1
+ php-font-lock-keywords-2
+ ;; Comment-out the next line if the font-coloring is too
+ ;; extreme/ugly for you.
+ php-font-lock-keywords-3)
+ nil ; KEYWORDS-ONLY
+ t ; CASE-FOLD
+ (("_" . "w")) ; SYNTAX-ALIST
+ nil)) ; SYNTAX-BEGIN
+ (modify-syntax-entry ?# "< b" php-mode-syntax-table)
+ ;;(modify-syntax-entry ?_ "w" php-mode-syntax-table)
+
+ ;; Electric behaviour must be turned off, they do not work since
+ ;; they can not find the correct syntax in embedded PHP.
+ ;;
+ ;; Seems to work with narrowing so let it be on if the user prefers it.
+ ;;(setq c-electric-flag nil)
+
+ (setq font-lock-maximum-decoration t
+ case-fold-search t ; PHP vars are case-sensitive
+ imenu-generic-expression php-imenu-generic-expression)
+
+ ;; Do not force newline at end of file. Such newlines can cause
+ ;; trouble if the PHP file is included in another file before calls
+ ;; to header() or cookie().
+ (set (make-local-variable 'require-final-newline) nil)
+ (set (make-local-variable 'next-line-add-newlines) nil)
+
+ ;; PEAR coding standards
+ (add-hook 'php-mode-pear-hook
+ (lambda ()
+ (set (make-local-variable 'tab-width) 4)
+ (set (make-local-variable 'c-basic-offset) 4)
+ (set (make-local-variable 'indent-tabs-mode) nil)
+ (c-set-offset 'block-open' - )
+ (c-set-offset 'block-close' 0 )) nil t)
+
+ (if (or php-mode-force-pear
+ (and (stringp buffer-file-name)
+ (string-match "PEAR\\|pear"
+ (buffer-file-name))
+ (string-match "\\.php$" (buffer-file-name))))
+ (run-hooks 'php-mode-pear-hook))
+
+ (setq indent-line-function 'php-cautious-indent-line)
+ (setq indent-region-function 'php-cautious-indent-region)
+ (setq c-special-indent-hook nil)
+ (setq c-at-vsemi-p-fn 'php-c-at-vsemi-p)
+ (setq c-vsemi-status-unknown-p 'php-c-vsemi-status-unknown-p)
+
+ (set (make-local-variable 'syntax-begin-function)
+ 'c-beginning-of-syntax)
+ (set (make-local-variable 'beginning-of-defun-function)
+ 'php-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ 'php-end-of-defun)
+ (set (make-local-variable 'open-paren-in-column-0-is-defun-start)
+ nil)
+ (set (make-local-variable 'defun-prompt-regexp)
+ "^\\s-*function\\s-+&?\\s-*\\(\\(\\sw\\|\\s_\\)+\\)\\s-*")
+ (set (make-local-variable 'add-log-current-defun-header-regexp)
+ php-beginning-of-defun-regexp)
+
+ (run-hooks 'php-mode-hook))
+\f
+;; Make a menu keymap (with a prompt string)
+;; and make it the menu bar item's definition.
+(define-key php-mode-map [menu-bar] (make-sparse-keymap))
+(define-key php-mode-map [menu-bar php]
+ (cons "PHP" (make-sparse-keymap "PHP")))
+
+;; Define specific subcommands in this menu.
+(define-key php-mode-map [menu-bar php complete-function]
+ '("Complete function name" . php-complete-function))
+(define-key php-mode-map
+ [menu-bar php browse-manual]
+ '("Browse manual" . php-browse-manual))
+(define-key php-mode-map
+ [menu-bar php search-documentation]
+ '("Search documentation" . php-search-documentation))
+\f
+;; Define function name completion function
+(defvar php-completion-table nil
+ "Obarray of tag names defined in current tags table and functions known to PHP.")
+
+(defun php-complete-function ()
+ "Perform function completion on the text around point.
+Completes to the set of names listed in the current tags table
+and the standard php functions.
+The string to complete is chosen in the same way as the default
+for \\[find-tag] (which see)."
+ (interactive)
+ (let ((pattern (php-get-pattern))
+ beg
+ completion
+ (php-functions (php-completion-table)))
+ (if (not pattern) (message "Nothing to complete")
+ (if (not (search-backward pattern nil t))
+ (message "Can't complete here")
+ (setq beg (point))
+ (forward-char (length pattern))
+ (setq completion (try-completion pattern php-functions nil))
+ (cond ((eq completion t))
+ ((null completion)
+ (message "Can't find completion for \"%s\"" pattern)
+ (ding))
+ ((not (string= pattern completion))
+ (delete-region beg (point))
+ (insert completion))
+ (t
+ (message "Making completion list...")
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list
+ (all-completions pattern php-functions)))
+ (message "Making completion list...%s" "done")))))))
+
+(defun php-completion-table ()
+ "Build variable `php-completion-table' on demand.
+The table includes the PHP functions and the tags from the
+current `tags-file-name'."
+ (or (and tags-file-name
+ (save-excursion (tags-verify-table tags-file-name))
+ php-completion-table)
+ (let ((tags-table
+ (if (and tags-file-name
+ (functionp 'etags-tags-completion-table))
+ (with-current-buffer (get-file-buffer tags-file-name)
+ (etags-tags-completion-table))
+ nil))
+ (php-table
+ (cond ((and (not (string= "" php-completion-file))
+ (file-readable-p php-completion-file))
+ (php-build-table-from-file php-completion-file))
+ (php-manual-path
+ (php-build-table-from-path php-manual-path))
+ (t nil))))
+ (unless (or php-table tags-table)
+ (error
+ (concat "No TAGS file active nor are "
+ "`php-completion-file' or `php-manual-path' set")))
+ (when tags-table
+ ;; Combine the tables.
+ (mapatoms (lambda (sym) (intern (symbol-name sym) php-table))
+ tags-table))
+ (setq php-completion-table php-table))))
+
+(defun php-build-table-from-file (filename)
+ (let ((table (make-vector 1022 0))
+ (buf (find-file-noselect filename)))
+ (save-excursion
+ (set-buffer buf)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\([-a-zA-Z0-9_.]+\\)\n"
+ nil t)
+ (intern (buffer-substring (match-beginning 1) (match-end 1))
+ table)))
+ (kill-buffer buf)
+ table))
+
+(defun php-build-table-from-path (path)
+ (let ((table (make-vector 1022 0))
+ (files (directory-files
+ path
+ nil
+ "^function\\..+\\.html$")))
+ (mapc (lambda (file)
+ (string-match "\\.\\([-a-zA-Z_0-9]+\\)\\.html$" file)
+ (intern
+ (replace-regexp-in-string
+ "-" "_" (substring file (match-beginning 1) (match-end 1)) t)
+ table))
+ files)
+ table))
+
+;; Find the pattern we want to complete
+;; find-tag-default from GNU Emacs etags.el
+(defun php-get-pattern ()
+ (save-excursion
+ (while (looking-at "\\sw\\|\\s_")
+ (forward-char 1))
+ (if (or (re-search-backward "\\sw\\|\\s_"
+ (save-excursion (beginning-of-line) (point))
+ t)
+ (re-search-forward "\\(\\sw\\|\\s_\\)+"
+ (save-excursion (end-of-line) (point))
+ t))
+ (progn (goto-char (match-end 0))
+ (buffer-substring-no-properties
+ (point)
+ (progn (forward-sexp -1)
+ (while (looking-at "\\s'")
+ (forward-char 1))
+ (point))))
+ nil)))
+
+(defun php-show-arglist ()
+ (interactive)
+ (let* ((tagname (php-get-pattern))
+ (buf (find-tag-noselect tagname nil nil))
+ arglist)
+ (save-excursion
+ (set-buffer buf)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (format "function\\s-+%s\\s-*(\\([^{]*\\))" tagname)
+ nil t)
+ (setq arglist (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1)))))
+ (if arglist
+ (message "Arglist for %s: %s" tagname arglist)
+ (message "Unknown function: %s" tagname))))
+\f
+;; Define function documentation function
+(defun php-search-documentation ()
+ "Search PHP documentation for the word at point."
+ (interactive)
+ (browse-url (concat php-search-url (current-word t))))
+
+;; Define function for browsing manual
+(defun php-browse-manual ()
+ "Bring up manual for PHP."
+ (interactive)
+ (browse-url php-manual-url))
+
+;; Define shortcut
+(define-key php-mode-map
+ "\C-c\C-f"
+ 'php-search-documentation)
+
+;; Define shortcut
+(define-key php-mode-map
+ [(meta tab)]
+ 'php-complete-function)
+
+;; Define shortcut
+(define-key php-mode-map
+ "\C-c\C-m"
+ 'php-browse-manual)
+
+;; Define shortcut
+(define-key php-mode-map
+ '[(control .)]
+ 'php-show-arglist)
+
+;; Use the Emacs standard indentation binding. This may upset c-mode
+;; which does not follow this at the moment, but I see no better
+;; choice.
+(define-key php-mode-map [?\t] 'indent-for-tab-command)
+
+\f
+(defconst php-constants
+ (eval-when-compile
+ (regexp-opt
+ '(;; core constants
+ "__LINE__" "__FILE__"
+ "__FUNCTION__" "__CLASS__" "__METHOD__"
+ "PHP_OS" "PHP_VERSION"
+ "TRUE" "FALSE" "NULL"
+ "E_ERROR" "E_NOTICE" "E_PARSE" "E_WARNING" "E_ALL" "E_STRICT"
+ "E_USER_ERROR" "E_USER_WARNING" "E_USER_NOTICE"
+ "DEFAULT_INCLUDE_PATH" "PEAR_INSTALL_DIR" "PEAR_EXTENSION_DIR"
+ "PHP_BINDIR" "PHP_LIBDIR" "PHP_DATADIR" "PHP_SYSCONFDIR"
+ "PHP_LOCALSTATEDIR" "PHP_CONFIG_FILE_PATH"
+ "PHP_EOL"
+
+ ;; date and time constants
+ "DATE_ATOM" "DATE_COOKIE" "DATE_ISO8601"
+ "DATE_RFC822" "DATE_RFC850" "DATE_RFC1036" "DATE_RFC1123"
+ "DATE_RFC2822" "DATE_RFC3339"
+ "DATE_RSS" "DATE_W3C"
+
+ ;; from ext/standard:
+ "EXTR_OVERWRITE" "EXTR_SKIP" "EXTR_PREFIX_SAME"
+ "EXTR_PREFIX_ALL" "EXTR_PREFIX_INVALID" "SORT_ASC" "SORT_DESC"
+ "SORT_REGULAR" "SORT_NUMERIC" "SORT_STRING" "ASSERT_ACTIVE"
+ "ASSERT_CALLBACK" "ASSERT_BAIL" "ASSERT_WARNING"
+ "ASSERT_QUIET_EVAL" "CONNECTION_ABORTED" "CONNECTION_NORMAL"
+ "CONNECTION_TIMEOUT" "M_E" "M_LOG2E" "M_LOG10E" "M_LN2"
+ "M_LN10" "M_PI" "M_PI_2" "M_PI_4" "M_1_PI" "M_2_PI"
+ "M_2_SQRTPI" "M_SQRT2" "M_SQRT1_2" "CRYPT_SALT_LENGTH"
+ "CRYPT_STD_DES" "CRYPT_EXT_DES" "CRYPT_MD5" "CRYPT_BLOWFISH"
+ "DIRECTORY_SEPARATOR" "SEEK_SET" "SEEK_CUR" "SEEK_END"
+ "LOCK_SH" "LOCK_EX" "LOCK_UN" "LOCK_NB" "HTML_SPECIALCHARS"
+ "HTML_ENTITIES" "ENT_COMPAT" "ENT_QUOTES" "ENT_NOQUOTES"
+ "INFO_GENERAL" "INFO_CREDITS" "INFO_CONFIGURATION"
+ "INFO_ENVIRONMENT" "INFO_VARIABLES" "INFO_LICENSE" "INFO_ALL"
+ "CREDITS_GROUP" "CREDITS_GENERAL" "CREDITS_SAPI"
+ "CREDITS_MODULES" "CREDITS_DOCS" "CREDITS_FULLPAGE"
+ "CREDITS_QA" "CREDITS_ALL" "PHP_OUTPUT_HANDLER_START"
+ "PHP_OUTPUT_HANDLER_CONT" "PHP_OUTPUT_HANDLER_END"
+ "STR_PAD_LEFT" "STR_PAD_RIGHT" "STR_PAD_BOTH"
+ "PATHINFO_DIRNAME" "PATHINFO_BASENAME" "PATHINFO_EXTENSION"
+ "CHAR_MAX" "LC_CTYPE" "LC_NUMERIC" "LC_TIME" "LC_COLLATE"
+ "LC_MONETARY" "LC_ALL" "LC_MESSAGES" "LOG_EMERG" "LOG_ALERT"
+ "LOG_CRIT" "LOG_ERR" "LOG_WARNING" "LOG_NOTICE" "LOG_INFO"
+ "LOG_DEBUG" "LOG_KERN" "LOG_USER" "LOG_MAIL" "LOG_DAEMON"
+ "LOG_AUTH" "LOG_SYSLOG" "LOG_LPR" "LOG_NEWS" "LOG_UUCP"
+ "LOG_CRON" "LOG_AUTHPRIV" "LOG_LOCAL0" "LOG_LOCAL1"
+ "LOG_LOCAL2" "LOG_LOCAL3" "LOG_LOCAL4" "LOG_LOCAL5"
+ "LOG_LOCAL6" "LOG_LOCAL7" "LOG_PID" "LOG_CONS" "LOG_ODELAY"
+ "LOG_NDELAY" "LOG_NOWAIT" "LOG_PERROR"
+
+ ;; Disabled by default because they slow buffer loading
+ ;; If you have use for them, uncomment the strings
+ ;; that you want colored.
+ ;; To compile, you may have to increase 'max-specpdl-size'
+
+ ;; from other bundled extensions:
+; "CAL_EASTER_TO_xxx" "VT_NULL" "VT_EMPTY" "VT_UI1" "VT_I2"
+; "VT_I4" "VT_R4" "VT_R8" "VT_BOOL" "VT_ERROR" "VT_CY" "VT_DATE"
+; "VT_BSTR" "VT_DECIMAL" "VT_UNKNOWN" "VT_DISPATCH" "VT_VARIANT"
+; "VT_I1" "VT_UI2" "VT_UI4" "VT_INT" "VT_UINT" "VT_ARRAY"
+; "VT_BYREF" "CP_ACP" "CP_MACCP" "CP_OEMCP" "CP_SYMBOL"
+; "CP_THREAD_ACP" "CP_UTF7" "CP_UTF8" "CPDF_PM_NONE"
+; "CPDF_PM_OUTLINES" "CPDF_PM_THUMBS" "CPDF_PM_FULLSCREEN"
+; "CPDF_PL_SINGLE" "CPDF_PL_1COLUMN" "CPDF_PL_2LCOLUMN"
+; "CPDF_PL_2RCOLUMN" "CURLOPT_PORT" "CURLOPT_FILE"
+; "CURLOPT_INFILE" "CURLOPT_INFILESIZE" "CURLOPT_URL"
+; "CURLOPT_PROXY" "CURLOPT_VERBOSE" "CURLOPT_HEADER"
+; "CURLOPT_HTTPHEADER" "CURLOPT_NOPROGRESS" "CURLOPT_NOBODY"
+; "CURLOPT_FAILONERROR" "CURLOPT_UPLOAD" "CURLOPT_POST"
+; "CURLOPT_FTPLISTONLY" "CURLOPT_FTPAPPEND" "CURLOPT_NETRC"
+; "CURLOPT_FOLLOWLOCATION" "CURLOPT_FTPASCII" "CURLOPT_PUT"
+; "CURLOPT_MUTE" "CURLOPT_USERPWD" "CURLOPT_PROXYUSERPWD"
+; "CURLOPT_RANGE" "CURLOPT_TIMEOUT" "CURLOPT_POSTFIELDS"
+; "CURLOPT_REFERER" "CURLOPT_USERAGENT" "CURLOPT_FTPPORT"
+; "CURLOPT_LOW_SPEED_LIMIT" "CURLOPT_LOW_SPEED_TIME"
+; "CURLOPT_RESUME_FROM" "CURLOPT_COOKIE" "CURLOPT_SSLCERT"
+; "CURLOPT_SSLCERTPASSWD" "CURLOPT_WRITEHEADER"
+; "CURLOPT_COOKIEFILE" "CURLOPT_SSLVERSION"
+; "CURLOPT_TIMECONDITION" "CURLOPT_TIMEVALUE"
+; "CURLOPT_CUSTOMREQUEST" "CURLOPT_STDERR" "CURLOPT_TRANSFERTEXT"
+; "CURLOPT_RETURNTRANSFER" "CURLOPT_QUOTE" "CURLOPT_POSTQUOTE"
+; "CURLOPT_INTERFACE" "CURLOPT_KRB4LEVEL"
+; "CURLOPT_HTTPPROXYTUNNEL" "CURLOPT_FILETIME"
+; "CURLOPT_WRITEFUNCTION" "CURLOPT_READFUNCTION"
+; "CURLOPT_PASSWDFUNCTION" "CURLOPT_HEADERFUNCTION"
+; "CURLOPT_MAXREDIRS" "CURLOPT_MAXCONNECTS" "CURLOPT_CLOSEPOLICY"
+; "CURLOPT_FRESH_CONNECT" "CURLOPT_FORBID_REUSE"
+; "CURLOPT_RANDOM_FILE" "CURLOPT_EGDSOCKET"
+; "CURLOPT_CONNECTTIMEOUT" "CURLOPT_SSL_VERIFYPEER"
+; "CURLOPT_CAINFO" "CURLOPT_BINARYTRANSER"
+; "CURLCLOSEPOLICY_LEAST_RECENTLY_USED" "CURLCLOSEPOLICY_OLDEST"
+; "CURLINFO_EFFECTIVE_URL" "CURLINFO_HTTP_CODE"
+; "CURLINFO_HEADER_SIZE" "CURLINFO_REQUEST_SIZE"
+; "CURLINFO_TOTAL_TIME" "CURLINFO_NAMELOOKUP_TIME"
+; "CURLINFO_CONNECT_TIME" "CURLINFO_PRETRANSFER_TIME"
+; "CURLINFO_SIZE_UPLOAD" "CURLINFO_SIZE_DOWNLOAD"
+; "CURLINFO_SPEED_DOWNLOAD" "CURLINFO_SPEED_UPLOAD"
+; "CURLINFO_FILETIME" "CURLE_OK" "CURLE_UNSUPPORTED_PROTOCOL"
+; "CURLE_FAILED_INIT" "CURLE_URL_MALFORMAT"
+; "CURLE_URL_MALFORMAT_USER" "CURLE_COULDNT_RESOLVE_PROXY"
+; "CURLE_COULDNT_RESOLVE_HOST" "CURLE_COULDNT_CONNECT"
+; "CURLE_FTP_WEIRD_SERVER_REPLY" "CURLE_FTP_ACCESS_DENIED"
+; "CURLE_FTP_USER_PASSWORD_INCORRECT"
+; "CURLE_FTP_WEIRD_PASS_REPLY" "CURLE_FTP_WEIRD_USER_REPLY"
+; "CURLE_FTP_WEIRD_PASV_REPLY" "CURLE_FTP_WEIRD_227_FORMAT"
+; "CURLE_FTP_CANT_GET_HOST" "CURLE_FTP_CANT_RECONNECT"
+; "CURLE_FTP_COULDNT_SET_BINARY" "CURLE_PARTIAL_FILE"
+; "CURLE_FTP_COULDNT_RETR_FILE" "CURLE_FTP_WRITE_ERROR"
+; "CURLE_FTP_QUOTE_ERROR" "CURLE_HTTP_NOT_FOUND"
+; "CURLE_WRITE_ERROR" "CURLE_MALFORMAT_USER"
+; "CURLE_FTP_COULDNT_STOR_FILE" "CURLE_READ_ERROR"
+; "CURLE_OUT_OF_MEMORY" "CURLE_OPERATION_TIMEOUTED"
+; "CURLE_FTP_COULDNT_SET_ASCII" "CURLE_FTP_PORT_FAILED"
+; "CURLE_FTP_COULDNT_USE_REST" "CURLE_FTP_COULDNT_GET_SIZE"
+; "CURLE_HTTP_RANGE_ERROR" "CURLE_HTTP_POST_ERROR"
+; "CURLE_SSL_CONNECT_ERROR" "CURLE_FTP_BAD_DOWNLOAD_RESUME"
+; "CURLE_FILE_COULDNT_READ_FILE" "CURLE_LDAP_CANNOT_BIND"
+; "CURLE_LDAP_SEARCH_FAILED" "CURLE_LIBRARY_NOT_FOUND"
+; "CURLE_FUNCTION_NOT_FOUND" "CURLE_ABORTED_BY_CALLBACK"
+; "CURLE_BAD_FUNCTION_ARGUMENT" "CURLE_BAD_CALLING_ORDER"
+; "CURLE_HTTP_PORT_FAILED" "CURLE_BAD_PASSWORD_ENTERED"
+; "CURLE_TOO_MANY_REDIRECTS" "CURLE_UNKOWN_TELNET_OPTION"
+; "CURLE_TELNET_OPTION_SYNTAX" "CURLE_ALREADY_COMPLETE"
+; "DBX_MYSQL" "DBX_ODBC" "DBX_PGSQL" "DBX_MSSQL" "DBX_PERSISTENT"
+; "DBX_RESULT_INFO" "DBX_RESULT_INDEX" "DBX_RESULT_ASSOC"
+; "DBX_CMP_TEXT" "DBX_CMP_NUMBER" "XML_ELEMENT_NODE"
+; "XML_ATTRIBUTE_NODE" "XML_TEXT_NODE" "XML_CDATA_SECTION_NODE"
+; "XML_ENTITY_REF_NODE" "XML_ENTITY_NODE" "XML_PI_NODE"
+; "XML_COMMENT_NODE" "XML_DOCUMENT_NODE" "XML_DOCUMENT_TYPE_NODE"
+; "XML_DOCUMENT_FRAG_NODE" "XML_NOTATION_NODE"
+; "XML_HTML_DOCUMENT_NODE" "XML_DTD_NODE" "XML_ELEMENT_DECL_NODE"
+; "XML_ATTRIBUTE_DECL_NODE" "XML_ENTITY_DECL_NODE"
+; "XML_NAMESPACE_DECL_NODE" "XML_GLOBAL_NAMESPACE"
+; "XML_LOCAL_NAMESPACE" "XML_ATTRIBUTE_CDATA" "XML_ATTRIBUTE_ID"
+; "XML_ATTRIBUTE_IDREF" "XML_ATTRIBUTE_IDREFS"
+; "XML_ATTRIBUTE_ENTITY" "XML_ATTRIBUTE_NMTOKEN"
+; "XML_ATTRIBUTE_NMTOKENS" "XML_ATTRIBUTE_ENUMERATION"
+; "XML_ATTRIBUTE_NOTATION" "XPATH_UNDEFINED" "XPATH_NODESET"
+; "XPATH_BOOLEAN" "XPATH_NUMBER" "XPATH_STRING" "XPATH_POINT"
+; "XPATH_RANGE" "XPATH_LOCATIONSET" "XPATH_USERS" "FBSQL_ASSOC"
+; "FBSQL_NUM" "FBSQL_BOTH" "FDFValue" "FDFStatus" "FDFFile"
+; "FDFID" "FDFFf" "FDFSetFf" "FDFClearFf" "FDFFlags" "FDFSetF"
+; "FDFClrF" "FDFAP" "FDFAS" "FDFAction" "FDFAA" "FDFAPRef"
+; "FDFIF" "FDFEnter" "FDFExit" "FDFDown" "FDFUp" "FDFFormat"
+; "FDFValidate" "FDFKeystroke" "FDFCalculate"
+; "FRIBIDI_CHARSET_UTF8" "FRIBIDI_CHARSET_8859_6"
+; "FRIBIDI_CHARSET_8859_8" "FRIBIDI_CHARSET_CP1255"
+; "FRIBIDI_CHARSET_CP1256" "FRIBIDI_CHARSET_ISIRI_3342"
+; "FTP_ASCII" "FTP_BINARY" "FTP_IMAGE" "FTP_TEXT" "IMG_GIF"
+; "IMG_JPG" "IMG_JPEG" "IMG_PNG" "IMG_WBMP" "IMG_COLOR_TILED"
+; "IMG_COLOR_STYLED" "IMG_COLOR_BRUSHED"
+; "IMG_COLOR_STYLEDBRUSHED" "IMG_COLOR_TRANSPARENT"
+; "IMG_ARC_ROUNDED" "IMG_ARC_PIE" "IMG_ARC_CHORD"
+; "IMG_ARC_NOFILL" "IMG_ARC_EDGED" "GMP_ROUND_ZERO"
+; "GMP_ROUND_PLUSINF" "GMP_ROUND_MINUSINF" "HW_ATTR_LANG"
+; "HW_ATTR_NR" "HW_ATTR_NONE" "IIS_READ" "IIS_WRITE"
+; "IIS_EXECUTE" "IIS_SCRIPT" "IIS_ANONYMOUS" "IIS_BASIC"
+; "IIS_NTLM" "NIL" "OP_DEBUG" "OP_READONLY" "OP_ANONYMOUS"
+; "OP_SHORTCACHE" "OP_SILENT" "OP_PROTOTYPE" "OP_HALFOPEN"
+; "OP_EXPUNGE" "OP_SECURE" "CL_EXPUNGE" "FT_UID" "FT_PEEK"
+; "FT_NOT" "FT_INTERNAL" "FT_PREFETCHTEXT" "ST_UID" "ST_SILENT"
+; "ST_SET" "CP_UID" "CP_MOVE" "SE_UID" "SE_FREE" "SE_NOPREFETCH"
+; "SO_FREE" "SO_NOSERVER" "SA_MESSAGES" "SA_RECENT" "SA_UNSEEN"
+; "SA_UIDNEXT" "SA_UIDVALIDITY" "SA_ALL" "LATT_NOINFERIORS"
+; "LATT_NOSELECT" "LATT_MARKED" "LATT_UNMARKED" "SORTDATE"
+; "SORTARRIVAL" "SORTFROM" "SORTSUBJECT" "SORTTO" "SORTCC"
+; "SORTSIZE" "TYPETEXT" "TYPEMULTIPART" "TYPEMESSAGE"
+; "TYPEAPPLICATION" "TYPEAUDIO" "TYPEIMAGE" "TYPEVIDEO"
+; "TYPEOTHER" "ENC7BIT" "ENC8BIT" "ENCBINARY" "ENCBASE64"
+; "ENCQUOTEDPRINTABLE" "ENCOTHER" "INGRES_ASSOC" "INGRES_NUM"
+; "INGRES_BOTH" "IBASE_DEFAULT" "IBASE_TEXT" "IBASE_UNIXTIME"
+; "IBASE_READ" "IBASE_COMMITTED" "IBASE_CONSISTENCY"
+; "IBASE_NOWAIT" "IBASE_TIMESTAMP" "IBASE_DATE" "IBASE_TIME"
+; "LDAP_DEREF_NEVER" "LDAP_DEREF_SEARCHING" "LDAP_DEREF_FINDING"
+; "LDAP_DEREF_ALWAYS" "LDAP_OPT_DEREF" "LDAP_OPT_SIZELIMIT"
+; "LDAP_OPT_TIMELIMIT" "LDAP_OPT_PROTOCOL_VERSION"
+; "LDAP_OPT_ERROR_NUMBER" "LDAP_OPT_REFERRALS" "LDAP_OPT_RESTART"
+; "LDAP_OPT_HOST_NAME" "LDAP_OPT_ERROR_STRING"
+; "LDAP_OPT_MATCHED_DN" "LDAP_OPT_SERVER_CONTROLS"
+; "LDAP_OPT_CLIENT_CONTROLS" "GSLC_SSL_NO_AUTH"
+; "GSLC_SSL_ONEWAY_AUTH" "GSLC_SSL_TWOWAY_AUTH" "MCAL_SUNDAY"
+; "MCAL_MONDAY" "MCAL_TUESDAY" "MCAL_WEDNESDAY" "MCAL_THURSDAY"
+; "MCAL_FRIDAY" "MCAL_SATURDAY" "MCAL_JANUARY" "MCAL_FEBRUARY"
+; "MCAL_MARCH" "MCAL_APRIL" "MCAL_MAY" "MCAL_JUNE" "MCAL_JULY"
+; "MCAL_AUGUST" "MCAL_SEPTEMBER" "MCAL_OCTOBER" "MCAL_NOVEMBER"
+; "MCAL_RECUR_NONE" "MCAL_RECUR_DAILY" "MCAL_RECUR_WEEKLY"
+; "MCAL_RECUR_MONTHLY_MDAY" "MCAL_RECUR_MONTHLY_WDAY"
+; "MCAL_RECUR_YEARLY" "MCAL_M_SUNDAY" "MCAL_M_MONDAY"
+; "MCAL_M_TUESDAY" "MCAL_M_WEDNESDAY" "MCAL_M_THURSDAY"
+; "MCAL_M_FRIDAY" "MCAL_M_SATURDAY" "MCAL_M_WEEKDAYS"
+; "MCAL_M_WEEKEND" "MCAL_M_ALLDAYS" "MCRYPT_" "MCRYPT_"
+; "MCRYPT_ENCRYPT" "MCRYPT_DECRYPT" "MCRYPT_DEV_RANDOM"
+; "MCRYPT_DEV_URANDOM" "MCRYPT_RAND" "SWFBUTTON_HIT"
+; "SUNFUNCS_RET_STRING" "SUNFUNCS_RET_DOUBLE"
+; "SWFBUTTON_DOWN" "SWFBUTTON_OVER" "SWFBUTTON_UP"
+; "SWFBUTTON_MOUSEUPOUTSIDE" "SWFBUTTON_DRAGOVER"
+; "SWFBUTTON_DRAGOUT" "SWFBUTTON_MOUSEUP" "SWFBUTTON_MOUSEDOWN"
+; "SWFBUTTON_MOUSEOUT" "SWFBUTTON_MOUSEOVER"
+; "SWFFILL_RADIAL_GRADIENT" "SWFFILL_LINEAR_GRADIENT"
+; "SWFFILL_TILED_BITMAP" "SWFFILL_CLIPPED_BITMAP"
+; "SWFTEXTFIELD_HASLENGTH" "SWFTEXTFIELD_NOEDIT"
+; "SWFTEXTFIELD_PASSWORD" "SWFTEXTFIELD_MULTILINE"
+; "SWFTEXTFIELD_WORDWRAP" "SWFTEXTFIELD_DRAWBOX"
+; "SWFTEXTFIELD_NOSELECT" "SWFTEXTFIELD_HTML"
+; "SWFTEXTFIELD_ALIGN_LEFT" "SWFTEXTFIELD_ALIGN_RIGHT"
+; "SWFTEXTFIELD_ALIGN_CENTER" "SWFTEXTFIELD_ALIGN_JUSTIFY"
+; "UDM_FIELD_URLID" "UDM_FIELD_URL" "UDM_FIELD_CONTENT"
+; "UDM_FIELD_TITLE" "UDM_FIELD_KEYWORDS" "UDM_FIELD_DESC"
+; "UDM_FIELD_DESCRIPTION" "UDM_FIELD_TEXT" "UDM_FIELD_SIZE"
+; "UDM_FIELD_RATING" "UDM_FIELD_SCORE" "UDM_FIELD_MODIFIED"
+; "UDM_FIELD_ORDER" "UDM_FIELD_CRC" "UDM_FIELD_CATEGORY"
+; "UDM_PARAM_PAGE_SIZE" "UDM_PARAM_PAGE_NUM"
+; "UDM_PARAM_SEARCH_MODE" "UDM_PARAM_CACHE_MODE"
+; "UDM_PARAM_TRACK_MODE" "UDM_PARAM_PHRASE_MODE"
+; "UDM_PARAM_CHARSET" "UDM_PARAM_STOPTABLE"
+; "UDM_PARAM_STOP_TABLE" "UDM_PARAM_STOPFILE"
+; "UDM_PARAM_STOP_FILE" "UDM_PARAM_WEIGHT_FACTOR"
+; "UDM_PARAM_WORD_MATCH" "UDM_PARAM_MAX_WORD_LEN"
+; "UDM_PARAM_MAX_WORDLEN" "UDM_PARAM_MIN_WORD_LEN"
+; "UDM_PARAM_MIN_WORDLEN" "UDM_PARAM_ISPELL_PREFIXES"
+; "UDM_PARAM_ISPELL_PREFIX" "UDM_PARAM_PREFIXES"
+; "UDM_PARAM_PREFIX" "UDM_PARAM_CROSS_WORDS"
+; "UDM_PARAM_CROSSWORDS" "UDM_LIMIT_CAT" "UDM_LIMIT_URL"
+; "UDM_LIMIT_TAG" "UDM_LIMIT_LANG" "UDM_LIMIT_DATE"
+; "UDM_PARAM_FOUND" "UDM_PARAM_NUM_ROWS" "UDM_PARAM_WORDINFO"
+; "UDM_PARAM_WORD_INFO" "UDM_PARAM_SEARCHTIME"
+; "UDM_PARAM_SEARCH_TIME" "UDM_PARAM_FIRST_DOC"
+; "UDM_PARAM_LAST_DOC" "UDM_MODE_ALL" "UDM_MODE_ANY"
+; "UDM_MODE_BOOL" "UDM_MODE_PHRASE" "UDM_CACHE_ENABLED"
+; "UDM_CACHE_DISABLED" "UDM_TRACK_ENABLED" "UDM_TRACK_DISABLED"
+; "UDM_PHRASE_ENABLED" "UDM_PHRASE_DISABLED"
+; "UDM_CROSS_WORDS_ENABLED" "UDM_CROSSWORDS_ENABLED"
+; "UDM_CROSS_WORDS_DISABLED" "UDM_CROSSWORDS_DISABLED"
+; "UDM_PREFIXES_ENABLED" "UDM_PREFIX_ENABLED"
+; "UDM_ISPELL_PREFIXES_ENABLED" "UDM_ISPELL_PREFIX_ENABLED"
+; "UDM_PREFIXES_DISABLED" "UDM_PREFIX_DISABLED"
+; "UDM_ISPELL_PREFIXES_DISABLED" "UDM_ISPELL_PREFIX_DISABLED"
+; "UDM_ISPELL_TYPE_AFFIX" "UDM_ISPELL_TYPE_SPELL"
+; "UDM_ISPELL_TYPE_DB" "UDM_ISPELL_TYPE_SERVER" "UDM_MATCH_WORD"
+; "UDM_MATCH_BEGIN" "UDM_MATCH_SUBSTR" "UDM_MATCH_END"
+; "MSQL_ASSOC" "MSQL_NUM" "MSQL_BOTH" "MYSQL_ASSOC" "MYSQL_NUM"
+; "MYSQL_BOTH" "MYSQL_USE_RESULT" "MYSQL_STORE_RESULT"
+; "OCI_DEFAULT" "OCI_DESCRIBE_ONLY" "OCI_COMMIT_ON_SUCCESS"
+; "OCI_EXACT_FETCH" "SQLT_BFILEE" "SQLT_CFILEE" "SQLT_CLOB"
+; "SQLT_BLOB" "SQLT_RDD" "OCI_B_SQLT_NTY" "OCI_SYSDATE"
+; "OCI_B_BFILE" "OCI_B_CFILEE" "OCI_B_CLOB" "OCI_B_BLOB"
+; "OCI_B_ROWID" "OCI_B_CURSOR" "OCI_B_BIN" "OCI_ASSOC" "OCI_NUM"
+; "OCI_BOTH" "OCI_RETURN_NULLS" "OCI_RETURN_LOBS"
+; "OCI_DTYPE_FILE" "OCI_DTYPE_LOB" "OCI_DTYPE_ROWID" "OCI_D_FILE"
+; "OCI_D_LOB" "OCI_D_ROWID" "ODBC_TYPE" "ODBC_BINMODE_PASSTHRU"
+; "ODBC_BINMODE_RETURN" "ODBC_BINMODE_CONVERT" "SQL_ODBC_CURSORS"
+; "SQL_CUR_USE_DRIVER" "SQL_CUR_USE_IF_NEEDED" "SQL_CUR_USE_ODBC"
+; "SQL_CONCURRENCY" "SQL_CONCUR_READ_ONLY" "SQL_CONCUR_LOCK"
+; "SQL_CONCUR_ROWVER" "SQL_CONCUR_VALUES" "SQL_CURSOR_TYPE"
+; "SQL_CURSOR_FORWARD_ONLY" "SQL_CURSOR_KEYSET_DRIVEN"
+; "SQL_CURSOR_DYNAMIC" "SQL_CURSOR_STATIC" "SQL_KEYSET_SIZE"
+; "SQL_CHAR" "SQL_VARCHAR" "SQL_LONGVARCHAR" "SQL_DECIMAL"
+; "SQL_NUMERIC" "SQL_BIT" "SQL_TINYINT" "SQL_SMALLINT"
+; "SQL_INTEGER" "SQL_BIGINT" "SQL_REAL" "SQL_FLOAT" "SQL_DOUBLE"
+; "SQL_BINARY" "SQL_VARBINARY" "SQL_LONGVARBINARY" "SQL_DATE"
+; "SQL_TIME" "SQL_TIMESTAMP" "SQL_TYPE_DATE" "SQL_TYPE_TIME"
+; "SQL_TYPE_TIMESTAMP" "SQL_BEST_ROWID" "SQL_ROWVER"
+; "SQL_SCOPE_CURROW" "SQL_SCOPE_TRANSACTION" "SQL_SCOPE_SESSION"
+; "SQL_NO_NULLS" "SQL_NULLABLE" "SQL_INDEX_UNIQUE"
+; "SQL_INDEX_ALL" "SQL_ENSURE" "SQL_QUICK"
+; "X509_PURPOSE_SSL_CLIENT" "X509_PURPOSE_SSL_SERVER"
+; "X509_PURPOSE_NS_SSL_SERVER" "X509_PURPOSE_SMIME_SIGN"
+; "X509_PURPOSE_SMIME_ENCRYPT" "X509_PURPOSE_CRL_SIGN"
+; "X509_PURPOSE_ANY" "PKCS7_DETACHED" "PKCS7_TEXT"
+; "PKCS7_NOINTERN" "PKCS7_NOVERIFY" "PKCS7_NOCHAIN"
+; "PKCS7_NOCERTS" "PKCS7_NOATTR" "PKCS7_BINARY" "PKCS7_NOSIGS"
+; "OPENSSL_PKCS1_PADDING" "OPENSSL_SSLV23_PADDING"
+; "OPENSSL_NO_PADDING" "OPENSSL_PKCS1_OAEP_PADDING"
+; "ORA_BIND_INOUT" "ORA_BIND_IN" "ORA_BIND_OUT"
+; "ORA_FETCHINTO_ASSOC" "ORA_FETCHINTO_NULLS"
+; "PREG_PATTERN_ORDER" "PREG_SET_ORDER" "PREG_SPLIT_NO_EMPTY"
+; "PREG_SPLIT_DELIM_CAPTURE"
+; "PGSQL_ASSOC" "PGSQL_NUM" "PGSQL_BOTH"
+; "PRINTER_COPIES" "PRINTER_MODE" "PRINTER_TITLE"
+; "PRINTER_DEVICENAME" "PRINTER_DRIVERVERSION"
+; "PRINTER_RESOLUTION_Y" "PRINTER_RESOLUTION_X" "PRINTER_SCALE"
+; "PRINTER_BACKGROUND_COLOR" "PRINTER_PAPER_LENGTH"
+; "PRINTER_PAPER_WIDTH" "PRINTER_PAPER_FORMAT"
+; "PRINTER_FORMAT_CUSTOM" "PRINTER_FORMAT_LETTER"
+; "PRINTER_FORMAT_LEGAL" "PRINTER_FORMAT_A3" "PRINTER_FORMAT_A4"
+; "PRINTER_FORMAT_A5" "PRINTER_FORMAT_B4" "PRINTER_FORMAT_B5"
+; "PRINTER_FORMAT_FOLIO" "PRINTER_ORIENTATION"
+; "PRINTER_ORIENTATION_PORTRAIT" "PRINTER_ORIENTATION_LANDSCAPE"
+; "PRINTER_TEXT_COLOR" "PRINTER_TEXT_ALIGN" "PRINTER_TA_BASELINE"
+; "PRINTER_TA_BOTTOM" "PRINTER_TA_TOP" "PRINTER_TA_CENTER"
+; "PRINTER_TA_LEFT" "PRINTER_TA_RIGHT" "PRINTER_PEN_SOLID"
+; "PRINTER_PEN_DASH" "PRINTER_PEN_DOT" "PRINTER_PEN_DASHDOT"
+; "PRINTER_PEN_DASHDOTDOT" "PRINTER_PEN_INVISIBLE"
+; "PRINTER_BRUSH_SOLID" "PRINTER_BRUSH_CUSTOM"
+; "PRINTER_BRUSH_DIAGONAL" "PRINTER_BRUSH_CROSS"
+; "PRINTER_BRUSH_DIAGCROSS" "PRINTER_BRUSH_FDIAGONAL"
+; "PRINTER_BRUSH_HORIZONTAL" "PRINTER_BRUSH_VERTICAL"
+; "PRINTER_FW_THIN" "PRINTER_FW_ULTRALIGHT" "PRINTER_FW_LIGHT"
+; "PRINTER_FW_NORMAL" "PRINTER_FW_MEDIUM" "PRINTER_FW_BOLD"
+; "PRINTER_FW_ULTRABOLD" "PRINTER_FW_HEAVY" "PRINTER_ENUM_LOCAL"
+; "PRINTER_ENUM_NAME" "PRINTER_ENUM_SHARED"
+; "PRINTER_ENUM_DEFAULT" "PRINTER_ENUM_CONNECTIONS"
+; "PRINTER_ENUM_NETWORK" "PRINTER_ENUM_REMOTE" "PSPELL_FAST"
+; "PSPELL_NORMAL" "PSPELL_BAD_SPELLERS" "PSPELL_RUN_TOGETHER"
+; "SID" "SID" "AF_UNIX" "AF_INET" "SOCK_STREAM" "SOCK_DGRAM"
+; "SOCK_RAW" "SOCK_SEQPACKET" "SOCK_RDM" "MSG_OOB" "MSG_WAITALL"
+; "MSG_PEEK" "MSG_DONTROUTE" "SO_DEBUG" "SO_REUSEADDR"
+; "SO_KEEPALIVE" "SO_DONTROUTE" "SO_LINGER" "SO_BROADCAST"
+; "SO_OOBINLINE" "SO_SNDBUF" "SO_RCVBUF" "SO_SNDLOWAT"
+; "SO_RCVLOWAT" "SO_SNDTIMEO" "SO_RCVTIMEO" "SO_TYPE" "SO_ERROR"
+; "SOL_SOCKET" "PHP_NORMAL_READ" "PHP_BINARY_READ"
+; "PHP_SYSTEM_READ" "SOL_TCP" "SOL_UDP" "MOD_COLOR" "MOD_MATRIX"
+; "TYPE_PUSHBUTTON" "TYPE_MENUBUTTON" "BSHitTest" "BSDown"
+; "BSOver" "BSUp" "OverDowntoIdle" "IdletoOverDown"
+; "OutDowntoIdle" "OutDowntoOverDown" "OverDowntoOutDown"
+; "OverUptoOverDown" "OverUptoIdle" "IdletoOverUp" "ButtonEnter"
+; "ButtonExit" "MenuEnter" "MenuExit" "XML_ERROR_NONE"
+; "XML_ERROR_NO_MEMORY" "XML_ERROR_SYNTAX"
+; "XML_ERROR_NO_ELEMENTS" "XML_ERROR_INVALID_TOKEN"
+; "XML_ERROR_UNCLOSED_TOKEN" "XML_ERROR_PARTIAL_CHAR"
+; "XML_ERROR_TAG_MISMATCH" "XML_ERROR_DUPLICATE_ATTRIBUTE"
+; "XML_ERROR_JUNK_AFTER_DOC_ELEMENT" "XML_ERROR_PARAM_ENTITY_REF"
+; "XML_ERROR_UNDEFINED_ENTITY" "XML_ERROR_RECURSIVE_ENTITY_REF"
+; "XML_ERROR_ASYNC_ENTITY" "XML_ERROR_BAD_CHAR_REF"
+; "XML_ERROR_BINARY_ENTITY_REF"
+; "XML_ERROR_ATTRIBUTE_EXTERNAL_ENTITY_REF"
+; "XML_ERROR_MISPLACED_XML_PI" "XML_ERROR_UNKNOWN_ENCODING"
+; "XML_ERROR_INCORRECT_ENCODING"
+; "XML_ERROR_UNCLOSED_CDATA_SECTION"
+; "XML_ERROR_EXTERNAL_ENTITY_HANDLING" "XML_OPTION_CASE_FOLDING"
+; "XML_OPTION_TARGET_ENCODING" "XML_OPTION_SKIP_TAGSTART"
+; "XML_OPTION_SKIP_WHITE" "YPERR_BADARGS" "YPERR_BADDB"
+; "YPERR_BUSY" "YPERR_DOMAIN" "YPERR_KEY" "YPERR_MAP"
+; "YPERR_NODOM" "YPERR_NOMORE" "YPERR_PMAP" "YPERR_RESRC"
+; "YPERR_RPC" "YPERR_YPBIND" "YPERR_YPERR" "YPERR_YPSERV"
+; "YPERR_VERS" "FORCE_GZIP" "FORCE_DEFLATE"
+
+ ;; PEAR constants
+; "PEAR_ERROR_RETURN" "PEAR_ERROR_PRINT" "PEAR_ERROR_TRIGGER"
+; "PEAR_ERROR_DIE" "PEAR_ERROR_CALLBACK" "OS_WINDOWS" "OS_UNIX"
+; "PEAR_OS" "DB_OK" "DB_ERROR" "DB_ERROR_SYNTAX"
+; "DB_ERROR_CONSTRAINT" "DB_ERROR_NOT_FOUND"
+; "DB_ERROR_ALREADY_EXISTS" "DB_ERROR_UNSUPPORTED"
+; "DB_ERROR_MISMATCH" "DB_ERROR_INVALID" "DB_ERROR_NOT_CAPABLE"
+; "DB_ERROR_TRUNCATED" "DB_ERROR_INVALID_NUMBER"
+; "DB_ERROR_INVALID_DATE" "DB_ERROR_DIVZERO"
+; "DB_ERROR_NODBSELECTED" "DB_ERROR_CANNOT_CREATE"
+; "DB_ERROR_CANNOT_DELETE" "DB_ERROR_CANNOT_DROP"
+; "DB_ERROR_NOSUCHTABLE" "DB_ERROR_NOSUCHFIELD"
+; "DB_ERROR_NEED_MORE_DATA" "DB_ERROR_NOT_LOCKED"
+; "DB_ERROR_VALUE_COUNT_ON_ROW" "DB_ERROR_INVALID_DSN"
+; "DB_ERROR_CONNECT_FAILED" "DB_WARNING" "DB_WARNING_READ_ONLY"
+; "DB_PARAM_SCALAR" "DB_PARAM_OPAQUE" "DB_BINMODE_PASSTHRU"
+; "DB_BINMODE_RETURN" "DB_BINMODE_CONVERT" "DB_FETCHMODE_DEFAULT"
+; "DB_FETCHMODE_ORDERED" "DB_FETCHMODE_ASSOC"
+; "DB_FETCHMODE_FLIPPED" "DB_GETMODE_ORDERED" "DB_GETMODE_ASSOC"
+; "DB_GETMODE_FLIPPED" "DB_TABLEINFO_ORDER"
+; "DB_TABLEINFO_ORDERTABLE" "DB_TABLEINFO_FULL"
+
+ )))
+ "PHP constants.")
+
+(defconst php-keywords
+ (eval-when-compile
+ (regexp-opt
+ ;; "class", "new" and "extends" get special treatment
+ ;; "case" and "default" get special treatment elsewhere
+ '("and" "as" "break" "continue" "declare" "do" "echo" "else" "elseif"
+ "endfor" "endforeach" "endif" "endswitch" "endwhile" "exit"
+ "extends" "for" "foreach" "global" "if" "include" "include_once"
+ "next" "or" "require" "require_once" "return" "static" "switch"
+ "then" "var" "while" "xor" "throw" "catch" "try"
+ "instanceof" "catch all" "finally")))
+ "PHP keywords.")
+
+(defconst php-identifier
+ (eval-when-compile
+ '"[a-zA-Z\_\x7f-\xff][a-zA-Z0-9\_\x7f-\xff]*")
+ "Characters in a PHP identifier.")
+
+(defconst php-types
+ (eval-when-compile
+ (regexp-opt '("array" "bool" "boolean" "char" "const" "double" "float"
+ "int" "integer" "long" "mixed" "object" "real"
+ "string")))
+ "PHP types.")
+
+(defconst php-superglobals
+ (eval-when-compile
+ (regexp-opt '("_GET" "_POST" "_COOKIE" "_SESSION" "_ENV" "GLOBALS"
+ "_SERVER" "_FILES" "_REQUEST")))
+ "PHP superglobal variables.")
+
+;; Set up font locking
+(defconst php-font-lock-keywords-1
+ (list
+ ;; Fontify constants
+ (cons
+ (concat "[^_$]?\\<\\(" php-constants "\\)\\>[^_]?")
+ '(1 font-lock-constant-face))
+
+ ;; Fontify keywords
+ (cons
+ (concat "[^_$]?\\<\\(" php-keywords "\\)\\>[^_]?")
+ '(1 font-lock-keyword-face))
+
+ ;; Fontify keywords and targets, and case default tags.
+ (list "\\<\\(break\\|case\\|continue\\)\\>\\s-+\\(-?\\sw+\\)?"
+ '(1 font-lock-keyword-face) '(2 font-lock-constant-face t t))
+ ;; This must come after the one for keywords and targets.
+ '(":" ("^\\s-+\\(\\sw+\\)\\s-+\\s-+$"
+ (beginning-of-line) (end-of-line)
+ (1 font-lock-constant-face)))
+
+ ;; treat 'print' as keyword only when not used like a function name
+ '("\\<print\\s-*(" . php-default-face)
+ '("\\<print\\>" . font-lock-keyword-face)
+
+ ;; Fontify PHP tag
+ (cons php-tags-key font-lock-preprocessor-face)
+
+ ;; Fontify ASP-style tag
+ '("<\\%\\(=\\)?" . font-lock-preprocessor-face)
+ '("\\%>" . font-lock-preprocessor-face)
+
+ )
+ "Subdued level highlighting for PHP mode.")
+
+(defconst php-font-lock-keywords-2
+ (append
+ php-font-lock-keywords-1
+ (list
+
+ ;; class declaration
+ '("\\<\\(class\\|interface\\)\\s-+\\(\\sw+\\)?"
+ (1 font-lock-keyword-face) (2 font-lock-type-face nil t))
+ ;; handle several words specially, to include following word,
+ ;; thereby excluding it from unknown-symbol checks later
+ ;; FIX to handle implementing multiple
+ ;; currently breaks on "class Foo implements Bar, Baz"
+ '("\\<\\(new\\|extends\\|implements\\)\\s-+\\$?\\(\\sw+\\)"
+ (1 font-lock-keyword-face) (2 font-lock-type-face))
+
+ ;; function declaration
+ '("\\<\\(function\\)\\s-+&?\\(\\sw+\\)\\s-*("
+ (1 font-lock-keyword-face)
+ (2 font-lock-function-name-face nil t))
+
+ ;; class hierarchy
+ '("\\<\\(self\\|parent\\)\\>" (1 font-lock-constant-face nil nil))
+
+ ;; method and variable features
+ '("\\<\\(private\\|protected\\|public\\)\\s-+\\$?\\sw+"
+ (1 font-lock-keyword-face))
+
+ ;; method features
+ '("^\\s-*\\(abstract\\|static\\|final\\)\\s-+\\$?\\sw+"
+ (1 font-lock-keyword-face))
+
+ ;; variable features
+ '("^\\s-*\\(static\\|const\\)\\s-+\\$?\\sw+"
+ (1 font-lock-keyword-face))
+ ))
+ "Medium level highlighting for PHP mode.")
+
+(defconst php-font-lock-keywords-3
+ (append
+ php-font-lock-keywords-2
+ (list
+
+ ;; <word> or </word> for HTML
+ ;;'("</?\\sw+[^> ]*>" . font-lock-constant-face)
+ ;;'("</?\\sw+[^>]*" . font-lock-constant-face)
+ ;;'("<!DOCTYPE" . font-lock-constant-face)
+ '("</?[a-z!:]+" . font-lock-constant-face)
+
+ ;; HTML >
+ '("<[^>]*\\(>\\)" (1 font-lock-constant-face))
+
+ ;; HTML tags
+ '("\\(<[a-z]+\\)[[:space:]]+\\([a-z:]+=\\)[^>]*?" (1 font-lock-constant-face) (2 font-lock-constant-face) )
+ '("\"[[:space:]]+\\([a-z:]+=\\)" (1 font-lock-constant-face))
+
+ ;; HTML entities
+ ;;'("&\\w+;" . font-lock-variable-name-face)
+
+ ;; warn about '$' immediately after ->
+ '("\\$\\sw+->\\s-*\\(\\$\\)\\(\\sw+\\)"
+ (1 font-lock-warning-face) (2 php-default-face))
+
+ ;; warn about $word.word -- it could be a valid concatenation,
+ ;; but without any spaces we'll assume $word->word was meant.
+ '("\\$\\sw+\\(\\.\\)\\sw"
+ 1 font-lock-warning-face)
+
+ ;; Warn about ==> instead of =>
+ '("==+>" . font-lock-warning-face)
+
+ ;; exclude casts from bare-word treatment (may contain spaces)
+ `(,(concat "(\\s-*\\(" php-types "\\)\\s-*)")
+ 1 font-lock-type-face)
+
+ ;; PHP5: function declarations may contain classes as parameters type
+ `(,(concat "[(,]\\s-*\\(\\sw+\\)\\s-+&?\\$\\sw+\\>")
+ 1 font-lock-type-face)
+
+ ;; Fontify variables and function calls
+ '("\\$\\(this\\|that\\)\\W" (1 font-lock-constant-face nil nil))
+ `(,(concat "\\$\\(" php-superglobals "\\)\\W")
+ (1 font-lock-constant-face nil nil)) ;; $_GET & co
+ '("\\$\\(\\sw+\\)" (1 font-lock-variable-name-face)) ;; $variable
+ '("->\\(\\sw+\\)" (1 font-lock-variable-name-face t t)) ;; ->variable
+ '("->\\(\\sw+\\)\\s-*(" . (1 php-default-face t t)) ;; ->function_call
+ '("\\(\\sw+\\)::\\sw+\\s-*(?" . (1 font-lock-type-face)) ;; class::member
+ '("::\\(\\sw+\\>[^(]\\)" . (1 php-default-face)) ;; class::constant
+ '("\\<\\sw+\\s-*[[(]" . php-default-face) ;; word( or word[
+ '("\\<[0-9]+" . php-default-face) ;; number (also matches word)
+
+ ;; Warn on any words not already fontified
+ '("\\<\\sw+\\>" . font-lock-warning-face)
+
+ ))
+ "Gauchy level highlighting for PHP mode.")
+
+(provide 'php-mode)
+
+;;; php-mode.el ends here
--- /dev/null
+This subdir (related/) contains files that are taken from different\r
+places and are maybe modified to work with nXhtml.\r
+\r
+Please notice that major mode that are used with mumamo-mode must be a\r
+bit more carefully written. One problem I have noticed is that some\r
+major modes requuires that buffer-file-name is non-nil. That\r
+assumption does not work when mumamo-mode is used!\r
--- /dev/null
+// Where you store your files
+var project_folder = 'file:///c:/emacs/p/091105/EmacsW32/nxhtml/related/';
+// Browser environment wrapper over Rhino
+load(project_folder + 'env.js');
+// For DOM constructing
+window.location = project_folder + 'blank.html';
+var my_script = arguments[0];
+// If DOM ready
+window.onload = function(){
+ // Avoid recursive inclusion
+ if ("rhino_flymake.js" != my_script) {
+ load(my_script);
+ }
+}
--- /dev/null
+;;; smarty-mode.el --- major mode for editing Smarty templates
+
+;; Author: Vincent DEBOUT <deboutv@free.fr>
+;; Maintainer: Vincent DEBOUT <deboutv@free.fr>
+;; Keywords: languages smarty templates
+;; WWW: http://deboutv.free.fr/lisp/smarty/
+
+;;; License
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 2
+;; of the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+;; Minor changes by Lennart Borgman
+
+(defconst smarty-version "0.0.5"
+ "Smarty Mode version number.")
+
+(defconst smarty-time-stamp "2007-11-01"
+ "Smarty Mode time stamp for last update.")
+
+(defconst smarty-is-xemacs (string-match "XEmacs" emacs-version)
+ "Non-nil if XEmacs is used.")
+
+(require 'font-lock)
+(when (not smarty-is-xemacs)
+ (require 'cc-mode)
+ (require 'custom)
+ (require 'etags))
+(eval-when-compile
+ (require 'regexp-opt))
+;;(when smarty-is-xemacs
+ (require 'easymenu)
+ (require 'hippie-exp)
+;;)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Customization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defgroup smarty nil
+ "Customizations for Smarty mode."
+ :prefix "smarty-"
+ :group 'languages)
+
+(defgroup smarty-mode nil
+ "Customizations for Smarty mode."
+ :group 'smarty)
+
+(defcustom smarty-electric-mode t
+ "*Non-nil enables electrification (automatic template generation).
+If nil, template generators can still be invoked through key bindings and
+menu. Is indicated in the modeline by \"/e\" after the mode name and can be
+toggled by `\\[smarty-electric-mode]'."
+ :type 'boolean
+ :group 'smarty-mode)
+
+(defcustom smarty-stutter-mode t
+ "*Non-nil enables stuttering.
+Is indicated in the modeline by \"/s\" after the mode name and can be toggled
+by `\\[smarty-stutter-mode]'."
+ :type 'boolean
+ :group 'smarty-mode)
+
+(defgroup smarty-menu nil
+ "Customizations for menues."
+ :group 'smarty)
+
+(defcustom smarty-source-file-menu t
+ "*Non-nil means add a menu of all source files in current directory."
+ :type 'boolean
+ :group 'smarty-menu)
+
+(defgroup smarty-highlight nil
+ "Customizations for highlight."
+ :group 'smarty)
+
+(defcustom smarty-highlight-plugin-functions t
+ "*Non-nil means highlight the plugin functions in the buffer."
+ :type 'boolean
+ :group 'smarty-highlight)
+
+(defgroup smarty-template nil
+ "Customizations for templates."
+ :group 'smarty)
+
+(defgroup smarty-header nil
+ "Customizations for header template."
+ :group 'smarty-template)
+
+(defcustom smarty-file-header ""
+ "*String or file to insert as file header.
+If the string specifies an existing file name, the contents of the file is
+inserted, otherwise the string itself is inserted as file header.
+Type `C-j' for newlines.
+If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS>
+if the header needs to be version controlled.
+
+The following keywords for template generation are supported:
+ <filename> : replaced by the name of the buffer
+ <author> : replaced by the user name and email address
+ \(`user-full-name',`mail-host-address', `user-mail-address')
+ <login> : replaced by user login name (`user-login-name')
+ <company> : replaced by contents of option `smarty-company-name'
+ <date> : replaced by the current date
+ <year> : replaced by the current year
+ <copyright> : replaced by copyright string (`smarty-copyright-string')
+ <cursor> : final cursor position."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-file-footer ""
+ "*String or file to insert as file footer.
+If the string specifies an existing file name, the contents of the file is
+inserted, otherwise the string itself is inserted as file footer (i.e. at
+the end of the file).
+Type `C-j' for newlines.
+The same keywords as in option `smarty-file-header' can be used."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-company-name ""
+ "*Name of company to insert in file header.
+See option `smarty-file-header'."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-copyright-string ""
+ "*Copyright string to insert in file header.
+Can be multi-line string (type `C-j' for newline) and contain other file
+header keywords (see option `smarty-file-header')."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-date-format "%Y-%m-%d"
+ "*Specifies the date format to use in the header.
+This string is passed as argument to the command `format-time-string'.
+For more information on format strings, see the documentation for the
+`format-time-string' command (C-h f `format-time-string')."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-modify-date-prefix-string ""
+ "*Prefix string of modification date in Smarty file header.
+If actualization of the modification date is called (menu,
+`\\[smarty-template-modify]'), this string is searched and the rest
+of the line replaced by the current date."
+ :type 'string
+ :group 'smarty-header)
+
+(defcustom smarty-modify-date-on-saving nil
+ "*Non-nil means update the modification date when the buffer is saved.
+Calls function `\\[smarty-template-modify]').
+
+NOTE: Activate the new setting in a Smarty buffer by using the menu entry
+ \"Activate Options\"."
+ :type 'boolean
+ :group 'smarty-header)
+
+(defgroup smarty-misc nil
+ "Miscellaneous customizations."
+ :group 'smarty)
+
+(defcustom smarty-left-delimiter "{"
+ "Left escaping delimiter."
+ :type 'string
+ :group 'smarty-misc)
+
+(defcustom smarty-right-delimiter "}"
+ "Right escaping delimiter."
+ :type 'string
+ :group 'smarty-misc)
+
+(defcustom smarty-intelligent-tab t
+ "*Non-nil means `TAB' does indentation, word completion and tab insertion.
+That is, if preceding character is part of a word then complete word,
+else if not at beginning of line then insert tab,
+else if last command was a `TAB' or `RET' then dedent one step,
+else indent current line (i.e. `TAB' is bound to `smarty-electric-tab').
+If nil, TAB always indents current line (i.e. `TAB' is bound to
+`indent-according-to-mode').
+
+NOTE: Activate the new setting in a Smarty buffer by using the menu entry
+ \"Activate Options\"."
+ :type 'boolean
+ :group 'smarty-misc)
+
+(defcustom smarty-word-completion-in-minibuffer t
+ "*Non-nil enables word completion in minibuffer (for template prompts).
+
+NOTE: Activate the new setting by restarting Emacs."
+ :type 'boolean
+ :group 'smarty-misc)
+
+(defcustom smarty-word-completion-case-sensitive nil
+ "*Non-nil means word completion using `TAB' is case sensitive.
+That is, `TAB' completes words that start with the same letters and case.
+Otherwise, case is ignored."
+ :type 'boolean
+ :group 'smarty-misc)
+
+;; Functions
+
+(defun smarty-customize ()
+ "Call the customize function with `smarty' as argument."
+ (interactive)
+ (customize-browse 'smarty))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-menu-max-size 20
+ "*Specifies the maximum size of a menu before splitting it into submenues.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Menu tools functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-menu-split (list title)
+ "Split menu LIST into several submenues, if number of
+elements > `smarty-menu-max-size'."
+ (if (> (length list) smarty-menu-max-size)
+ (let ((remain list)
+ (result '())
+ (sublist '())
+ (menuno 1)
+ (i 0))
+ (while remain
+ (setq sublist (cons (car remain) sublist))
+ (setq remain (cdr remain))
+ (setq i (+ i 1))
+ (if (= i smarty-menu-max-size)
+ (progn
+ (setq result (cons (cons (format "%s %s" title menuno)
+ (nreverse sublist)) result))
+ (setq i 0)
+ (setq menuno (+ menuno 1))
+ (setq sublist '()))))
+ (and sublist
+ (setq result (cons (cons (format "%s %s" title menuno)
+ (nreverse sublist)) result)))
+ (nreverse result))
+ list))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Source file menu
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-sources-menu nil)
+
+;; Create the source menu
+(defun smarty-add-source-files-menu ()
+ "Scan directory for all Smarty source files and generate menu.
+The directory of the current source file is scanned."
+ (interactive)
+ (message "Scanning directory for source files ...")
+ (let ((newmap (current-local-map))
+ (file-list (smarty-get-source-files))
+ menu-list found)
+ ;; Create list for menu
+ (setq found nil)
+ (while file-list
+ (setq found t)
+ (setq menu-list (cons (vector (car file-list)
+ (list 'find-file (car file-list)) t)
+ menu-list))
+ (setq file-list (cdr file-list)))
+ (setq menu-list (smarty-menu-split menu-list "Sources"))
+ (when found (setq menu-list (cons "--" menu-list)))
+ (setq menu-list (cons ["*Rescan*" smarty-add-source-files-menu t] menu-list))
+ (setq menu-list (cons "Sources" menu-list))
+ ;; Create menu
+ (easy-menu-add menu-list)
+ (easy-menu-define smarty-sources-menu newmap
+ "Smarty source files menu" menu-list))
+ (message ""))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Smarty menu
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-create-mode-menu ()
+ "Create Smarty Mode menu."
+ `("Smarty"
+ ("Templates"
+ ("Built-in Functions"
+ ["capture" smarty-template-capture t]
+ ["config_load" smarty-template-config-load t]
+ ["else" smarty-template-else t]
+ ["elseif" smarty-template-elseif t]
+ ["foreach" smarty-template-foreach t]
+ ["foreachelse" smarty-template-foreachelse t]
+ ["if" smarty-template-if t]
+ ["include" smarty-template-include t]
+ ["include_php" smarty-template-include-php t]
+ ["insert" smarty-template-insert t]
+ ["ldelim" smarty-template-ldelim t]
+ ["literal" smarty-template-literal t]
+ ["php" smarty-template-php t]
+ ["rdelim" smarty-template-rdelim t]
+ ["section" smarty-template-section t]
+ ["sectionelse" smarty-template-sectionelse t]
+ ["strip" smarty-template-strip t])
+ ("Custom Functions"
+ ["assign" smarty-template-assign t]
+ ["counter" smarty-template-counter t]
+ ["cycle" smarty-template-cycle t]
+ ["debug" smarty-template-debug t]
+ ["eval" smarty-template-eval t]
+ ["fetch" smarty-template-fetch t]
+ ["html_checkboxes" smarty-template-html-checkboxes t]
+ ["html_image" smarty-template-html-image t]
+ ["html_options" smarty-template-html-options t]
+ ["html_radios" smarty-template-html-radios t]
+ ["html_select_date" smarty-template-html-select-date t]
+ ["html_select_time" smarty-template-html-select-time t]
+ ["html_table" smarty-template-html-table t]
+ ["mailto" smarty-template-mailto t]
+ ["math" smarty-template-math t]
+ ["popup" smarty-template-popup t]
+ ["popup_init" smarty-template-popup-init t]
+ ["textformat" smarty-template-textformat t])
+ ("Variable Modifiers"
+ ["capitalize" smarty-template-capitalize t]
+ ["cat" smarty-template-cat t]
+ ["count_characters" smarty-template-count-characters t]
+ ["count_paragraphs" smarty-template-count-paragraphs t]
+ ["count_sentences" smarty-template-count-sentences t]
+ ["count_words" smarty-template-count-words t]
+ ["date_format" smarty-template-date-format t]
+ ["default" smarty-template-default t]
+ ["escape" smarty-template-escape t]
+ ["indent" smarty-template-indent t]
+ ["lower" smarty-template-lower t]
+ ["nl2br" smarty-template-nl2br t]
+ ["regex_replace" smarty-template-regex-replace t]
+ ["replace" smarty-template-replace t]
+ ["spacify" smarty-template-spacify t]
+ ["string_format" smarty-template-string-format t]
+ ["strip" smarty-template-vstrip t]
+ ["strip_tags" smarty-template-strip-tags t]
+ ["truncate" smarty-template-truncate t]
+ ["upper" smarty-template-upper t]
+ ["wordwrap" smarty-template-wordwrap t])
+ ("Plugins (Functions)"
+ ("BlockRepeatPlugin"
+ ["repeat" smarty-template-repeat t]
+ ["str_repeat" smarty-template-str-repeat t])
+ ("ClipCache"
+ ["clipcache" smarty-template-clipcache t]
+ ["include_clipcache" smarty-template-include-clipcache t])
+ ("SmartyFormtool"
+ ["formtool_checkall" smarty-template-formtool-checkall t]
+ ["formtool_copy" smarty-template-formtool-copy t]
+ ["formtool_count_chars" smarty-template-formtool-count-chars t]
+ ["formtool_init" smarty-template-formtool-init t]
+ ["formtool_move" smarty-template-formtool-move t]
+ ["formtool_moveall" smarty-template-formtool-moveall t]
+ ["formtool_movedown" smarty-template-formtool-movedown t]
+ ["formtool_moveup" smarty-template-formtool-moveup t]
+ ["formtool_remove" smarty-template-formtool-remove t]
+ ["formtool_rename" smarty-template-formtool-rename t]
+ ["formtool_save" smarty-template-formtool-save t]
+ ["formtool_selectall" smarty-template-formtool-selectall t])
+ ("SmartyPaginate"
+ ["paginate_first" smarty-template-paginate-first t]
+ ["paginate_last" smarty-template-paginate-last t]
+ ["paginate_middle" smarty-template-paginate-middle t]
+ ["paginate_next" smarty-template-paginate-next t]
+ ["paginate_prev" smarty-template-paginate-prev t])
+ ("SmartyValidate"
+ ["validate" smarty-template-validate t]))
+ ("Plugins (Variable Modifiers)"
+ ("AlternativeDateModifierPlugin"
+ ["date_format2" smarty-template-date-formatto t])
+ ("B2Smilies"
+ ["B2Smilies" smarty-template-btosmilies t])
+ ("BBCodePlugin"
+ ["bbcode2html" smarty-template-bbcodetohtml t])
+ )
+ "--"
+ ["Insert Header" smarty-template-header t]
+ ["Insert Footer" smarty-template-footer t]
+ ["Insert Date" smarty-template-insert-date t]
+ ["Modify Date" smarty-template-modify t])
+ "--"
+ ["Show Messages" smarty-show-messages :keys "C-c M-m"]
+ ["Smarty Mode Documentation" smarty-doc-mode :keys "C-c C-h"]
+ ["Version" smarty-version :keys "C-c C-v"]
+ "--"
+ ("Options"
+ ("Mode"
+ ["Electric Mode"
+ (progn (customize-set-variable 'smarty-electric-mode
+ (not smarty-electric-mode))
+ (smarty-mode-line-update))
+ :style toggle :selected smarty-electric-mode :keys "C-c C-m C-e"]
+ ["Stutter Mode"
+ (progn (customize-set-variable 'smarty-stutter-mode
+ (not smarty-stutter-mode))
+ (smarty-mode-line-update))
+ :style toggle :selected smarty-stutter-mode :keys "C-c C-m C-s"]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-mode) t])
+ ("Menu"
+ ["Source Menu"
+ (customize-set-variable 'smarty-source-file-menu
+ (not smarty-source-file-menu))
+ :style toggle :selected smarty-source-file-menu]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-menu) t])
+ ("Highlight"
+ ["Highlight plugin functions"
+ (progn (customize-set-variable 'smarty-highlight-plugin-functions
+ (not smarty-highlight-plugin-functions)))
+ :style toggle :selected smarty-highlight-plugin-functions]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-highlight) t])
+ ("Template"
+ ("Header"
+ ["Header template..."
+ (customize-option 'smarty-file-header) t]
+ ["Footer template..."
+ (customize-option 'smarty-file-footer) t]
+ ["Company..."
+ (customize-option 'smarty-company-name) t]
+ ["Copyright..."
+ (customize-option 'smarty-copyright-string) t]
+ ["Date format..."
+ (customize-option 'smarty-date-format) t]
+ ["Modify date prefix..."
+ (customize-option 'smarty-modify-date-prefix-string) t]
+ ["Modify date on saving"
+ (customize-set-variable 'smarty-modify-date-on-saving
+ (not smarty-modify-date-on-saving))
+ :style toggle :selected smarty-modify-date-on-saving]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-header) t])
+ "--"
+ ["Customize Group..." (customize-group 'smarty-template) t])
+ ("Miscellaneous"
+ ["Left delimiter..."
+ (customize-option 'smarty-left-delimiter) t]
+ ["Right delimiter..."
+ (customize-option 'smarty-right-delimiter) t]
+ ["Use Intelligent Tab"
+ (progn (customize-set-variable 'smarty-intelligent-tab
+ (not smarty-intelligent-tab))
+ (smarty-activate-customizations))
+ :style toggle :selected smarty-intelligent-tab]
+ ["Word Completion in Minibuffer"
+ (progn (customize-set-variable 'smarty-word-completion-in-minibuffer
+ (not smarty-word-completion-in-minibuffer))
+ (message "Activate new setting by saving options and restarting Emacs"))
+ :style toggle :selected smarty-word-completion-in-minibuffer]
+ ["Completion is case sensitive"
+ (customize-set-variable 'smarty-word-completion-case-sensitive
+ (not smarty-word-completion-case-sensitive))
+ :style toggle :selected smarty-word-completion-case-sensitive]
+ "--"
+ ["Customize Group..." (customize-group 'smarty-misc) t])
+ "--"
+ ["Save Options" customize-save-customized t]
+ ["Activate Options" smarty-activate-customizations t]
+ ["Browse Options..." smarty-customize t])))
+
+(defvar smarty-mode-menu-list (smarty-create-mode-menu)
+ "Smarty Mode menu.")
+
+(defvar smarty-mode-map nil
+ "Keymap for Smarty Mode.")
+
+(defun smarty-update-mode-menu ()
+ "Update Smarty Mode menu."
+ (interactive)
+ (easy-menu-remove smarty-mode-menu-list)
+ (setq smarty-mode-menu-list (smarty-create-mode-menu))
+ (easy-menu-add smarty-mode-menu-list)
+ (easy-menu-define smarty-mode-menu smarty-mode-map
+ "Menu keymap for Smarty Mode." smarty-mode-menu-list))
+
+
+
+
+(defvar smarty-mode-hook nil)
+
+(defvar smarty-functions nil
+ "List of Smarty functions.")
+
+(defvar smarty-functions-regexp nil
+ "Regexp for Smarty functions.")
+
+(defconst smarty-01-functions
+ '("capture" "config_load" "foreach" "foreachelse" "include"
+ "include_php" "insert" "if" "elseif" "else" "ldelim" "rdelim"
+ "literal" "php" "section" "sectionelse" "strip" "assign" "counter"
+ "cycle" "debug" "eval" "fetch" "html_checkboxes" "html_image"
+ "html_options" "html_radios" "html_select_date" "html_select_time"
+ "html_table" "math" "mailto" "popup_init" "popup" "textformat")
+ "Smarty built-in & custom functions.")
+
+(defvar smarty-modifiers nil
+ "List of Smarty variable modifiers.")
+
+(defvar smarty-modifiers-regexp nil
+ "Regexp for Smarty variable modifiers.")
+
+(defconst smarty-01-modifiers
+ '("capitalize" "cat" "count_characters" "count_paragraphs"
+ "count_sentences" "count_words" "date_format" "default"
+ "escape" "indent" "lower" "nl2br" "regex_replace" "replace"
+ "spacify" "string_format" "strip" "strip_tags" "truncate"
+ "upper" "wordwrap")
+ "Smarty variable modifiers.")
+
+(defvar smarty-plugins-functions nil
+ "List of Smarty functions.")
+
+(defvar smarty-plugins-functions-regexp nil
+ "Regexp for Smarty functions.")
+
+(defconst smarty-01-plugins-functions
+ '("validate" "formtool_checkall" "formtool_copy" "formtool_count_chars"
+ "formtool_init" "formtool_move" "formtool_moveall"
+ "formtool_movedown" "formtool_moveup" "formtool_remove"
+ "formtool_rename" "formtool_save" "formtool_selectall"
+ "paginate_first" "paginate_last" "paginate_middle"
+ "paginate_next" "paginate_prev" "clipcache" "include_clipcache"
+ "repeat" "str_repeat")
+ "Smarty plugins functions.")
+
+(defvar smarty-plugins-modifiers nil
+ "List of Smarty variable modifiers.")
+
+(defvar smarty-plugins-modifiers-regexp nil
+ "Regexp for Smarty functions.")
+
+(defconst smarty-01-plugins-modifiers
+ '("B2Smilies" "bbcode2html" "date_format2")
+ "Smarty plugins modifiers.")
+
+(defconst smarty-constants
+ (eval-when-compile
+ (regexp-opt
+ '("TRUE" "FALSE" "NULL") t))
+ "Smarty constants.")
+
+
+;; Syntax table creation
+(defvar smarty-mode-syntax-table nil
+ "Syntax table for smarty-mode.")
+
+(defvar smarty-mode-ext-syntax-table nil
+ "Syntax table extended by `_' used in `smarty-mode' buffers.")
+
+(defun smarty-create-syntax-table ()
+ (if smarty-mode-syntax-table
+ ()
+ (setq smarty-mode-syntax-table (make-syntax-table))
+
+ ;; Make | a punctuation character
+ (modify-syntax-entry ?| "." smarty-mode-syntax-table)
+ ;; Make " a punctuation character so highlighing works withing html strings
+ (modify-syntax-entry ?\" "." smarty-mode-syntax-table)
+ ;; define parentheses to match
+ (modify-syntax-entry ?\( "()" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\) ")(" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\[ "(]" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\] ")[" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\{ "(}" smarty-mode-syntax-table)
+ (modify-syntax-entry ?\} "){" smarty-mode-syntax-table)
+ )
+ (set-syntax-table smarty-mode-syntax-table)
+ ;; extended syntax table including '_' (for simpler search regexps)
+ (setq smarty-mode-ext-syntax-table (copy-syntax-table smarty-mode-syntax-table))
+ (modify-syntax-entry ?_ "w" smarty-mode-ext-syntax-table))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; File/directory manipulation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-directory-files (directory &optional full match)
+ "Call `directory-files' if DIRECTORY exists, otherwise generate error
+message."
+ (if (not (file-directory-p directory))
+ (smarty-warning-when-idle "No such directory: \"%s\"" directory)
+ (let ((dir (directory-files directory full match)))
+ (setq dir (delete "." dir))
+ (setq dir (delete ".." dir))
+ dir)))
+
+(defun smarty-get-source-files (&optional full directory)
+ "Get list of SMARTY source files in DIRECTORY or current directory."
+ (let ((mode-alist auto-mode-alist)
+ filename-regexp)
+ ;; create regular expressions for matching file names
+ (setq filename-regexp "\\`[^.].*\\(")
+ (while mode-alist
+ (when (eq (cdar mode-alist) 'smarty-mode)
+ (setq filename-regexp
+ (concat filename-regexp (caar mode-alist) "\\|")))
+ (setq mode-alist (cdr mode-alist)))
+ (setq filename-regexp
+ (concat (substring filename-regexp 0
+ (string-match "\\\\|$" filename-regexp)) "\\)"))
+ ;; find files
+ (smarty-directory-files
+ (or directory default-directory) full filename-regexp)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Messages reporting
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-warnings nil
+ "Warnings to tell the user during start up.")
+
+(defun smarty-run-when-idle (secs repeat function)
+ "Wait until idle, then run FUNCTION."
+ (if (fboundp 'start-itimer)
+ (start-itimer "smarty-mode" function secs repeat t)
+; (run-with-idle-timer secs repeat function)))
+ ;; explicitely activate timer (necessary when Emacs is already idle)
+ (aset (run-with-idle-timer secs repeat function) 0 nil)))
+
+(defun smarty-warning-when-idle (&rest args)
+ "Wait until idle, then print out warning STRING and beep."
+ (save-match-data ;; runs in timer
+ (if noninteractive
+ (smarty-warning (apply 'format args) t)
+ (unless smarty-warnings
+ (smarty-run-when-idle .1 nil 'smarty-print-warnings))
+ (setq smarty-warnings (cons (apply 'format args) smarty-warnings)))))
+
+(defun smarty-warning (string &optional nobeep)
+ "Print out warning STRING and beep."
+ (message (concat "WARNING: " string))
+ (unless (or nobeep noninteractive) (beep)))
+
+(defun smarty-print-warnings ()
+ "Print out messages in variable `smarty-warnings'."
+ (let ((no-warnings (length smarty-warnings)))
+ (setq smarty-warnings (nreverse smarty-warnings))
+ (while smarty-warnings
+ (message (concat "WARNING: " (car smarty-warnings)))
+ (setq smarty-warnings (cdr smarty-warnings)))
+ (beep)
+ (when (> no-warnings 1)
+ (message "WARNING: See warnings in message buffer (type `C-c M-m')."))))
+
+(defun smarty-show-messages ()
+ "Get *Messages* buffer to show recent messages."
+ (interactive)
+ (display-buffer " *Message-Log*"))
+
+(defun smarty-version ()
+ "Echo the current version of Smarty Mode in the minibuffer."
+ (interactive)
+ (message "Smarty Mode %s (%s)" smarty-version smarty-time-stamp)
+ (smarty-keep-region-active))
+
+;; active regions
+(defun smarty-keep-region-active ()
+ "Do whatever is necessary to keep the region active in XEmacs.
+Ignore byte-compiler warnings you might see."
+ (and (boundp 'zmacs-region-stays)
+ (setq zmacs-region-stays t)))
+
+(defmacro smarty-prepare-search-1 (&rest body)
+ "Enable case insensitive search and switch to syntax table that includes '_',
+then execute BODY, and finally restore the old environment. Used for
+consistent searching."
+ `(let ((case-fold-search t) ; case insensitive search
+ (current-syntax-table (syntax-table))
+ result
+ (restore-prog ; program to restore enviroment
+ '(progn
+ ;; restore syntax table
+ (set-syntax-table current-syntax-table))))
+ ;; use extended syntax table
+ (set-syntax-table smarty-mode-ext-syntax-table)
+ ;; execute BODY safely
+ (setq result
+ (condition-case info
+ (progn ,@body)
+ (error (eval restore-prog) ; restore environment on error
+ (error (cadr info))))) ; pass error up
+ ;; restore environment
+ (eval restore-prog)
+ result))
+
+(defmacro smarty-prepare-search-2 (&rest body)
+ "Enable case insensitive search, switch to syntax table that includes '_',
+and remove `intangible' overlays, then execute BODY, and finally restore the
+old environment. Used for consistent searching."
+ `(let ((case-fold-search t) ; case insensitive search
+ (current-syntax-table (syntax-table))
+ result overlay-all-list overlay-intangible-list overlay
+ (restore-prog ; program to restore enviroment
+ '(progn
+ ;; restore syntax table
+ (set-syntax-table current-syntax-table)
+ ;; restore `intangible' overlays
+ (when (fboundp 'overlay-lists)
+ (while overlay-intangible-list
+ (overlay-put (car overlay-intangible-list) 'intangible t)
+ (setq overlay-intangible-list
+ (cdr overlay-intangible-list)))))))
+ ;; use extended syntax table
+ (set-syntax-table smarty-mode-ext-syntax-table)
+ ;; remove `intangible' overlays
+ (when (fboundp 'overlay-lists)
+ (setq overlay-all-list (overlay-lists))
+ (setq overlay-all-list
+ (append (car overlay-all-list) (cdr overlay-all-list)))
+ (while overlay-all-list
+ (setq overlay (car overlay-all-list))
+ (when (memq 'intangible (overlay-properties overlay))
+ (setq overlay-intangible-list
+ (cons overlay overlay-intangible-list))
+ (overlay-put overlay 'intangible nil))
+ (setq overlay-all-list (cdr overlay-all-list))))
+ ;; execute BODY safely
+ (setq result
+ (condition-case info
+ (progn ,@body)
+ (error (eval restore-prog) ; restore environment on error
+ (error (cadr info))))) ; pass error up
+ ;; restore environment
+ (eval restore-prog)
+ result))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Enabling/disabling
+
+(defun smarty-mode-line-update ()
+ "Update the modeline string for Smarty major mode."
+ (setq mode-name (concat "Smarty"
+ (and (or smarty-electric-mode smarty-stutter-mode) "/")
+ (and smarty-electric-mode "e")
+ (and smarty-stutter-mode "s")))
+ (force-mode-line-update t))
+
+(defun smarty-electric-mode (arg)
+ "Toggle Smarty electric mode.
+Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
+ (interactive "P")
+ (setq smarty-electric-mode
+ (cond ((or (not arg) (zerop arg)) (not smarty-electric-mode))
+ ((> arg 0) t) (t nil)))
+ (smarty-mode-line-update))
+
+(defun smarty-stutter-mode (arg)
+ "Toggle Smarty stuttering mode.
+Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
+ (interactive "P")
+ (setq smarty-stutter-mode
+ (cond ((or (not arg) (zerop arg)) (not smarty-stutter-mode))
+ ((> arg 0) t) (t nil)))
+ (smarty-mode-line-update))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Smarty code delimitation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-in-literal ()
+ "Determine if point is in a Smarty literal."
+ (save-excursion
+ (let ((here (point))
+ start state)
+ (beginning-of-line)
+ (setq start (point))
+ (goto-char here)
+ (setq state (parse-partial-sexp start (point)))
+ (cond
+ ((nth 3 state) 'string)
+ ((nth 4 state) 'comment)
+ (t nil)))))
+
+(defun smarty-in-comment-p ()
+ "Check if point is in a comment."
+ (let ((result nil) (here (point-marker)) found)
+ (save-excursion
+ (setq found (re-search-backward (regexp-quote (concat smarty-left-delimiter "*")) nil t))
+ (when found
+ (setq result (re-search-forward (regexp-quote (concat "*" smarty-right-delimiter)) here t))
+ (setq result (not result))))
+ result))
+
+(defun smarty-after-ldelim ()
+ "Check that the previous character is the left delimiter."
+ (let ((here (point-marker)) ldelim-found ldelim-point)
+ (save-excursion
+ (setq ldelim-found (re-search-backward (regexp-quote smarty-left-delimiter) nil t))
+ (re-search-forward (regexp-quote smarty-left-delimiter) here t)
+ (setq ldelim-point (point-marker))
+ (goto-char here)
+ (if (and (= here ldelim-point) ldelim-found)
+ t
+ nil))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Words to expand
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-words-init ()
+ "Initialize reserved words."
+ (setq smarty-functions smarty-01-functions)
+ (setq smarty-modifiers smarty-01-modifiers)
+ (setq smarty-plugins-functions smarty-01-plugins-functions)
+ (setq smarty-plugins-modifiers smarty-01-plugins-modifiers)
+ (setq smarty-functions-regexp (concat "\\<\\(" (regexp-opt smarty-functions) "\\)\\>"))
+ (setq smarty-modifiers-regexp (concat "\\<\\(" (regexp-opt smarty-modifiers) "\\)\\>"))
+ (setq smarty-plugins-functions-regexp (concat "\\<\\(" (regexp-opt smarty-plugins-functions) "\\)\\>"))
+ (setq smarty-plugins-modifiers-regexp (concat "\\<\\(" (regexp-opt smarty-plugins-modifiers) "\\)\\>"))
+ (smarty-abbrev-list-init))
+
+(defvar smarty-abbrev-list nil
+ "Predefined abbreviations for Smarty.")
+
+(defun smarty-abbrev-list-init ()
+ (setq smarty-abbrev-list
+ (append
+ (list nil) smarty-functions
+ (list nil) smarty-modifiers
+ (list nil) smarty-plugins-functions
+ (list nil) smarty-plugins-modifiers)))
+
+(defvar smarty-expand-upper-case nil)
+
+(defun smarty-try-expand-abbrev (old)
+ "Try expanding abbreviations from `smarty-abbrev-list'."
+ (unless old
+ (he-init-string (he-dabbrev-beg) (point))
+ (setq he-expand-list
+ (let ((abbrev-list smarty-abbrev-list)
+ (sel-abbrev-list '()))
+ (while abbrev-list
+ ; (if (stringp (car abbrev-list))
+ ; (insert (concat " " (car abbrev-list))))
+ (when (or (not (stringp (car abbrev-list)))
+ (string-match
+ (concat "^" he-search-string) (car abbrev-list)))
+ (setq sel-abbrev-list
+ (cons (car abbrev-list) sel-abbrev-list)))
+ (setq abbrev-list (cdr abbrev-list)))
+ (nreverse sel-abbrev-list))))
+ (while (and he-expand-list
+ (or (not (stringp (car he-expand-list)))
+ (he-string-member (car he-expand-list) he-tried-table t)))
+ (unless (stringp (car he-expand-list))
+ (setq smarty-expand-upper-case (car he-expand-list)))
+ (setq he-expand-list (cdr he-expand-list)))
+ (if (null he-expand-list)
+ (progn (when old (he-reset-string))
+ nil)
+ (he-substitute-string
+ (if smarty-expand-upper-case
+ (upcase (car he-expand-list))
+ (car he-expand-list))
+ t)
+ (setq he-expand-list (cdr he-expand-list))
+ t))
+
+;; initialize reserved words for Smarty Mode
+(smarty-words-init)
+
+;; function for expanding abbrevs and dabbrevs
+(defun smarty-expand-abbrev (arg))
+(fset 'smarty-expand-abbrev (make-hippie-expand-function
+ '(try-expand-dabbrev
+ try-expand-dabbrev-all-buffers
+ smarty-try-expand-abbrev)))
+
+;; function for expanding parenthesis
+(defun smarty-expand-paren (arg))
+(fset 'smarty-expand-paren (make-hippie-expand-function
+ '(try-expand-list
+ try-expand-list-all-buffers)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Stuttering
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-end-comment-column 80)
+
+(defvar found) ;; silence compiler, dyn var
+
+(defun smarty-electric-tab (&optional prefix-arg)
+ "If preceding character is part of a word or a paren then hippie-expand,
+else if right of non whitespace on line then insert tab,
+else if last command was a tab or return then dedent one step or if a comment
+toggle between normal indent and inline comment indent,
+else indent `correctly'."
+ (interactive "*P")
+ (smarty-prepare-search-2
+ (cond
+ ;; expand word
+ ((= (char-syntax (preceding-char)) ?w)
+ (let ((case-fold-search (not smarty-word-completion-case-sensitive))
+ (case-replace nil)
+ (hippie-expand-only-buffers
+ (or (and (boundp 'hippie-expand-only-buffers)
+ hippie-expand-only-buffers)
+ '(smarty-mode))))
+ (smarty-expand-abbrev prefix-arg)))
+ ;; expand parenthesis
+ ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
+ (let ((case-fold-search (not smarty-word-completion-case-sensitive))
+ (case-replace nil))
+ (smarty-expand-paren prefix-arg))))
+ (setq this-command 'smarty-electric-tab)))
+
+(defun smarty-electric-space (count)
+ "Expand abbreviations and self-insert space(s)."
+ (interactive "p")
+ (let ((here (point-marker)) ldelim-found ldelim-point rdelim-found rdelim-point
+ delete-a)
+ (setq ldelim-found (re-search-backward (regexp-quote smarty-left-delimiter) nil t))
+ (re-search-forward (regexp-quote smarty-left-delimiter) here t)
+ (setq ldelim-point (point-marker))
+ (goto-char here)
+ (setq rdelim-found (re-search-backward (regexp-quote (concat " " smarty-right-delimiter)) nil t))
+ (re-search-forward (regexp-quote (concat " " smarty-right-delimiter)) here t)
+ (setq rdelim-point (point-marker))
+ (goto-char here)
+ (cond ((and (= here ldelim-point) ldelim-found) (insert (concat "ldelim" smarty-right-delimiter)))
+ ((and (= here rdelim-point) rdelim-found)
+ (re-search-backward (regexp-quote (concat " " smarty-right-delimiter)) nil t)
+ (delete-char 1)
+ (insert (concat " " smarty-left-delimiter "rdelim"))
+ (goto-char here))
+ ((smarty-in-comment-p)
+ (self-insert-command count)
+ (cond ((>= (current-column) (+ 2 smarty-end-comment-column))
+ (backward-char 1)
+ (skip-chars-backward "^ \t\n")
+ (indent-new-comment-line)
+ (skip-chars-forward "^ \t\n")
+ (forward-char 1))
+ ((>= (current-column) smarty-end-comment-column)
+ (indent-new-comment-line))
+ (t nil)))
+ ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
+ (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z))
+ (and (>= (preceding-char) ?0) (<= (preceding-char) ?9)))
+ (progn
+ (setq here (point-marker))
+ (insert " ")
+ (setq delete-a t)
+ (if (re-search-backward "|" nil t)
+ (progn
+ (setq found (re-search-forward (regexp-quote "B2Smilies") here t))
+ (if (and found (= here (point-marker)))
+ (replace-match "btosmilies")
+ (setq found (re-search-forward (regexp-quote "bbcode2html") here t))
+ (if (and found (= here (point-marker)))
+ (replace-match "bbcodetohtml")
+ (setq found (re-search-forward (regexp-quote "date_format2") here t))
+ (if (and found (= here (point-marker)))
+ (replace-match "date_formatto")
+ (goto-char here)
+ (setq delete-a nil)
+ (delete-char 1)))))
+ (goto-char here)
+ (setq delete-a nil)
+ (delete-char 1)))
+ (smarty-prepare-search-1 (expand-abbrev))
+ (self-insert-command count)
+ (if (and delete-a (looking-at " "))
+ (delete-char 1)))
+ (t (self-insert-command count)))))
+
+(defun smarty-electric-open-bracket (count)
+ "'(' --> '(', '((' --> '[', '[(' --> '{'"
+ (interactive "p")
+ (if (and smarty-stutter-mode (= count 1) (not (smarty-in-literal)))
+ (if (= (preceding-char) ?\()
+ (progn (delete-char -1) (insert-char ?\[ 1))
+ (if (= (preceding-char) ?\[)
+ (progn (delete-char -1) (insert-char ?\{ 1))
+ (insert-char ?\( 1)))
+ (self-insert-command count)))
+
+(defun smarty-electric-close-bracket (count)
+ "')' --> ')', '))' --> ']', '])' --> '}'"
+ (interactive "p")
+ (if (and smarty-stutter-mode (= count 1) (not (smarty-in-literal)))
+ (progn
+ (if (= (preceding-char) ?\))
+ (progn (delete-char -1) (insert-char ?\] 1))
+ (if (= (preceding-char) ?\])
+ (progn (delete-char -1) (insert-char ?} 1))
+ (insert-char ?\) 1)))
+ (blink-matching-open))
+ (self-insert-command count)))
+
+(defun smarty-electric-star (count)
+ "After a left delimiter add a right delemiter to close the comment"
+ (interactive "p")
+ (let ((here (point-marker)) found)
+ (if (and smarty-stutter-mode (= count 1) (not (smarty-in-literal)))
+ (progn
+ (setq found (re-search-backward (regexp-quote smarty-left-delimiter) nil t))
+ (re-search-forward (regexp-quote smarty-left-delimiter) here t)
+ (if (not (and (= here (point-marker)) found))
+ (progn (goto-char here)
+ (self-insert-command count))
+ (self-insert-command count)
+ (insert " ")
+ (setq here (point-marker))
+ (insert " *")
+ (insert smarty-right-delimiter)
+ (goto-char here)))
+ (self-insert-command count))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Electrification
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst smarty-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]"
+ "Syntax of prompt inserted by template generators.")
+
+(defvar smarty-template-invoked-by-hook nil
+ "Indicates whether a template has been invoked by a hook or by key or menu.
+Used for undoing after template abortion.")
+
+(defun smarty-minibuffer-tab (&optional prefix-arg)
+ "If preceding character is part of a word or a paren then hippie-expand,
+else insert tab (used for word completion in Smarty minibuffer)."
+ (interactive "P")
+ (cond
+ ;; expand word
+ ((= (char-syntax (preceding-char)) ?w)
+ (let ((case-fold-search (not smarty-word-completion-case-sensitive))
+ (case-replace nil)
+ (hippie-expand-only-buffers
+ (or (and (boundp 'hippie-expand-only-buffers)
+ hippie-expand-only-buffers)
+ '(smarty-mode))))
+ (smarty-expand-abbrev prefix-arg)))
+ ;; expand parenthesis
+ ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
+ (let ((case-fold-search (not smarty-word-completion-case-sensitive))
+ (case-replace nil))
+ (smarty-expand-paren prefix-arg)))
+ ;; insert tab
+ (t (insert-tab))))
+
+;; correct different behavior of function `unread-command-events' in XEmacs
+(defun smarty-character-to-event (arg))
+(defalias 'smarty-character-to-event
+ (if (fboundp 'character-to-event) 'character-to-event 'identity))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Abbrev ook bindings
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-mode-abbrev-table nil
+ "Abbrev table to use in `smarty-mode' buffers.")
+
+(defun smarty-mode-abbrev-table-init ()
+ "Initialize `smarty-mode-abbrev-table'."
+ (when smarty-mode-abbrev-table (clear-abbrev-table smarty-mode-abbrev-table))
+ (define-abbrev-table 'smarty-mode-abbrev-table
+ (append
+ '(
+ ("capture" "" smarty-template-capture-hook 0)
+ ("config_load" "" smarty-template-config-load-hook 0)
+ ("else" "" smarty-template-else-hook 0)
+ ("elseif" "" smarty-template-elseif-hook 0)
+ ("foreach" "" smarty-template-foreach-hook 0)
+ ("foreachelse" "" smarty-template-foreachelse-hook 0)
+ ("if" "" smarty-template-if-hook 0)
+ ("include" "" smarty-template-include-hook 0)
+ ("include_php" "" smarty-template-include-php-hook 0)
+ ("insert" "" smarty-template-insert-hook 0)
+ ("ldelim" "" smarty-template-ldelim-hook 0)
+ ("literal" "" smarty-template-literal-hook 0)
+ ("php" "" smarty-template-php-hook 0)
+ ("rdelim" "" smarty-template-rdelim-hook 0)
+ ("section" "" smarty-template-section-hook 0)
+ ("sectionelse" "" smarty-template-sectionelse-hook 0)
+ ("strip" "" smarty-template-strip-hook 0)
+ ("assign" "" smarty-template-assign-hook 0)
+ ("counter" "" smarty-template-counter-hook 0)
+ ("cycle" "" smarty-template-cycle-hook 0)
+ ("debug" "" smarty-template-debug-hook 0)
+ ("eval" "" smarty-template-eval-hook 0)
+ ("fetch" "" smarty-template-fetch-hook 0)
+ ("html_checkboxes" "" smarty-template-html-checkboxes-hook 0)
+ ("html_image" "" smarty-template-html-image-hook 0)
+ ("html_options" "" smarty-template-html-options-hook 0)
+ ("html_radios" "" smarty-template-html-radios-hook 0)
+ ("html_select_date" "" smarty-template-html-select-date-hook 0)
+ ("html_select_time" "" smarty-template-html-select-time-hook 0)
+ ("html_table" "" smarty-template-html-table-hook 0)
+ ("mailto" "" smarty-template-mailto-hook 0)
+ ("math" "" smarty-template-math-hook 0)
+ ("popup" "" smarty-template-popup-hook 0)
+ ("popup_init" "" smarty-template-popup-init-hook 0)
+ ("textformat" "" smarty-template-textformat-hook 0)
+ ("capitalize" "" smarty-template-capitalize-hook 0)
+ ("cat" "" smarty-template-cat-hook 0)
+ ("count_characters" "" smarty-template-count-characters-hook 0)
+ ("count_paragraphs" "" smarty-template-count-paragraphs-hook 0)
+ ("count_sentences" "" smarty-template-count-sentences-hook 0)
+ ("count_words" "" smarty-template-count-words-hook 0)
+ ("date_format" "" smarty-template-date-format-hook 0)
+ ("default" "" smarty-template-default-hook 0)
+ ("escape" "" smarty-template-escape-hook 0)
+ ("indent" "" smarty-template-indent-hook 0)
+ ("lower" "" smarty-template-lower-hook 0)
+ ("nl2br" "" smarty-template-nl2br-hook 0)
+ ("regex_replace" "" smarty-template-regex-replace-hook 0)
+ ("replace" "" smarty-template-replace-hook 0)
+ ("spacify" "" smarty-template-spacify-hook 0)
+ ("string_format" "" smarty-template-string-format-hook 0)
+ ("strip" "" smarty-template-vstrip-hook 0)
+ ("strip_tags" "" smarty-template-strip-tags-hook 0)
+ ("truncate" "" smarty-template-truncate-hook 0)
+ ("upper" "" smarty-template-upper-hook 0)
+ ("wordwrap" "" smarty-template-wordwrap-hook 0)
+ ("validate" "" smarty-template-validate-hook 0)
+ ("clipcache" "" smarty-template-clipcache-hook 0)
+ ("repeat" "" smarty-template-repeat-hook 0)
+ ("str_repeat" "" smarty-template-str-repeat-hook 0)
+ ("include_clipcache" "" smarty-template-include-clipcache-hook 0)
+ ("formtool_checkall" "" smarty-template-formtool-checkall-hook 0)
+ ("formtool_copy" "" smarty-template-formtool-copy-hook 0)
+ ("formtool_count_chars" "" smarty-template-formtool-count-chars-hook 0)
+ ("formtool_init" "" smarty-template-formtool-init-hook 0)
+ ("formtool_move" "" smarty-template-formtool-move-hook 0)
+ ("formtool_moveall" "" smarty-template-formtool-moveall-hook 0)
+ ("formtool_movedown" "" smarty-template-formtool-movedown-hook 0)
+ ("formtool_moveup" "" smarty-template-formtool-moveup-hook 0)
+ ("formtool_remove" "" smarty-template-formtool-remove-hook 0)
+ ("formtool_rename" "" smarty-template-formtool-rename-hook 0)
+ ("formtool_save" "" smarty-template-formtool-save-hook 0)
+ ("formtool_selectall" "" smarty-template-formtool-selectall-hook 0)
+ ("paginate_first" "" smarty-template-paginate-first-hook 0)
+ ("paginate_last" "" smarty-template-paginate-last-hook 0)
+ ("paginate_middle" "" smarty-template-paginate-middle-hook 0)
+ ("paginate_next" "" smarty-template-paginate-next-hook 0)
+ ("paginate_prev" "" smarty-template-paginate-prev-hook 0)
+ ("btosmilies" "" smarty-template-btosmilies-hook 0)
+ ("bbcodetohtml" "" smarty-template-bbcodetohtml-hook 0)
+ ("date_formatto" "" smarty-template-date-formatto-hook 0)))))
+
+;; initialize abbrev table for Smarty Mode
+(smarty-mode-abbrev-table-init)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Abbrev hooks
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-hooked-abbrev (func)
+ "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
+but not if inside a comment or quote)."
+ (if (or (smarty-in-literal)
+ (smarty-in-comment-p))
+ (progn
+ (insert " ")
+ (unexpand-abbrev)
+ (delete-char -1))
+ (if (not smarty-electric-mode)
+ (progn
+ (insert " ")
+ (unexpand-abbrev)
+ (backward-word 1)
+ (delete-char 1))
+ (let ((invoke-char last-command-event)
+ (abbrev-mode -1)
+ (smarty-template-invoked-by-hook t))
+ (let ((caught (catch 'abort
+ (funcall func))))
+ (when (stringp caught) (message caught)))
+ (when (= invoke-char ?-) (setq abbrev-start-location (point)))
+ ;; delete CR which is still in event queue
+ (if (fboundp 'enqueue-eval-event)
+ (enqueue-eval-event 'delete-char -1)
+ (setq unread-command-events ; push back a delete char
+ (list (smarty-character-to-event ?\177))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Fontification
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-font-lock-keywords-1
+ (list
+
+ ;; Fontify built-in functions
+ (cons
+ (concat (regexp-quote smarty-left-delimiter) "[/]*" smarty-functions-regexp)
+ '(1 font-lock-keyword-face))
+
+ (cons
+ (concat "\\<\\(" smarty-constants "\\)\\>")
+ 'font-lock-constant-face)
+
+ (cons (concat "\\(" (regexp-quote (concat smarty-left-delimiter "*")) "\\(\\s-\\|\\w\\|\\s.\\|\\s_\\|\\s(\\|\\s)\\|\\s\\\\)*" (regexp-quote (concat "*" smarty-right-delimiter)) "\\)")
+ 'font-lock-comment-face)
+
+ )
+ "Subdued level highlighting for Smarty mode.")
+
+(defconst smarty-font-lock-keywords-2
+ (append
+ smarty-font-lock-keywords-1
+ (list
+
+ ;; Fontify variable names (\\sw\\|\\s_\\) matches any word character +
+ ;; underscore
+ '("\\$\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face)) ; $variable
+ '("->\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face t t)) ; ->variable
+ '("\\.\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face t t)) ; .variable
+ '("->\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(" (1 font-lock-function-name-face t t)) ; ->function_call
+ '("\\<\\(\\(?:\\sw\\|\\s_\\)+\\s-*\\)(" (1 font-lock-function-name-face)) ; word(
+ '("\\<\\(\\(?:\\sw\\|\\s_\\)+\\s-*\\)[[]" (1 font-lock-variable-name-face)) ; word[
+ '("\\<[0-9]+" . 'default) ; number (also matches word)
+
+ ;; Fontify strings
+ ;;'("\"\\([^\"]*\\)\"[^\"]+" (1 font-lock-string-face t t))
+ ))
+
+ "Medium level highlighting for Smarty mode.")
+
+(defconst smarty-font-lock-keywords-3
+ (append
+ smarty-font-lock-keywords-2
+ (list
+ ;; Fontify modifiers
+ (cons (concat "|\\(" smarty-modifiers-regexp "\\)[:|]+") '(1 font-lock-function-name-face))
+ (cons (concat "|\\(" smarty-modifiers-regexp "\\)" (regexp-quote smarty-right-delimiter)) '(1 font-lock-function-name-face))
+
+ ;; Fontify config vars
+ (cons (concat (regexp-quote smarty-left-delimiter) "\\(#\\(?:\\sw\\|\\s_\\)+#\\)") '(1 font-lock-constant-face))))
+ "Balls-out highlighting for Smarty mode.")
+
+(defconst smarty-font-lock-keywords-4
+ (append
+ smarty-font-lock-keywords-3
+ (list
+ ;; Fontify plugin functions
+ (cons
+ (concat (regexp-quote smarty-left-delimiter) "[/]*" smarty-plugins-functions-regexp)
+ '(1 font-lock-keyword-face))
+
+ (cons (concat "|\\(" smarty-plugins-modifiers-regexp "\\)[:|]+") '(1 font-lock-function-name-face))
+ (cons (concat "|\\(" smarty-plugins-modifiers-regexp "\\)" (regexp-quote smarty-right-delimiter)) '(1 font-lock-function-name-face)))))
+
+(defvar smarty-font-lock-keywords smarty-font-lock-keywords-3
+ "Default highlighting level for Smarty mode")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Mode map
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar smarty-template-map nil
+ "Keymap for Smarty templates.")
+
+(defun smarty-template-map-init ()
+ "Initialize `smarty-template-map'."
+ (setq smarty-template-map (make-sparse-keymap))
+ ;; key bindings for Smarty templates
+ (define-key smarty-template-map "\C-ba" 'smarty-template-capture)
+ (define-key smarty-template-map "\C-bc" 'smarty-template-config-load)
+ (define-key smarty-template-map "\C-b\M-e" 'smarty-template-else)
+ (define-key smarty-template-map "\C-b\C-e" 'smarty-template-elseif)
+ (define-key smarty-template-map "\C-b\C-f" 'smarty-template-foreach)
+ (define-key smarty-template-map "\C-b\M-f" 'smarty-template-foreachelse)
+ (define-key smarty-template-map "\C-bf" 'smarty-template-if)
+ (define-key smarty-template-map "\C-b\C-i" 'smarty-template-include)
+ (define-key smarty-template-map "\C-b\M-i" 'smarty-template-include-php)
+ (define-key smarty-template-map "\C-bi" 'smarty-template-insert)
+ (define-key smarty-template-map "\C-bl" 'smarty-template-ldelim)
+ (define-key smarty-template-map "\C-b\C-l" 'smarty-template-literal)
+ (define-key smarty-template-map "\C-bp" 'smarty-template-php)
+ (define-key smarty-template-map "\C-br" 'smarty-template-rdelim)
+ (define-key smarty-template-map "\C-b\C-s" 'smarty-template-section)
+ (define-key smarty-template-map "\C-b\M-s" 'smarty-template-sectionelse)
+ (define-key smarty-template-map "\C-bs" 'smarty-template-strip)
+ (define-key smarty-template-map "\C-ca" 'smarty-template-assign)
+ (define-key smarty-template-map "\C-co" 'smarty-template-counter)
+ (define-key smarty-template-map "\C-cc" 'smarty-template-cycle)
+ (define-key smarty-template-map "\C-cd" 'smarty-template-debug)
+ (define-key smarty-template-map "\C-ce" 'smarty-template-eval)
+ (define-key smarty-template-map "\C-cf" 'smarty-template-fetch)
+ (define-key smarty-template-map "\C-c\C-hc" 'smarty-template-html-checkboxes)
+ (define-key smarty-template-map "\C-c\C-hi" 'smarty-template-html-image)
+ (define-key smarty-template-map "\C-c\C-ho" 'smarty-template-html-options)
+ (define-key smarty-template-map "\C-c\C-hr" 'smarty-template-html-radios)
+ (define-key smarty-template-map "\C-c\C-hd" 'smarty-template-html-select-date)
+ (define-key smarty-template-map "\C-c\C-hm" 'smarty-template-html-select-time)
+ (define-key smarty-template-map "\C-c\C-ht" 'smarty-template-html-table)
+ (define-key smarty-template-map "\C-ci" 'smarty-template-mailto)
+ (define-key smarty-template-map "\C-ch" 'smarty-template-math)
+ (define-key smarty-template-map "\C-c\C-p" 'smarty-template-popup)
+ (define-key smarty-template-map "\C-c\M-p" 'smarty-template-popup-init)
+ (define-key smarty-template-map "\C-ct" 'smarty-template-textformat)
+ (define-key smarty-template-map "\C-vp" 'smarty-template-capitalize)
+ (define-key smarty-template-map "\C-vc" 'smarty-template-cat)
+ (define-key smarty-template-map "\C-v\C-cc" 'smarty-template-count-characters)
+ (define-key smarty-template-map "\C-v\C-cp" 'smarty-template-count-paragraphs)
+ (define-key smarty-template-map "\C-v\C-cs" 'smarty-template-count-sentences)
+ (define-key smarty-template-map "\C-v\C-cw" 'smarty-template-count-words)
+ (define-key smarty-template-map "\C-vf" 'smarty-template-date-format)
+ (define-key smarty-template-map "\C-vd" 'smarty-template-default)
+ (define-key smarty-template-map "\C-ve" 'smarty-template-escape)
+ (define-key smarty-template-map "\C-vi" 'smarty-template-indent)
+ (define-key smarty-template-map "\C-vl" 'smarty-template-lower)
+ (define-key smarty-template-map "\C-vn" 'smarty-template-nl2br)
+ (define-key smarty-template-map "\C-vx" 'smarty-template-regex-replace)
+ (define-key smarty-template-map "\C-v\C-p" 'smarty-template-replace)
+ (define-key smarty-template-map "\C-vy" 'smarty-template-spacify)
+ (define-key smarty-template-map "\C-vs" 'smarty-template-string-format)
+ (define-key smarty-template-map "\C-v\C-s" 'smarty-template-vstrip)
+ (define-key smarty-template-map "\C-v\M-s" 'smarty-template-strip-tags)
+ (define-key smarty-template-map "\C-vt" 'smarty-template-truncate)
+ (define-key smarty-template-map "\C-vu" 'smarty-template-upper)
+ (define-key smarty-template-map "\C-vw" 'smarty-template-wordwrap)
+ (define-key smarty-template-map "\C-h" 'smarty-template-header)
+ (define-key smarty-template-map "\C-f" 'smarty-template-footer)
+ (define-key smarty-template-map "\C-di" 'smarty-template-insert-date)
+ (define-key smarty-template-map "\C-dm" 'smarty-template-modify))
+
+;; initialize template map for Smarty Mode
+(smarty-template-map-init)
+
+(defun smarty-mode-map-init ()
+ "Initialize `smarty-mode-map'."
+ (setq smarty-mode-map (make-sparse-keymap))
+ ;; template key bindings
+ (define-key smarty-mode-map "\C-c\C-t" smarty-template-map)
+ ;; mode specific key bindings
+ (define-key smarty-mode-map "\C-c\C-m\C-e" 'smarty-electric-mode)
+ (define-key smarty-mode-map "\C-c\C-m\C-s" 'smarty-stutter-mode)
+ (define-key smarty-mode-map "\C-c\C-s\C-u" 'smarty-add-source-files-menu)
+ (define-key smarty-mode-map "\C-c\M-m" 'smarty-show-messages)
+ (define-key smarty-mode-map "\C-c\C-h" 'smarty-doc-mode)
+ (define-key smarty-mode-map "\C-c\C-v" 'smarty-version)
+ ;; electric key bindings
+ (when smarty-intelligent-tab
+ (define-key smarty-mode-map "\t" 'smarty-electric-tab))
+ (define-key smarty-mode-map " " 'smarty-electric-space)
+ (define-key smarty-mode-map "(" 'smarty-electric-open-bracket)
+ (define-key smarty-mode-map ")" 'smarty-electric-close-bracket)
+ (define-key smarty-mode-map "*" 'smarty-electric-star))
+
+;; initialize mode map for Smarty Mode
+(smarty-mode-map-init)
+
+(defvar smarty-minibuffer-local-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (when smarty-word-completion-in-minibuffer
+ (define-key map "\t" 'smarty-minibuffer-tab))
+ map)
+ "Keymap for minibuffer used in Smarty Mode.")
+
+(mapcar
+ (function
+ (lambda (sym)
+ (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs)
+ (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs)
+ '(smarty-electric-space
+ smarty-electric-tab
+ smarty-electric-open-bracket
+ smarty-electric-close-bracket
+ smarty-electric-star))
+
+;;;###autoload
+(defun smarty-mode ()
+ "Smarty Mode
+***********
+
+Smarty Mode is a GNU XEmacs major mode for editing Smarty templates.
+
+1 Introduction
+**************
+
+Smarty-Mode is a mode allowing easy edit of Smarty templates:
+highlight, templates, navigation into source files...
+
+
+
+Features (new features in bold) :
+
+ * Completion
+
+ * Customizable
+
+ * Highlight
+
+ * Menu
+
+ * Stuttering
+
+ * Templates
+ - Built-in Functions
+
+ - User Functions
+
+ - Variable Modifiers
+
+ - Plugin (Functions)
+ * BlockRepeatPlugin
+
+ * ClipCache
+
+ * Smarty Formtool
+
+ * Smarty Paginate
+
+ * Smarty Validate
+
+ - Plugin (Variable Modifiers)
+ * AlternativeDateModifierPlugin
+
+ * B2Smilies
+
+ * BBCodePlugin
+
+ - Fonctions Non-Smarty
+
+
+
+This manual describes Smarty Mode version 0.0.5.
+
+2 Installation
+**************
+
+2.1 Requirements
+================
+
+Smarty Mode is a XEmacs major mode that needs the following
+software/packages:
+
+ * XEmacs (http://www.xemacs.org/).
+
+ * `font-lock' mode generaly installed with XEmacs.
+
+ * `assoc' mode generaly installed with XEmacs.
+
+ * `easymenu' mode generaly installed with XEmacs.
+
+ * `hippie-exp' mode generaly installed with XEmacs.
+
+Before continuing, you must be sure to have all this packages
+installed.
+
+2.2 Download
+============
+
+Two internet address to download Smarty Mode :
+
+ * Principal: Smarty-Mode 0.0.5
+ (http://deboutv.free.fr/lisp/smarty/download/smarty-0.0.5.tar.gz)
+ (http://deboutv.free.fr/lisp/smarty/)
+
+ * Secondary: Smarty-Mode 0.0.5
+ (http://www.morinie.fr/lisp/smarty/download/smarty-0.0.5.tar.gz)
+ (http://www.morinie.fr/lisp/smarty/)
+
+ * Old releases: Smarty-Mode
+ (http://deboutv.free.fr/lisp/smarty/download.php)
+ (http://deboutv.free.fr/lisp/smarty/)
+
+2.3 Installation
+================
+
+2.3.1 Installation
+------------------
+
+To install Smarty Mode you need to choose an installation directory
+\(for example `/usr/local/share/lisp' or `c:\lisp'). The administrator
+must have the write rights on this directory.
+
+With your favorite unzip software, unzip the archive in the
+installation directory.
+
+Example:
+ cd /usr/local/share/lisp
+ tar zxvf smarty-0.0.5.tar.gz
+Now you have a `smarty' directory in the installation directory. This
+directory contains 2 files `smarty-mode.el' and `smarty-mode.elc' and
+another directory `docs' containing the documentation.
+
+You need to configure XEmacs. open you initialization file `init.el'
+\(open the file or start XEmacs then choose the Options menu and Edit
+Init File). Add the following lines (the installation directory in
+this example is `/usr/local/share/lisp') :
+
+ (setq load-path
+ (append (list \"/usr/local/share/lisp/\") load-path))
+ (autoload 'smarty-mode \"smarty-mode\" \"Smarty Mode\" t)
+
+2.3.2 Update
+------------
+
+The update is easy. You need to unzip the archive in the installation
+directory to remove the old release.
+
+Example:
+ cd /usr/local/share/lisp
+ rm -rf smarty
+ tar zxvf smarty-0.0.5.tar.gz
+
+2.4 Invoke Smarty-Mode
+======================
+
+You have two possibilities to invoke the Smarty Mode.
+
+ - Manually: At each file opening you need to launch Smarty Mode
+ with the following command:
+
+ `M-x smarty-mode'
+
+ - Automatically: Add the following linesin your initialization
+ file `init.el' :
+
+ (setq auto-mode-alist
+ (append
+ '((\"\\.tpl$\" . smarty-mode))
+ auto-mode-alist))
+
+
+3 Customization
+***************
+
+This chapter describes the differents parameters and functions that
+you can change to customize Smarty Mode. To do that, open a Smarty
+file, click on the Smarty menu and choose Options then Browse
+Options....
+
+3.1 Parameters
+==============
+
+3.1.1 Mode
+----------
+
+Smarty Mode has 2 modes allowing to simplify the writing of Smarty
+templates. You can enable/disable each mode individually.
+
+`smarty-electric-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable automatic generation of template.
+ If `nil'; template generators can still be invoked through key
+ bindings and menu. Is indicated in the modeline by \"/e\" after
+ the mode name and can be toggled by `smarty-electric-mode'.
+
+`smarty-stutter-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable the stuttering. Is indicated in the
+ modeline by \"/s\" after the mode name and can be toggled by
+ `smarty-stutter-mode'.
+
+3.1.2 Menu
+----------
+
+Smarty Mode has also 1 menu that you can enable/disable. The menu
+Sources is specific to each Smarty files opened.
+
+`smarty-source-file-menu'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; the Sources menu is enabled. This menu
+ contains the list of Smarty file located in the current
+ directory. The Sources menu scans the directory when a file is
+ opened.
+
+3.1.3 Menu
+----------
+
+`smarty-highlight-plugin-functions'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; the functions described in the smarty
+ plugins are highlighted.
+
+3.1.4 Templates
+---------------
+
+3.1.4.1 Header
+..............
+
+`smarty-file-header'
+ Type: string
+ Default value: `\"\"'
+ Description: String or file to insert as file header. If the
+ string specifies an existing file name the contents of the file
+ is inserted; otherwise the string itself is inserted as file
+ header.
+ Type `C-j' for newlines.
+ The follonwing keywords are supported:
+ <filename>: replaced by the file name.
+ <author>: replaced by the user name and email address.
+ <login>: replaced by `user-login-name'.
+ <company>: replaced by `smarty-company-name' content.
+ <date>: replaced by the current date.
+ <year>: replaced by the current year.
+ <copyright>: replaced by `smarty-copyright-string' content.
+ <cursor>: final cursor position.
+
+`smarty-file-footer'
+ Type: string
+ Default value: `\"\"'
+ Description: String or file to insert as file footer. See
+ `smarty-file-header'
+
+`smarty-company-name'
+ Type: string
+ Default value: `\"\"'
+ Description: Name of the company to insert in file header.
+
+`smarty-copyright-string'
+ Type: string
+ Default value: `\"\"'
+ Description: Coryright string to insert in file header.
+
+`smarty-date-format'
+ Type: string
+ Default value: `\"%Y-%m-%d\"'
+ Description: Date format.
+
+`smarty-modify-date-prefix-string'
+ Type: string
+ Default value: `\"\"'
+ Description: Prefix string of modification date in Smarty file
+ header.
+
+`smarty-modify-date-on-saving'
+ Type: bool
+ Default value: `nil'
+ Description: If `t'; update the modification date when the
+ buffer is saved.
+
+3.1.5 Miscellaneous
+-------------------
+
+`smarty-left-delimiter'
+ Type: string
+ Default value: `\"\"'
+ Description: Left escaping delimiter for Smarty templates.
+
+`smarty-right-delimiter'
+ Type: string
+ Default value: `\"\"'
+ Description: Right escaping delimiter for Smarty templates.
+
+`smarty-intelligent-tab'
+ Type: bool
+ Default value: `t'
+ Description: If `t'; TAB does indentation; completion and insert
+ tabulations. If `nil'; TAB does only indentation.
+
+`smarty-word-completion-in-minibuffer'
+ Type: bool
+ Default value: `t'
+ Description: If `t'; enable completion in the minibuffer.
+
+`smarty-word-completion-case-sensitive'
+ Type: bool
+ Default value: `nil'
+ Description: If `t'; completion is case sensitive.
+
+3.2 Functions
+=============
+
+3.2.1 Mode
+----------
+
+`smarty-electric-mode'
+ Menu: Smarty -> Options -> Mode -> Electric Mode
+ Keybinding: `C-c C-m C-e'
+ Description: This functions is used to enable/disable the
+ electric mode.
+
+`smarty-stutter-mode'
+ Menu: Smarty -> Options -> Mode -> Stutter Mode
+ Keybinding: `C-c C-m C-s'
+ Description: This function is used to enable/disable the stutter
+ mode.
+
+4 Menus
+*******
+
+There are 2 menus: Smarty and Sources. All theses menus can be
+accessed from the menubar or from the right click. This chapter
+describes each menus.
+
+4.1 Smarty
+==========
+
+This is the main menu of Smarty Mode. It allows an easy access to the
+main features of the Smarty Mode: Templates (see *Note Templates::)
+and Options (see *Note Customization::).
+
+This menu contains also 3 functions that are discussed in the next
+part.
+
+4.1.1 Functions
+---------------
+
+`smarty-show-messages'
+ Menu: Smarty -> Show Messages
+ Keybinding: `C-c M-m'
+ Description: This function opens the *Messages* buffer to
+ display previous error messages.
+
+`smarty-doc-mode'
+ Menu: Smarty -> Smarty Mode Documentation
+ Keybinding: `C-c C-h'
+ Description: This function opens the *Help* buffer and prints in
+ it the Smarty Mode documentation.
+
+`smarty-version'
+ Menu: Smarty -> Version
+ Keybinding: `C-c C-v'
+ Description: This function displays in the minibuffer the
+ current Smarty Mode version with the timestamp.
+
+4.2 Sources
+===========
+
+The Sources menu shows the Smarty files in the current directory. If
+you add or delete a file in the current directory, you need to
+refresh the menu.
+
+4.2.1 Customization
+-------------------
+
+`smarty-source-file-menu'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; the Sources menu is enabled. This menu
+ contains the list of Smarty file located in the current
+ directory. The Sources menu scans the directory when a file is
+ opened.
+
+4.2.2 Functions
+---------------
+
+`smarty-add-source-files-menu'
+ Menu: Sources -> *Rescan*
+ Keybinding: `C-c C-s C-u'
+ Description: This function is used to refresh the Sources menu.
+
+5 Stuttering
+************
+
+The stutter mode is a mode that affects a function to a key. For
+example, when you use the `ENTER' key, the associated function will
+create a new line and indent it.
+
+5.1 Customization
+=================
+
+`smarty-stutter-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable the stuttering. Is indicated in the
+ modeline by \"/s\" after the mode name and can be toggled by
+ `smarty-stutter-mode'.
+
+5.2 Functions
+=============
+
+`SPACE'
+ If in comment, indent the comment and add new line if necessary.
+ In other case, add a space.
+
+`('
+ If the previous character is a `(', the `((' will be replaced by
+ `['.
+ If the previous character is a `[', the `[(' will be replaced by
+ `{'.
+ In other case, insert a `('.
+
+`)'
+ If the previous character is a `)', the `))' will be replaced by
+ `]'.
+ If the previous character is a `]', the `])' will be replaced by
+ `}'.
+ In other case, insert a `)'.
+
+6 Templates
+***********
+
+In the Smarty Mode, the Smarty functions (like if, while, for, fopen,
+fclose) are predefined in functions called \"Templates\".
+
+Each template can be invoked by the function name or by using the
+<SPACE> key after the Smarty function name in the buffer (Note, using
+`M-<SPACE>' disable the template).
+
+A template can be aborted by using the `C-g' or by lefting empty the
+tempate prompt (in the minibuffer).
+
+6.1 Customization
+=================
+
+`smarty-electric-mode'
+ Type: boolean
+ Default value: `t'
+ Description: If `t'; enable automatic generation of template.
+ If `nil'; template generators can still be invoked through key
+ bindings and menu. Is indicated in the modeline by \"/e\" after
+ the mode name and can be toggled by `smarty-electric-mode'.
+
+For a complete description of the template customizable variables,
+see *Note Cu01-Pa01-Template::
+
+6.2 Functions
+=============
+
+6.2.1 Smarty Functions
+----------------------
+
+For Smarty functions, see PDF or HTML documentation.
+
+6.2.2 Non-Smarty Functions
+--------------------------
+
+`smarty-template-header'
+ Menu: Smarty -> Templates -> Insert Header
+ Keybinding: `C-c C-t C-h'
+ Description: This function is used to insert a header in the
+ current buffer.
+
+`smarty-template-footer'
+ Menu: Smarty -> Templates -> Insert Footer
+ Keybinding: `C-c C-t C-f'
+ Description: This function is used to insert a footer in the
+ current buffer.
+
+`smarty-template-insert-date'
+ Menu: Smarty -> Templates -> Insert Date
+ Keybinding: `C-c C-t C-d i'
+ Description: This function is used to insert the date in the
+ current buffer.
+
+`smarty-template-modify'
+ Menu: Smarty -> Templates -> Modify Date
+ Keybinding: `C-c C-t C-d m'
+ Description: This function is used to modify the last
+ modification date in the current buffer.
+
+7 Bugs, Help
+************
+
+ * To report bugs: Bugtracker
+ (http://bugtracker.morinie.fr/lisp/set_project.php?project_id=2)
+
+ * To obtain help you can post on the dedicated forum: Forum
+ (http://forum.morinie.fr/lisp/)
+
+8 Key bindings
+**************
+
+\\{smarty-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'smarty-mode)
+ (setq mode-name "Smarty")
+
+ (smarty-create-syntax-table)
+
+ ;; set maps and tables
+ (use-local-map smarty-mode-map)
+ (set-syntax-table smarty-mode-syntax-table)
+ (setq local-abbrev-table smarty-mode-abbrev-table)
+
+ (set (make-local-variable 'comment-start) (concat smarty-left-delimiter "*"))
+ (set (make-local-variable 'comment-end) (concat "*" smarty-right-delimiter))
+ (set (make-local-variable 'comment-multi-line) t)
+ (set (make-local-variable 'smarty-end-comment-column) 80)
+
+ (make-local-variable 'font-lock-defaults)
+ (if smarty-highlight-plugin-functions
+ (setq smarty-font-lock-keywords smarty-font-lock-keywords-4)
+ (setq smarty-font-lock-keywords smarty-font-lock-keywords-3))
+ (setq font-lock-defaults
+ '((smarty-font-lock-keywords)
+ nil ; Keywords only (i.e. no comment or string highlighting
+ t ; case fold
+ nil ; syntax-alist
+ nil ; syntax-begin
+ ))
+
+ (setq font-lock-maximum-decoration t
+ case-fold-search t)
+
+ ;; add source file menu
+ (if smarty-source-file-menu (smarty-add-source-files-menu))
+ ;; add Smarty menu
+ (easy-menu-add smarty-mode-menu-list)
+ (easy-menu-define smarty-mode-menu smarty-mode-map
+ "Menu keymap for Smarty Mode." smarty-mode-menu-list)
+
+ ;; (message "Smarty Mode %s.%s" smarty-version
+ ;; (if noninteractive "" " See menu for documentation and release notes."))
+ (smarty-mode-line-update)
+ (run-hooks 'smarty-mode-hook))
+
+(defun smarty-doc-mode ()
+ "Display Smarty Mode documentation in *Help* buffer."
+ (interactive)
+ (with-output-to-temp-buffer
+ (if (fboundp 'help-buffer) (help-buffer) "*Help*")
+ (princ mode-name)
+ (princ " mode:\n")
+ (princ (documentation 'smarty-mode))
+ (with-current-buffer standard-output
+ (help-mode))
+ (print-help-return-message)))
+
+(defun smarty-activate-customizations ()
+ "Activate all customizations on local variables."
+ (interactive)
+ (smarty-mode-map-init)
+ (use-local-map smarty-mode-map)
+ (set-syntax-table smarty-mode-syntax-table)
+ (smarty-update-mode-menu)
+ (run-hooks 'menu-bar-update-hook)
+ (smarty-mode-line-update))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Templates
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun smarty-template-field (prompt &optional follow-string optional
+ begin end is-string string-char default)
+ "Prompt for string and insert it in buffer with optional FOLLOW-STRING.
+If OPTIONAL is nil, the prompt is left if an empty string is inserted. If
+an empty string is inserted, return nil and call `smarty-template-undo' for
+the region between BEGIN and END. IS-STRING indicates whether a string
+with double-quotes is to be inserted. DEFAULT specifies a default string."
+ (let ((position (point))
+ string)
+ (insert "<" prompt ">")
+ (if (not (> (length string-char) 0))
+ (setq string-char "\""))
+ (setq string
+ (condition-case ()
+ (read-from-minibuffer (concat prompt ": ")
+ (or (and is-string (cons (concat string-char string-char) 1)) default)
+ smarty-minibuffer-local-map)
+ (quit (if (and optional begin end)
+ (progn (beep) "")
+ (keyboard-quit)))))
+ (when (or (not (equal string "")) optional)
+ (delete-region position (point)))
+ (when (and (equal string "") optional begin end)
+ (smarty-template-undo begin end)
+ (message "Template aborted"))
+ (unless (equal string "")
+ (insert string))
+ (when (or (not (equal string "")) (not optional))
+ (insert (or follow-string "")))
+ (if (equal string "") nil string)))
+
+(defun smarty-template-undo (begin end)
+ "Undo aborted template by deleting region and unexpanding the keyword."
+ (cond (smarty-template-invoked-by-hook
+ (goto-char end)
+ (insert " ")
+ (delete-region begin end)
+ (unexpand-abbrev))
+ (t (delete-region begin end))))
+
+(defun smarty-template-generic-function (label close-label field mandatory-count &optional infinite special-field force-var)
+ "Generic function template 'label field1= field2=..."
+ (interactive)
+ (let ((start (point)) found here result-value elt continue field-count stop prompt)
+ (if smarty-template-invoked-by-hook
+ (setq found (smarty-after-ldelim))
+ (insert smarty-left-delimiter)
+ (setq found t))
+ (insert label)
+ (setq here (point-marker))
+ (insert " ")
+ (when found
+ (setq elt field)
+ (setq continue t)
+ (setq field-count 0)
+ (setq stop nil)
+ (while (and elt continue)
+ (setq prompt (car elt))
+ (when (not special-field)
+ (insert prompt "="))
+ (setq result-value (smarty-template-field prompt nil t))
+ (if (and (not result-value)
+ (< field-count mandatory-count))
+ (progn (setq continue nil)
+ (delete-region start (point))
+ (insert (concat label " "))
+ (setq stop t))
+ (if (not result-value)
+ (setq continue nil)
+ (setq here (point-marker))
+ (insert " ")))
+ (setq field-count (+ 1 field-count))
+ (setq elt (cdr elt)))
+ (when (and infinite (or continue force-var))
+ (when (not continue)
+ (delete-region here (point))
+ (insert " "))
+ (setq continue t)
+ (while continue
+ (setq result-value (smarty-template-field "var_name" "=" t here))
+ (if (not result-value)
+ (setq continue nil)
+ (setq continue (smarty-template-field "var_value" nil t here))
+ (setq here (point-marker))
+ (insert " "))))
+ (when (not stop)
+ (delete-region here (point))
+ (if (> 0 mandatory-count)
+ (delete-char -1))
+ (insert smarty-right-delimiter)
+ (setq here (point-marker))
+ (if close-label
+ (insert smarty-left-delimiter "/" label smarty-right-delimiter))
+ (goto-char here)))))
+
+(defun smarty-template-generic-modifier (label field mandatory-count)
+ "Generic modifier template '|label:field1:field2..."
+ (interactive)
+ (let ((start (point)) found here result-value elt continue field-count stop prompt)
+ (setq found (re-search-backward (concat (regexp-quote smarty-left-delimiter) "\\$\\(\\sw\\|\\s.\\)+" (regexp-quote "|")) nil t))
+ (if found
+ (progn
+ (setq found (re-search-forward (regexp-quote smarty-right-delimiter) start t))
+ (if (not found)
+ (progn
+ (goto-char start)
+ (insert label)
+ (setq here (point-marker))
+ (setq elt field)
+ (setq continue t)
+ (setq field-count 0)
+ (setq stop nil)
+ (while (and elt continue)
+ (setq prompt (car elt))
+ (insert ":")
+ (setq result-value (smarty-template-field prompt nil t))
+ (if (and (not result-value)
+ (< field-count mandatory-count))
+ (progn (setq continue nil)
+ (delete-region start (point))
+ (insert (concat label " "))
+ (setq stop t))
+ (if (not result-value)
+ (setq continue nil)
+ (setq here (point-marker))
+ (insert ":")))
+ (setq field-count (+ 1 field-count))
+ (setq elt (cdr elt)))
+ (when (not stop)
+ (delete-region here (point))
+ (if (not (or (looking-at smarty-right-delimiter)
+ (looking-at "|")))
+ (insert smarty-right-delimiter))))
+ (goto-char start)
+ (insert label " ")))
+ (goto-char start)
+ (insert label " "))))
+
+(defun smarty-template-capture-hook ()
+ (smarty-hooked-abbrev 'smarty-template-capture))
+(defun smarty-template-config-load-hook ()
+ (smarty-hooked-abbrev 'smarty-template-config-load))
+(defun smarty-template-else-hook ()
+ (smarty-hooked-abbrev 'smarty-template-else))
+(defun smarty-template-elseif-hook ()
+ (smarty-hooked-abbrev 'smarty-template-elseif))
+(defun smarty-template-foreach-hook ()
+ (smarty-hooked-abbrev 'smarty-template-foreach))
+(defun smarty-template-foreachelse-hook ()
+ (smarty-hooked-abbrev 'smarty-template-foreachelse))
+(defun smarty-template-if-hook ()
+ (smarty-hooked-abbrev 'smarty-template-if))
+(defun smarty-template-include-hook ()
+ (smarty-hooked-abbrev 'smarty-template-include))
+(defun smarty-template-include-php-hook ()
+ (smarty-hooked-abbrev 'smarty-template-include-php))
+(defun smarty-template-insert-hook ()
+ (smarty-hooked-abbrev 'smarty-template-insert))
+(defun smarty-template-ldelim-hook ()
+ (smarty-hooked-abbrev 'smarty-template-ldelim))
+(defun smarty-template-literal-hook ()
+ (smarty-hooked-abbrev 'smarty-template-literal))
+(defun smarty-template-php-hook ()
+ (smarty-hooked-abbrev 'smarty-template-php))
+(defun smarty-template-rdelim-hook ()
+ (smarty-hooked-abbrev 'smarty-template-rdelim))
+(defun smarty-template-section-hook ()
+ (smarty-hooked-abbrev 'smarty-template-section))
+(defun smarty-template-sectionelse-hook ()
+ (smarty-hooked-abbrev 'smarty-template-sectionelse))
+(defun smarty-template-strip-hook ()
+ (smarty-hooked-abbrev 'smarty-template-strip))
+
+(defun smarty-template-assign-hook ()
+ (smarty-hooked-abbrev 'smarty-template-assign))
+(defun smarty-template-counter-hook ()
+ (smarty-hooked-abbrev 'smarty-template-counter))
+(defun smarty-template-cycle-hook ()
+ (smarty-hooked-abbrev 'smarty-template-cycle))
+(defun smarty-template-debug-hook ()
+ (smarty-hooked-abbrev 'smarty-template-debug))
+(defun smarty-template-eval-hook ()
+ (smarty-hooked-abbrev 'smarty-template-eval))
+(defun smarty-template-fetch-hook ()
+ (smarty-hooked-abbrev 'smarty-template-fetch))
+(defun smarty-template-html-checkboxes-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-checkboxes))
+(defun smarty-template-html-image-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-image))
+(defun smarty-template-html-options-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-options))
+(defun smarty-template-html-radios-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-radios))
+(defun smarty-template-html-select-date-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-select-date))
+(defun smarty-template-html-select-time-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-select-time))
+(defun smarty-template-html-table-hook ()
+ (smarty-hooked-abbrev 'smarty-template-html-table))
+(defun smarty-template-mailto-hook ()
+ (smarty-hooked-abbrev 'smarty-template-mailto))
+(defun smarty-template-math-hook ()
+ (smarty-hooked-abbrev 'smarty-template-math))
+(defun smarty-template-popup-hook ()
+ (smarty-hooked-abbrev 'smarty-template-popup))
+(defun smarty-template-popup-init-hook ()
+ (smarty-hooked-abbrev 'smarty-template-popup-init))
+(defun smarty-template-textformat-hook ()
+ (smarty-hooked-abbrev 'smarty-template-textformat))
+
+(defun smarty-template-capitalize-hook ()
+ (smarty-hooked-abbrev 'smarty-template-capitalize))
+(defun smarty-template-cat-hook ()
+ (smarty-hooked-abbrev 'smarty-template-cat))
+(defun smarty-template-count-characters-hook ()
+ (smarty-hooked-abbrev 'smarty-template-count-characters))
+(defun smarty-template-count-paragraphs-hook ()
+ (smarty-hooked-abbrev 'smarty-template-count-paragraphs))
+(defun smarty-template-count-sentences-hook ()
+ (smarty-hooked-abbrev 'smarty-template-count-sentences))
+(defun smarty-template-count-words-hook ()
+ (smarty-hooked-abbrev 'smarty-template-count-words))
+(defun smarty-template-date-format-hook ()
+ (smarty-hooked-abbrev 'smarty-template-date-format))
+(defun smarty-template-default-hook ()
+ (smarty-hooked-abbrev 'smarty-template-default))
+(defun smarty-template-escape-hook ()
+ (smarty-hooked-abbrev 'smarty-template-escape))
+(defun smarty-template-indent-hook ()
+ (smarty-hooked-abbrev 'smarty-template-indent))
+(defun smarty-template-lower-hook ()
+ (smarty-hooked-abbrev 'smarty-template-lower))
+(defun smarty-template-nl2br-hook ()
+ (smarty-hooked-abbrev 'smarty-template-nl2br))
+(defun smarty-template-regex-replace-hook ()
+ (smarty-hooked-abbrev 'smarty-template-regex-replace))
+(defun smarty-template-replace-hook ()
+ (smarty-hooked-abbrev 'smarty-template-replace))
+(defun smarty-template-spacify-hook ()
+ (smarty-hooked-abbrev 'smarty-template-spacify))
+(defun smarty-template-string-format-hook ()
+ (smarty-hooked-abbrev 'smarty-template-string-format))
+(defun smarty-template-vstrip-hook ()
+ (smarty-hooked-abbrev 'smarty-template-vstrip))
+(defun smarty-template-strip-tags-hook ()
+ (smarty-hooked-abbrev 'smarty-template-strip-tags))
+(defun smarty-template-truncate-hook ()
+ (smarty-hooked-abbrev 'smarty-template-truncate))
+(defun smarty-template-upper-hook ()
+ (smarty-hooked-abbrev 'smarty-template-upper))
+(defun smarty-template-wordwrap-hook ()
+ (smarty-hooked-abbrev 'smarty-template-wordwrap))
+
+(defun smarty-template-validate-hook ()
+ (smarty-hooked-abbrev 'smarty-template-validate))
+(defun smarty-template-clipcache-hook ()
+ (smarty-hooked-abbrev 'smarty-template-clipcache))
+(defun smarty-template-include-clipcache-hook ()
+ (smarty-hooked-abbrev 'smarty-template-include-clipcache))
+(defun smarty-template-formtool-checkall-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-checkall))
+(defun smarty-template-formtool-copy-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-copy))
+(defun smarty-template-formtool-count-chars-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-count-chars))
+(defun smarty-template-formtool-init-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-init))
+(defun smarty-template-formtool-move-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-move))
+(defun smarty-template-formtool-moveall-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-moveall))
+(defun smarty-template-formtool-movedown-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-movedown))
+(defun smarty-template-formtool-moveup-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-moveup))
+(defun smarty-template-formtool-remove-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-remove))
+(defun smarty-template-formtool-rename-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-rename))
+(defun smarty-template-formtool-save-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-save))
+(defun smarty-template-formtool-selectall-hook ()
+ (smarty-hooked-abbrev 'smarty-template-formtool-selectall))
+(defun smarty-template-paginate-first-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-first))
+(defun smarty-template-paginate-last-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-last))
+(defun smarty-template-paginate-middle-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-middle))
+(defun smarty-template-paginate-next-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-next))
+(defun smarty-template-paginate-prev-hook ()
+ (smarty-hooked-abbrev 'smarty-template-paginate-prev))
+
+(defun smarty-template-btosmilies-hook ()
+ (smarty-hooked-abbrev 'smarty-template-btosmilies))
+(defun smarty-template-bbcodetohtml-hook ()
+ (smarty-hooked-abbrev 'smarty-template-bbcodetohtml))
+(defun smarty-template-date-formatto-hook ()
+ (smarty-hooked-abbrev 'smarty-template-date-formatto))
+
+(defun smarty-template-capture ()
+ "Insert a capture statement."
+ (interactive)
+ (smarty-template-generic-function "capture" t '("name" "assign") 0))
+
+(defun smarty-template-config-load ()
+ "Insert a config_load statement."
+ (interactive)
+ (smarty-template-generic-function "config_load" nil '("file" "section" "scope" "global") 1))
+
+(defun smarty-template-else ()
+ "Insert a else statement."
+ (interactive)
+ (smarty-template-generic-function "else" nil '() 0))
+
+(defun smarty-template-elseif ()
+ "Insert a elseif statement."
+ (interactive)
+ (smarty-template-generic-function "elseif" nil '("condition") 1 nil t))
+
+(defun smarty-template-foreach ()
+ "Insert a foreach statement."
+ (interactive)
+ (smarty-template-generic-function "foreach" t '("from" "item" "key" "name") 2))
+
+(defun smarty-template-foreachelse ()
+ "Insert a foreachelse statement."
+ (interactive)
+ (smarty-template-generic-function "foreachelse" nil '() 0))
+
+(defun smarty-template-if ()
+ "Insert a if statement."
+ (interactive)
+ (smarty-template-generic-function "if" t '("condition") 1 nil t))
+
+(defun smarty-template-include ()
+ "Insert a include statement."
+ (interactive)
+ (smarty-template-generic-function "include" nil '("file" "assign") 1 t))
+
+(defun smarty-template-include-php ()
+ "Insert a include_php statement."
+ (interactive)
+ (smarty-template-generic-function "include_php" nil '("file" "once" "assign") 1))
+
+(defun smarty-template-insert ()
+ "Insert a insert statement."
+ (interactive)
+ (smarty-template-generic-function "insert" nil '("name" "assign" "script") 1 t))
+
+(defun smarty-template-ldelim ()
+ "Insert a ldelim statement."
+ (interactive)
+ (smarty-template-generic-function "ldelim" nil '() 0))
+
+(defun smarty-template-literal ()
+ "Insert a literal statement."
+ (interactive)
+ (smarty-template-generic-function "literal" t '() 0))
+
+(defun smarty-template-php ()
+ "Insert a php statement."
+ (interactive)
+ (smarty-template-generic-function "php" t '() 0))
+
+(defun smarty-template-rdelim ()
+ "Insert a rdelim statement."
+ (interactive)
+ (smarty-template-generic-function "rdelim" nil '() 0))
+
+(defun smarty-template-section ()
+ "Insert a section statement."
+ (interactive)
+ (smarty-template-generic-function "section" t '("name" "loop" "start" "step" "max" "show") 2))
+
+(defun smarty-template-sectionelse ()
+ "Insert a sectionelse statement."
+ (interactive)
+ (smarty-template-generic-function "sectionelse" nil '() 0))
+
+(defun smarty-template-strip ()
+ "Insert a strip statement."
+ (interactive)
+ (smarty-template-generic-function "strip" t '() 0))
+
+
+(defun smarty-template-assign ()
+ "Insert a assign statement."
+ (interactive)
+ (smarty-template-generic-function "assign" nil '("var" "value") 2))
+
+(defun smarty-template-counter ()
+ "Insert a counter statement."
+ (interactive)
+ (smarty-template-generic-function "counter" nil '("name" "start" "skip" "direction" "print" "assign") 0))
+
+(defun smarty-template-cycle ()
+ "Insert a cycle statement."
+ (interactive)
+ (smarty-template-generic-function "cycle" nil '("values" "name" "print" "advance" "delimiter" "assign" "reset") 1))
+
+(defun smarty-template-debug ()
+ "Insert a debug statement."
+ (interactive)
+ (smarty-template-generic-function "debug" nil '("output") 0))
+
+(defun smarty-template-eval ()
+ "Insert a eval statement."
+ (interactive)
+ (smarty-template-generic-function "eval" nil '("var" "assign") 1))
+
+(defun smarty-template-fetch ()
+ "Insert a fetch statement."
+ (interactive)
+ (smarty-template-generic-function "fetch" nil '("file" "assign") 1))
+
+(defun smarty-template-html-checkboxes ()
+ "Insert a html_checkboxes statement."
+ (interactive)
+ (smarty-template-generic-function "html_checkboxes" nil '("name" "values" "output" "selected" "options" "separator" "assign" "labels") 0))
+
+(defun smarty-template-html-image ()
+ "Insert a html_image statement."
+ (interactive)
+ (smarty-template-generic-function "html_image" nil '("file" "height" "width" "basedir" "alt" "href" "path_prefix") 1))
+
+(defun smarty-template-html-options ()
+ "Insert a html_options statement."
+ (interactive)
+ (smarty-template-generic-function "html_options" nil '("name" "values" "output" "selected" "options") 0))
+
+(defun smarty-template-html-radios ()
+ "Insert a html_radios statement."
+ (interactive)
+ (smarty-template-generic-function "html_radios" nil '("name" "values" "output" "selected" "options" "separator" "assign") 0))
+
+(defun smarty-template-html-select-date ()
+ "Insert a html_select_date statement."
+ (interactive)
+ (smarty-template-generic-function "html_select_date" nil '("prefix" "time" "start_year" "end_year" "display_days" "display_months" "display_years" "month_format" "day_format" "day_value_format" "year_as_text" "reverse_years" "field_array" "day_size" "month_size" "year_size" "all_extra" "day_extra" "month_extra" "year_extra" "field_order" "field_separator" "month_value_format" "year_empty" "month_empty" "day_empty") 0))
+
+(defun smarty-template-html-select-time ()
+ "Insert a html_select_time statement."
+ (interactive)
+ (smarty-template-generic-function "html_select_time" nil '("prefix" "time" "display_hours" "display_minutes" "display_seconds" "display_meridian" "use_24_hours" "minute_interval" "second_interval" "field_array" "all_extra" "hour_extra" "minute_extra" "second_extra" "meridian_extra") 0))
+
+(defun smarty-template-html-table ()
+ "Insert a html_table statement."
+ (interactive)
+ (smarty-template-generic-function "html_table" nil '("loop" "cols" "rows" "inner" "caption" "table_attr" "th_attr" "tr_attr" "td_attr" "trailpad" "hdir" "vdir") 1))
+
+(defun smarty-template-mailto ()
+ "Insert a mailto statement."
+ (interactive)
+ (smarty-template-generic-function "mailto" nil '("address" "text" "encode" "cc" "bcc" "subject" "newsgroups" "followupto" "extra") 1))
+
+(defun smarty-template-math ()
+ "Insert a math statement."
+ (interactive)
+ (smarty-template-generic-function "math" nil '("equation" "format" "assign") 1 t nil t))
+
+(defun smarty-template-popup ()
+ "Insert a popup statement."
+ (interactive)
+ (smarty-template-generic-function "popup" nil '("text" "trigger" "sticky" "caption" "fgcolor" "bgcolor" "textcolor" "capcolor" "closecolor" "textfont" "captionfont" "closefont" "textsize" "captionsize" "closesize" "width" "height" "left" "right" "center" "above" "below" "border" "offsetx" "offsety" "fgbackground" "bgbackground" "closetext" "noclose" "status" "autostatus" "autostatuscap" "inarray" "caparray" "capicon" "snapx" "snapy" "fixx" "fixy" "background" "padx" "pady" "fullhtml" "frame" "function" "delay" "hauto" "vauto") 1))
+
+(defun smarty-template-popup-init ()
+ "Insert a popup_init statement."
+ (interactive)
+ (smarty-template-generic-function "popup_init" nil '("src") 1))
+
+(defun smarty-template-textformat ()
+ "Insert a textformat statement."
+ (interactive)
+ (smarty-template-generic-function "textformat" t '("style" "indent" "indent_first" "indent_char" "wrap" "wrap_char" "wrap_cut" "assign") 0))
+
+(defun smarty-template-capitalize ()
+ "Insert a capitalize statement."
+ (interactive)
+ (smarty-template-generic-modifier "capitalize" '("upcase_numeric") 0))
+
+(defun smarty-template-cat ()
+ "Insert a cat statement."
+ (interactive)
+ (smarty-template-generic-modifier "cat" '("value") 0))
+
+(defun smarty-template-count-characters ()
+ "Insert a count_characters statement."
+ (interactive)
+ (smarty-template-generic-modifier "count_characters" '("include_whitespace") 0))
+
+(defun smarty-template-count-paragraphs ()
+ "Insert a count_paragraphs statement."
+ (interactive)
+ (smarty-template-generic-modifier "count_paragraphs" '() 0))
+
+(defun smarty-template-count-sentences ()
+ "Insert a count_sentences statement."
+ (interactive)
+ (smarty-template-generic-modifier "count_sentences" '() 0))
+
+(defun smarty-template-count-words ()
+ "Insert a count_words statement."
+ (interactive)
+ (smarty-template-generic-modifier "count_words" '() 0))
+
+(defun smarty-template-date-format ()
+ "Insert a date_format statement."
+ (interactive)
+ (smarty-template-generic-modifier "date_format" '("format" "default") 0))
+
+(defun smarty-template-default ()
+ "Insert a default statement."
+ (interactive)
+ (smarty-template-generic-modifier "default" '("value") 0))
+
+(defun smarty-template-escape ()
+ "Insert a escape statement."
+ (interactive)
+ (smarty-template-generic-modifier "escape" '("html|htmlall|url|urlpathinfo|quotes|hex|hexentity|javascript|mail" "charset") 0))
+
+(defun smarty-template-indent ()
+ "Insert a indent statement."
+ (interactive)
+ (smarty-template-generic-modifier "indent" '("value" "character") 0))
+
+(defun smarty-template-lower ()
+ "Insert a lower statement."
+ (interactive)
+ (smarty-template-generic-modifier "lower" '() 0))
+
+(defun smarty-template-nl2br ()
+ "Insert a nl2br statement."
+ (interactive)
+ (smarty-template-generic-modifier "nl2br" '() 0))
+
+(defun smarty-template-regex-replace ()
+ "Insert a regex_replace statement."
+ (interactive)
+ (smarty-template-generic-modifier "regex_replace" '("regexp" "string_to_replace") 2))
+
+(defun smarty-template-replace ()
+ "Insert a replace statement."
+ (interactive)
+ (smarty-template-generic-modifier "replace" '("string" "string_to_replace_with") 2))
+
+(defun smarty-template-spacify ()
+ "Insert a spacify statement."
+ (interactive)
+ (smarty-template-generic-modifier "spacify" '("character") 0))
+
+(defun smarty-template-string-format ()
+ "Insert a string_format statement."
+ (interactive)
+ (smarty-template-generic-modifier "string_format" '("format") 1))
+
+(defun smarty-template-vstrip ()
+ "Insert a strip statement."
+ (interactive)
+ (smarty-template-generic-modifier "strip" '() 0))
+
+(defun smarty-template-strip-tags ()
+ "Insert a strip_tags statement."
+ (interactive)
+ (smarty-template-generic-modifier "strip_tags" '("replace_by_space") 0))
+
+(defun smarty-template-truncate ()
+ "Insert a truncate statement."
+ (interactive)
+ (smarty-template-generic-modifier "truncate" '("count" "text_to_replace" "character_boundary" "middle_string") 0))
+
+(defun smarty-template-upper ()
+ "Insert a upper statement."
+ (interactive)
+ (smarty-template-generic-modifier "upper" '() 0))
+
+(defun smarty-template-wordwrap ()
+ "Insert a wordwrap statement."
+ (interactive)
+ (smarty-template-generic-modifier "wordwrap" '("count" "string" "character_boundary") 0))
+
+
+(defun smarty-template-validate ()
+ "Insert a validate statement."
+ (interactive)
+ (smarty-template-generic-function "validate" nil '("field" "criteria" "message" "form" "transform" "trim" "empty" "halt" "assign" "append" "page") 3))
+
+(defun smarty-template-repeat ()
+ "Insert a repeat statement."
+ (interactive)
+ (smarty-template-generic-function "repeat" nil '("count" "assign") 1))
+
+(defun smarty-template-str_repeat ()
+ "Insert a str_repeat statement."
+ (interactive)
+ (smarty-template-generic-function "str_repeat" nil '("string" "count" "assign") 2))
+
+(defun smarty-template-clipcache ()
+ "Insert a clipcache statement."
+ (interactive)
+ (smarty-template-generic-function "clipcache" nil '("id" "group" "ttl" "ldelim" "rdelim") 3))
+
+(defun smarty-template-include-clipcache ()
+ "Insert a include_clipcache statement."
+ (interactive)
+ (smarty-template-generic-function "include_clipcache" nil '("file" "cache_id" "cache_lifetime" "ldelim" "rdelim") 3))
+
+(defun smarty-template-formtool-checkall ()
+ "Insert a formtool_checkall statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_checkall" nil '("name" "class" "style") 1))
+
+(defun smarty-template-formtool-copy ()
+ "Insert a formtool_copy statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_copy" nil '("from" "to" "save" "button_text" "all" "counter" "class" "style") 3))
+
+(defun smarty-template-formtool-count-chars ()
+ "Insert a formtool_count_chars statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_count_chars" nil '("name" "limit" "alert") 3))
+
+(defun smarty-template-formtool-init ()
+ "Insert a formtool_init statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_init" nil '("src") 1))
+
+(defun smarty-template-formtool-move ()
+ "Insert a formtool_move statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_move" nil '("from" "to" "save_from" "save_to" "all" "count_to" "count_from" "class" "style") 4))
+
+(defun smarty-template-formtool-moveall ()
+ "Insert a formtool_moveall statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_moveall" nil '("from" "to" "save_from" "save_to" "all" "count_to" "count_from" "class" "style") 4))
+
+(defun smarty-template-formtool-movedown ()
+ "Insert a formtool_movedown statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_movedown" nil '("save" "name" "class" "style") 2))
+
+(defun smarty-template-formtool-moveup ()
+ "Insert a formtool_moveup statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_moveup" nil '("save" "name" "class" "style") 2))
+
+(defun smarty-template-formtool-remove ()
+ "Insert a formtool_remove statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_remove" nil '("from" "save" "all" "counter" "class" "style") 2))
+
+(defun smarty-template-formtool-rename ()
+ "Insert a formtool_rename statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_rename" nil '("name" "from" "save" "class" "style") 3))
+
+(defun smarty-template-formtool-save ()
+ "Insert a formtool_save statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_save" nil '("from" "name" "save") 3))
+
+(defun smarty-template-formtool-selectall ()
+ "Insert a formtool_selectall statement."
+ (interactive)
+ (smarty-template-generic-function "formtool_selectall" nil '("name" "class" "style") 1))
+
+(defun smarty-template-paginate-first ()
+ "Insert a paginate_first statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_first" nil '("id" "text") 0))
+
+(defun smarty-template-paginate-last ()
+ "Insert a paginate_last statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_last" nil '("id" "text") 0))
+
+(defun smarty-template-paginate-middle ()
+ "Insert a paginate_middle statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_middle" nil '("id" "format" "prefix" "page_limit" "link_prefix" "link_suffix") 0))
+
+(defun smarty-template-paginate-next ()
+ "Insert a paginate_next statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_next" nil '("id" "text") 0))
+
+(defun smarty-template-paginate-prev ()
+ "Insert a paginate_prev statement."
+ (interactive)
+ (smarty-template-generic-function "paginate_prev" nil '("id" "text") 0))
+
+
+(defun smarty-template-btosmilies ()
+ "Insert a B2Smilies statement."
+ (interactive)
+ (smarty-template-generic-modifier "B2Smilies" '() 0))
+
+(defun smarty-template-bbcodetohtml ()
+ "Insert a bbcode2html statement."
+ (interactive)
+ (smarty-template-generic-modifier "bbcode2html" '() 0))
+
+(defun smarty-template-date-formatto ()
+ "Insert a date_format2 statement."
+ (interactive)
+ (smarty-template-generic-modifier "date_format2" '("format" "default") 0))
+
+;;
+
+(defun smarty-resolve-env-variable (string)
+ "Resolve environment variables in STRING."
+ (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string)
+ (setq string (concat (match-string 1 string)
+ (getenv (match-string 2 string))
+ (match-string 4 string))))
+ string)
+
+(defun smarty-insert-string-or-file (string)
+ "Insert STRING or file contents if STRING is an existing file name."
+ (unless (equal string "")
+ (let ((file-name
+ (progn (string-match "^\\([^\n]+\\)" string)
+ (smarty-resolve-env-variable (match-string 1 string)))))
+ (if (file-exists-p file-name)
+ (forward-char (cadr (insert-file-contents file-name)))
+ (insert string)))))
+
+(defun smarty-template-insert-date ()
+ "Insert date in appropriate format."
+ (interactive)
+ (insert
+ (cond
+ ;; 'american, 'european, 'scientific kept for backward compatibility
+ ((eq smarty-date-format 'american) (format-time-string "%m/%d/%Y" nil))
+ ((eq smarty-date-format 'european) (format-time-string "%d.%m.%Y" nil))
+ ((eq smarty-date-format 'scientific) (format-time-string "%Y/%m/%d" nil))
+ (t (format-time-string smarty-date-format nil)))))
+
+(defun smarty-template-header (&optional file-title)
+ "Insert a Smarty file header."
+ (interactive)
+ (unless (equal smarty-file-header "")
+ (let (pos)
+ (save-excursion
+ (smarty-insert-string-or-file smarty-file-header)
+ (setq pos (point-marker)))
+ (smarty-template-replace-header-keywords
+ (point-min-marker) pos file-title))))
+
+(defun smarty-template-footer ()
+ "Insert a Smarty file footer."
+ (interactive)
+ (unless (equal smarty-file-footer "")
+ (let (pos)
+ (save-excursion
+ (setq pos (point-marker))
+ (smarty-insert-string-or-file smarty-file-footer)
+ (unless (= (preceding-char) ?\n)
+ (insert "\n")))
+ (smarty-template-replace-header-keywords pos (point-max-marker)))))
+
+(defun smarty-template-replace-header-keywords (beg end &optional file-title is-model)
+ "Replace keywords in header and footer."
+ (let ()
+ (smarty-prepare-search-2
+ (save-excursion
+ (goto-char beg)
+ (while (search-forward "<filename>" end t)
+ (replace-match (buffer-name) t t))
+ (goto-char beg)
+ (while (search-forward "<copyright>" end t)
+ (replace-match smarty-copyright-string t t))
+ (goto-char beg)
+ (while (search-forward "<author>" end t)
+ (replace-match "" t t)
+ (insert (user-full-name))
+ (when user-mail-address (insert " <" user-mail-address ">")))
+ (goto-char beg)
+ (while (search-forward "<login>" end t)
+ (replace-match (user-login-name) t t))
+ (goto-char beg)
+ (while (search-forward "<company>" end t)
+ (replace-match smarty-company-name t t))
+ (goto-char beg)
+ ;; Replace <RCS> with $, so that RCS for the source is
+ ;; not over-enthusiastic with replacements
+ (while (search-forward "<RCS>" end t)
+ (replace-match "$" nil t))
+ (goto-char beg)
+ (while (search-forward "<date>" end t)
+ (replace-match "" t t)
+ (smarty-template-insert-date))
+ (goto-char beg)
+ (while (search-forward "<year>" end t)
+ (replace-match (format-time-string "%Y" nil) t t))
+ (goto-char beg)
+ (let (string)
+ (while
+ (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
+ (setq string (read-string (concat (match-string 1) ": ")))
+ (replace-match string t t)))
+ (goto-char beg)
+ (when (and (not is-model) (search-forward "<cursor>" end t))
+ (replace-match "" t t))))))
+
+(provide 'smarty-mode)
+;;; smarty-mode.el ends here
--- /dev/null
+;; tt-mode.el --- Emacs major mode for editing Template Toolkit files
+;;
+;; Copyright (c) 2002 Dave Cross, all rights reserved.
+;;
+;; This file may be distributed under the same terms as GNU Emacs.
+;;
+;; $Id: tt-mode.el 13 2008-01-27 09:35:16Z dave $
+;;
+;; This file adds simple font highlighting of TT directives when you are
+;; editing Template Toolkit files.
+;;
+;; I usually give these files an extension of .tt and in order to automatically
+;; invoke this mode for these files, I have the following in my .emacs file.
+;;
+;; (setq load-path
+;; (cons "/home/dave/xemacs" load-path))
+;; (autoload 'tt-mode "tt-mode")
+;; (setq auto-mode-alist
+;; (append '(("\\.tt$" . tt-mode)) auto-mode-alist ))
+;;
+;; Something similar may well work for you.
+;;
+;; Author: Dave Cross <dave@dave.org.uk>
+;;
+;; Modified by Lennart Borgman 2008-08-06
+
+(require 'font-lock)
+
+(defvar tt-mode-hook nil
+ "List of functions to call when entering TT mode")
+
+(defvar tt-keywords
+ (concat "\\b\\(?:"
+ (regexp-opt (list "GET" "CALL" "SET" "DEFAULT" "INSERT" "INCLUDE"
+ "BLOCK" "END" "PROCESS" "WRAPPER" "IF" "UNLESS"
+ "ELSIF" "ELSE" "SWITCH" "CASE" "FOR" "FOREACH"
+ "WHILE" "FILTER" "USE" "MACRO" "PERL" "RAWPERL"
+ "TRY" "THROW" "CATCH" "FINAL" "LAST" "RETURN"
+ "STOP" "CLEAR" "META" "TAGS"))
+ "\\)\\b"))
+
+(defvar tt-font-lock-keywords
+ (list
+ ;; Fontify [& ... &] expressions
+ '("\\(\\[%[-+]?\\)\\(\\(.\\|\n\\)+?\\)\\([-+]?%\\]\\)"
+ (1 font-lock-string-face t)
+ (2 font-lock-variable-name-face t)
+ (4 font-lock-string-face t))
+ ;; Look for keywords within those expressions
+ ;;
+ ;; Comment out whole directive tag
+ '("\\[%\\(#.*?\\)%\\]"
+ (1 font-lock-comment-face t))
+ ;; Comments to end of line
+;;; '("\\[%\\(?:.\\|\n\\)*\\(#.*\\)"
+;;; (1 font-lock-comment-face t))
+ '("\\[% *\\([a-z_0-9]*\\) *%\\]"
+ (1 font-lock-constant-face t))
+ (list (concat
+ "\\(\\[%[-+]?\\|;\\)[ \n\t]*\\("
+ tt-keywords
+ "\\)")
+ 2 font-lock-keyword-face t)
+ )
+ "Expressions to font-lock in tt-mode.")
+
+;; (defvar tt-font-lock-keywords
+;; ;; Since this is used in a multi major mode we
+;; (list
+;; ;; Fontify [& ... &] expressions
+;; ;;; '("^\\([-+]?\\)\\(\\(.\\|\n\\)+?\\)\\([-+]?\\)$"
+;; ;;; (1 font-lock-string-face t)
+;; ;;; (2 font-lock-variable-name-face t)
+;; ;;; (4 font-lock-string-face t))
+;; '("\\(#.*\\)$"
+;; (1 font-lock-comment-face t))
+;; '("^ *\\([a-z_0-9]*\\) *$"
+;; (1 font-lock-constant-face t))
+;; (list (concat
+;; "^\\(?:[-+]?\\|;\\)[ \n\t]*\\("
+;; tt-keywords
+;; "\\)")
+;; )
+;; 1 font-lock-keyword-face t)
+;; )
+;; "Expressions to font-lock in tt-mode.")
+
+(defvar tt-font-lock-defaults
+ '(tt-font-lock-keywords nil t))
+
+(defun tt-mode-after-change (beg end pre-len)
+ ;; add/remove font-lock-multiline
+ ;; Fix-me: add variable for search lengths
+ (let* ((here (point))
+ (beg-is-ml (get-text-property beg 'font-lock-multiline))
+ tt-beg
+ tt-end
+ )
+ (when beg-is-ml
+ (let ((beg-ok (not (previous-single-property-change
+ here 'font-lock-multiline
+ nil (- here 1))))
+ )
+ (when beg-ok
+ (goto-char beg)
+ (search-forward "%]" end t)
+ )
+ (search-forward "[%" end t)
+ ))
+ (when tt-end
+ (remove-list-of-text-properties here tt-beg '(font-lock-multiline))
+ (set-text-properties tt-beg tt-end '(font-lock-multiline t))))
+ )
+
+
+;;;###autoload
+(define-derived-mode tt-mode fundamental-mode "TT"
+ "Major mode for editing Template Toolkit files."
+ (set (make-local-variable 'font-lock-defaults) tt-font-lock-defaults)
+ (add-hook 'after-change-functions 'tt-mode-after-change nil t)
+ )
+
+(provide 'tt-mode)
+;; tt-mode.el ends here
--- /dev/null
+;;; visual-basic-mode.el
+;; This is free software.
+
+;; A mode for editing Visual Basic programs.
+;; Modified version of Fred White's visual-basic-mode.el
+
+;; Copyright (C) 1996 Fred White <fwhite@alum.mit.edu>
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; (additions by Dave Love)
+;; Copyright (C) 2008-2009 Free Software Foundation, Inc.
+;; (additions by Randolph Fritz and Vincent Belaiche (VB1) )
+
+;; Author: Fred White <fwhite@alum.mit.edu>
+;; Adapted-by: Dave Love <d.love@dl.ac.uk>
+;; : Kevin Whitefoot <kevin.whitefoot@nopow.abb.no>
+;; : Randolph Fritz <rfritz@u.washington.edu>
+;; : Vincent Belaiche (VB1) <vincentb1@users.sourceforge.net>
+;; Version: 1.4.8 (2009-09-29)
+;; Serial Version: %Id: 17%
+;; Keywords: languages, basic, Evil
+
+
+;; (Old) LCD Archive Entry:
+;; basic-mode|Fred White|fwhite@alum.mit.edu|
+;; A mode for editing Visual Basic programs.|
+;; 18-Apr-96|1.0|~/modes/basic-mode.el.Z|
+
+;; This file is NOT part of GNU Emacs but the same permissions apply.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of the
+;; License, or (at your option) any later version.
+
+;;; Commentary:
+
+;; Purpose of this package:
+;; This is a mode for editing programs written in The World's Most
+;; Successful Programming Language. It features automatic
+;; indentation, font locking, keyword capitalization, and some minor
+;; convenience functions.
+
+;; Installation instructions
+;; Put visual-basic-mode.el somewhere in your path, compile it, and add
+;; the following to your init file:
+
+;; (autoload 'visual-basic-mode "visual-basic-mode" "Visual Basic mode." t)
+;; (setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\)$" .
+;; visual-basic-mode)) auto-mode-alist))
+;;
+;; If you are doing Rhino scripts, add:
+;; (setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\|rvb\\)$" .
+;; visual-basic-mode)) auto-mode-alist))
+
+;; If you had visual-basic-mode already installed, you may need to call
+;; visual-basic-upgrade-keyword-abbrev-table the first time that
+;; visual-basic-mode is loaded.
+
+;; Of course, under Windows 3.1, you'll have to name this file
+;; something shorter than visual-basic-mode.el
+
+;; Revisions:
+;; 1.0 18-Apr-96 Initial version
+;; 1.1 Accomodate emacs 19.29+ font-lock-defaults
+;; Simon Marshall <Simon.Marshall@esrin.esa.it>
+; 1.2 Rename to visual-basic-mode
+;; 1.3 Fix some indentation bugs.
+;; 1.3+ Changes by Dave Love: [No attempt at compatibility with
+;; anything other than Emacs 20, sorry, but little attempt to
+;; sanitize for Emacs 20 specifically.]
+;; Change `_' syntax only for font-lock and imenu, not generally;
+;; provide levels of font-locking in the current fashion;
+;; font-lock case-insensitively; use regexp-opt with the font-lok
+;; keywords; imenu support; `visual-basic-split-line', bound to
+;; C-M-j; account for single-statement `if' in indentation; add
+;; keyword "Global"; use local-write-file-hooks, not
+;; write-file-hooks.
+;; 1.4 September 1998
+;; 1.4 KJW Add begin..end, add extra keywords
+;; Add customisation for single line if. Disallow by default.
+;; Fix if regexp to require whitespace after if and require then.
+;; Add more VB keywords. Make begin..end work as if..endif so
+;; that forms are formatted correctly.
+;; 1.4.1 KJW Merged Dave Love and KJW versions.
+;; Added keywords suggested by Mickey Ferguson
+;; <MFerguson@peinc.com>
+;; Fixed imenu variable to find private variables and enums
+
+;; Changed syntax class of =, <, > to punctuation to allow dynamic
+;; abbreviations to pick up only the word at point rather than the
+;; whole expression.
+
+;; Fixed bug introduced by KJW adding suport for begin...end in
+;; forms whereby a single end outdented.
+
+;; Partially fixed failure to recognise if statements with
+;; continuations (still fails on 'single line' if with
+;; continuation, ugh).
+;; 1.4.2 RF added "class" and "null" keywords, "Rhino" script note.
+;; 1.4.3 VB1 added
+;; 1) function visual-basic-if-not-on-single-line to recognize single line
+;; if statements, even when line is broken. variable
+;; visual-basic-allow-single-line-if default set to t again.
+;; 2) use of 'words in calling regexp-opt rather than concat \\< ...\\>
+;; 3) new keywords Preserve and Explicit
+;; 1.4.4 VB1 added function visual-basic-close-block
+;; 1.4.5 VB1, (expand-abbrev) within (save-excusion...)
+;; 1.4.6 VB1 correct visual-basic-close-block (single line If case)
+;; 1.4.7 VB1 correct visual-basic-close-block (For/Next)
+;; 1.4.8 VB1 correct visual-basic-close-block (Property, + add With /End With)
+;; add command visual-basic-insert-item
+
+;; Lennart Borgman:
+;; 2009-11-20
+;; - Added eval-and-compile to visual-basic-label-regexp.
+;;
+;; Notes:
+;; Dave Love
+;; BTW, here's a script for making tags tables that I (Dave Love) have
+;; used with reasonable success. It assumes a hacked version of etags
+;; with support for case-folded regexps. I think this is now in the
+;; development version at <URL:ftp://fly.cnuce.cnr.it/pub/> and should
+;; make it into Emacs after 20.4.
+
+;; #! /bin/sh
+
+;; # etags-vb: (so-called) Visual (so-called) Basic TAGS generation.
+;; # Dave Love <d.love@dl.ac.uk>. Public domain.
+;; # 1997-11-21
+
+;; if [ $# -lt 1 ]; then
+;; echo "Usage: `basename $0` [etags options] VBfile ... [etags options] " 1>&2
+;; exit 1
+;; fi
+
+;; if [ $1 = "--help" ] || [ $1 = "-h" ]; then
+;; echo "Usage: `basename $0` [etags options] VBfile ... [etags options]
+
+;; "
+;; etags --help
+;; fi
+
+;; exec etags --lang=none -c '/\(global\|public\)[ \t]+\(\(const\|type\)[ \t]+\)*\([a-z_0-9]+\)/\4/' \
+;; -c '/public[ \t]+\(sub\|function\|class\)[ \t]+\([a-z_0-9]+\)/\2/' \
+;; "$@"
+
+;; End Notes Dave Love
+
+
+;; Known bugs:
+;; Doesn't know about ":" separated stmts
+
+
+
+;; todo:
+;; fwd/back-compound-statement
+;; completion over OCX methods and properties.
+;; IDE integration
+;; Change behaviour of ESC-q to recognise words used as paragraph
+;; titles and prevent them being dragged into the previous
+;; paragraph.
+;; etc.
+
+
+;;; Code:
+
+(provide 'visual-basic-mode)
+
+(defvar visual-basic-xemacs-p (string-match "XEmacs\\|Lucid" (emacs-version)))
+(defvar visual-basic-winemacs-p (string-match "Win-Emacs" (emacs-version)))
+(defvar visual-basic-win32-p (eq window-system 'w32))
+
+;; Variables you may want to customize.
+(defvar visual-basic-mode-indent 8 "*Default indentation per nesting level.")
+(defvar visual-basic-fontify-p t "*Whether to fontify Basic buffers.")
+(defvar visual-basic-capitalize-keywords-p t
+ "*Whether to capitalize BASIC keywords.")
+(defvar visual-basic-wild-files "*.frm *.bas *.cls"
+ "*Wildcard pattern for BASIC source files.")
+(defvar visual-basic-ide-pathname nil
+ "*The full pathname of your Visual Basic exe file, if any.")
+;; VB
+(defvar visual-basic-allow-single-line-if t
+ "*Whether to allow single line if")
+
+
+(defvar visual-basic-defn-templates
+ (list "Public Sub ()\nEnd Sub\n\n"
+ "Public Function () As Variant\nEnd Function\n\n"
+ "Public Property Get ()\nEnd Property\n\n")
+ "*List of function templates though which visual-basic-new-sub cycles.")
+
+(defvar visual-basic-imenu-generic-expression
+ '((nil "^\\s-*\\(public\\|private\\)*\\s-+\\(declare\\s-+\\)*\\(sub\\|function\\)\\s-+\\(\\sw+\\>\\)"
+ 4)
+ ("Constants"
+ "^\\s-*\\(private\\|public\\|global\\)*\\s-*\\(const\\s-+\\)\\(\\sw+\\>\\s-*=\\s-*.+\\)$\\|'"
+ 3)
+ ("Variables"
+ "^\\(private\\|public\\|global\\|dim\\)+\\s-+\\(\\sw+\\>\\s-+as\\s-+\\sw+\\>\\)"
+ 2)
+ ("Types" "^\\(public\\s-+\\)*type\\s-+\\(\\sw+\\)" 2)))
+
+
+
+(defvar visual-basic-mode-syntax-table nil)
+(if visual-basic-mode-syntax-table
+ ()
+ (setq visual-basic-mode-syntax-table (make-syntax-table))
+ (modify-syntax-entry ?\' "\<" visual-basic-mode-syntax-table) ; Comment starter
+ (modify-syntax-entry ?\n ">" visual-basic-mode-syntax-table)
+ (modify-syntax-entry ?\\ "w" visual-basic-mode-syntax-table)
+ (modify-syntax-entry ?\= "." visual-basic-mode-syntax-table)
+ (modify-syntax-entry ?\< "." visual-basic-mode-syntax-table)
+ (modify-syntax-entry ?\> "." visual-basic-mode-syntax-table)) ; Make =, etc., punctuation so that dynamic abbreviations work properly
+
+
+(defvar visual-basic-mode-map nil)
+(if visual-basic-mode-map
+ ()
+ (setq visual-basic-mode-map (make-sparse-keymap))
+ (define-key visual-basic-mode-map "\t" 'visual-basic-indent-line)
+ (define-key visual-basic-mode-map "\r" 'visual-basic-newline-and-indent)
+ (define-key visual-basic-mode-map "\M-\r" 'visual-basic-insert-item)
+ (define-key visual-basic-mode-map "\C-c\C-j" 'visual-basic-insert-item)
+ (define-key visual-basic-mode-map "\M-\C-a" 'visual-basic-beginning-of-defun)
+ (define-key visual-basic-mode-map "\M-\C-e" 'visual-basic-end-of-defun)
+ (define-key visual-basic-mode-map "\M-\C-h" 'visual-basic-mark-defun)
+ (define-key visual-basic-mode-map "\M-\C-\\" 'visual-basic-indent-region)
+ (define-key visual-basic-mode-map "\M-q" 'visual-basic-fill-or-indent)
+ (define-key visual-basic-mode-map "\M-\C-j" 'visual-basic-split-line)
+ (define-key visual-basic-mode-map "\C-c]" 'visual-basic-close-block)
+ (cond (visual-basic-winemacs-p
+ (define-key visual-basic-mode-map '(control C) 'visual-basic-start-ide))
+ (visual-basic-win32-p
+ (define-key visual-basic-mode-map (read "[?\\S-\\C-c]") 'visual-basic-start-ide)))
+ (if visual-basic-xemacs-p
+ (progn
+ (define-key visual-basic-mode-map "\M-G" 'visual-basic-grep)
+ (define-key visual-basic-mode-map '(meta backspace) 'backward-kill-word)
+ (define-key visual-basic-mode-map '(control meta /) 'visual-basic-new-sub))))
+
+
+;; These abbrevs are valid only in a code context.
+(defvar visual-basic-mode-abbrev-table nil)
+
+(defvar visual-basic-mode-hook ())
+
+
+;; Is there a way to case-fold all regexp matches?
+;; Change KJW Add enum, , change matching from 0 or more to zero or one for public etc.
+(eval-and-compile
+ (defconst visual-basic-defun-start-regexp
+ (concat
+ "^[ \t]*\\([Pp]ublic \\|[Pp]rivate \\|[Ss]tatic\\|[Ff]riend \\)?"
+ "\\([Ss]ub\\|[Ff]unction\\|[Pp]roperty +[GgSsLl]et\\|[Tt]ype\\|[Ee]num\\|[Cc]lass\\)"
+ "[ \t]+\\(\\w+\\)[ \t]*(?")))
+
+
+(defconst visual-basic-defun-end-regexp
+ "^[ \t]*[Ee]nd \\([Ss]ub\\|[Ff]unction\\|[Pp]roperty\\|[Tt]ype\\|[Ee]num\\|[Cc]lass\\)")
+
+(defconst visual-basic-dim-regexp
+ "^[ \t]*\\([Cc]onst\\|[Dd]im\\|[Pp]rivate\\|[Pp]ublic\\)\\_>" )
+
+
+;; Includes the compile-time #if variation.
+;; KJW fixed if to require a whitespace so as to avoid matching, for
+;; instance, iFileName and to require then.
+
+;; Two versions; one recognizes single line if just as though it were
+;; a multi-line and the other does not. Modified again to remove the
+;; requirement for then so as to allow it to match if statements that
+;; have continuations -- VB1 further elaborated on this for single line
+;; if statement to be recognized on broken lines.
+;;(defconst visual-basic-if-regexp
+;; "^[ \t]*#?[Ii]f[ \t]+.*[ \t]+[Tt]hen[ \t]*.*\\('\\|$\\)")
+(defconst visual-basic-if-regexp
+ "^[ \t]*#?[Ii]f[ \t]+.*[ \t_]+")
+
+(defconst visual-basic-ifthen-regexp "^[ \t]*#?[Ii]f.+\\<[Tt]hen\\>\\s-\\S-+")
+
+(defconst visual-basic-else-regexp "^[ \t]*#?[Ee]lse\\([Ii]f\\)?")
+(defconst visual-basic-endif-regexp "[ \t]*#?[Ee]nd[ \t]*[Ii]f")
+
+(defconst visual-basic-looked-at-continuation-regexp "_[ \t]*$")
+
+(defconst visual-basic-continuation-regexp
+ (concat "^.*" visual-basic-looked-at-continuation-regexp))
+
+(eval-and-compile
+ (defconst visual-basic-label-regexp "^[ \t]*[a-zA-Z0-9_]+:$"))
+
+(defconst visual-basic-select-regexp "^[ \t]*[Ss]elect[ \t]+[Cc]ase")
+(defconst visual-basic-case-regexp "^[ \t]*[Cc]ase")
+(defconst visual-basic-select-end-regexp "^[ \t]*[Ee]nd[ \t]+[Ss]elect")
+
+
+(defconst visual-basic-for-regexp "^[ \t]*[Ff]or\\b")
+(defconst visual-basic-next-regexp "^[ \t]*[Nn]ext\\b")
+
+(defconst visual-basic-do-regexp "^[ \t]*[Dd]o\\b")
+(defconst visual-basic-loop-regexp "^[ \t]*[Ll]oop\\b")
+
+(defconst visual-basic-while-regexp "^[ \t]*[Ww]hile\\b")
+(defconst visual-basic-wend-regexp "^[ \t]*[Ww]end\\b")
+
+;; Added KJW Begin..end for forms
+(defconst visual-basic-begin-regexp "^[ \t]*[Bb]egin)?")
+;; This has created a bug. End on its own in code should not outdent.
+;; How can we fix this? They are used in separate Lisp expressions so
+;; add another one.
+(defconst visual-basic-end-begin-regexp "^[ \t]*[Ee]nd")
+
+(defconst visual-basic-with-regexp "^[ \t]*[Ww]ith\\b")
+(defconst visual-basic-end-with-regexp "^[ \t]*[Ee]nd[ \t]+[Ww]ith\\b")
+
+(defconst visual-basic-blank-regexp "^[ \t]*$")
+(defconst visual-basic-comment-regexp "^[ \t]*\\s<.*$")
+
+
+;; This is some approximation of the set of reserved words in Visual Basic.
+(eval-and-compile
+ (defvar visual-basic-all-keywords
+ '("Add" "Aggregate" "And" "App" "AppActivate" "Application" "Array" "As"
+ "Asc" "AscB" "Atn" "Attribute"
+ "Beep" "Begin" "BeginTrans" "Boolean" "ByVal" "ByRef"
+ "CBool" "CByte" "CCur"
+ "CDate" "CDbl" "CInt" "CLng" "CSng" "CStr" "CVErr" "CVar" "Call"
+ "Case" "ChDir" "ChDrive" "Character" "Choose" "Chr" "ChrB" "Class"
+ "ClassModule" "Clipboard" "Close" "Collection" "Column" "Columns"
+ "Command" "CommitTrans" "CompactDatabase" "Component" "Components"
+ "Const" "Container" "Containers" "Cos" "CreateDatabase" "CreateObject"
+ "CurDir" "Currency"
+ "DBEngine" "DDB" "Data" "Database" "Databases"
+ "Date" "DateAdd" "DateDiff" "DatePart" "DateSerial" "DateValue" "Day"
+ "Debug" "Declare" "Deftype" "DeleteSetting" "Dim" "Dir" "Do"
+ "DoEvents" "Domain"
+ "Double" "Dynaset" "EOF" "Each" "Else" "Empty" "End" "EndProperty"
+ "Enum" "Environ" "Erase" "Err" "Error" "Exit" "Exp" "Explicit" "FV" "False" "Field"
+ "Fields" "FileAttr" "FileCopy" "FileDateTime" "FileLen" "Fix" "Font" "For"
+ "Form" "FormTemplate" "Format" "Forms" "FreeFile" "FreeLocks" "Friend"
+ "Function"
+ "Get" "GetAllSettings" "GetAttr" "GetObject" "GetSetting" "Global" "GoSub"
+ "GoTo" "Group" "Groups" "Hex" "Hour" "IIf" "IMEStatus" "IPmt" "IRR"
+ "If" "Implements" "InStr" "Input" "Int" "Integer" "Is" "IsArray" "IsDate"
+ "IsEmpty" "IsError" "IsMissing" "IsNull" "IsNumeric" "IsObject" "Kill"
+ "LBound" "LCase" "LOF" "LSet" "LTrim" "Left" "Len" "Let" "Like" "Line"
+ "Load" "LoadPicture" "LoadResData" "LoadResPicture" "LoadResString" "Loc"
+ "Lock" "Log" "Long" "Loop" "MDIForm" "MIRR" "Me" "MenuItems"
+ "MenuLine" "Mid" "Minute" "MkDir" "Month" "MsgBox" "NPV" "NPer" "Name"
+ "New" "Next" "Not" "Now" "Nothing" "Null" "Object" "Oct" "On" "Open"
+ "OpenDatabase"
+ "Operator" "Option" "Optional"
+ "Or" "PPmt" "PV" "Parameter" "Parameters" "Partition"
+ "Picture" "Pmt" "Preserve" "Print" "Printer" "Printers" "Private"
+ "ProjectTemplate" "Property"
+ "Properties" "Public" "Put" "QBColor" "QueryDef" "QueryDefs"
+ "RSet" "RTrim" "Randomize" "Rate" "ReDim" "Recordset" "Recordsets"
+ "RegisterDatabase" "Relation" "Relations" "Rem" "RepairDatabase"
+ "Reset" "Resume" "Return" "Right" "RmDir" "Rnd" "Rollback" "RowBuffer"
+ "SLN" "SYD" "SavePicture" "SaveSetting" "Screen" "Second" "Seek"
+ "SelBookmarks" "Select" "SelectedComponents" "SendKeys" "Set"
+ "SetAttr" "SetDataAccessOption" "SetDefaultWorkspace" "Sgn" "Shell"
+ "Sin" "Single" "Snapshot" "Space" "Spc" "Sqr" "Static" "Step" "Stop" "Str"
+ "StrComp" "StrConv" "String" "Sub" "SubMenu" "Switch" "Tab" "Table"
+ "TableDef" "TableDefs" "Tan" "Then" "Time" "TimeSerial" "TimeValue"
+ "Timer" "To" "Trim" "True" "Type" "TypeName" "UBound" "UCase" "Unload"
+ "Unlock" "Val" "Variant" "VarType" "Verb" "Weekday" "Wend"
+ "While" "Width" "With" "Workspace" "Workspaces" "Write" "Year")))
+
+(defvar visual-basic-font-lock-keywords-1
+ (eval-when-compile
+ (list
+ ;; Names of functions.
+ (list visual-basic-defun-start-regexp
+ '(1 font-lock-keyword-face nil t)
+ '(2 font-lock-keyword-face nil t)
+ '(3 font-lock-function-name-face))
+
+ ;; Statement labels
+ (cons visual-basic-label-regexp 'font-lock-keyword-face)
+
+ ;; Case values
+ ;; String-valued cases get font-lock-string-face regardless.
+ (list "^[ \t]*case[ \t]+\\([^'\n]+\\)" 1 'font-lock-keyword-face t)
+
+ ;; Any keywords you like.
+ (list (regexp-opt
+ '("Dim" "If" "Then" "Else" "ElseIf" "End If") 'words)
+ 1 'font-lock-keyword-face))))
+
+(defvar visual-basic-font-lock-keywords-2
+ (append visual-basic-font-lock-keywords-1
+ (eval-when-compile
+ `((, (regexp-opt visual-basic-all-keywords 'words)
+ 1 font-lock-keyword-face)))))
+
+(defvar visual-basic-font-lock-keywords visual-basic-font-lock-keywords-1)
+
+
+(put 'visual-basic-mode 'font-lock-keywords 'visual-basic-font-lock-keywords)
+
+;;;###autoload
+(defun visual-basic-mode ()
+ "A mode for editing Microsoft Visual Basic programs.
+Features automatic indentation, font locking, keyword capitalization,
+and some minor convenience functions.
+Commands:
+\\{visual-basic-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map visual-basic-mode-map)
+ (setq major-mode 'visual-basic-mode)
+ (setq mode-name "Visual Basic")
+ (set-syntax-table visual-basic-mode-syntax-table)
+
+ ;;; This does not work in multi major modes.
+ ;;(add-hook 'local-write-file-hooks 'visual-basic-untabify)
+
+ (setq local-abbrev-table visual-basic-mode-abbrev-table)
+ (if visual-basic-capitalize-keywords-p
+ (progn
+ (make-local-variable 'pre-abbrev-expand-hook)
+ (add-hook 'pre-abbrev-expand-hook 'visual-basic-pre-abbrev-expand-hook)
+ (abbrev-mode 1)))
+
+ (make-local-variable 'comment-start)
+ (setq comment-start "' ")
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip "'+ *")
+ (make-local-variable 'comment-column)
+ (setq comment-column 40)
+ (make-local-variable 'comment-end)
+ (setq comment-end "")
+
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'visual-basic-indent-line)
+
+ (if visual-basic-fontify-p
+ (visual-basic-enable-font-lock))
+
+ (make-local-variable 'imenu-generic-expression)
+ (setq imenu-generic-expression visual-basic-imenu-generic-expression)
+
+ (set (make-local-variable 'imenu-syntax-alist) `((,(string-to-char "_") . "w")))
+ (set (make-local-variable 'imenu-case-fold-search) t)
+
+ ;;(make-local-variable 'visual-basic-associated-files)
+ ;; doing this here means we need not check to see if it is bound later.
+ (add-hook 'find-file-hooks 'visual-basic-load-associated-files)
+
+ (run-hooks 'visual-basic-mode-hook))
+
+
+(defun visual-basic-enable-font-lock ()
+ ;; Emacs 19.29 requires a window-system else font-lock-mode errs out.
+ (cond ((or visual-basic-xemacs-p window-system)
+
+ ;; In win-emacs this sets font-lock-keywords back to nil!
+ (if visual-basic-winemacs-p
+ (font-lock-mode 1))
+
+ ;; Accomodate emacs 19.29+
+ ;; From: Simon Marshall <Simon.Marshall@esrin.esa.it>
+ (cond ((boundp 'font-lock-defaults)
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults
+ `((visual-basic-font-lock-keywords
+ visual-basic-font-lock-keywords-1
+ visual-basic-font-lock-keywords-2)
+ nil t ((,(string-to-char "_") . "w")))))
+ (t
+ (make-local-variable 'font-lock-keywords)
+ (setq font-lock-keywords visual-basic-font-lock-keywords)))
+
+ (if visual-basic-winemacs-p
+ (font-lock-fontify-buffer)
+ (font-lock-mode 1)))))
+
+;; KJW should add some odds and bobs here to cover "end if" one way
+;; could be to create the abbreviations by removing whitespace then we
+;; could put "end if", "end with" and so on in the keyword table
+;; Another idea would be to make it intelligent enough to substitute
+;; the correct end for the construct (with, select, if)
+;; Is this what the abbrev table hook entry is for?
+(defun visual-basic-construct-keyword-abbrev-table ()
+ (if visual-basic-mode-abbrev-table
+ nil
+ (let ((words visual-basic-all-keywords)
+ (word nil)
+ (list nil))
+ (while words
+ (setq word (car words)
+ words (cdr words))
+ (setq list (cons (list (downcase word) word) list)))
+
+ (define-abbrev-table 'visual-basic-mode-abbrev-table list))))
+
+;; Would like to do this at compile-time.
+(visual-basic-construct-keyword-abbrev-table)
+
+
+(defun visual-basic-upgrade-keyword-abbrev-table ()
+ "Use this in case of upgrading visual-basic-mode.el"
+ (interactive)
+
+ (let ((words visual-basic-all-keywords)
+ (word nil)
+ (list nil))
+ (while words
+ (setq word (car words)
+ words (cdr words))
+ (setq list (cons (list (downcase word) word) list)))
+ (define-abbrev-table 'visual-basic-mode-abbrev-table list)))
+
+
+(defun visual-basic-in-code-context-p ()
+ (if (fboundp 'buffer-syntactic-context) ; XEmacs function.
+ (null (buffer-syntactic-context))
+ ;; Attempt to simulate buffer-syntactic-context
+ ;; I don't know how reliable this is.
+ (let* ((beg (save-excursion
+ (beginning-of-line)
+ (point)))
+ (list
+ (parse-partial-sexp beg (point))))
+ (and (null (nth 3 list)) ; inside string.
+ (null (nth 4 list)))))) ; inside comment
+
+
+(defun visual-basic-pre-abbrev-expand-hook ()
+ ;; Allow our abbrevs only in a code context.
+ (setq local-abbrev-table
+ (if (visual-basic-in-code-context-p)
+ visual-basic-mode-abbrev-table)))
+
+
+(defun visual-basic-newline-and-indent (&optional count)
+ "Insert a newline, updating indentation."
+ (interactive)
+ (save-excursion
+ (expand-abbrev)
+ (visual-basic-indent-line))
+ (call-interactively 'newline-and-indent))
+
+(defun visual-basic-beginning-of-defun ()
+ (interactive)
+ (re-search-backward visual-basic-defun-start-regexp))
+
+(defun visual-basic-end-of-defun ()
+ (interactive)
+ (re-search-forward visual-basic-defun-end-regexp))
+
+(defun visual-basic-mark-defun ()
+ (interactive)
+ (beginning-of-line)
+ (visual-basic-end-of-defun)
+ (set-mark (point))
+ (visual-basic-beginning-of-defun)
+ (if visual-basic-xemacs-p
+ (zmacs-activate-region)))
+
+(defun visual-basic-indent-defun ()
+ (interactive)
+ (save-excursion
+ (visual-basic-mark-defun)
+ (call-interactively 'visual-basic-indent-region)))
+
+
+(defun visual-basic-fill-long-comment ()
+ "Fills block of comment lines around point."
+ ;; Derived from code in ilisp-ext.el.
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (let ((comment-re "^[ \t]*\\s<+[ \t]*"))
+ (if (looking-at comment-re)
+ (let ((fill-prefix
+ (buffer-substring
+ (progn (beginning-of-line) (point))
+ (match-end 0))))
+
+ (while (and (not (bobp))
+ (looking-at visual-basic-comment-regexp))
+ (forward-line -1))
+ (if (not (bobp)) (forward-line 1))
+
+ (let ((start (point)))
+
+ ;; Make all the line prefixes the same.
+ (while (and (not (eobp))
+ (looking-at comment-re))
+ (replace-match fill-prefix)
+ (forward-line 1))
+
+ (if (not (eobp))
+ (beginning-of-line))
+
+ ;; Fill using fill-prefix
+ (fill-region-as-paragraph start (point))))))))
+
+
+(defun visual-basic-fill-or-indent ()
+ "Fill long comment around point, if any, else indent current definition."
+ (interactive)
+ (cond ((save-excursion
+ (beginning-of-line)
+ (looking-at visual-basic-comment-regexp))
+ (visual-basic-fill-long-comment))
+ (t
+ (visual-basic-indent-defun))))
+
+
+(defun visual-basic-new-sub ()
+ "Insert template for a new subroutine. Repeat to cycle through alternatives."
+ (interactive)
+ (beginning-of-line)
+ (let ((templates (cons visual-basic-blank-regexp
+ visual-basic-defn-templates))
+ (tem nil)
+ (bound (point)))
+ (while templates
+ (setq tem (car templates)
+ templates (cdr templates))
+ (cond ((looking-at tem)
+ (replace-match (or (car templates)
+ ""))
+ (setq templates nil))))
+
+ (search-backward "()" bound t)))
+
+
+;; (defun visual-basic-untabify ()
+;; "Do not allow any tabs into the file."
+;; (if (eq major-mode 'visual-basic-mode)
+;; (untabify (point-min) (point-max)))
+;; nil)
+
+(defun visual-basic-default-tag ()
+ (if (and (not (bobp))
+ (save-excursion
+ (backward-sexp)
+ (looking-at "\\w")))
+ (backward-word 1))
+ (let ((s (point))
+ (e (save-excursion
+ (forward-sexp)
+ (point))))
+ (buffer-substring s e)))
+
+(defun visual-basic-grep (tag)
+ "Search BASIC source files in current directory for TAG."
+ (interactive
+ (list (let* ((def (visual-basic-default-tag))
+ (tag (read-string
+ (format "Grep for [%s]: " def))))
+ (if (string= tag "") def tag))))
+ (grep (format "grep -n %s %s" tag visual-basic-wild-files)))
+
+
+;;; IDE Connection.
+
+(defun visual-basic-buffer-project-file ()
+ "Return a guess as to the project file associated with the current buffer."
+ (car (directory-files (file-name-directory (buffer-file-name)) t "\\.vbp")))
+
+(defun visual-basic-start-ide ()
+ "Start Visual Basic (or your favorite IDE, (after Emacs, of course))
+on the first project file in the current directory.
+Note: it's not a good idea to leave Visual Basic running while you
+are editing in Emacs, since Visual Basic has no provision for reloading
+changed files."
+ (interactive)
+ (let (file)
+ (cond ((null visual-basic-ide-pathname)
+ (error "No pathname set for Visual Basic. See visual-basic-ide-pathname"))
+ ((null (setq file (visual-basic-buffer-project-file)))
+ (error "No project file found"))
+ ((fboundp 'win-exec)
+ (iconify-emacs)
+ (win-exec visual-basic-ide-pathname 'win-show-normal file))
+ ((fboundp 'start-process)
+ (iconify-frame (selected-frame))
+ (start-process "*VisualBasic*" nil visual-basic-ide-pathname file))
+ (t
+ (error "No way to spawn process!")))))
+
+
+
+;;; Indentation-related stuff.
+
+(defun visual-basic-indent-region (start end)
+ "Perform visual-basic-indent-line on each line in region."
+ (interactive "r")
+ (save-excursion
+ (goto-char start)
+ (beginning-of-line)
+ (while (and (not (eobp))
+ (< (point) end))
+ (if (not (looking-at visual-basic-blank-regexp))
+ (visual-basic-indent-line))
+ (forward-line 1)))
+
+ (cond ((fboundp 'zmacs-deactivate-region)
+ (zmacs-deactivate-region))
+ ((fboundp 'deactivate-mark)
+ (deactivate-mark))))
+
+
+
+(defun visual-basic-previous-line-of-code ()
+ (if (not (bobp))
+ (forward-line -1)) ; previous-line depends on goal column
+ (while (and (not (bobp))
+ (or (looking-at visual-basic-blank-regexp)
+ (looking-at visual-basic-comment-regexp)))
+ (forward-line -1)))
+
+
+(defun visual-basic-find-original-statement ()
+ "If the current line is a continuation, move back to the original stmt."
+ (let ((here (point)))
+ (visual-basic-previous-line-of-code)
+ (while (and (not (bobp))
+ (looking-at visual-basic-continuation-regexp))
+ (setq here (point))
+ (visual-basic-previous-line-of-code))
+ (goto-char here)))
+
+(defun visual-find-matching-stmt (open-p close-p)
+ ;; Searching backwards
+ (let ((level 0))
+ (while (and (>= level 0) (not (bobp)))
+ (visual-basic-previous-line-of-code)
+ (visual-basic-find-original-statement)
+ (cond ((funcall close-p)
+ (setq level (+ level 1)))
+ ((funcall open-p)
+ (setq level (- level 1)))))))
+
+(defun visual-basic-find-matching-stmt (open-regexp close-regexp)
+ (visual-find-matching-stmt
+ (lambda () (looking-at open-regexp))
+ (lambda () (looking-at close-regexp))))
+
+(defun visual-basic-get-complete-tail-of-line ()
+ "Return the tail of the current statement line, starting at
+ point and going up to end of statement line. If you want the
+ complete statement line, you have to call functions
+ `visual-basic-find-original-statement' and then
+ `beginning-of-line' before"
+ (let* ((start-point (point))
+ complete-line
+ (line-beg start-point)
+ line-end)
+ (while (null line-end)
+ (end-of-line)
+ (setq line-end (point))
+ (if (search-backward "_" line-beg t)
+ (if (looking-at visual-basic-looked-at-continuation-regexp)
+ ;; folded line
+ (progn
+ (setq line-end (1- (point))
+ complete-line (cons
+ (buffer-substring-no-properties
+ line-beg line-end)
+ complete-line)
+ line-end nil)
+ (beginning-of-line 2)
+ (setq line-beg (point)))
+ ;; _ found, but not a folded line (this is a syntax error)
+ (setq complete-line
+ (cons (buffer-substring-no-properties line-beg line-end) complete-line)))
+ ;; not a folded line
+ (setq complete-line
+ (cons (buffer-substring-no-properties line-beg line-end)
+ complete-line))))
+ (mapconcat 'identity (nreverse complete-line) " ")))
+
+(defun visual-basic-if-not-on-single-line ()
+ "Return non-`nil' when the If statement is not on a single statement
+line, i.e. requires a matching End if. Note that a statement line may
+be folded over several code lines."
+ (if (looking-at visual-basic-if-regexp)
+ (save-excursion
+ (beginning-of-line)
+ (let (p1
+ p2
+ ;; 1st reconstruct complete line
+ (complete-line (visual-basic-get-complete-tail-of-line)) )
+
+ ;; now complete line has been reconstructed, drop confusing elements
+
+ ;; remove any VB string from complete line, as strings may disrupt : and ' detection
+ (while (and (setq p1 (string-match "\"" complete-line))
+ (setq p2 (string-match "\"" complete-line (1+ p1))))
+ (setq complete-line (concat (substring complete-line 0 p1)
+ (substring complete-line (1+ p2)))))
+ ;; now drop tailing comment if any
+ (when (setq p1 (string-match "'" complete-line))
+ (setq complete-line (substring complete-line p1)))
+ ;; now drop 1st concatenated instruction is any
+ (when (setq p1 (string-match ":" complete-line))
+ (setq complete-line (substring complete-line p1)))
+ ;;
+ (string-match "Then\\s-*$" complete-line))); end (save-excursion ...)
+ ;; else, not a basic if
+ nil))
+
+(defun visual-basic-find-matching-if ()
+ (visual-find-matching-stmt 'visual-basic-if-not-on-single-line
+ (lambda () (looking-at visual-basic-endif-regexp))))
+
+(defun visual-basic-find-matching-select ()
+ (visual-basic-find-matching-stmt visual-basic-select-regexp
+ visual-basic-select-end-regexp))
+
+(defun visual-basic-find-matching-for ()
+ (visual-basic-find-matching-stmt visual-basic-for-regexp
+ visual-basic-next-regexp))
+
+(defun visual-basic-find-matching-do ()
+ (visual-basic-find-matching-stmt visual-basic-do-regexp
+ visual-basic-loop-regexp))
+
+(defun visual-basic-find-matching-while ()
+ (visual-basic-find-matching-stmt visual-basic-while-regexp
+ visual-basic-wend-regexp))
+
+(defun visual-basic-find-matching-with ()
+ (visual-basic-find-matching-stmt visual-basic-with-regexp
+ visual-basic-end-with-regexp))
+
+;;; If this fails it must return the indent of the line preceding the
+;;; end not the first line because end without matching begin is a
+;;; normal simple statement
+(defun visual-basic-find-matching-begin ()
+ (let ((original-point (point)))
+ (visual-basic-find-matching-stmt visual-basic-begin-regexp
+ visual-basic-end-begin-regexp)
+ (if (bobp) ;failed to find a matching begin so assume that it is
+ ;an end statement instead and use the indent of the
+ ;preceding line.
+ (progn (goto-char original-point)
+ (visual-basic-previous-line-of-code)))))
+
+
+(defun visual-basic-calculate-indent ()
+ (let ((original-point (point)))
+ (save-excursion
+ (beginning-of-line)
+ ;; Some cases depend only on where we are now.
+ (cond ((or (looking-at visual-basic-defun-start-regexp)
+ (looking-at visual-basic-label-regexp)
+ (looking-at visual-basic-defun-end-regexp))
+ 0)
+
+ ;; The outdenting stmts, which simply match their original.
+ ((or (looking-at visual-basic-else-regexp)
+ (looking-at visual-basic-endif-regexp))
+ (visual-basic-find-matching-if)
+ (current-indentation))
+
+ ;; All the other matching pairs act alike.
+ ((looking-at visual-basic-next-regexp) ; for/next
+ (visual-basic-find-matching-for)
+ (current-indentation))
+
+ ((looking-at visual-basic-loop-regexp) ; do/loop
+ (visual-basic-find-matching-do)
+ (current-indentation))
+
+ ((looking-at visual-basic-wend-regexp) ; while/wend
+ (visual-basic-find-matching-while)
+ (current-indentation))
+
+ ((looking-at visual-basic-end-with-regexp) ; with/end with
+ (visual-basic-find-matching-with)
+ (current-indentation))
+
+ ((looking-at visual-basic-select-end-regexp) ; select case/end select
+ (visual-basic-find-matching-select)
+ (current-indentation))
+
+ ;; A case of a select is somewhat special.
+ ((looking-at visual-basic-case-regexp)
+ (visual-basic-find-matching-select)
+ (+ (current-indentation) visual-basic-mode-indent))
+
+ ;; Added KJW: Make sure that this comes after the cases
+ ;; for if..endif, end select because end-regexp will also
+ ;; match "end select" etc.
+ ((looking-at visual-basic-end-begin-regexp) ; begin/end
+ (visual-basic-find-matching-begin)
+ (current-indentation))
+
+ (t
+ ;; Other cases which depend on the previous line.
+ (visual-basic-previous-line-of-code)
+
+ ;; Skip over label lines, which always have 0 indent.
+ (while (looking-at visual-basic-label-regexp)
+ (visual-basic-previous-line-of-code))
+
+ (cond
+ ((looking-at visual-basic-continuation-regexp)
+ (visual-basic-find-original-statement)
+ ;; Indent continuation line under matching open paren,
+ ;; or else one word in.
+ (let* ((orig-stmt (point))
+ (matching-open-paren
+ (condition-case ()
+ (save-excursion
+ (goto-char original-point)
+ (beginning-of-line)
+ (backward-up-list 1)
+ ;; Only if point is now w/in cont. block.
+ (if (<= orig-stmt (point))
+ (current-column)))
+ (error nil))))
+ (cond (matching-open-paren
+ (1+ matching-open-paren))
+ (t
+ ;; Else, after first word on original line.
+ (back-to-indentation)
+ (forward-word 1)
+ (while (looking-at "[ \t]")
+ (forward-char 1))
+ (current-column)))))
+ (t
+ (visual-basic-find-original-statement)
+
+ (let ((indent (current-indentation)))
+ ;; All the various +indent regexps.
+ (cond ((looking-at visual-basic-defun-start-regexp)
+ (+ indent visual-basic-mode-indent))
+
+ ((or (visual-basic-if-not-on-single-line)
+ (and (looking-at visual-basic-else-regexp)
+ (not (and visual-basic-allow-single-line-if
+ (looking-at visual-basic-ifthen-regexp)))))
+ (+ indent visual-basic-mode-indent))
+
+ ((or (looking-at visual-basic-select-regexp)
+ (looking-at visual-basic-case-regexp))
+ (+ indent visual-basic-mode-indent))
+
+ ((or (looking-at visual-basic-do-regexp)
+ (looking-at visual-basic-for-regexp)
+ (looking-at visual-basic-while-regexp)
+ (looking-at visual-basic-with-regexp)
+ (looking-at visual-basic-begin-regexp))
+ (+ indent visual-basic-mode-indent))
+
+ (t
+ ;; By default, just copy indent from prev line.
+ indent))))))))))
+
+(defun visual-basic-indent-to-column (col)
+ (let* ((bol (save-excursion
+ (beginning-of-line)
+ (point)))
+ (point-in-whitespace
+ (<= (point) (+ bol (current-indentation))))
+ (blank-line-p
+ (save-excursion
+ (beginning-of-line)
+ (looking-at visual-basic-blank-regexp))))
+
+ (cond ((/= col (current-indentation))
+ (save-excursion
+ (beginning-of-line)
+ (back-to-indentation)
+ (delete-region bol (point))
+ (indent-to col))))
+
+ ;; If point was in the whitespace, move back-to-indentation.
+ (cond (blank-line-p
+ (end-of-line))
+ (point-in-whitespace
+ (back-to-indentation)))))
+
+
+(defun visual-basic-indent-line ()
+ "Indent current line for BASIC."
+ (interactive)
+ (visual-basic-indent-to-column (visual-basic-calculate-indent)))
+
+
+(defun visual-basic-split-line ()
+ "Split line at point, adding continuation character or continuing a comment.
+In Abbrev mode, any abbrev before point will be expanded."
+ (interactive)
+ (let ((pps-list (parse-partial-sexp (save-excursion
+ (beginning-of-line)
+ (point))
+ (point))))
+ ;; Dispatch on syntax at this position.
+ (cond ((equal t (nth 4 pps-list)) ; in comment
+ (indent-new-comment-line))
+ ((equal t (nth 4 pps-list)) ; in string
+ (error "Can't break line inside a string"))
+ (t (just-one-space) ; leading space on next line
+ ; doesn't count, sigh
+ (insert "_")
+ (visual-basic-newline-and-indent)))))
+
+(defun visual-basic-detect-idom ()
+ "Detects whether this is a VBA or VBS script. Returns symbol
+ `vba' if it is VBA, `nil' otherwise"
+ (let (ret)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (cond
+ ((looking-at "^[ \t]*Attribute\\s-+VB_Name\\s-+= ") (setq ret 'vba)))
+ ))
+ ret))
+
+(defun visual-basic-close-block ()
+ "Insert `End If' is current block is a `If Then ...', `End
+With' if the block is a `With ...', etc..."
+ (interactive)
+ (let (end-statement end-indent)
+ (save-excursion
+ (save-match-data
+ (while
+ (unless (bobp)
+ (visual-basic-previous-line-of-code)
+ (visual-basic-find-original-statement)
+ (cond
+ ;; Cases where the current statement is a start-of-smthing statement
+ ((looking-at visual-basic-defun-start-regexp)
+ (let ((smt (match-string 2)))
+ (when (string-match "\\`Prop" smt)
+ (setq smt "Property"))
+ (setq end-statement (concat "End " smt)
+ end-indent 0))
+ nil)
+ ((looking-at visual-basic-select-regexp)
+ (setq end-statement "End Select"
+ end-indent (current-indentation))
+ nil)
+ ((looking-at visual-basic-with-regexp)
+ (setq end-statement "End With"
+ end-indent (current-indentation))
+ nil)
+ ((looking-at visual-basic-case-regexp)
+ (setq end-statement "End Select"
+ end-indent (max 0 (- (current-indentation) visual-basic-mode-indent)))
+ nil)
+ ((looking-at visual-basic-begin-regexp)
+ (setq end-statement "End"
+ end-indent (current-indentation))
+ nil)
+ ((or (visual-basic-if-not-on-single-line)
+ (looking-at visual-basic-else-regexp))
+ (setq end-statement "End If"
+ end-indent (current-indentation))
+ nil)
+
+ ((looking-at visual-basic-do-regexp)
+ (setq end-statement "Loop"
+ end-indent (current-indentation))
+ nil)
+
+ ((looking-at visual-basic-for-regexp)
+ (goto-char (match-end 0))
+ (setq end-statement "Next"
+ end-indent (current-indentation))
+ (let ((vb-idom (visual-basic-detect-idom)))
+ (cond
+ ;; for VBA add the variable name after Next.
+ ((eq vb-idom 'vba)
+ (when (looking-at "\\s-+\\(Each\\s-+\\|\\)\\([^ \t\n\r]+\\)")
+ (setq end-statement (concat end-statement " " (match-string 2)))))))
+ nil)
+ ;; Cases where the current statement is an end-of-smthing statement
+ ((or (looking-at visual-basic-else-regexp)
+ (looking-at visual-basic-endif-regexp))
+ (visual-basic-find-matching-if)
+ t)
+ ((looking-at visual-basic-next-regexp) ; for/next
+ (visual-basic-find-matching-for)
+ t)
+ ((looking-at visual-basic-loop-regexp) ; do/loop
+ (visual-basic-find-matching-do)
+ t)
+ ((looking-at visual-basic-wend-regexp) ; while/wend
+ (visual-basic-find-matching-while)
+ t)
+ ((looking-at visual-basic-end-with-regexp) ; with/end with
+ (visual-basic-find-matching-with)
+ t)
+ ((looking-at visual-basic-select-end-regexp) ; select case/end select
+ (visual-basic-find-matching-select)
+ t)
+
+
+ ;; default is to loop again back to previous line of code.
+ (t t))))))
+ (when end-statement
+ (insert end-statement)
+ (visual-basic-indent-to-column end-indent))))
+
+(defvar delta-split-to-cur-point) ;; Don't know what it is, just silence compiler
+
+(defun visual-basic-insert-item ()
+ "Insert a new item in a block.
+
+This function is under developement, and for the time being only Dim items are handled.
+
+Interting an item means:
+
+* Add a `Case' or `Case Else' into a `Select ... End Select'
+ block. Pressing again toggles between `Case' and `Case
+ Else'. `Case Else' is possible only if there is not already a `Case Else'.
+
+* split a Dim declaration over several lines.
+
+* Add an `Else' or `ElseIf ... Then' into an `If ... Then ... End
+ If' block. Pressing again toggles between `Else' and `ElseIf
+ ... Then'. `Else' is possible only if therei s not already an
+ `Else'.
+"
+ (interactive)
+ ;; possible cases are
+ ;; dim-split-before => split before variable name
+ ;; dim-split-after => split after type name if any
+ ;; if-with-else
+ ;; if-without-else
+ ;; select-with-else
+ ;; select-without-else
+ ;; not-itemizable
+ (let (item-case
+ item-ident
+ split-point
+ cur-point-mark
+ prefix
+ tentative-split-point
+ block-stack (cur-point (point)) previous-line-of-code)
+ (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (while
+ (progn
+ (visual-basic-find-original-statement)
+ (cond
+ ;; dim case
+ ;;--------------------------------------------------------------
+ ((and (null previous-line-of-code)
+ (looking-at visual-basic-dim-regexp)
+ (null (save-match-data (looking-at visual-basic-defun-start-regexp))))
+ (setq prefix (buffer-substring-no-properties
+ (point)
+ (goto-char (setq split-point (match-end 0)))))
+ (while
+ (progn
+ (if
+ (looking-at "\\s-*\\sw+\\s-*")
+ (progn
+ (goto-char (setq tentative-split-point (match-end 0)))
+ (if (>= tentative-split-point cur-point)
+ nil
+ (while (or
+ (looking-at "([^)\n]+)\\s-*")
+ (looking-at visual-basic-looked-at-continuation-regexp))
+ (goto-char (setq tentative-split-point (match-end 0))))
+ (when (looking-at "As\\s-+\\sw+\\s-*")
+ (goto-char (setq tentative-split-point (match-end 0))))
+ (when (looking-at visual-basic-looked-at-continuation-regexp)
+ (beginning-of-line 2))
+ (if (looking-at ",")
+ (goto-char (setq split-point (match-end 0)))
+ (setq split-point (point))
+ nil)))
+ nil)))
+ (goto-char split-point)
+ (setq item-case (if (<= split-point cur-point) 'dim-split-before 'dim-split-after))
+ (setq delta-split-to-cur-point (- split-point cur-point))
+ (setq cur-point-mark (make-marker))
+ (set-marker cur-point-mark cur-point)
+ (looking-at "\\s-*")
+ (setq delta-split-to-cur-point (- delta-split-to-cur-point
+ (- (match-end 0) (match-beginning 0))))
+ (delete-region (point) (match-end 0))
+ (when (looking-back ",")
+ (delete-region split-point (1- split-point)))
+ (insert "\n" prefix " ")
+ (setq cur-point (marker-position cur-point-mark))
+ (set-marker cur-point-mark nil)
+ nil)
+ ;; next
+ ((looking-at visual-basic-next-regexp)
+ (push (list 'next) block-stack))
+ ;; default
+ ;;--------------------------------------------------------------
+ (t (if (bobp)
+ (setq item-case 'not-itemizable)))
+ )
+ (when (null item-case)
+ (visual-basic-previous-line-of-code)
+ (setq previous-line-of-code t))
+ (null item-case)))))
+ (cond
+ ((eq item-case 'dim-split-after)
+ (goto-char cur-point))
+ )
+ ))
+
+;;; Some experimental functions
+
+;;; Load associated files listed in the file local variables block
+(defun visual-basic-load-associated-files ()
+ "Load files that are useful to have around when editing the source of the file that has just been loaded.
+The file must have a local variable that lists the files to be loaded.
+If the file name is relative it is relative to the directory
+containing the current buffer. If the file is already loaded nothing
+happens, this prevents circular references causing trouble. After an
+associated file is loaded its associated files list will be
+processed."
+ (if (boundp 'visual-basic-associated-files)
+ (let ((files visual-basic-associated-files)
+ (file nil))
+ (while files
+ (setq file (car files)
+ files (cdr files))
+ (message "Load associated file: %s" file)
+ (visual-basic-load-file-ifnotloaded file default-directory)))))
+
+
+
+(defun visual-basic-load-file-ifnotloaded (file default-directory)
+ "Load file if not already loaded.
+If file is relative then default-directory provides the path"
+ (let((file-absolute (expand-file-name file default-directory)))
+ (if (get-file-buffer file-absolute); don't do anything if the buffer is already loaded
+ ()
+ (find-file-noselect file-absolute ))))
+
+
+
+;;; visual-basic-mode.el ends here
+
+
+;External Links
+;* [http://visualbasic.freetutes.com/ Visual Basic tutorials]
+
--- /dev/null
+;;; wikipedia-mode.el --- Mode for editing Wikipedia articles off-line
+;; Copyright (C) 2003, 2004, 2006 Chong Yidong, Uwe Brauer
+
+;; Author: Chong Yidong <cyd at stupidchicken com>
+;; Maintainer: Uwe Brauer <oub at mat.ucm.es>
+;; Version: 0.51
+;; Keywords: wiki
+;; $Id: wikipedia-mode.el,v 1.5 2006/05/30 15:16:45 oub Exp oub $
+
+
+;; This file is not part of GNU Emacs.
+
+;;{{{ GPL2
+
+;; This file is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+
+;; This file is distributed in the hope that it will be
+;; useful, but WITHOUT ANY WARRANTY; without even the implied
+;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public
+;; License along with GNU Emacs; if not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+;; MA 02111-1307 USA
+
+;;}}}
+
+;;; Commentary:
+
+;; This is `wikipedia-mode', a major mode for editing articles written
+;; in the markup language used by Wikipedia, the free on-line
+;; encyclopedia (http://www.wikipedia.org). It is intended to work
+;; with GNU Emacs 21.x, and Xemacs 21.4.x. See below for details.
+
+;; wikipedia mode can be found also at:
+;; http://en.wikipedia.org/wiki/Wikipedia:Wikipedia-mode.el
+
+;;{{{ INSTALLING WIKIPEDIA-MODE
+
+;; Installing wikipedia-mode
+;; =========================
+;;
+;; Save wikipedia-mode.el in a convenient directory, preferably in
+;; your `load-path'. Add the following to your `user-init-file':
+;;
+;; (autoload 'wikipedia-mode
+;; "wikipedia-mode.el"
+;; "Major mode for editing documents in Wikipedia markup." t)
+;;
+;; If you did not save wikipedia-mode.el in your `load-path', you must
+;; use the full pathname. On MS Windows, use forward slashes (/)
+;; rather than back slashes (\) to indicate the directory, e.g.:
+;;
+;; (autoload 'wikipedia-mode
+;; "C:/Documents and Settings/USERNAME/.emacs.d/Wikipedia-mode.el"
+;; "Major mode for editing documents in Wikipedia markup." t)
+;;
+;; If you want to associate filenames ending in ".wiki" with
+;; wikipedia-mode, add the following to your init file:
+;;
+;; (setq auto-mode-alist
+;; (cons '("\\.wiki\\'" . wikipedia-mode) auto-mode-alist))
+
+;;}}}
+
+;;{{{ REQUIREMENTS
+
+;; This is not a real requirements but I highly recommend to use
+;; outline-magic written by Carsten Dominik. If you don't want to use it
+;; you have to comment out the relevant reference to outline magic.
+;; It can be found at
+;; http://www.astro.uva.nl/~dominik/Tools/outline-magic.el
+
+
+
+
+;;}}}
+
+;;{{{ RECOMMENDATIONS INSTALLING LONGLINES-MODE
+
+;; Installing longlines-mode
+;; =========================
+;;
+;; If you are using Emacs 22 or later longlines-mode is included so
+;; please skip this section!
+;;
+;; Wikipedia articles don't use newline characters to break paragraphs
+;; into lines, so each paragraph looks like a super-long line to
+;; Emacs. To let Emacs handle "soft word wrapping", you need to
+;; download a third-party package, longlines-mode.
+;;
+;; Download longlines.el, saving into your `load-path':
+;;
+;; http://www.emacswiki.org/elisp/longlines.el
+;;
+;; Add the following to your `user-init-file':
+;;
+;; (autoload 'longlines-mode "longlines.el"
+;; "Minor mode for editing long lines." t)
+;;
+;;
+;; WARNING: if you insert text from one file in wikipedia-mode to
+;; another file in wikipedia-mode I strongly recommend, to turn
+;; longlines-mode off, before the copying!
+
+;;}}}
+
+;;{{{ RECOMMENDATIONS INSTALLING PABBREV-MODE
+
+;; Installing pabbrev-mode
+;; =========================
+;;
+;; You may find pabbrev.el useful, which can be found at
+;; http://www.russet.org.uk/download/emacs/pabbrev.el
+
+
+;;}}}
+
+;;{{{ Xemacs or (GNU) Emacs
+
+;; Xemacs or (GNU) Emacs
+;; =====================
+;; Usually that is a question of taste. However almost all wikipedia
+;; articles nowadays use UTF8 coding, so the question which of the
+;; Macsen to use, boils down to which degree UTF8 support is
+;; implemented (no mule Xemacs is ruled out). While Xemacs has the
+;; better font support, the UTF8 support still is not complete and
+;; hence at the time being it is sad for the maintainer (a long time
+;; Xemacs user) to recommend NOT to use Xemacs, even not 21.5.x, which
+;; has a much better implemented UTF8 coding engine. That might
+;; however change in the foreseeable future....
+;; WARNING: at least for me in Debian testing/unstable Emacs does not
+;; ship all fonts necessary for a flawless editing of UTF8 files. For
+;; example you can chose Greek input, write Greek text, but then when
+;; you close and open the file again, the Greek symbol are not
+;; displayed but you see empty blocks. The reason seems that emacs
+;; chooses for the input fonts other fonts as for the display (don't
+;; ask me). However for installing the (ugly) UTF8 compatible fonts
+;; from ..... solved that problem.
+
+
+;;}}}
+
+;;{{{ INSTALLING EE-HELPER or MOZEX
+
+;; Installing the helper programs.
+;; =========================
+;; Helper Programs: MozEx and EE-HELPER. There are three possibilities
+;; in order to use Emacs as an external editor
+;;
+;; (1) Firefox add-on It's All Text: Recommended. The elisp
+;; library its-all-text.el makes it easier to use this.
+;;
+;; PROS: Easy to intall, supported. (You need to add Emacs
+;; client as the editor.) Can be used for editing other
+;; text fields with Emacs too.
+;;
+;; (2) EE-HELPER: This is perl script which will communicate with
+;; the wikipedia server. However that sometimes be slow.
+
+;; PROS: if the editor supports UTF8, then ee-helper will
+;; pass the coding flawlessly.
+;;
+;; CONTRA: the problem with this script is that it directly
+;; communicates with the wikipedia site and does not
+;; warn you about simultaneous editing. Use it with
+;; care!!! Moreover section editing is not implemented.
+
+;; (3) MozEx: this is a Java-script which allows to communicate
+;; Mozilla (or Firefox) directly with Emacs.
+
+;; PROS: After finishing editing you use the wikipedia
+;; software to submit your changes and not the script,
+;; so you are warned about possible conflicting editing.
+;;
+;; CONTRA: the official version does not support UTF8,
+;; however there is now a new semi official version which
+;; does support UTF8.
+
+;; Installing It's All Text
+;; ========================
+;;
+;; Go to the home page and follow the instructions there:
+;;
+;; https://addons.mozilla.org/en-US/firefox/addon/4125
+;;
+;; Then open It's All Text preferences from the Firefox Add-ons page
+;; and choose emacsclient as your editor (emacsclientw.exe on
+;; Windows).
+
+;; Installing ee-helper
+;; ====================
+;;
+;; Download the perl script from
+;;
+;; http://meta.wikimedia.org/wiki/Help:External_editors
+;;
+;; and follow the instructions. configure the .ee-ini file. chance in
+;; your personal wikipedia-mode-map account setting the editing
+;; functions: activate the `external editor' option.
+
+;; Installing MozEx
+;; ================
+;;
+;; If your web browser is Mozilla or Firefox, take a look at the MozEx
+;; extension, which allows you to call Emacs for editing text boxes:
+;;
+;; http://mozex.mozdev.org/development.html
+;;
+;; See also
+;;
+;; http://www.emacswiki.org/cgi-bin/wiki/FireFox
+;;
+;; If you mostly use MozEx to edit Wikipedia articles, it might be
+;; worthwhile to tell Emacs to enter wikipedia-mode whenever it is
+;; called by MozEx. Just add this to your `user-init-file':
+;;
+;; (add-to-list 'auto-mode-alist '("mozex.\\.*" . wikipedia-mode))
+
+;; Recall: you have to click on edit (either edit article or edit
+;; section), then use mouse3 (or shift f10), then select
+;; mozex, then edit textarea: Edit-->mouse3-->mozex-->Edit
+;; Textarea. After editing, you have to _click_ on the
+;; text in the browser otherwise Mozilla will ignore your
+;; typing.
+
+;;}}}
+
+;;{{{ NEWS
+
+
+;; NEWS
+;; ==================================
+;; (1) Font setting has changed.
+;; (2) Some makeup formats have been added: italics, bold, strong
+;; emphasise, links.
+;; (3) outline-cycle from Carsten Dominiks outline-magic has been
+;; added.
+;; (4) "Draft", "send" and "reply" (for discussion pages)
+;; abilities 'based' on ideas of John Wigleys remember.el: see
+;; the functions wikipedia-draft-*
+;; RATIONALE: This comes handy in 2 situations
+;; 1. You are editing articles which various authors (this I
+;; think is the usual case), you then want not to submit
+;; your edit immediately but want to copy it somewhere and
+;; to continue later. You can use the following functions
+;; for doing that:
+;; wikipedia-draft-buffer \C-c\C-b
+;; wikipedia-draft-region \C-c\C-r
+;; then the buffer/region will be appended to the
+;; wikipedia-draft-data-file (default is
+;; "~/Wiki/discussions/draft.wiki", which you can visit via
+;; wikipedia-draft-view-draft) and it will be
+;; surrounded by the ^L marks in order to set a page.
+;; moreover on top on that a section header == will be
+;; inserted, which consists of the Word Draft, a subject
+;; you are asked for and a date stamp.
+;;
+;; Another possibility consists in using the function
+;; wikipedia-draft, bound to \C-c \C-m then a new buffer
+;; will opened already in wikipedia mode. You edit and then
+;; either can send the content of the buffer to the
+;; wikipedia-draft-data-file in the same manner as
+;; described above using the function
+;; wikipedia-draft-buffer (bound to \C-c\C-k)
+;;
+;; BACK: In order to copy/send the content of temporary
+;; buffer or of a page in the wikipedia-draft-data-file
+;; back in to your wikipedia file, use the function
+;; `wikipedia-send-to-mozex'. You
+;; will be asked to which buffer to copy your text!
+;;
+;;
+;; 2. You want to reply in a discussion page to a specific
+;; contribution, you can use either the function
+;;
+;; \\[wikipedia-reply-at-point-simple] bound to [(meta shift r)]
+;; which inserts a newline, a hline, and the signature of
+;; the author. Or can use
+;; \\[wikipedia-draft-reply] bound [(meta r)]
+;; which does the same as wikipedia-reply-at-point-simple
+;; but in a temporary draft buffer.
+;;
+;; BACK: In order to copy/send the content of that buffer
+;; back in to your wikipedia file, use the function
+;; \\[wikipedia-send-to-mozex] bound to "\C-c\C-c". You
+;; will be asked to which buffer to copy your text! If
+;; you want a copy to be send to your draft file, use
+;; the variable wikipedia-draft-send-archive
+;;
+
+;;}}}
+
+;;{{{ NEW FUNCTIONS AND VARIABLES
+
+
+;; VERSION 0.4
+;;==================
+;; NEW FUNCTIONS
+;; ------------------
+;; wikipedia-insert-enumerate
+;; wikipedia-insert-itemize
+;; wikipedia-insert-strong-emphasis (renamed to wikipedia-insert-bold-italic)
+;; wikipedia-insert-bold
+;; wikipedia-insert-italics
+;; wikipedia-insert-header
+;; wikipedia-insert-link-wiki
+;; wikipedia-turn-on-outline-minor-mode
+;; wikipedia-insert-signature
+;; wikipedia-insert-hline
+;; wikipedia-unfill-paragraph-or-region
+;; wikipedia-start-paragraph
+;; wikipedia-hardlines
+;; wikipedia-outline-magic-keys
+;; wikipedia-enhance-indent
+;; wikipedia-yank-prefix
+;; wikipedia-simple-outline-promote
+;; wikipedia-simple-outline-demote
+;; wikipedia-next-long-line
+;; wikipedia-unfill-paragraph
+;; wikipedia-rename-buffer
+;; wikipedia-draft
+;; wikipedia-draft-buffer-desc
+;; wikipedia-draft-append-to-file
+;; wikipedia-draft-page
+;; wikipedia-draft-region (&optional beg end)
+;; wikipedia-draft-buffer
+;; wikipedia-draft-clipboard
+;; wikipedia-draft-mode
+;; wikipedia-draft-view-draft
+;; wikipedia-mark-section
+;; wikipedia-activate-region
+;; wikipedia-copy-page-to-register
+;; wikipedia-insert-page-to-register
+;; wikipedia-send-to-mozex (target-buffer)
+;; wikipedia-reply-at-point-simple
+;; wikipedia-draft-reply
+;; wikipedia-insert-quotation-with-signature
+;; wikipedia-insert-quotation
+
+;; NEW VARIABLES
+;;---------------------
+;; wikipedia-enumerate-with-terminate-paragraph
+;; wikipedia-draft-buffer "*Wikipedia-Draft*"
+;; wikipedia-draft-mode-map
+;; wikipedia-draft-mode-hook
+;; wikipedia-draft-register ?R
+;; wikipedia-draft-filter-functions
+;; wikipedia-draft-handler-functions '(wikipedia-draft-append-to-file)
+;; wikipedia-draft-data-file "~/Wiki/discussions/draft.wiki"
+;; wikipedia-draft-leader-text "== "
+;; wikipedia-draft-page ?S
+;; wikipedia-draft-send-archive
+;; wikipedia-reply-with-quote
+
+
+;; VERSION 0.5
+;;====================================
+;; NEW FUNCTIONS
+;; ------------------------------------
+;; wikipedia-insert-audio
+;; wikipedia-insert-image
+;; wikipedia-insert-link-www (renamed to wikipedia-insert-link-external)
+;; wikipedia-insert-user
+;; wikipedia-mark-signature
+;; wikipedia-outline-cycle
+;; wikipedia-reply-at-signature
+;; wikipedia-terminate-paragraph-and-indent
+;; wikipedia-yank-prefix
+
+;; NEW VARIABLES (defvar, defcustom, defconst)
+;; ----------------------
+;; wikipedia-reply-with-hline
+;; wikipedia-user-simplify-signature
+;; wikipedia-english-or-german
+;; wikipedia-draft-reply-register ?M
+;; wikipedia-mode-version
+
+;; VERSION 0.51
+;;====================================
+;;
+;; - Now requires Emacs 22 or higher.
+;; - Cleaned the code in various ways.
+;; - Removed wikipedia-english-or-german
+;; - Removed some private stuff
+;; - Simplified some key bindings.
+;; - Changed some key bindings to those used in org-mode.
+;; - Added wikipedia-lang etc
+;; - Added support for templates
+;; - Adjusted header end after inserting heading/promoting/demoting
+;; - Removed some functions that are already supported by outline.el
+;; - Changed wikipedia-mode menus
+;; - Added support for bullets and numbering
+
+;;}}}
+
+;;{{{ TODO
+
+;; Todo
+;; ----
+
+
+;; * Implement TeX highlighting in <math> environment
+;; * Implement (La)TeX input syntax, following the ideas of CDlatex.el
+;; * Make outline-cycle work correctly
+;; * wikipedia-reply-at-point-simple should use regexp!
+
+;;}}}
+
+
+
+;;; Code:
+
+(require 'org)
+
+(defconst wikipedia-mode-version (concat "0." (substring "$Revision: 1.5 $" 13 14))
+ "$Id: wikipedia-mode.el,v 1.5 2006/05/30 15:16:45 oub Exp oub $
+
+Report bugs to: Uwe Brauer oub at mat.ucm.es")
+
+;;{{{ LANGS
+
+;; (defvar wikipedia-english-or-german t
+;; "*Variable in order to set the english (t) or german (nil) environment.")
+
+(require 'tutorial) ;; for lang strings
+
+(defvar wikipedia-lang "English")
+
+(defvar wikipedia-langs-added nil)
+;;(defconst xlang-strings nil)
+
+(unless wikipedia-langs-added
+ (defun add-lang-strings (lang new-strings)
+ (let ((lang-rec (assoc lang lang-strings)))
+ (if lang-rec
+ (dolist (str new-strings)
+ (nconc (cdr lang-rec) (list str)))
+ (setq lang-rec (cons lang new-strings))
+ (add-to-list 'lang-strings lang-rec))))
+
+ (add-lang-strings "English"
+ '(
+ (wikip-username-prompt . "Name of user: ")
+ (wikip-image-mark . "[[Image:")
+ (wikip-media-mark . "[[Media:")
+ (wikip-utc . "(UTC)")
+ (wikip-user-mark . "[[User:")
+ ))
+ (add-lang-strings "Deutsch"
+ '(
+ (wikip-username-prompt . "Name des Benutzers: ")
+ (wikip-image-mark . "[[Bild:")
+ (wikip-media-mark . "[[Bild:")
+ (wikip-utc . "(CET)")
+ (wikip-user-mark . "[[Benutzer:")
+ ))
+ (setq wikipedia-langs-added t))
+
+;;}}}
+
+;;{{{ TAGS
+
+(defvar wikipedia-simple-tags
+ '("b" "big" "blockquote" "br" "caption" "code" "center" "cite" "del"
+ "dfn" "dl" "em" "i" "ins" "kbd" "math" "nowiki" "ol" "pre" "samp"
+ "small" "strike" "strong" "sub" "sup" "tt" "u" "ul" "var")
+ "Tags that do not accept arguments.")
+
+(defvar wikipedia-complex-tags
+ '("a" "div" "font" "table" "td" "th" "tr")
+ "Tags that accept arguments.")
+
+(defvar wikipedia-url-protocols
+ '("ftp" "gopher" "http" "https" "mailto" "news")
+ "Valid protocols for URLs in Wikipedia articles.")
+
+;;}}}
+
+;;{{{ FACES
+
+(defvar font-wikipedia-sedate-face 'font-wikipedia-sedate-face
+ "Face to use for Wikipedia minor keywords.")
+
+(defvar font-wikipedia-italic-face 'font-wikipedia-italic-face
+ "Face to use for Wikipedia italics.")
+(defvar font-wikipedia-bold-face 'font-wikipedia-bold-face
+ "Face to use for Wikipedia bolds.")
+(defvar font-wikipedia-math-face 'font-wikipedia-math-face
+ "Face to use for Wikipedia math environments.")
+(defvar font-wikipedia-string-face 'font-wikipedia-string-face
+ "Face to use for strings. This is set by Font Wikipedia.")
+(defvar font-wikipedia-verbatim-face 'font-wikipedia-verbatim-face
+ "Face to use for text in verbatim macros or environments.")
+
+
+
+
+(defface font-wikipedia-bold-face
+ (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit bold))
+ ((assq :weight custom-face-attributes) '(:weight bold))
+ (t '(:bold t)))))
+ `((((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "DarkOliveGreen" ,@font))
+ (((class color) (background dark))
+ (:foreground "OliveDrab" ,@font))
+ (t (,@font))))
+ "Face used to highlight text to be typeset in bold."
+ :group 'font-wikipedia-highlighting-faces)
+
+(defface font-wikipedia-italic-face
+ (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit italic))
+ ((assq :slant custom-face-attributes) '(:slant italic))
+ (t '(:italic t)))))
+ `((((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "DarkOliveGreen" ,@font))
+ (((class color) (background dark))
+ (:foreground "OliveDrab" ,@font))
+ (t (,@font))))
+ "Face used to highlight text to be typeset in italic."
+ :group 'font-wikipedia-highlighting-faces)
+
+(defface font-wikipedia-math-face
+ (let ((font (cond ((assq :inherit custom-face-attributes)
+ '(:inherit underline))
+ (t '(:underline t)))))
+ `((((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "SaddleBrown"))
+ (((class color) (background dark))
+ (:foreground "burlywood"))
+ (t (,@font))))
+ "Face used to highlight math."
+ :group 'font-wikipedia-highlighting-faces)
+
+(defface font-wikipedia-sedate-face
+ '((((class grayscale) (background light)) (:foreground "DimGray"))
+ (((class grayscale) (background dark)) (:foreground "LightGray"))
+ (((class color) (background light)) (:foreground "DimGray"))
+ (((class color) (background dark)) (:foreground "LightGray"))
+;;;(t (:underline t))
+ )
+ "Face used to highlight sedate stuff."
+ :group 'font-wikipedia-highlighting-faces)
+
+(defface font-wikipedia-string-face
+ (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit italic))
+ ((assq :slant custom-face-attributes) '(:slant italic))
+ (t '(:italic t)))))
+ `((((type tty) (class color))
+ (:foreground "green"))
+ (((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "RosyBrown"))
+ (((class color) (background dark))
+ (:foreground "LightSalmon"))
+ (t (,@font))))
+ "Face used to highlight strings."
+ :group 'font-wikipedia-highlighting-faces)
+
+(defface font-wikipedia-warning-face
+ (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit bold))
+ ((assq :weight custom-face-attributes) '(:weight bold))
+ (t '(:bold t)))))
+ `((((class grayscale)(background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale)(background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color)(background light))
+ (:foreground "red" ,@font))
+ (((class color)(background dark))
+ (:foreground "red" ,@font))
+ (t (,@font))))
+ "Face for important keywords."
+ :group 'font-wikipedia-highlighting-faces)
+
+(defface font-wikipedia-verbatim-face
+ (let ((font (if (and (assq :inherit custom-face-attributes)
+ (if (featurep 'xemacs)
+ (find-face 'fixed-pitch)
+ (facep 'fixed-pitch)))
+ '(:inherit fixed-pitch)
+ '(:family "courier"))))
+ `((((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "SaddleBrown" ,@font))
+ (((class color) (background dark))
+ (:foreground "burlywood" ,@font))
+ (t (,@font))))
+ "Face used to highlight TeX verbatim environments."
+ :group 'font-wikipedia-highlighting-faces)
+
+
+(defvar wikipedia-font-lock-keywords
+ (list
+
+ ;; Apostrophe-style text markup
+ (cons "''''\\([^']\\|[^']'\\)*?\\(''''\\|\n\n\\)"
+ 'font-lock-builtin-face)
+ (cons "'''\\([^']\\|[^']'\\)*?\\('''\\|\n\n\\)"
+ ; 'font-lock-builtin-face)
+ 'font-wikipedia-bold-face)
+ (cons "''\\([^']\\|[^']'\\)*?\\(''\\|\n\n\\)"
+ 'font-wikipedia-italic-face)
+
+ ;; Headers and dividers
+ (list "^\\(==+\\)\\(.*\\)\\(\\1\\)"
+ '(1 font-lock-builtin-face)
+ ; '(2 wikipedia-header-face)
+ '(2 font-wikipedia-sedate-face)
+ '(3 font-lock-builtin-face))
+ (cons "^-----*" 'font-lock-builtin-face)
+
+ ;; Bare URLs and ISBNs
+ (cons (concat "\\(^\\| \\)" (regexp-opt wikipedia-url-protocols t)
+ "://[-A-Za-z0-9._\/~%+&#?!=()@]+")
+ 'font-lock-variable-name-face)
+ (cons "\\(^\\| \\)ISBN [-0-9A-Z]+" 'font-lock-variable-name-face)
+
+ ;; Colon indentation, lists, definitions, and tables
+ (cons "^\\(:+\\|[*#]+\\||[}-]?\\|{|\\)" 'font-lock-builtin-face)
+
+ (list "^\\(;\\)\\([^:\n]*\\)\\(:?\\)"
+ '(1 font-lock-builtin-face)
+ '(2 font-lock-keyword-face)
+ '(3 font-lock-builtin-face))
+
+
+
+ ;; Tags and comments
+
+ (list (concat "\\(</?\\)"
+ (regexp-opt wikipedia-simple-tags t) "\\(>\\)")
+ '(1 font-lock-builtin-face t t)
+ '(2 font-lock-function-name-face t t)
+ '(3 font-lock-builtin-face t t))
+ (list (concat "\\(</?\\)"
+ (regexp-opt wikipedia-complex-tags t)
+ "\\(\\(?: \\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?\\)\\(>\\)")
+ '(1 font-lock-builtin-face t t)
+ '(2 font-lock-function-name-face t t)
+ '(3 font-lock-keyword-face t t)
+ '(4 font-lock-builtin-face t t))
+ (cons (concat "<!-- \\([^->]\\|>\\|-\\([^-]\\|-[^>]\\)\\)*-->")
+ '(0 font-lock-comment-face t t))
+
+
+
+ ;; External Links
+
+ (list (concat "\\(\\[\\)\\(\\(?:"
+ (regexp-opt wikipedia-url-protocols)
+ "\\)://[-A-Za-z0-9._\/~%-+&#?!=()@]+\\)\\(\\(?: [^]\n]*\\)?\\)\\(\\]\\)")
+ '(1 font-lock-builtin-face t t)
+ '(2 font-lock-variable-name-face t t)
+ '(3 font-lock-keyword-face t t)
+ '(4 font-lock-builtin-face t t))
+
+
+
+
+ ;; Wiki links
+ '("\\(\\[\\[\\)\\([^]\n|]*\\)\\(|?\\)\\([^]\n]*\\)\\(\\]\\]\\)"
+ (1 font-lock-builtin-face t t)
+ (2 font-lock-variable-name-face t t)
+ (3 font-lock-builtin-face t t)
+ (4 font-lock-keyword-face t t)
+ (5 font-lock-builtin-face t t))
+
+ ;; Wiki variables
+ '("\\({{\\)\\(.+?\\)\\(}}\\)"
+ (1 font-lock-builtin-face t t)
+ (2 font-lock-variable-name-face t t)
+ (3 font-lock-builtin-face t t))
+
+ ;; Character entity references
+ (cons "&#?[a-zA-Z0-9]+;" '(0 font-lock-type-face t t))
+
+ ;; Preformatted text
+ (cons "^ .*$" '(0 font-lock-constant-face t t))
+
+ ;; Math environment (uniform highlight only, no TeX markup)
+ (list "<math>\\(\\(\n?.\\)*\\)</math>"
+ '(1 font-lock-keyword-face t t))))
+
+ ; )
+
+;;}}}
+
+;;{{{ Menu and header stuff
+
+(defvar wikipedia-imenu-generic-expression
+ ;;(list '(nil "^==+ *\\(.*[^\n=]\\)==+" 1))
+ (list '(nil "^=+ *\\(.*[^\n=]\\)=+" 1))
+ "Imenu expression for `wikipedia-mode'. See `imenu-generic-expression'.")
+
+;; (defun wikipedia-next-header ()
+;; "Move point to the end of the next section header."
+;; (interactive)
+;; (let ((oldpoint (point)))
+;; (end-of-line)
+;; (if (re-search-forward "\\(^==+\\).*\\1" (point-max) t)
+;; (beginning-of-line)
+;; (goto-char oldpoint)
+;; (message "No section headers after point."))))
+
+;; (defun wikipedia-prev-header ()
+;; "Move point to the start of the previous section header."
+;; (interactive)
+;; (unless (re-search-backward "\\(^==+\\).*\\1" (point-min) t)
+;; (message "No section headers before point.")))
+
+;;}}}
+
+;;{{{ Paragraph terminate and filling stuff (Chong)
+
+(defun wikipedia-terminate-paragraph () ;Version:1.58
+ "New list item or paragraph.
+In a list, start a new list item. In a paragraph, start a new
+paragraph.
+
+If the current paragraph is colon indented, the new paragraph
+will be indented in the same way."
+ (interactive)
+ (let (indent-chars)
+ (save-excursion
+ (beginning-of-line)
+ (while (cond ((looking-at "^$") nil)
+ ((looking-at "^\\(\\(?: \\|:+\\|[#*]+\\) *\\)")
+ (setq indent-chars (match-string 1)) nil)
+ ((eq (point) (point-min)) nil)
+ ((progn (forward-line -1) t)))
+ t))
+ (newline) (if (not indent-chars) (newline)
+ (insert indent-chars))))
+
+(defun wikipedia-terminate-paragraph-and-indent ()
+ "New list item or paragraph, ignore *,#.
+In a list, start a new list item. In a paragraph, start a new
+paragraph but *,# will be ignored.
+
+If the current paragraph is colon ; indented, the new paragraph
+will be indented in the same way."
+ (interactive)
+ (let (indent-chars)
+ (save-excursion
+ (beginning-of-line)
+ (while (cond ((looking-at "^$") nil)
+ ((looking-at "^\\(\\(?: \\|:+\\) *\\)")
+ (setq indent-chars (match-string 1)) nil)
+ ((eq (point) (point-min)) nil)
+ ((progn (forward-line -1) t)))
+ t))
+ (newline) (if (not indent-chars) (newline)
+ (insert indent-chars))))
+
+
+(defun wikipedia-link-fill-nobreak-p ()
+ "Function for `fill-nobreak-predicate'.
+When filling, don't break the line for preformatted (fixed-width)
+text or inside a Wiki link."
+ (save-excursion
+ (let ((pos (point)))
+ (or (eq (char-after (line-beginning-position)) ? )
+ (if (re-search-backward "\\[\\[" (line-beginning-position) t)
+ ;; Break if the link is really really long.
+ ;; You often get this with captioned images.
+ (null (or (> (- pos (point)) fill-column)
+ (re-search-forward "\\]\\]" pos t))))))))
+
+(defun wikipedia-fill-article ()
+ "Fill the entire article."
+ (interactive)
+ (save-excursion
+ (fill-region (point-min) (point-max))))
+
+(defun wikipedia-unfill-article ()
+ "Unfill article.
+Undo filling, deleting stand-alone newlines (newlines that do not
+end paragraphs, list entries, etc.)"
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward ".\\(\n\\)\\([^# *;:|!\n]\\|----\\)" nil t)
+ (replace-match " " nil nil nil 1)))
+ (message "Stand-alone newlines deleted"))
+
+
+(defun wikipedia-unfill-paragraph-with-newline (&optional justifyp)
+ (interactive "P")
+ (let ((before (point))) ;Version:1.3
+ (save-excursion
+ (forward-paragraph)
+ (or (bolp) (newline 1))
+ (let ((end (point))
+ (start (progn (backward-paragraph) (point))))
+ (goto-char before)
+ (while (re-search-forward ".\\(\n\\)\\([^# *;:|!\n]\\|----\\)" nil t)
+ (replace-match " " nil nil nil 1))))))
+ ; (message "Stand-alone newlines IN PARAGRAPH deleted"))
+
+(defun wikipedia-unfill-region ()
+ "Unfill region.
+Undo filling, deleting stand-alone newlines (newlines that do not
+end paragraphs, list entries, etc.) see also the function
+\\[wikipedia-unfill-paragraph-or-region] and the even simpler
+function \\[wikipedia-unfill-paragraph-simple]."
+ (interactive)
+ (save-excursion
+ (narrow-to-region (point) (mark))
+ (goto-char (point-min))
+ (while (re-search-forward ".\\(\n\\)\\([^# *;:|!\n]\\|----\\)" nil t)
+ (replace-match " " nil nil nil 1)))
+ (message "Stand-alone newlines deleted")
+ (widen))
+
+;;}}}
+
+;;{{{ Main function wikipedia mode (using define-derived mode)
+
+;;{{{ KEY SETTING
+;; (defvar wikipedia-outline-map
+;; (let ((map (make-sparse-keymap)))
+;; (define-key map [(down)] 'outline-next-visible-heading)
+;; (define-key map [(up)] 'outline-previous-visible-heading)
+;; (define-key map "n" 'outline-next-visible-heading)
+;; (define-key map "p" 'outline-previous-visible-heading)
+;; (define-key map "f" 'outline-forward-same-level)
+;; (define-key map "b" 'outline-backward-same-level)
+;; (define-key map "u" 'outline-up-heading)
+;; (define-key map "/" 'org-occur)
+;; (define-key map "\C-c\C-n" 'outline-next-visible-heading)
+;; (define-key map "\C-c\C-p" 'outline-previous-visible-heading)
+;; (define-key map "\C-c\C-f" 'outline-forward-same-level)
+;; (define-key map "\C-c\C-b" 'outline-backward-same-level)
+;; (define-key map "\C-c\C-u" 'outline-up-heading)
+;; map))
+
+
+(defvar wikipedia-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;;(define-key map "\M-n" 'wikipedia-next-header)
+ (define-key map "\C-c\C-n" 'wikipedia-next-long-line)
+ ;; (define-key map "\M-p" 'wikipedia-prev-header)
+ ;; (define-key map [(meta down)] 'wikipedia-next-header)
+ ;; (define-key map [(meta up)] 'wikipedia-prev-header)
+ (define-key map "\C-j" 'wikipedia-terminate-paragraph)
+ ;;(define-key map "RET" 'wikipedia-newline)
+ (define-key map [(shift return)] 'wikipedia-newline)
+
+ ;;(define-key mm [separator-format] '("--"))
+;; (define-key mm [outline]
+;; '("Toggle Outline Mode..." . outline-minor-mode))
+ ;;(define-key mm [separator-edit-structure] '("--"))
+
+
+ ;; Use some mnemonic
+ ;;(define-key map "\C-c\C-q" 'wikipedia-unfill-article)
+ (define-key map "\C-c\M-qua" 'wikipedia-unfill-article)
+ ;;(define-key map "\C-c\M-q" 'wikipedia-fill-article)
+ (define-key map "\C-c\M-qfa" 'wikipedia-fill-article)
+ ;;(define-key map "\M-u" 'wikipedia-unfill-paragraph-or-region)
+ (define-key map "\C-c\M-qur" 'wikipedia-unfill-paragraph-or-region)
+ ;;(define-key map "\C-c\C-u" 'wikipedia-unfill-paragraph-simple)
+ (define-key map "\C-c\M-qup" 'wikipedia-unfill-paragraph-simple)
+
+ (define-key map "\C-c\C-fs" 'wikipedia-insert-bold-italic)
+ (define-key map "\C-c\C-fb" 'wikipedia-insert-bold) ;Version:1.3
+ (define-key map "\C-c\C-fi" 'wikipedia-insert-italics)
+ (define-key map "\C-c\C-fn" 'wikipedia-insert-nowiki)
+
+ (define-key map "\C-c\C-ts" 'wikipedia-insert-signature)
+ (define-key map "\C-c\C-tt" 'wikipedia-insert-template)
+ (define-key map "\C-c\C-tu" 'wikipedia-insert-user)
+ ;;(define-key map "\C-c\C-fq" 'wikipedia-insert-quotation)
+ ;;(define-key map "\C-c\C-fh" 'wikipedia-insert-header)
+ (define-key map "\C-c\C-fr" 'wikipedia-insert-hline) ;Version:1.30
+ (define-key map "\C-c\C-li" 'wikipedia-insert-link-wiki)
+ (define-key map "\C-c\C-le" 'wikipedia-insert-link-external)
+
+ ;; Breaks key binding conventions:
+ ;;(define-key map [(meta f7)] 'wikipedia-draft)
+ ;;(define-key map [(meta f8)] 'wikipedia-reply-at-point-simple)
+ ;;(define-key map [(meta f9)] 'wikipedia-draft-view-draft)
+
+ (define-key map "\C-c\C-r" 'wikipedia-reply-at-point-simple)
+
+ ;; Breaks key binding conventions:
+ ;;(define-key map "\C-cr" 'wikipedia-draft-region)
+
+ (define-key map [(meta r)] 'wikipedia-draft-reply)
+ (define-key map "\C-c\C-m" 'wikipedia-draft) ;Version:1.25
+ (define-key map "\C-c\C-b" 'wikipedia-draft-region)
+ (define-key map "\C-c\C-d" 'wikipedia-draft-buffer)
+ (define-key map "\C-c\C-k" 'wikipedia-draft-buffer)
+ (define-key map "\C-c\C-p" 'wikipedia-draft-copy-page-to-register) ;Version:1.39
+ ;; (define-key map "\C-c\C-c" 'wikipedia-draft-send-to-mozex)
+ (define-key map "\C-c\C-s" 'wikipedia-draft-yank-page-to-register)
+
+ (define-key map [(control meta prior)] 'wikipedia-enhance-indent)
+ (define-key map [(control meta next)] 'wikipedia-yank-prefix)
+ (define-key map [(meta return)] 'wikipedia-insert-enumerate)
+ (define-key map [(meta control return)] 'wikipedia-insert-enumerate-nonewline)
+ ;; private setting
+ ;; This is bound to C-j by default:
+ ;;(define-key map [(shift return)] 'newline-and-indent) ;Version:1.24
+ (define-key map "\C-\\" 'wikipedia-insert-itemize) ;Version:1.28
+ (define-key map [(control return)] 'wikipedia-insert-itemize)
+
+ ;; The next three breaks Emacs key binding conventions, are they really necessary?
+ ;;(define-key map "\C-ca" 'auto-capitalize-mode)
+ ;;(define-key map "\C-ci" 'set-input-method)
+ ;;(define-key map "\C-ct" 'toggle-input-method) ;Version:1.23
+
+ (define-key map [(shift tab)] 'org-shifttab)
+ (define-key map [backtab] 'org-shifttab)
+ (define-key map [tab] 'org-cycle)
+
+ map))
+
+(defvar wikipedia-org-menu nil)
+;; From org.el:
+(easy-menu-define wikipedia-org-menu wikipedia-mode-map "Wikipedia menu"
+ '("Wikipedia"
+ ("Show/Hide"
+ ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))]
+ ["Cycle Global Visibility" org-shifttab]
+ ["Sparse Tree" org-occur t]
+ ["Reveal Context" org-reveal t]
+ ["Show All" show-all t]
+ "--"
+ ["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
+ "--"
+ ["New Heading" outline-insert-heading t]
+ ("Navigate Headings"
+ ["Up" outline-up-heading t]
+ ["Next" outline-next-visible-heading t]
+ ["Previous" outline-previous-visible-heading t]
+ ["Next Same Level" outline-forward-same-level t]
+ ["Previous Same Level" outline-backward-same-level t]
+ "--"
+ ["Jump" org-goto t])
+ ("Edit Structure"
+ ["Move Subtree Up" outline-move-subtree-up]
+ ["Move Subtree Down" outline-move-subtree-down]
+ "--"
+ ["Copy Subtree" org-copy-special]
+ ["Cut Subtree" org-cut-special]
+ ["Paste Subtree" org-paste-special]
+ "--"
+ ["Promote Heading" wikipedia-simple-outline-promote]
+ ["Promote Subtree" outline-promote]
+ ["Demote Heading" wikipedia-simple-outline-demote]
+ ["Demote Subtree" outline-demote])
+ ("Filling"
+ ["Unfill article" wikipedia-unfill-article]
+ ["Fill article" wikipedia-fill-article])
+ "--"
+ ("Format"
+ ["Horizontal line" wikipedia-insert-hline]
+ "--"
+ ["Indent Paragraph" wikipedia-indent-paragraph]
+ ["Deindent Paragraph" wikipedia-deindent-paragraph]
+ "--"
+ ["Insert No Wiki Formatting" wikipedia-insert-nowiki]
+ ["Bold-Italic" wikipedia-insert-bold-italic]
+ ["Italic" wikipedia-insert-italics]
+ ["Bold" wikipedia-insert-bold]
+ "--"
+ ("Insert"
+ ("Templates"
+ ["Site Specific Template" wikipedia-insert-template]
+ ["Signature" wikipedia-insert-signature]
+ )
+ ("Links"
+ ["External Link" wikipedia-insert-link-external]
+ ["Internal Wiki Link" wikipedia-insert-link-wiki]
+ )
+ ("Bullets and numbering"
+ ["Bullet" wikipedia-insert-bullet]
+ ["Numbering" wikipedia-insert-numbering]
+ )
+ ))
+ ))
+;;}}}
+
+
+;;;###autoload
+;;{{{ Main function wikipedia-mode
+
+(define-derived-mode wikipedia-mode outline-mode "Wikipedia"
+ "Major mode for editing wikimedia style wikis.
+Major mode for editing articles written in the markup language
+used by Wikipedia, the free on-line
+encyclopedia (see URL `http://www.wikipedia.org').
+
+There are several ways to use wikipedia-mode:
+
+- You can simply cut and paste articles between Emacs and your
+ web browser's text box.
+- If you are using Firefox you can use the It's All Text add-on
+ for Firefox.
+- You can use MozEx, a Mozilla/Firefox web browser extension that
+ allows you to call Emacs from a text
+ box (see URL `http://mozex.mozdev.org/').
+- Another way is to use the PERL script ee-helper, which allows
+ you to up and download wiki texts.
+
+Wikipedia articles are usually unfilled: newline characters are not
+used for breaking paragraphs into lines. Unfortunately, Emacs does not
+handle word wrapping yet. As a workaround, wikipedia-mode turns on
+longlines-mode automatically. In case something goes wrong, the
+following commands may come in handy:
+
+\\[wikipedia-fill-article] fills the buffer.
+\\[wikipedia-unfill-article] unfills the buffer.
+Be warned that function can be dead slow, better use wikipedia-unfill-paragraph-or-region.
+\\[wikipedia-unfill-paragraph-or-region] unfills the paragraph
+\\[wikipedia-unfill-paragraph-simple] doehe same but simpler.
+
+
+
+The following commands put in markup structures.
+
+\\[wikipedia-insert-bold-italic] bold+italic
+\\[wikipedia-insert-bold] bold text
+\\[wikipedia-insert-italics] italics
+\\[wikipedia-insert-nowiki] no wiki markup
+\\[wikipedia-insert-link-wiki] inserts a link
+
+The following commands are also defined:
+\\[wikipedia-insert-user] inserts user name
+\\[wikipedia-insert-signature] inserts ~~~~
+\\[wikipedia-insert-enumerate] inserts enumerate type structures
+\\[wikipedia-insert-itemize] inserts itemize type structures
+\\[wikipedia-insert-hline] inserts a hline
+
+The draft functionality
+\\[wikipedia-draft]
+\\[wikipedia-draft-region]
+\\[wikipedia-draft-view-draft]
+\\[wikipedia-draft-page]
+\\[wikipedia-draft-buffer]
+
+Replying and sending functionality
+\\[wikipedia-reply-at-point-simple]
+\\[wikipedia-draft-reply]
+
+
+The register functionality
+\\[wikipedia-copy-page-to-register]
+\\[defun wikipedia-insert-page-to-register]
+
+
+Some simple editing commands.
+\\[wikipedia-enhance-indent]
+\\[wikipedia-yank-prefix]
+\\[wikipedia-unfill-paragraph-or-region]
+
+
+
+\\[wikipedia-terminate-paragraph] starts a new list item or paragraph in a context-aware manner."
+
+ (set (make-local-variable 'adaptive-fill-regexp) "[ ]*")
+ (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?-- *")
+ (set (make-local-variable 'comment-end-skip) " *--\\([ \n]*>\\)?")
+ (set (make-local-variable 'comment-start) "<!-- ")
+ (set (make-local-variable 'comment-end) " -->")
+ (set (make-local-variable 'paragraph-start)
+ "\\*\\| \\|#\\|;\\|:\\||\\|!\\|$")
+ (set (make-local-variable 'sentence-end-double-space) nil)
+ (set (make-local-variable 'font-lock-multiline) t)
+ (set (make-local-variable 'font-lock-defaults)
+ '(wikipedia-font-lock-keywords t nil nil nil))
+ (set (make-local-variable 'fill-nobreak-predicate)
+ 'wikipedia-link-fill-nobreak-p)
+ (set (make-local-variable 'auto-fill-inhibit-regexp) "^[ *#:|;]")
+
+ ;; Support for outline-minor-mode. No key conflicts, so we'll use
+ ;; the normal outline-mode prefix.
+ ;;(set (make-local-variable 'outline-regexp) "==+")
+ (set (make-local-variable 'outline-regexp) "=+")
+ ;;(set (make-local-variable 'outline-heading-end-regexp) "=+") ;; For betting fixing
+ ;; (set (make-local-variable 'outline-regexp) "=+")
+ ;; (set (make-local-variable 'outline-regexp) ":")
+
+ ;; Fix-me: Why change this?? Should not the user do this globally instead?
+ ;;(set (make-local-variable 'outline-minor-mode-prefix) "\C-c\C-o")
+
+ ;; Fix-mde For longlines-mode??:
+ (set (make-local-variable 'auto-fill-inhibit-regexp) "^[ *#:|;]")
+
+ ;: From org.el:
+ ;; Get rid of Outline menus, they are not needed
+ ;; Need to do this here because define-derived-mode sets up
+ ;; the keymap so late. Still, it is a waste to call this each time
+ ;; we switch another buffer into org-mode.
+ (if (featurep 'xemacs)
+ (when (boundp 'outline-mode-menu-heading)
+ ;; Assume this is Greg's port, it used easymenu
+ (easy-menu-remove outline-mode-menu-heading)
+ (easy-menu-remove outline-mode-menu-show)
+ (easy-menu-remove outline-mode-menu-hide))
+ (define-key wikipedia-mode-map [menu-bar headings] 'undefined)
+ (define-key wikipedia-mode-map [menu-bar hide] 'undefined)
+ (define-key wikipedia-mode-map [menu-bar show] 'undefined))
+
+ (easy-menu-add wikipedia-org-menu)
+
+ ;; Turn on the Imenu automatically.
+;; (when menu-bar-mode
+;; (set (make-local-variable 'imenu-generic-expression)
+;; wikipedia-imenu-generic-expression)
+;; (imenu-add-to-menubar "TOC"))
+
+ (modify-syntax-entry ?< "(>" wikipedia-mode-syntax-table)
+ (modify-syntax-entry ?> ")<" wikipedia-mode-syntax-table)
+
+ ;;}}}
+
+ ;;; This is the wrong way to do it, see add-hook:
+ ;; (make-local-variable 'change-major-mode-hook)
+
+ ;; Check if our version of outline.el has the new header hooks:
+ (require 'outline)
+ (when (boundp 'outline-demote-hook)
+ (add-hook 'outline-demote-hook 'wikipedia-outline-insert-heading-f nil t)
+ (add-hook 'outline-promote-hook 'wikipedia-outline-insert-heading-f nil t)
+ (add-hook 'outline-insert-heading-hook 'wikipedia-outline-insert-heading-f nil t)
+ )
+ )
+
+(defun wikipedia-outline-insert-heading-f ()
+ (insert " ")
+ (backward-char)
+ (wikipedia-adjust-header-end))
+
+;; wikipedia-mode ends here
+;;}}}
+
+;;{{{ longlines-mode
+
+(defun wikipedia-turn-on-longlines () ;Version:1.58
+ "Turn on longlines-mode if it is defined."
+ (if (functionp 'longlines-mode)
+ (longlines-mode 1)))
+
+(defcustom wikipedia-use-longlines-mode nil
+ "Turn on longlines-mode' if non-nil.
+Unfortunately there are some bugs in `longlines-mode' so turning
+it on is an option currently."
+ :type 'boolean
+ :set (lambda (sym val)
+ (set-default sym val)
+ (if val
+ (add-hook 'wikipedia-mode-hook 'wikipedia-turn-on-longlines)
+ (remove-hook 'wikipedia-mode-hook 'wikipedia-turn-on-longlines)))
+ :group 'wikipedia)
+
+;;}}}
+
+;; New formating stuff for inserting simple formating structures such
+
+;;{{{ Insert makeup and templates
+
+(defvar wikipedia-enumerate-with-terminate-paragraph nil
+ "*Before insert enumerate/itemize do \\[wikipedia-terminate-paragraph].")
+
+(defun wikipedia-region-active-p ()
+ (or (and (boundp 'zmacs-region-active-p) zmacs-region-active-p)
+ (and (boundp 'transient-mark-mode) transient-mark-mode mark-active)))
+
+(defun wikipedia-insert-around-region (before after)
+ (if (wikipedia-region-active-p)
+ (save-excursion
+ (let ((beginning (region-beginning))
+ (end (region-end))
+ (check (= (string-to-char before) ?')))
+ ;; When we are inserting ' do not mix them:
+ (if (or (not check)
+ (not (memq ?'
+ (append (buffer-substring-no-properties
+ beginning end) nil))))
+ (progn
+ (goto-char end)
+ (insert after)
+ (goto-char beginning)
+ (insert before))
+ (message "Sorry, the region already contains the char '.")
+ )))
+ (insert before)
+ (insert after)
+ (backward-char (length after))))
+
+(defun wikipedia-insert-enumerate ()
+ "Insert enumerated items.
+Format depends on `wikipedia-enumerate-with-terminate-paragraph'.
+Note however that `wikipedia-terminate-paragraph' does not work
+very well will longlines-mode."
+ (interactive)
+ (if wikipedia-enumerate-with-terminate-paragraph
+ (progn
+ (wikipedia-terminate-paragraph)
+ (insert "#"))
+ (newline nil)
+ (insert ":#")))
+
+
+
+
+
+(defun wikipedia-insert-itemize ()
+ "Insert not enumerated items.
+Format depends on `wikipedia-enumerate-with-terminate-paragraph'.
+Note however that the `wikipedia-terminate-paragraph' does not
+work very well will longlines-mode."
+ (interactive)
+ (if wikipedia-enumerate-with-terminate-paragraph
+ (progn
+ (wikipedia-terminate-paragraph)
+ (insert "*"))
+ (newline nil)
+ (insert ":*")))
+
+
+(defun wikipedia-insert-bold-italic ()
+ "Insert strong emphasis.
+Uses four apostrophes (e.g. ''''FOO''''.) When mark is active, surrounds region."
+ (interactive)
+ (wikipedia-insert-around-region "''''" "''''"))
+
+
+(defun wikipedia-insert-bold ()
+ "Insert bold.
+Uses three apostrophes (e.g. '''FOO'''.) When mark is active,
+surrounds region."
+ (interactive)
+ (wikipedia-insert-around-region "'''" "'''"))
+
+
+(defun wikipedia-insert-italics ()
+ "Insert italics.
+Uses two apostrophes (e.g. ''FOO''.) When mark is active,
+surrounds region."
+ (interactive)
+ (wikipedia-insert-around-region "''" "''"))
+
+(defun wikipedia-indent-paragraph ()
+ (interactive)
+ (backward-paragraph)
+ )
+(defun wikipedia-deindent-paragraph ()
+ (interactive)
+ )
+;;}}}
+;;{{{ Templates
+
+;; http://en.wikipedia.org/wiki/Template:Quotation
+;; http://en.wikipedia.org/wiki/Help:A_quick_guide_to_templates
+(defvar wikipedia-site nil)
+(make-variable-buffer-local 'wikipedia-site)
+(defvar wikipedia-site-history nil)
+
+(defcustom wikipedia-templates nil
+ "Templates for different wikis."
+ :type '(repeat (list
+ (string :tag "Wiki site")
+ (repeat
+ (list
+ (string :tag "Template name")
+ (string :tag "Template code")))))
+ :group 'wikipedia)
+
+(defun wikipedia-insert-template ()
+ "Prompts for a template and inserts it."
+ (interactive)
+ (let* ((t-name-code (wikipedia-get-template))
+ (t-name (car t-name-code))
+ ;; Ask how to insert:
+ (choices '("Evaluate when page is created"
+ "Substitute when saving this source page"
+ "Show template when page is fetched"
+ "Insert template itself"))
+ (hist (copy-sequence choices))
+ (default (car choices))
+ (choice (completing-read
+ "How do you want to insert the template? "
+ choices
+ nil
+ t
+ default
+ (cons 'hist 1))))
+;; (lwarn 't :warning "t-name=%s" t-name)
+;; (lwarn 't :warning "choice=%s" choice)
+;; (lwarn 't :warning "0=%s" (nth 0 choices))
+;; (lwarn 't :warning "1=%s" (nth 1 choices))
+;; (lwarn 't :warning "2=%s" (nth 2 choices))
+ (cond
+ ((string= choice (nth 0 choices))
+ ;;(lwarn 't :warning "evaluate=>%s" (concat "{{" t-name "}}"))
+ (insert "{{" t-name "}}")
+ )
+ ((string= choice (nth 1 choices))
+ ;;(lwarn 't :warning "subst=>%s" (concat "{{subst:" t-name "}}"))
+ (insert "{{subst:" t-name "}}")
+ )
+ ((string= choice (nth 2 choices))
+ ;;(lwarn 't :warning "raw=>%s" (concat "{{msgnw:" t-name "}}"))
+ (insert "{{msgnw:" t-name "}}")
+ )
+ ((string= choice (nth 3 choices))
+ (insert (cdr t-name-code))
+ ))))
+
+(defun wikipedia-get-template ()
+ (let* ((sites (mapcar (lambda (t-sites)
+ (car t-sites))
+ wikipedia-templates))
+ (hist (copy-sequence sites))
+ (default-site wikipedia-site)
+ (histpos (if (not default-site)
+ 1
+ (catch 'pos
+ (let ((n 0))
+ (dolist (elt sites)
+ (setq n (1+ n))
+ (when (string= default-site elt)
+ (throw 'pos n)))))))
+ (site (if (= 1 (length sites))
+ (car sites)
+ (completing-read "Wiki site: "
+ sites
+ nil
+ t
+ default-site
+ (cons 'hist histpos))))
+ (s-t (assoc site wikipedia-templates))
+ (templates (car (cdr s-t)))
+ (t-names (mapcar (lambda (t-for-site)
+ ;;(lwarn 't :warning "t-for-site=%s" t-for-site)
+ (car t-for-site))
+ templates))
+ (t-name (wikipedia-get-template-name site templates))
+ (code (car (cdr (assoc t-name templates))))
+ )
+ (setq wikipedia-site site)
+;; (lwarn 't :warning "site=%s" site)
+;; (lwarn 't :warning "s-t=%s" s-t)
+;; (lwarn 't :warning "templates=%s" templates)
+;; (lwarn 't :warning "t-names=%s" t-names)
+;; (lwarn 't :warning "t-name=%s" t-name)
+;; (lwarn 't :warning "code=%s" code)
+ (cons t-name code)))
+
+(defun wikipedia-get-template-name (site templates)
+ ""
+ (let* ((prompt "Template: ")
+ (minibuffer-local-must-match-map (copy-keymap minibuffer-local-must-match-map))
+ (hist (mapcar (lambda (elt)
+ (car elt))
+ templates))
+ (desc-fun (lambda ()
+ (let ((s (minibuffer-contents-no-properties)))
+ (when (< 0 (length s))
+ (wikipedia-describe-template s site templates)))))
+ (up-fun (lambda () (interactive)
+ (previous-history-element 1)
+ (funcall desc-fun)))
+ (down-fun (lambda () (interactive)
+ (next-history-element 1)
+ (funcall desc-fun)))
+ (default nil)
+ (histpos (if (not default) 1))
+ (default-name (if default
+ default
+ (car (nth (1- histpos) templates))))
+ (tpl-name nil)
+ )
+ (define-key minibuffer-local-must-match-map [up] up-fun)
+ (define-key minibuffer-local-must-match-map [down] down-fun)
+ (save-window-excursion
+ (wikipedia-describe-template default-name site templates)
+ (setq tpl-name (completing-read prompt
+ templates
+ nil ; predicate
+ t ; require-match
+ default-name ;; initial-input
+ (cons 'hist histpos) ;; hist
+ )))
+ (when (= 0 (length tpl-name))
+ (error "No template name given"))
+ (let ((tpl (assoc tpl-name templates)))
+ (unless tpl
+ (error "There is no template named %s for site %s" tpl-name site))
+ ;;(lwarn 't :warning "tpl=%s" tpl)
+ )
+ tpl-name))
+
+(defun wikipedia-describe-template (name site templates)
+ (let ((tpl-rec (assoc name templates)))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer (help-buffer)
+ (help-setup-xref (list #'wikipedia-describe-template name site templates) (interactive-p))
+ (let ((inhibit-read-only t)
+ start end
+ here
+ (tpl (assoc name templates)))
+ ;;(insert (format "%S\n\n" family))
+ (insert (format "%s - a wiki template for site %s" name site))
+ (insert "\n\n")
+ (setq start (point))
+ (insert (cadr tpl))
+ (setq end (point))
+ (with-no-warnings (print-help-return-message))
+ ;;(put-text-property start end 'face 'highlight)
+ (goto-char start)
+ (setq here (point))
+ (while (re-search-forward "\\(?:<onlyinclude>\\|</onlyinclude>\\|<noinclude>.*</noinclude>\\)" end t)
+ (put-text-property here (match-beginning 0) 'face 'highlight)
+ (setq here (point))
+ )
+ (put-text-property (point) end 'face 'highlight)
+ )))))
+
+(defun wikipedia-insert-nowiki ()
+ "Mark the region as 'nowiki'.
+When mark is active, surrounds region."
+ (interactive)
+ (wikipedia-insert-around-region "<nowiki>" "</nowiki>"))
+
+
+
+(defun wikipedia-insert-user ()
+ "Prompt for a user name, insert [[User:foo]]"
+ (interactive)
+ (let ((user (read-string (get-lang-string wikipedia-lang 'wikip-username-prompt)))
+ (user-mark (get-lang-string wikipedia-lang 'wikip-user-mark)))
+ (insert (concat user-mark user "|" user "]]"))))
+
+(defun wikipedia-insert-signature () ;Version:1.4
+ "Insert \"~~~~\".
+This will be shown as your user identity when showing the page."
+ (interactive)
+ (insert "~~~~"))
+
+
+
+(defun wikipedia-insert-reply-prefix () ;Version:1.60
+ "Quotation box of the form {{Quotation}}{{}}. When mark is active,
+surrounds region."
+ (interactive)
+ (beginning-of-line 1)
+ (search-forward "[[")
+ (backward-char 2)
+ (mark-sexp 1)
+ (copy-to-register wikipedia-draft-reply-register (region-beginning) (region-end) nil)
+ (end-of-line 1)
+ (wikipedia-terminate-paragraph)
+ (beginning-of-line 1)
+ (kill-line nil)
+ (insert "----")
+ (newline 1)
+ (yank)
+ (insert ":'''Re: ")
+ (insert-register wikipedia-draft-reply-register 1)
+ (insert "''' ")
+ (end-of-line 1))
+
+;; (defun wikipedia-insert-header ()
+;; "Insert subheader via == (e.g. == FOO ==.)"
+;; (interactive)
+;; (unless (bolp)
+;; (beginning-of-line))
+;; (insert "== ")
+;; (end-of-line)
+;; (insert " ==")
+;; (backward-char 3))
+
+(defvar wikipedia-link-wiki-history nil)
+
+(defun wikipedia-insert-link-wiki ()
+ "Insert link via [[ (e.g. [[FOO]].) When mark is active, surround region."
+ (interactive)
+ (if (wikipedia-region-active-p)
+ (wikipedia-insert-around-region "[[" "]]")
+ (let* ((link (read-string "Wiki link: " nil wikipedia-link-wiki-history))
+ (name (read-string "Name (optional): ")))
+ (insert "[[" link)
+ (when (< 0 (length name))
+ (insert "|" name))
+ (insert "]]"))))
+
+(defun wikipedia-insert-link-external ()
+ "Insert link via [[ (e.g. [http://FOO].) When mark is active, surround region."
+ (interactive)
+ (if (wikipedia-region-active-p)
+ (wikipedia-insert-around-region "[" "]")
+ (let* ((choices '("Plain" "Footnote" "Named"))
+ (hist (copy-sequence choices))
+ (style (completing-read
+ "Link style: " ; prompt
+ choices ; collection
+ nil ; predicate
+ t ; requite-match
+ "Plain" ; initial-input
+ (cons 'hist 1) ; hist
+ ))
+ (url (read-string "URL: "))
+ name)
+ ;;(lwarn 't :warning "style=%s" style)
+ (cond
+ ((string= style "Plain")
+ (insert url))
+ ((string= style "Footnote")
+ (insert "[" url "]"))
+ ((string= style "Named")
+ (let ((name (read-string "Link name: ")))
+ (insert "[" url)
+ (when (< 0 (length name))
+ (insert " " name))
+ (insert "]")))
+ (t
+ (error "Internal error, bad style=%s" style))))))
+
+
+(defun wikipedia-insert-image ()
+ "Insert link image, e.g. [[Image:FOO]].
+When mark is active, surround region."
+ (interactive)
+ (let ((img-mark (get-lang-string wikipedia-lang 'wikip-image-mark)))
+ (wikipedia-insert-around-region img-mark "]]")))
+
+(defun wikipedia-insert-audio ()
+ "Insert audio link, e.g. [[Media:FOO]].
+When mark is active, surround region."
+ (interactive)
+ (let ((aud-mark (get-lang-string wikipedia-lang 'wikip-audio-mark)))
+ (wikipedia-insert-around-region aud-mark "]]")))
+
+
+
+
+;; (defun wikipedia-turn-on-outline-minor-mode ()
+;; "Turn on outline minor mode."
+;; ;;(interactive)
+;; (outline-minor-mode nil))
+
+
+
+
+
+
+(defun wikipedia-insert-hline () ;Version:1.29
+ "Insert \"----\" "
+ (interactive)
+ (end-of-line)
+ (insert hard-newline "----" hard-newline))
+
+(defun wikipedia-newline (&optional arg)
+ "Insert newline and check for bullets and numbering."
+ (interactive "*P")
+ (let ((here (point))
+ (line-type nil))
+ (beginning-of-line)
+ (when (eq ?* (char-after))
+ (setq line-type 'bullet))
+ (when (eq ?# (char-after))
+ (setq line-type 'numbered))
+ (if (and line-type
+ (looking-at ".\\s-*$"))
+ (progn
+ (delete-region (match-beginning 0) (match-end 0))
+ (newline arg))
+ (goto-char here)
+ (newline arg)
+ (cond
+ ((eq line-type 'bullet)
+ (insert "* "))
+ ((eq line-type 'numbered)
+ (insert "# "))))))
+
+;;}}}
+
+;;{{{ bullets and numbering
+
+;; Fix-me: Seems like this and my newline stuff already was there ... ;-)
+(defun wikipedia-insert-bullet ()
+ "Insert a bullet."
+ (interactive)
+ (end-of-line)
+ (newline)
+ (insert "* "))
+
+(defun wikipedia-insert-numbering ()
+ "Insert numbering."
+ (interactive)
+ (end-of-line)
+ (newline)
+ (insert "# "))
+
+;;}}}
+
+;;{{{ filling and longline
+
+(defun wikipedia-unfill-paragraph-or-region () ;Version:1.7
+ "Unfill region.
+This function does NOT explicitly search for \"soft newlines\" as
+does wikipedia-unfill-region."
+ (interactive)
+ (when use-hard-newlines
+ ;; (backward-paragraph 1)
+ ;; (next-line 1)
+ (beginning-of-line 1)
+ (set-fill-prefix)
+ ;; Fix-me: The use of make-local-variable here looks incorrect,
+ ;; use lexical binding instead:
+;; (set (make-local-variable 'use-hard-newlines) nil)
+;; (set (make-local-variable 'sentence-end-double-space) t)
+;; (set (make-local-variable 'paragraph-start) "[ \n\f]")
+ (let ((use-hard-newlines nil)
+ (sentence-end-double-space t)
+ (paragraph-start nil))
+ (when (featurep 'xemacs)
+ (let ((fill-column (point-max)))
+ (fill-paragraph-or-region nil)))
+ (unless (featurep 'xemacs)
+ (let ((fill-column (point-max)))
+ (fill-paragraph nil)))))
+;; (set (make-local-variable 'use-hard-newlines) t)
+;; (set (make-local-variable 'sentence-end-double-space) nil)
+;; (set (make-local-variable 'paragraph-start) "\\*\\| \\|#\\|;\\|:\\||\\|!\\|$"))
+ (unless use-hard-newlines
+ ;; (backward-paragraph 1)
+ ;; (next-line 1)
+ (beginning-of-line 1)
+ (set-fill-prefix)
+;; (set (make-local-variable 'sentence-end-double-space) t)
+;; (set (make-local-variable 'paragraph-start)
+ (let ((sentence-end-double-space t)
+ (paragraph-start nil))
+ (when (featurep 'xemacs)
+ (let ((fill-column (point-max)))
+ (fill-paragraph-or-region nil)))
+ (unless (featurep 'xemacs)
+ (let ((fill-column (point-max)))
+ (fill-paragraph nil))))
+;; (set (make-local-variable 'sentence-end-double-space) nil)
+;; (set (make-local-variable 'paragraph-start) "\\*\\| \\|#\\|;\\|:\\||\\|!\\|$")
+ ))
+
+
+
+
+;; (defun wikipedia-start-paragraph ()
+;; (interactive)
+;; (set (make-local-variable 'paragraph-start)
+;; "\\*\\| \\|#\\|;\\|:\\||\\|!\\|$"))
+
+;; Use function use-hard-newlines instead:
+;; (defun wikipedia-hardlines ()
+;; "Set use-hard-newlines to NIL."
+;; (interactive)
+;; (setq use-hard-newlines nil))
+
+;; from emacs wiki
+(defun wikipedia-next-long-line ()
+ "Move forward to the next long line with column-width greater
+ than `fill-column'.
+
+ TODO: When function reaches end of buffer, save-excursion to
+ starting point.
+ Generalise to make `previous-long-line'."
+ (interactive)
+ ;; global-variable: fill-column
+ (if (= (forward-line) 0)
+ (let ((line-length
+ (save-excursion
+ (end-of-line)
+ (current-column))))
+ (if (<= line-length fill-column)
+ (wikipedia-next-long-line)
+ (message "Long line found")))
+ ;; Stop, end of buffer reached.
+ (error "Long line not found")))
+
+
+(defun wikipedia-unfill-paragraph-simple ()
+ "A very simple function for unfilling a paragraph."
+ (interactive)
+ (if (functionp 'filladapt-mode)
+ (filladapt-mode nil))
+ (let ((fill-column (point-max)))
+ (fill-paragraph nil)
+ (if (functionp 'filladapt-mode)
+ (filladapt-mode nil))))
+
+;;}}}
+
+;;{{{ outline and outline-magic stuff
+
+;;(add-hook 'wikipedia-mode-hook 'wikipedia-turn-on-outline-minor-mode)
+;;(remove-hook 'wikipedia-mode-hook 'wikipedia-turn-on-outline-minor-mode)
+
+(defun wikipedia-outline-cycle ()
+ (interactive)
+ (if (functionp 'outline-cycle)
+ (outline-cycle)))
+
+;; Fix-me: Unfortunately outline maybe does not take care of the
+;; heading endings when promoting and demoting (I have submitted a bug
+;; report for this and hooks will be added). To work around this we
+;; defadvice outline-demote/promote:
+
+(require 'outline)
+(unless (boundp 'outline-demote-hook)
+
+ (defadvice outline-demote (after wikipedia-outline-demote-advice
+ (&optional which))
+ "Adjust heading after demote."
+ (unless which
+ (wikipedia-adjust-header-end)))
+
+ (defadvice outline-promote (after wikipedia-outline-promote-advice
+ (&optional which))
+ "Adjust heading after promote."
+ (unless which
+ (wikipedia-adjust-header-end)))
+
+ (defadvice outline-insert-heading (after wikipedia-outline-insert-heading-advice
+ ())
+ "Adjust heading after insert new heading."
+ (wikipedia-adjust-header-end))
+
+ )
+
+(defun wikipedia-adjust-header-end ()
+ (when (eq major-mode 'wikipedia-mode)
+ (let ((here (point))
+ (end-pos (line-end-position))
+ bgn-mark
+ bgn-len
+ end-mark
+ end-len
+ )
+ (beginning-of-line)
+ (when (looking-at outline-regexp)
+ (setq bgn-mark (match-string-no-properties 0))
+ (setq bgn-len (length bgn-mark))
+ (end-of-line)
+ (if (looking-back outline-regexp nil t)
+ (when (progn
+ (setq end-mark (match-string-no-properties 0))
+ (setq end-len (length end-mark))
+ (/= end-len bgn-len))
+ (replace-match bgn-mark))
+ (insert bgn-mark)))
+ ;;(lwarn 't :warning "bgn-len=%s, end-len=%s" bgn-len end-len)
+ (goto-char here))))
+
+
+
+;;(add-hook 'outline-minor-mode-hook 'wikipedia-outline-magic-keys)
+(add-hook 'wikipedia-mode-hook 'wikipedia-outline-magic-keys)
+
+(defun wikipedia-outline-magic-keys ()
+ (interactive)
+ (unless (featurep 'xemacs)
+ (local-set-key [(shift iso-lefttab)] 'wikipedia-outline-cycle))
+ (local-set-key [iso-left-tab] 'wikipedia-outline-cycle)
+ ;;(local-set-key [(meta left)] 'outline-promote)
+ (local-set-key [(meta shift left)] 'outline-promote)
+ ;;(local-set-key [(meta right)] 'outline-demote)
+ (local-set-key [(meta shift right)] 'outline-demote)
+ ;;(local-set-key [(control left)] 'wikipedia-simple-outline-promote)
+ (local-set-key [(meta left)] 'wikipedia-simple-outline-promote)
+ ;;(local-set-key [(control right)] 'wikipedia-simple-outline-demote)
+ (local-set-key [(meta right)] 'wikipedia-simple-outline-demote)
+ (local-set-key [(shift return)] 'newline-and-indent)
+ ;;(local-set-key [(control up)] 'outline-move-subtree-up)
+ (local-set-key [(meta shift up)] 'outline-move-subtree-up)
+ ;;(local-set-key [(control down)] 'outline-move-subtree-down))
+ (local-set-key [(meta shift down)] 'outline-move-subtree-down))
+
+(defun wikipedia-enhance-indent () ;Version:1.26
+ (interactive)
+ (string-rectangle (region-beginning) (region-end) ":"))
+
+(defun wikipedia-yank-prefix () ;Version:1.26
+ (interactive)
+ (string-rectangle (region-beginning) (region-end) ":"))
+
+;; modification for outline-magic
+
+(defun wikipedia-simple-outline-promote ()
+ "Function simple deletes \"=\" and the end and the beginning of line,
+does not promote the whole tree!"
+ (interactive)
+ (save-excursion
+ (progn
+ (beginning-of-line 1)
+ (search-forward "=")
+ (delete-char 1 nil)
+ (end-of-line 1)
+ (search-backward "=")
+ (delete-char 1 nil))))
+
+(defun wikipedia-simple-outline-demote ()
+ "Function simple adds \"=\" and the end and the beginning of line,
+does not promote the whole tree!"
+ (interactive)
+ (save-excursion
+ (progn
+ (beginning-of-line 1)
+ (search-forward "=")
+ (insert "=")
+ (end-of-line 1)
+ (search-backward "=")
+ (insert "="))))
+
+
+(defun wikipedia-rename-buffer () ;Version:1.5
+ "Make sure that the option UNIQUE is used."
+ (interactive)
+ (rename-buffer (read-string "Name of new buffer (unique): " ) 1))
+
+;;}}}
+
+;;{{{ wikipedia drafts functionality: `stolen' from remember.el:
+
+(defgroup wikipedia-draft nil
+ "A mode to wikipedia-draft information."
+ :group 'data)
+
+;;; User Variables:
+
+(defcustom wikipedia-draft-mode-hook nil
+ "*Functions run upon entering wikipedia-draft-mode."
+ :type 'hook
+ :group 'wikipedia-draft)
+
+(defcustom wikipedia-draft-register ?R
+ "The register in which the window configuration is stored."
+ :type 'character
+ :group 'wikipedia-draft)
+
+(defcustom wikipedia-draft-filter-functions nil
+ "*Functions run to filter wikipedia-draft data.
+All functions are run in the wikipedia-draft buffer."
+ :type 'hook
+ :group 'wikipedia-draft)
+
+(defcustom wikipedia-draft-handler-functions '(wikipedia-draft-append-to-file)
+ "*Functions run to process wikipedia-draft data.
+Each function is called with the current buffer narrowed to what the
+user wants wikipedia-drafted.
+If any function returns non-nil, the data is assumed to have been
+recorded somewhere by that function. "
+ :type 'hook
+ :group 'wikipedia-draft)
+
+(defcustom wikipedia-draft-data-file "~/Wiki/discussions/draft.wiki"
+ "*The file in which to store the wikipedia drafts."
+ :type 'file
+ :group 'wikipedia-draft)
+
+(defcustom wikipedia-draft-reply-register ?M
+ "The register in which the window configuration is stored."
+ :type 'character
+ :group 'wikipedia-draft)
+
+(defcustom wikipedia-draft-page ?S ;Version:1.37
+ "The register in which the a page of the wiki draft file is stored."
+ :type 'character
+ :group 'wikipedia-draft)
+
+
+(defcustom wikipedia-draft-leader-text "== "
+ "*The text used to begin each wikipedia-draft item."
+ :type 'string
+ :group 'wikipedia-draft)
+
+
+;;; Internal Variables:
+
+(defvar wikipedia-draft-buffer "*Wikipedia-Draft*"
+ "The name of the wikipedia-draft (temporary) data entry buffer.")
+
+;;; User Functions:
+
+;;;###autoload
+(defun wikipedia-draft ()
+ "Open a temporary buffer in wikipedia mode for editing an
+ wikipedia draft, which an arbitrary piece of data. After
+ finishing the editing either use \\[wikipedia-draft-buffer] to
+ send the data into the wikipedia-draft-data-file, or send the
+ buffer using `wikipedia-draft-send-to-mozex' and insert it later
+ into a wikipedia article."
+ (interactive)
+ (window-configuration-to-register wikipedia-draft-register)
+ (let ((buf (get-buffer-create wikipedia-draft-buffer)))
+ (switch-to-buffer-other-window buf)
+ (wikipedia-mode)
+ (message " C-c C-k sends to draft file, C-c C-c sends to org buffer.")))
+
+
+
+
+
+(defsubst wikipedia-draft-time-to-seconds (time)
+ "Convert TIME to a floating point number."
+ (+ (* (car time) 65536.0)
+ (cadr time)
+ (/ (or (car (cdr (cdr time))) 0) 1000000.0)))
+
+(defsubst wikipedia-draft-mail-date (&optional rfc822-p)
+ "Return a simple date. Nothing fancy."
+ (if rfc822-p
+ (format-time-string "%a, %e %b %Y %T %z" (current-time))
+ (format-time-string "%c" (current-time))))
+
+(defun wikipedia-draft-buffer-desc ()
+ "Using the first line of the current buffer, create a short description."
+ (buffer-substring (point-min)
+ (save-excursion
+ (goto-char (point-min))
+ (end-of-line)
+ (if (> (- (point) (point-min)) 60)
+ (goto-char (+ (point-min) 60)))
+ (point))))
+
+
+;; Wikipedia-Drafting to plain files:
+
+
+(defun wikipedia-draft-append-to-file ()
+ "Add a header together with a subject to the text and add it to the
+draft file. It might be better if longlines-mode is off."
+ (let ((text (buffer-string))
+ (desc (wikipedia-draft-buffer-desc)))
+ (with-temp-buffer
+ (insert "\n\n")
+ (insert wikipedia-draft-leader-text)
+ (insert "Draft: ") ;Version:1.39
+ (insert (read-string "Enter Subject: "))
+ (insert " ")
+ (insert (current-time-string))
+ (insert " ")
+ (insert wikipedia-draft-leader-text)
+ (insert "\n\n") ;Version:1.27
+ (insert "\f")
+ (insert "\n\n")
+ (insert text)
+ (insert "\n")
+ (insert "\f")
+ (insert "\n")
+ (if (not (bolp))
+ (insert "\n\n"))
+ (if (find-buffer-visiting wikipedia-draft-data-file)
+ (let ((wikipedia-draft-text (buffer-string)))
+ (set-buffer (get-file-buffer wikipedia-draft-data-file))
+ (save-excursion
+ (goto-char (point-max))
+ (insert "\n")
+ (insert wikipedia-draft-text)
+ (insert "\n")
+ (save-buffer)))
+ (append-to-file (point-min) (point-max) wikipedia-draft-data-file)))))
+
+
+(setq wikipedia-draft-handler-functions 'wikipedia-draft-append-to-file)
+
+
+(custom-add-option 'wikipedia-draft-handler-functions 'wikipedia-draft-append-to-file)
+
+;;;###autoload
+(defun wikipedia-draft-page () ;Version:1.32
+ (interactive)
+ (mark-page)
+ (copy-region-as-kill (region-beginning) (region-end))
+ (wikipedia-draft)
+ (yank nil))
+
+
+(defun wikipedia-draft-region (&optional beg end)
+ "Wikipedia-Draft the data from BEG to END.
+If called from within the wikipedia-draft buffer, BEG and END are ignored,
+and the entire buffer will be wikipedia-drafted. If called from any other
+buffer, that region, plus any context information specific to that
+region, will be wikipedia-drafted."
+ (interactive)
+ (let ((b (or beg (min (point) (or (mark) (point-min)))))
+ (e (or end (max (point) (or (mark) (point-max))))))
+ (save-restriction
+ (narrow-to-region b e)
+ (run-hook-with-args-until-success 'wikipedia-draft-handler-functions)
+ (when (equal wikipedia-draft-buffer (buffer-name))
+ (kill-buffer (current-buffer))
+ (jump-to-register wikipedia-draft-register)))))
+
+;;
+;;;###autoload
+(defun wikipedia-draft-buffer ()
+ "Wikipedia-draft-buffer sends the contents of the current (temporary)
+buffer to the wikipedia-draft-buffer, see the variable
+wikipedia-draft-data-file."
+ (interactive)
+ (wikipedia-draft-region (point-min) (point-max)))
+
+(defun wikipedia-draft-clipboard ()
+ "Wikipedia-Draft the contents of the current clipboard.
+Most useful for wikipedia-drafting things from Netscape or other X Windows
+application."
+ (interactive)
+ (with-temp-buffer
+ (insert (x-get-clipboard))
+ (run-hook-with-args-until-success 'wikipedia-draft-handler-functions)))
+
+;;;###autoload
+
+
+;;; Internal Functions:
+(defvar wikipedia-draft-send-archive t ;Version:1.56
+ "*Archive the reply.")
+
+(defvar wikipedia-draft-mode-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "\C-c\C-k" 'wikipedia-draft-buffer)
+ (define-key m "\C-c\C-d" 'wikipedia-draft-buffer)
+ m))
+
+(defun wikipedia-draft-mode ()
+ "Major mode for output from \\[wikipedia-draft].
+\\<wikipedia-draft-mode-map> This buffer is used to collect data that
+you want wikipedia-draft. Just hit \\[wikipedia-draft-region] when
+you're done entering, and it will go ahead and file the data for
+latter retrieval, and possible indexing.
+\\{wikipedia-draft-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (indented-text-mode)
+ (use-local-map wikipedia-draft-mode-map)
+ (setq major-mode 'wikipedia-draft-mode
+ mode-name "Wikipedia-Draft")
+ (run-hooks 'wikipedia-draft-mode-hook))
+
+
+(defun wikipedia-draft-view-draft ()
+ (interactive)
+ "Simple shortcut to visit the file, which contains the wikipedia drafts."
+ (find-file wikipedia-draft-data-file))
+
+;;}}}
+
+;;{{{ functions for marking regions
+
+(defun wikipedia-mark-section () ;Version:1.36
+ "Set mark at end of current logical section, and point at top."
+ (interactive)
+ (re-search-forward (concat "== " "[a-z,A-z \t]*"
+ " =="))
+ (re-search-backward "^")
+ (set-mark (point))
+ (re-search-backward (concat "== " "[a-z,A-z \t]*"
+ " "))
+ (wikipedia-activate-region))
+
+(defun wikipedia-mark-signature () ;Version:1.36
+ "Set mark at end of current logical section, and point at top."
+ (interactive)
+ (re-search-forward "]]") ;;[[ ]]
+ (re-search-backward "^")
+ (set-mark (point))
+ (re-search-backward "[[")
+ (wikipedia-activate-region))
+
+(when (featurep 'xemacs)
+ (fset 'wikipedia-activate-region (symbol-function 'zmacs-activate-region)))
+
+(unless (featurep 'xemacs)
+ (defun wikipedia-activate-region ()
+ nil))
+
+;;}}}
+
+;;{{{ `reply' and `send' functions
+
+(defun wikipedia-draft-copy-page-to-register () ;Version:1.47
+ "Copy a page via the wikipedia-draft-register."
+ (interactive)
+ (save-excursion
+ (narrow-to-page nil)
+ (copy-to-register wikipedia-draft-page (point-min) (point-max) nil)
+ (message "draft page copied to wikipedia register wikipedia-draft-page.")
+ (widen)))
+
+ ;aux function
+(defun wikipedia-draft-yank-page-to-register () ;Version:1.50
+ "Insert a page via the wikipedia-draft-register."
+ (interactive)
+ (insert-register wikipedia-draft-page nil))
+
+
+
+(defun wikipedia-draft-send-to-mozex (target-buffer) ;Version:1.56
+ "Copy the current page from the wikipedia draft file to
+ TARGET-BUFFER, this buffer is named something like mozex.textarea.
+Check the variable wikipedia-draft-send-archive. If it is t, then
+additionally the text will be archived in the draft.wiki file. Check
+longlines-mode, it might be better if it is set off."
+ (interactive "bTarget buffer: ")
+ (let ((src-buf (current-buffer)))
+ (wikipedia-draft-copy-page-to-register)
+ (switch-to-buffer target-buffer)
+ (end-of-line 1)
+ (newline 1)
+ (wikipedia-draft-yank-page-to-register)
+ (message "The page has been sent (copied) to the mozex file!")
+ (switch-to-buffer "*Wikipedia-Draft*")
+ (when wikipedia-draft-send-archive ;Version:1.56
+ (let ((text (buffer-string)) ;Version:1.59
+ (desc (wikipedia-draft-buffer-desc)))
+ (with-temp-buffer
+ (insert "\n\n")
+ (insert wikipedia-draft-leader-text)
+ (insert-register wikipedia-draft-reply-register 1)
+ (insert " ")
+ (insert (current-time-string))
+ (insert " ")
+ (insert wikipedia-draft-leader-text)
+ (insert "\n\n")
+ (insert "\f")
+ (insert "\n\n")
+ (insert text)
+ (insert "\n")
+ (insert "\f")
+ (insert "\n")
+ (if (not (bolp))
+ (insert "\n\n"))
+ (if (find-buffer-visiting wikipedia-draft-data-file)
+ (let ((wikipedia-draft-text (buffer-string)))
+ (set-buffer (get-file-buffer wikipedia-draft-data-file))
+ (save-excursion
+ (goto-char (point-max))
+ (insert "\n")
+ (insert wikipedia-draft-text)
+ (insert "\n")
+ (save-buffer)))
+ (append-to-file (point-min) (point-max) wikipedia-draft-data-file)))))
+ (when (equal wikipedia-draft-buffer (buffer-name))
+ (kill-buffer (current-buffer)))
+ (switch-to-buffer target-buffer)))
+
+
+;;Apr_22_2006
+(defvar wikipedia-reply-with-hline nil
+ "*Whether to use a hline as a header seperator in the reply.")
+
+(defvar wikipedia-reply-with-quote nil ;Version:1.60
+ "*Whether to use a quotation tempalate or not.")
+
+(defvar wikipedia-user-simplify-signature t
+ "*Simple varible in order to threat complicated signatures of users, which uses
+fonts and other makeup.")
+
+(defun wikipedia-reply-at-signature () ;Version:1.40
+ "Very simple function to add the reply prefix to the signature,
+sorrounded by the boldface makeup. You have to set the point BEFORE
+the signature, then the functions inserts the following
+:'''Re: [[User:foo]]'''."
+ (interactive)
+ (beginning-of-line 1)
+ (search-forward "[[")
+ (mark-word 3)
+ (yank)
+ (end-of-line 1)
+ (wikipedia-terminate-paragraph)
+ (insert ":'''Re: ")
+ (insert "[[")
+ (yank)
+ (insert "]]")
+ (insert "'''"))
+
+
+
+
+(defun wikipedia-draft-reply () ;Version:1.62
+ "Open a temporary buffer in wikipedia mode for editing an wikipedia
+draft, with an arbitrary piece of data. After finishing the editing
+|]]:either use \"C-c C-k\" \\[wikipedia-draft-buffer] to send the data into
+the wikipedia-draft-data-file, or send the buffer \"C-c\C-c\",
+\\[wikipedia-draft-send-to-mozex] to the current wikipedia article via
+mozex. Check the varibale wikipedia-draft-send-archive."
+ (interactive)
+ (wikipedia-reply-at-point-simple)
+ (beginning-of-line 1)
+ (kill-line nil)
+ (save-excursion
+ (window-configuration-to-register wikipedia-draft-register)
+ (let ((buf (get-buffer-create wikipedia-draft-buffer)))
+ (switch-to-buffer-other-window buf)
+ (wikipedia-mode)
+ (if (functionp 'pabbrev-mode)
+ (pabbrev-mode))
+ (when (not wikipedia-reply-with-quote)
+ (when wikipedia-reply-with-hline
+ (insert "----")
+ (newline 1))
+ (yank)
+ (end-of-line 1))
+ (when wikipedia-reply-with-quote
+ (insert "{{Quotation|")
+ (yank)
+ (insert "'''Re: ")
+ (insert-register wikipedia-draft-reply-register 1)
+ (insert "''' |~~~~}}")
+ (backward-char 7))
+ (message " C-c C-k sends to draft, C-c C-c sends to org buffer."))))
+
+(defun wikipedia-reply-at-point-simple () ;Version:1.65
+ "Reply to posts in discussion forums.
+You have to put the region around the signature, then the
+functions inserts the following
+:'''Re: [[User:foo]]'''."
+ (interactive)
+ (beginning-of-line 1)
+ (search-forward (get-lang-string wikipedia-lang 'wikip-utc))
+ (search-backward (get-lang-string wikipedia-lang 'wikip-user-mark))
+ (when (not wikipedia-user-simplify-signature)
+ (mark-word 3))
+ (when wikipedia-user-simplify-signature
+ (mark-word 2))
+ (copy-to-register wikipedia-draft-reply-register (region-beginning) (region-end) nil)
+ (end-of-line 1)
+ (wikipedia-terminate-paragraph-and-indent)
+ (insert ":'''Re: ")
+ (insert-register wikipedia-draft-reply-register 1)
+ (when wikipedia-user-simplify-signature
+ (insert "|]]''' "))
+ (when (not wikipedia-user-simplify-signature)
+ (insert "]]''' ")))
+
+;;}}}
+
+;;{{{ Optional private stuff:
+
+;; (defun wikipedia-insert-quotation-with-signature () ;Version:1.60
+;; "Insert quotation with signature.
+;; When mark is active, surrounds region."
+;; (interactive)
+;; (wikipedia-insert-around-region "{{Quotation|" "}}{{~~~~}}"))
+
+;; (defun wikipedia-insert-quotation () ;Version:1.60
+;; "Insert quotation box.
+;; When mark is active, surrounds region."
+;; (interactive)
+;; ;; Fix-me: This uses a template, is that really always available???
+;; (wikipedia-insert-around-region "{{Quotation|" "}}"))
+
+;; (define-key wikipedia-mode-map "\C-c\C-fv" 'wikipedia-insert-bible-verse-template)
+;;
+;; (defun wikipedia-insert-bible-verse-template ()
+;; "Insert a template for the quotation of bible verses."
+;; (interactive)
+;; (insert "({{niv|")
+;; (let ((name (read-string "Name: ")))
+;; (insert (concat name "|"))
+;; (let ((verse (read-string "Verse: ")))
+;; (insert (concat verse "|" name " " verse "}})")))))
+
+;;}}}
+
+(provide 'wikipedia-mode)
+;;; wikipedia-mode.el ends here.
+
+
--- /dev/null
+;;; angus77-setup-jde.el ---
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-08-20T16:57:35+0200 Wed
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; Question #42407 on nXhtml changed:
+;; https://answers.launchpad.net/nxhtml/+question/42407
+
+;; Angus77 posted a new comment:
+
+(eval-when-compile (require 'cl))
+(let (
+ ;;(jde-lisp-dir "C:/jdee/jdee/trunk/jde/lisp/")
+ (jde-lisp-dir "C:/jdee/jdee/branches/phil_lord/dimitre_liotev_new_build/jde/lisp")
+ (cedet-root "c:/cedet/cedet/")
+ (elib-dir "C:/DL/emacs/elib-1.0")
+ )
+ (assert (file-directory-p jde-lisp-dir) t)
+ ;;(add-to-list 'load-path (expand-file-name "~/elisp/jde-2.3.5.1/lisp"))
+ (add-to-list 'load-path jde-lisp-dir)
+ ;;(add-to-list 'load-path (expand-file-name "~/elisp/cedet-1.0pre4/semantic"))
+ (add-to-list 'load-path (expand-file-name "semantic" cedet-root))
+ ;;(add-to-list 'load-path (expand-file-name "~/elisp/cedet-1.0pre4/speedbar"))
+ (add-to-list 'load-path (expand-file-name "speedbar" cedet-root))
+ ;;(add-to-list 'load-path (expand-file-name "~/elisp/elib"))
+ (add-to-list 'load-path elib-dir)
+ ;;(add-to-list 'load-path (expand-file-name "~/elisp/cedet-1.0pre4/eieio"))
+ (add-to-list 'load-path (expand-file-name "eieio" cedet-root))
+ ;;(add-to-list 'load-path (expand-file-name "~/elisp/cedet-1.0pre4/common"))
+ (add-to-list 'load-path (expand-file-name "common" cedet-root)))
+
+;; Initialize CEDET.
+;;(load-file (expand-file-name "~/elisp/cedet-1.0pre4/common/cedet.el"))
+(load-library "cedet.el")
+
+(setq defer-loading-jde t)
+
+(if defer-loading-jde
+ (progn
+ (autoload 'jde-mode "jde" "JDE mode." t)
+ (setq auto-mode-alist
+ (append
+ '(("\\.java\\'" . jde-mode))
+ auto-mode-alist)))
+ (require 'jde))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; angus77-setup-jde.el ends here
--- /dev/null
+;;; emacstest-suites.el --- Some unit tests for Emacs
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-09-21T22:34:11+0200 Sun
+;; Version:
+;; Last-Updated: 2008-09-22T00:36:11+0200 Sun
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `button', `cl', `debug', `ert', `ert2', `ewoc', `find-func',
+;; `help-fns', `help-mode', `view'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Unit tests for some Emacs bug reports.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile
+ (let* ((this-file (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+ (this-dir (file-name-directory this-file))
+ (load-path (cons this-dir load-path)))
+ (require 'ert2)))
+
+(setq debug-on-error t)
+
+(defvar emacstest-bin
+ (file-name-directory (if load-file-name load-file-name buffer-file-name)))
+
+(pushnew emacstest-bin load-path)
+
+
+
+(defvar emacstest-files-root
+ (let* ((this-dir emacstest-bin)
+ (root (expand-file-name "inemacs/" this-dir)))
+ (unless (file-accessible-directory-p root)
+ (error (if (file-exists-p root)
+ "Can't read files in test directory %s"
+ "Can't find test directory %s")
+ root))
+ root))
+
+(let ((distr-in "c:/EmacsW32/nxhtml/tests/inemacs/"))
+ (when (file-directory-p distr-in)
+ (setq emacstest-files-root distr-in)))
+
+(defun emacstest-run ()
+ "Run Emacs tests."
+ (interactive)
+ (setq message-log-max t)
+ (setq ert-test-files-root emacstest-files-root)
+ (let ((selector "emacs-"))
+ (if noninteractive
+ (ert-run-tests-batch selector)
+ (ert-kill-temp-test-buffers)
+ (ert-run-tests-interactively selector)
+ (other-window 1)
+ (ert-list-temp-test-buffers))))
+
+(ert-deftest emacs-bug1013 ()
+ "Emacs bug 1013.
+See URL
+`http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?bug=1013'."
+ (ert-with-temp-buffer-include-file "bug1013.el"
+ (eval-buffer)))
+
+(provide 'emacstest-suites)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; emacstest-suites.el ends here
--- /dev/null
+;;; ert.el --- Emacs Lisp Regression Testing
+
+;; Modified by Lennart Borgman 2008-07-13 to make all global symbols
+;; use the "ert-" prefix.
+
+;; Copyright (C) 2007, 2008 Christian M. Ohler
+
+;; Author: Christian M. Ohler
+;; Version: 0.2
+;; Keywords: lisp, tools
+
+;; This file is NOT part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;; ERT is a tool for automated testing in Emacs Lisp. Its main
+;; features are facilities for defining and running test cases and
+;; reporting the results as well as for debugging test failures
+;; interactively.
+;;
+;; The main entry points are `ert-deftest', which is similar to
+;; `defun' but defines a test, and `ert-run-tests-interactively',
+;; which runs tests and offers an interactive interface for inspecting
+;; results and debugging. There is also `ert-run-tests-batch' for
+;; non-interactive use.
+;;
+;; The body of `ert-deftest' forms resembles a function body, but the
+;; additional operators `should', `should-not' and `should-error' are
+;; available. `should' is similar to cl's `assert', but signals a
+;; different error when its condition is violated that is caught and
+;; processed by ERT. In addition, it analyzes its argument form and
+;; records information that helps debugging (`assert' tries to do
+;; something similar when its second argument SHOW-ARGS is true, but
+;; `should' is more sophisticated). For information on `should-not'
+;; and `should-error', see their docstrings.
+;;
+;; For example,
+;;
+;; ;; Define a test named `foo'.
+;; (ert-deftest foo ()
+;; (ert-should (= (+ 1 2) 4)))
+;;
+;; ;; Run it.
+;; (ert-run-tests-interactively 'foo)
+;;
+;; generates the following output (in addition to some statistics) in
+;; the *ert* results buffer:
+;;
+;; F foo
+;; (ert-test-failed
+;; ((ert-should
+;; (=
+;; (+ 1 2)
+;; 4))
+;; :form
+;; (= 3 4)
+;; :value nil))
+;;
+;; This indicates that the test failed. The `should' form that failed
+;; was (ert-should (= (+ 1 2) 4)), because its inner form, after
+;; evaluation of its arguments, was the function call (= 3 4), which
+;; returned nil.
+;;
+;; Obviously, this is a bug in the test case, not in the functions `+'
+;; or `='. In the results buffer, with point on the test result, the
+;; key "." can be used to jump to the definition of the test to modify
+;; it to correct the bug. After evaluating the modified definition
+;; and switching back to the results buffer, the key "r" will re-run
+;; the test and show the new result.
+
+
+;; Test selectors
+;;
+;; Functions like `ert-run-tests-interactively' accept a test
+;; selector, which is a Lisp expression specifying a set of tests.
+;; Each test name is a selector that refers to that test, the selector
+;; `t' refers to all tests, and the selector `:failed' refers to all
+;; tests that failed; but more complex selectors are available. Test
+;; selector syntax is similar to cl's type specifier syntax. See the
+;; docstring of `ert-select-tests' for details.
+
+
+;; Comparison with other testing tools
+;;
+;; ERT allows test-driven development similar to *Unit frameworks for
+;; other languages. However, two common *Unit features are notably
+;; absent from ERT: fixtures and test suites.
+;;
+;; Fixtures, as used e.g. in SUnit or JUnit, have two main purposes:
+;; Setting up (and tearing down) an environment for a set of test
+;; cases, and making that environment accessible through object
+;; attributes that can be used like local variables.
+;;
+;; While fixtures are a great syntactic simplification in other
+;; languages, they are not very useful in Lisp, where higher-order
+;; functions and `unwind-protect' are available. One way to implement
+;; and use a fixture in ERT is
+;;
+;; (defun my-fixture (body)
+;; (unwind-protect
+;; (progn ...set up...
+;; (funcall body))
+;; ...tear down...))
+;;
+;; (ert-deftest my-test ()
+;; (my-fixture
+;; (lambda ()
+;; ...test code...)))
+;;
+;; (Another way would be a `with-my-fixture' macro.) This solves the
+;; set-up and tear-down part, and additionally allows any test case to
+;; use any combination of fixtures, so it is more general than what
+;; other tools typically allow.
+;;
+;; If the test case needs access to the environment the fixture sets
+;; up, the fixture can be modified to pass arguments to the body.
+;;
+;; These are standard Lisp idioms. Special syntax for them could be
+;; added easily enough, but would provide only a minor simplification.
+;;
+;; (Note that splitting set-up and tear-down into separate functions,
+;; like *Unit tools usually do, makes it impossible to establish
+;; dynamic `let' bindings as part of the fixture. So, blindly
+;; imitating the way fixtures are implemented in other languages would
+;; be counter-productive in Lisp.)
+;;
+;;
+;; The purpose of test suites is to group related test cases together.
+;; The most common use of this is to run just the tests for one
+;; particular module. Since symbol prefixes are the usual way of
+;; separating module namespaces in Emacs Lisp, test selectors already
+;; solve this by allowing regexp matching on test names; e.g., the
+;; selector "^ert-" selects ERT's self-tests.
+;;
+;; If test suites containing arbitrary sets of tests are found to be
+;; desirable, it would be easy to add a `define-test-selector'
+;; mechanism that introduces a new selector, defined in terms of
+;; existing ones; e.g.
+;;
+;; ;; Note that `define-test-selector' does not exist yet.
+;; (define-test-selector my-test-suite () `(member foo-test bar-test))
+;;
+;; would define a test suite named `my-test-suite' consisting of
+;; `foo-test' and `bar-test'. See also `deftype' in Common Lisp.
+
+
+;; TODO: Add `skip' feature for tests that can't run in current environment.
+
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ewoc)
+(require 'find-func)
+(require 'debug)
+
+(defvar ert-debug-on-error nil
+ "Non-nil means enter debugger when a test fails or terminates with an error.")
+
+
+;;; Defining and locating tests.
+
+;; The data structure that represents a test case.
+(defstruct ert-test
+ (name nil)
+ (documentation nil)
+ (body (assert nil))
+ (most-recent-result nil)
+ (expected-result-type 'ert-test-passed))
+
+(defun ert-test-boundp (symbol)
+ "Return non-nil if SYMBOL names a test."
+ (and (get symbol 'ert-test) t))
+
+(defun ert-get-test (symbol)
+ "If SYMBOL names a test, return that. Signal an error otherwise."
+ (assert (ert-test-boundp symbol) t)
+ (get symbol 'ert-test))
+
+(defun ert-set-test (symbol doc definition)
+ "Make SYMBOL name the test DEFINITION, and return DEFINITION."
+ (when doc
+ (put symbol 'ert-test-documentation doc))
+ (put symbol 'ert-test definition)
+ definition)
+
+(defun ert-make-test-unbound (symbol)
+ "Make SYMBOL name no test. Return SYMBOL."
+ (remprop symbol 'ert-test)
+ symbol)
+
+(defun ert-test-result-expected-p (test result)
+ "Return non-nil if RESULT matches the expected result type for TEST."
+ (typep result (ert-test-expected-result-type test)))
+
+(defvar ert-find-test-regexp
+ (concat "^\\s-*(ert-deftest"
+ find-function-space-re
+ "%s\\(\\s-\\|$\\)")
+ "The regexp the `find-function' mechanisms use for locating test definitions.")
+
+(eval-and-compile
+ (defun ert-parse-keys-and-body (docstr keys-and-body)
+ "Split KEYS-AND-BODY into keyword-and-value pairs and the remaining body.
+
+KEYS-AND-BODY should have the form of a property list, with the
+exception that only keywords are permitted as keys and that the
+tail -- the body -- is a list of forms that does not start with a
+keyword.
+
+Returns a two-element list containing the keys-and-values plist
+and the body."
+ (unless (stringp docstr)
+ (when docstr
+ (setq keys-and-body (cons docstr keys-and-body))
+ (setq docstr nil)))
+ (let ((extracted-key-accu '())
+ (remaining keys-and-body))
+ (while (and (consp remaining) (keywordp (first remaining)))
+ (let ((keyword (pop remaining)))
+ (unless (consp remaining)
+ (error "Value expected after keyword %S in %S"
+ keyword keys-and-body))
+ (when (assoc keyword extracted-key-accu)
+ (warn "Keyword %S appears more than once in %S" keyword
+ keys-and-body))
+ (push (cons keyword (pop remaining)) extracted-key-accu)))
+ (setq extracted-key-accu (nreverse extracted-key-accu))
+ (list (loop for (key . value) in extracted-key-accu
+ collect key
+ collect value)
+ docstr
+ remaining))))
+
+(defvar ert-error-on-test-redefinition nil)
+
+;;;###autoload
+(defmacro* ert-deftest (name ()
+ &optional docstr
+ &body keys-and-body)
+ "Define NAME (a symbol) as a test.
+
+\(fn NAME () [:documentation DOCSTRING] [:expected-result TYPE] BODY...)"
+ ;; The :documentation would be unreadable. I have therefore added
+ ;; docstr that will look like documentation use to in Emacs. Maybe
+ ;; add function ert-describe-test?
+ (declare (indent 2)
+ (debug (&define :name test name sexp
+ [&optional [":documentation" stringp]]
+ [&optional [":expected-result" sexp]]
+ def-body)))
+ (destructuring-bind ((&key (expected-result nil expected-result-supplied-p)
+ (documentation nil documentation-supplied-p))
+ doc
+ body)
+ (ert-parse-keys-and-body docstr keys-and-body)
+ `(progn
+ ;; Guard against missing/badly named tests:
+ (when (and ert-error-on-test-redefinition
+ (symbolp ',name)
+ (get ',name 'ert-test))
+ (with-output-to-temp-buffer "*Ert Error*"
+ (with-current-buffer "*Ert Error*"
+ (insert "Test "
+ (format "%s" ',name)
+ " is already defined in "
+ (format "%s" (find-definition-noselect ',name 'ert-deftest))
+ "\n\n"
+ "Tip: Use `ert-delete-all-tests' or `ert-delete-test' before redefining tests."
+ )))
+ (if (y-or-n-p "Do you want to call ert-delete-all-tests and then continue? ")
+ ;; Fix-me: This does not work, why?
+ (ert-delete-all-tests)
+ (error "Test %s is already defined in %s"
+ ',name
+ (find-definition-noselect ',name 'ert-deftest))))
+ (ert-set-test ',name
+ nil ;;doc
+ (make-ert-test
+ :name ',name
+ :body (lambda () ,@body)
+ ,@(when expected-result-supplied-p
+ `(:expected-result-type ,expected-result))
+ ,@(when documentation-supplied-p
+ `(:documentation ,documentation))))
+ ;; This hack allows `symbol-file' to associate `ert-deftest'
+ ;; forms with files, and therefore enables `find-function' to
+ ;; work with tests. However, it leads to warnings in
+ ;; `unload-feature', which doesn't know how to undefine tests
+ ;; and has no mechanism for extension.
+ (push '(ert-deftest . ,name) current-load-list)
+ ',name)))
+
+(defun ert-read-test-name (prompt &optional default-value history)
+ "Read the name of a test and return it as a symbol.
+Prompt with PROMPT. By default, return DEFAULT-VALUE."
+ (when (symbolp default-value) (setq default-value (symbol-name default-value)))
+ (intern (completing-read prompt obarray #'ert-test-boundp
+ t nil history default-value nil)))
+
+(defun ert-find-test-other-window (test-name)
+ "Find, in another window, the definition of TEST-NAME."
+ (interactive (list (ert-read-test-name "Find test definition: ")))
+ (find-function-do-it test-name 'ert-deftest 'switch-to-buffer-other-window))
+
+(defun ert-delete-test (test-name)
+ "An interactive interface to `ert-make-test-unbound'."
+ (interactive (list (let ((default (thing-at-point 'symbol)))
+ (when default
+ (set-text-properties 0 (length default) nil default)
+ (when (or (string= default "nil") (intern-soft default))
+ (setq default (intern default)))
+ (unless (ert-test-boundp default)
+ (setq default nil)))
+ (completing-read (if (null default)
+ "Delete test: "
+ (format "Delete test (default %s): "
+ default))
+ obarray #'ert-test-boundp
+ 'really-require-match
+ nil nil default nil))))
+ (ert-make-test-unbound test-name))
+
+(defun ert-delete-all-tests ()
+ "Make all symbols in `obarray' name no test."
+ (interactive)
+ (when (interactive-p)
+ (unless (y-or-n-p "Delete all tests? ")
+ (error "Aborted")))
+ (mapc #'ert-delete-test (mapcar #'ert-test-name (ert-select-tests t t)))
+ t)
+
+
+(defun ert-make-end-marker (buffer must-exist)
+ "Return a marker to the end of buffer BUFFER.
+BUFFER may be a string or a buffer. If BUFFER does not exist
+return nil.
+
+The buffer must exist if MUST-EXIST is non-nil.
+
+See also:
+ `ert-end-of-messages'
+ `ert-end-of-warnings'"
+ (let ((buf (if must-exist
+ (get-buffer buffer)
+ (get-buffer-create buffer))))
+ (when (and buf
+ (bufferp buf)
+ (buffer-live-p buf))
+ (with-current-buffer buf
+ (save-restriction
+ (widen)
+ (point-max-marker))))))
+
+(defun ert-end-of-messages ()
+ "Return a marker to the end of *Messages* buffer."
+ (ert-make-end-marker "*Messages*" nil))
+
+(defun ert-end-of-warnings ()
+ "Return a marker to the end of *Warnings* buffer."
+ (ert-make-end-marker "*Warnings*" nil))
+
+(defun ert-search-after (after regexp)
+ "Search after marker in AFTER for regular expression REGEXP.
+Return a alist of position and matches. AFTER should have been
+created with `ert-make-end-marker'.
+
+This is supposed to be used for messages and trace buffers.
+
+See also
+ `ert-get-messages'"
+ (let ((buf (marker-buffer after)))
+ (with-current-buffer buf
+ (let ((here (point))
+ res)
+ (goto-char after)
+ (save-match-data
+ (while (re-search-forward regexp nil t)
+ (setq res (cons (match-data) res))))
+ (goto-char here)
+ (reverse res)))))
+;; fix-me: add a conventient way to look at the result of
+;; `ert-search-after'. Probably this means adding something more to
+;; the returned result.
+
+(defvar ert-messages-mark)
+(defun ert-get-messages (regexp)
+ "Search *Messages* buffer for regular expression REGEXP.
+This should be used within `ert-deftest'. Search begins where
+the buffer ended when test started.
+
+See also:
+ `ert-get-warnings'
+ `ert-search-after'"
+ (ert-search-after ert-messages-mark regexp))
+
+(defvar ert-warnings-mark)
+(defun ert-get-warnings (regexp)
+ "Search *Warnings* buffer for regular expression REGEXP.
+See `ert-get-messages' for more information."
+ (ert-search-after ert-warnings-mark regexp))
+
+
+;;; Test selectors.
+
+(defun ert-select-tests (selector universe)
+ "Select, from UNIVERSE, a set of tests according to SELECTOR.
+
+UNIVERSE should be a list of tests, or t, which refers to all
+tests named by symbols in `obarray'.
+
+Returns the set of tests as a list.
+
+Valid selectors:
+
+nil -- Selects the empty set.
+t -- Selects UNIVERSE.
+:new -- Selects all tests that have not been run yet.
+:failed, :passed, :error -- Select tests according to their most recent result.
+:expected, :unexpected -- Select tests according to their most recent result.
+a string -- Selects all tests that have a name that matches the string, a regexp.
+a test -- Selects that test.
+a symbol -- Selects the test that the symbol names, errors if none.
+\(member TESTS...\) -- Selects TESTS, a list of tests or symbols naming tests.
+\(eql TEST\) -- Selects TEST, a test or a symbol naming a test.
+\(and SELECTORS...\) -- Selects the tests that match all SELECTORS.
+\(or SELECTORS...\) -- Selects the tests that match any SELECTOR.
+\(not SELECTOR\) -- Selects all tests that do not match SELECTOR.
+\(satisfies PREDICATE\) -- Selects all tests that satisfy PREDICATE.
+
+Only selectors that require a superset of tests, such
+as (satisfies ...), strings, :new, etc. make use of UNIVERSE.
+Selectors that do not, such as \(member ...\), just return the
+set implied by them without checking whether it is really
+contained in UNIVERSE."
+ ;; This code needs to match the etypecase in
+ ;; `ert-insert-human-readable-selector'.
+ (etypecase selector
+ ((member nil) nil)
+ ((member t) (etypecase universe
+ (list universe)
+ ((member t) (ert-select-tests "" universe))))
+ ((member :new) (ert-select-tests
+ `(satisfies ,(lambda (test)
+ (typep (ert-test-most-recent-result test)
+ 'null)))
+ universe))
+ ((member :failed) (ert-select-tests
+ `(satisfies ,(lambda (test)
+ (typep (ert-test-most-recent-result test)
+ 'ert-test-failed)))
+ universe))
+ ((member :passed) (ert-select-tests
+ `(satisfies ,(lambda (test)
+ (typep (ert-test-most-recent-result test)
+ 'ert-test-passed)))
+ universe))
+ ((member :error) (ert-select-tests
+ `(satisfies ,(lambda (test)
+ (typep (ert-test-most-recent-result test)
+ 'ert-test-error)))
+ universe))
+ ((member :expected) (ert-select-tests
+ `(satisfies
+ ,(lambda (test)
+ (ert-test-result-expected-p
+ test
+ (ert-test-most-recent-result test))))
+ universe))
+ ((member :unexpected) (ert-select-tests `(not :expected) universe))
+ (string
+ (etypecase universe
+ ((member t) (mapcar #'ert-get-test
+ (apropos-internal selector #'ert-test-boundp)))
+ (list (remove-if-not (lambda (test)
+ (and (ert-test-name test)
+ (string-match selector (ert-test-name test))))
+ universe))))
+ (ert-test (list selector))
+ (symbol
+ (assert (ert-test-boundp selector))
+ (list (ert-get-test selector)))
+ (cons
+ (destructuring-bind (operator &rest operands) selector
+ (ecase operator
+ (member
+ (mapcar (lambda (purported-test)
+ (etypecase purported-test
+ (symbol (assert (ert-test-boundp purported-test))
+ (ert-get-test purported-test))
+ (ert-test purported-test)))
+ operands))
+ (eql
+ (assert (eql (length operands) 1))
+ (ert-select-tests `(member ,@operands) universe))
+ (and
+ ;; Do these definitions of AND, NOT and OR satisfy de
+ ;; Morgan's rules? Should they?
+ (case (length operands)
+ (0 (ert-select-tests 't universe))
+ (t (ert-select-tests `(and ,@(rest operands))
+ (ert-select-tests (first operands) universe)))))
+ (not
+ (assert (eql (length operands) 1))
+ (set-difference (ert-select-tests 't universe)
+ (ert-select-tests (first operands) universe)))
+ (or
+ (case (length operands)
+ (0 (ert-select-tests 'nil universe))
+ (t (union (ert-select-tests (first operands) universe)
+ (ert-select-tests `(or ,@(rest operands)) universe)))))
+ (satisfies
+ (assert (eql (length operands) 1))
+ (remove-if-not (first operands) (ert-select-tests 't universe))))))))
+
+(defun ert-insert-human-readable-selector (selector)
+ "Insert a human-readable presentation of SELECTOR into the current buffer."
+ ;; This is needed to avoid printing the (huge) contents of the
+ ;; `backtrace' slot of the result objects in the
+ ;; `most-recent-result' slots of test case objects in (eql ...) or
+ ;; (member ...) selectors.
+ (labels ((rec (selector)
+ ;; This code needs to match the etypecase in `ert-select-tests'.
+ (etypecase selector
+ ((or (member nil t
+ :new :failed :passed :error
+ :expected :unexpected)
+ string
+ symbol)
+ selector)
+ (ert-test
+ (if (ert-test-name selector)
+ (make-symbol (format "<%S>" (ert-test-name selector)))
+ (make-symbol "<unnamed test>")))
+ (cons
+ (destructuring-bind (operator &rest operands) selector
+ (ecase operator
+ ((member eql and not or)
+ `(,operator ,@(mapcar #'rec operands)))
+ (satisfies
+ selector)))))))
+ (insert (format "%S" (rec selector)))))
+
+
+;;; Running tests.
+
+(put 'ert-test-failed 'error-conditions '(error ert-test-failed))
+(put 'ert-test-failed 'error-message "Test failed")
+
+(defun ert-pass ()
+ "Terminate the current test and mark it passed. Does not return."
+ (throw 'ert-pass nil))
+
+(defun ert-fail (data)
+ "Terminate the current test and mark it failed. Does not return.
+DATA is displayed to the user and should state the reason of the failure."
+ (signal 'ert-test-failed (list data)))
+
+;; The data structures that represent the result of running a test.
+(defstruct ert-test-result
+ (messages nil)
+ )
+(defstruct (ert-test-passed (:include ert-test-result)))
+(defstruct (ert-test-result-with-condition (:include ert-test-result))
+ (condition (assert nil))
+ (backtrace (assert nil)))
+(defstruct (ert-test-error (:include ert-test-result-with-condition)))
+(defstruct (ert-test-quit (:include ert-test-result-with-condition)))
+(defstruct (ert-test-failed (:include ert-test-result-with-condition)))
+(defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result)))
+
+
+(defun ert-record-backtrace ()
+ "Record the current backtrace (as a list) and return it."
+ ;; Since the backtrace is stored in the result object, result
+ ;; objects must only be printed with appropriate limits
+ ;; (`print-level' and `print-length') in place. For interactive
+ ;; use, the cost of ensuring this possibly outweighs the advantage
+ ;; of storing the backtrace for
+ ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
+ ;; already have `ert-results-rerun-test-debugging-errors-at-point'.
+ ;; For batch use, however, printing the backtrace may be useful.
+ (loop
+ ;; 6 is the number of frames our own debugger adds (when
+ ;; compiled; more when interpreted). FIXME: Need to describe a
+ ;; procedure for determining this constant.
+ for i from 6
+ for frame = (backtrace-frame i)
+ while frame
+ collect frame))
+
+;; A container for the state of the execution of a single test and
+;; environment data needed during its execution.
+(defstruct ert-test-execution-info
+ (test (assert nil))
+ (result (assert nil))
+ ;; A thunk that may be called when RESULT has been set to its final
+ ;; value and test execution should be terminated. Should not
+ ;; return.
+ (exit-continuation (assert nil))
+ ;; The binding of `debugger' outside of the execution of the test.
+ next-debugger
+ ;; The binding of `ert-debug-on-error' that is in effect for the
+ ;; execution of the current test. We store it to avoid being
+ ;; affected by any new bindings the test itself may establish. (I
+ ;; don't remember whether this feature is important.)
+ ert-debug-on-error)
+
+(defun ert-run-test-debugger (info debugger-args)
+ "The function that `debugger' is bound to during the execution of tests.
+
+Records failures and errors and either terminates the test
+silently or calls the interactive debugger, as appropriate."
+ (destructuring-bind (first-debugger-arg &rest more-debugger-args) debugger-args
+ (ecase first-debugger-arg
+ ((lambda debug t exit nil)
+ (apply (ert-test-execution-info-next-debugger info) debugger-args))
+ (error
+ (let* ((condition (first more-debugger-args))
+ (type (case (car condition)
+ ((quit) 'quit)
+ ((ert-test-failed) 'failed)
+ (otherwise 'error)))
+ (backtrace (ert-record-backtrace)))
+ (setf (ert-test-execution-info-result info)
+ (ecase type
+ (quit
+ (make-ert-test-quit :condition condition
+ :backtrace backtrace))
+ (failed
+ (make-ert-test-failed :condition condition
+ :backtrace backtrace))
+ (error
+ (make-ert-test-error :condition condition
+ :backtrace backtrace))))
+ ;; Work around Emacs' heuristic (in eval.c) for detecting
+ ;; errors in the debugger.
+ (incf num-nonmacro-input-events)
+ ;; FIXME: We should probably implement more fine-grained
+ ;; control a la non-t `debug-on-error' here.
+ (cond
+ ((ert-test-execution-info-ert-debug-on-error info)
+ (apply (ert-test-execution-info-next-debugger info) debugger-args))
+ (t))
+ (funcall (ert-test-execution-info-exit-continuation info)))))))
+
+(defun ert-run-test-internal (ert-test-execution-info)
+ (lexical-let ((info ert-test-execution-info))
+ (setf (ert-test-execution-info-next-debugger info) debugger
+ (ert-test-execution-info-ert-debug-on-error info) ert-debug-on-error)
+ (catch 'ert-pass
+ ;; For now, each test gets its own temp buffer and its own
+ ;; window excursion, just to be safe. If this turns out to be
+ ;; too expensive, we can remove it.
+ (with-temp-buffer
+ (save-window-excursion
+ (let ((debugger (lambda (&rest debugger-args)
+ (ert-run-test-debugger info debugger-args)))
+ (debug-on-error t)
+ (debug-on-quit t)
+ ;; FIXME: Do we need to store the old binding of this
+ ;; and consider it in `ert-run-test-debugger'?
+ (debug-ignored-errors nil)
+ (ert-messages-mark (ert-end-of-messages))
+ (ert-warnings-mark (ert-end-of-warnings)))
+ (funcall (ert-test-body (ert-test-execution-info-test info))))))
+ (ert-pass))
+ (setf (ert-test-execution-info-result info) (make-ert-test-passed)))
+ nil)
+
+(defun ert-make-marker-in-messages-buffer ()
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (set-marker (make-marker) (point-max))))
+
+(defun ert-force-message-log-buffer-truncation ()
+ (with-current-buffer (get-buffer-create "*Messages*")
+ ;; This is a reimplementation of this part of message_dolog() in xdisp.c:
+ ;; if (NATNUMP (Vmessage_log_max))
+ ;; {
+ ;; scan_newline (Z, Z_BYTE, BEG, BEG_BYTE,
+ ;; -XFASTINT (Vmessage_log_max) - 1, 0);
+ ;; del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, 0);
+ ;; }
+ (when (and (integerp message-log-max) (>= message-log-max 0))
+ (let ((begin (point-min))
+ (end (save-excursion
+ (goto-char (point-max))
+ (forward-line (- message-log-max))
+ (point))))
+ (delete-region begin end)))))
+
+(defun ert-run-test (test)
+ "Run TEST. Return the result and store it in TEST's `most-recent-result' slot."
+ (setf (ert-test-most-recent-result test) nil)
+ (block error
+ (lexical-let* ((begin-marker (ert-make-marker-in-messages-buffer))
+ (info (make-ert-test-execution-info
+ :test test
+ :result (make-ert-test-aborted-with-non-local-exit)
+ :exit-continuation (lambda ()
+ (return-from error nil)))))
+ (unwind-protect
+ (let ((message-log-max t))
+ (ert-run-test-internal info))
+ (let ((result (ert-test-execution-info-result info)))
+ (setf (ert-test-result-messages result)
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (buffer-substring begin-marker (point-max))))
+ (ert-force-message-log-buffer-truncation)
+ (setf (ert-test-most-recent-result test) result)))))
+ (ert-test-most-recent-result test))
+
+
+;;; The `should' macros.
+
+(eval-and-compile
+ (defun ert-special-operator-p (thing)
+ "Return non-nil if THING is a symbol naming a special operator."
+ (and (symbolp thing)
+ (let ((definition (indirect-function thing t)))
+ (and (subrp definition)
+ (eql (cdr (subr-arity definition)) 'unevalled)))))
+ (defun ert-expand-should (whole form env inner-expander)
+ "Helper function for the `should' macro and its variants.
+
+Analyzes FORM and produces an expression that has the same
+semantics under evaluation but records additional debugging
+information. INNER-EXPANDER adds the actual checks specific to
+the particular variant of `should'."
+ (let ((form (macroexpand form env)))
+ ;; It's sort of a wart that `inner-expander' can't influence the
+ ;; value the expansion returns.
+ (cond
+ ((atom form)
+ (funcall inner-expander form `(list ',whole :form ',form :value ,form)))
+ ((ert-special-operator-p (car form))
+ (let ((value (gensym "value-")))
+ `(let ((,value (make-symbol "ert-form-evaluation-aborted")))
+ ,(funcall inner-expander
+ `(setq ,value ,form)
+ `(list ',whole :form ',form :value ,value))
+ ,value)))
+ (t
+ (let ((fn-name (car form))
+ (arg-forms (cdr form)))
+ (assert (or (symbolp fn-name)
+ (and (consp fn-name)
+ (eql (car fn-name) 'lambda)
+ (listp (cdr fn-name)))))
+ (let ((fn (gensym "fn-"))
+ (args (gensym "args-"))
+ (value (gensym "value-"))
+ (default-value (gensym "ert-form-evaluation-aborted-")))
+ `(let ((,fn (function ,fn-name))
+ (,args (list ,@arg-forms)))
+ (let ((,value ',default-value))
+ ,(funcall inner-expander
+ `(setq ,value (apply ,fn ,args))
+ `(nconc (list ',whole)
+ (list :form `(,,fn ,@,args))
+ (unless (eql ,value ',default-value)
+ (list :value ,value))
+ (let ((-explainer-
+ (and (symbolp ',fn-name)
+ (get ',fn-name
+ 'ert-explainer))))
+ (when -explainer-
+ (list :explanation
+ (apply -explainer- ,args))))))
+ ,value)))))))))
+
+(defmacro* ert-should (form &environment env)
+ "Evaluate FORM. If it returns nil, abort the current test as failed.
+
+Returns the value of FORM."
+ (ert-expand-should `(ert-should ,form) form env
+ (lambda (inner-form form-description-form)
+ `(unless ,inner-form
+ (ert-fail ,form-description-form)))))
+
+(defmacro* ert-should-not (form &environment env)
+ "Evaluate FORM. If it returns non-nil, abort the current test as failed.
+
+Returns nil."
+ (ert-expand-should `(ert-should-not ,form) form env
+ (lambda (inner-form form-description-form)
+ `(unless (not ,inner-form)
+ (ert-fail ,form-description-form)))))
+
+(defun ert-should-error-handle-error (form-description-fn
+ condition type exclude-subtypes test)
+ "Helper function for `should-error'.
+
+Determines whether CONDITION matches TYPE, EXCLUDE-SUBTYPES and
+TEST, and aborts the current test as failed if it doesn't."
+ (let ((signalled-conditions (get (car condition) 'error-conditions))
+ (handled-conditions (etypecase type
+ (list type)
+ (symbol (list type)))))
+ (assert signalled-conditions)
+ (unless (intersection signalled-conditions handled-conditions)
+ (ert-fail (append
+ (funcall form-description-fn)
+ (list
+ :condition condition
+ :fail-reason (concat "the error signalled did not"
+ " have the expected type")))))
+ (when exclude-subtypes
+ (unless (member (car condition) handled-conditions)
+ (ert-fail (append
+ (funcall form-description-fn)
+ (list
+ :condition condition
+ :fail-reason (concat "the error signalled was a subtype"
+ " of the expected type"))))))
+ (unless (funcall test condition)
+ (ert-fail (append
+ (funcall form-description-fn)
+ (list
+ :condition condition
+ :fail-reason "the error signalled did not pass the test"))))))
+
+;; FIXME: The expansion will evaluate the keyword args (if any) in
+;; nonstandard order.
+(defmacro* ert-should-error (form &rest keys &key type exclude-subtypes test
+ &environment env)
+ "Evaluate FORM. Unless it signals an error, abort the current test as failed.
+
+The error signalled additionally needs to match TYPE and satisfy
+TEST. TYPE should be a condition name or a list of condition
+names. If EXCLUDE-SUBTYPES is nil, the error matches TYPE if one
+of its condition names is an element of TYPE. If
+EXCLUDE-SUBTYPES is non-nil, the error matches TYPE if it is an
+element of TYPE. TEST should be a predicate."
+ ;; Returns a gensym named `ert-form-evaluation-aborted-XXX', but
+ ;; that's a wart, so let's not document it.
+ (unless type (setq type ''error))
+ (unless test (setq test '(lambda (condition) t)))
+ (ert-expand-should
+ `(ert-should-error ,form ,@keys)
+ form env
+ (lambda (inner-form form-description-form)
+ (let ((errorp (gensym "errorp"))
+ (form-description-fn (gensym "form-description-fn-")))
+ `(let ((,errorp nil)
+ (,form-description-fn (lambda () ,form-description-form)))
+ (condition-case -condition-
+ ,inner-form
+ ;; We can't use ,type here because we want to evaluate it.
+ (error
+ (setq ,errorp t)
+ (ert-should-error-handle-error ,form-description-fn
+ -condition-
+ ,type ,exclude-subtypes ,test)
+ ;; It would make sense to have the `should-error' form
+ ;; return the error in this case, but `ert-expand-should'
+ ;; doesn't allow that at the moment.
+ ))
+ (unless ,errorp
+ (ert-fail (append
+ (funcall ,form-description-fn)
+ (list
+ :fail-reason "did not signal an error")))))))))
+
+
+;;; Explanation of `should' failures.
+
+(defun ert-proper-list-p (x)
+ "Return non-nil if X is a proper list, nil otherwise."
+ (loop
+ for firstp = t then nil
+ for fast = x then (cddr fast)
+ for slow = x then (cdr slow) do
+ (when (null fast) (return t))
+ (when (not (consp fast)) (return nil))
+ (when (null (cdr fast)) (return t))
+ (when (not (consp (cdr fast))) (return nil))
+ (when (and (not firstp) (eq fast slow)) (return nil))))
+
+(defun ert-explain-not-equal (a b)
+ "Return a programmer-readable explanation of why A and B are not `equal'.
+
+Returns nil if they are equal."
+ (if (not (equal (type-of a) (type-of b)))
+ `(different-types ,a ,b)
+ (etypecase a
+ (cons
+ (let ((a-proper-p (ert-proper-list-p a))
+ (b-proper-p (ert-proper-list-p b)))
+ (if (not (eql (not a-proper-p) (not b-proper-p)))
+ `(one-list-proper-one-improper ,a ,b)
+ (if a-proper-p
+ (if (not (equal (length a) (length b)))
+ ;; This would be even more helpful if it showed
+ ;; something like what `set-difference' would
+ ;; return.
+ `(proper-lists-of-different-length ,a ,b)
+ (loop for i from 0
+ for ai in a
+ for bi in b
+ for xi = (ert-explain-not-equal ai bi)
+ do (when xi (return `(list-elt ,i ,xi)))))
+ (let ((car-x (ert-explain-not-equal (car a) (car b))))
+ (if car-x
+ `(car ,car-x)
+ (let ((cdr-x (ert-explain-not-equal (cdr a) (cdr b))))
+ (if cdr-x
+ `(cdr ,cdr-x))
+ nil)))))))
+ (array (if (not (equal (length a) (length b)))
+ `(arrays-of-different-length ,a ,b)
+ (loop for i from 0
+ for ai across a
+ for bi across b
+ for xi = (ert-explain-not-equal ai bi)
+ do (when xi (return `(array-elt ,i ,xi))))))
+ (atom (if (not (equal a b))
+ `(different-atoms ,a ,b)
+ nil)))))
+(put 'equal 'ert-explainer 'ert-explain-not-equal)
+
+
+;;; Results display.
+
+;; The data structure that contains the set of tests being executed
+;; during one particular test run, their results, the state of the
+;; execution, and some statistics.
+;;
+;; The data about results and expected results of tests may seem
+;; redundant here, since the test objects also carry such information.
+;; However, the information in the test objects may be more recent, it
+;; may correspond to a different test run. We need the information
+;; that corresponds to this run in order to be able to update the
+;; statistics correctly when a test is re-run interactively and has a
+;; different result than before.
+(defstruct ert-stats
+ (selector (assert nil))
+ ;; The tests, in order.
+ (tests (assert nil) :type vector)
+ ;; A map of test names (or the test objects themselves for unnamed
+ ;; tests) to indices into the `tests' vector.
+ (test-map (assert nil) :type hash-table)
+ ;; The results of the tests during this run, in order.
+ (test-results (assert nil) :type vector)
+ ;; The expected result types of the tests, in order.
+ (test-results-expected (assert nil) :type vector)
+ (total (assert nil))
+ (passed-expected 0)
+ (passed-unexpected 0)
+ (failed-expected 0)
+ (failed-unexpected 0)
+ (error-expected 0)
+ (error-unexpected 0)
+ (start-time (assert nil))
+ (end-time nil)
+ (aborted-p nil)
+ (current-test nil))
+
+;; An entry in the results buffer ewoc. There is one entry per test.
+(defstruct ert-ewoc-entry
+ (test (assert nil))
+ (result nil)
+ ;; If the result of this test was expected, its ewoc entry is hidden
+ ;; initially.
+ (hidden-p (assert nil))
+ ;; An ewoc entry may be collapsed to hide details such as the error
+ ;; condition.
+ ;;
+ ;; I'm not sure the ability to expand and collapse entries is still
+ ;; a useful feature.
+ (expanded-p t)
+ ;; By default, the ewoc entry presents the error condition with
+ ;; certain limits on how much to print (`print-level',
+ ;; `print-length'). The user can interactively switch to a set of
+ ;; higher limits.
+ (extended-printer-limits-p nil))
+
+;; Variables local to the results buffer.
+
+;; The ewoc.
+(defvar ert-results-ewoc)
+;; The stats object.
+(defvar ert-results-stats)
+;; A string with one character per test. Each character represents
+;; the result of the corresponding test. The string is displayed near
+;; the top of the buffer and serves as a progress bar.
+(defvar ert-results-progress-bar-string)
+;; The position where the progress bar button begins.
+(defvar ert-results-progress-bar-button-begin)
+;; The test result listener that updates the buffer when tests are run.
+(defvar ert-results-listener)
+
+;; The same as `ert-results-stats', but dynamically bound. Used for
+;; the mode line progress indicator.
+(defvar ert-current-run-stats nil)
+
+(defun ert-format-time-iso8601 (time)
+ "Format TIME in the particular variant of ISO 8601 used for timestamps in ERT."
+ (format-time-string "%Y-%m-%d %T%z" time))
+
+(defun ert-insert-test-name-button (test-name)
+ (insert-text-button (format "%S" test-name)
+ :type 'ert-test-name-button
+ 'ert-test-name test-name))
+
+(defun ert-results-update-ewoc-hf (ewoc stats)
+ "Update the header and footer of EWOC to show certain information from STATS.
+
+Also sets `ert-results-progress-bar-button-begin'."
+ (let ((run-count (+ (ert-stats-passed-expected stats)
+ (ert-stats-passed-unexpected stats)
+ (ert-stats-failed-expected stats)
+ (ert-stats-failed-unexpected stats)
+ (ert-stats-error-expected stats)
+ (ert-stats-error-unexpected stats)))
+ (results-buffer (current-buffer)))
+ (ewoc-set-hf
+ ewoc
+ ;; header
+ (with-temp-buffer
+ (insert "Selector: ")
+ (ert-insert-human-readable-selector (ert-stats-selector stats))
+ (insert "\n")
+ (insert
+ (format (concat "Passed: %s (%s unexpected)\n"
+ "Failed: %s (%s unexpected)\n"
+ "Error: %s (%s unexpected)\n"
+ "Total: %s/%s\n\n")
+ (+ (ert-stats-passed-expected stats)
+ (ert-stats-passed-unexpected stats))
+ (ert-stats-passed-unexpected stats)
+ (+ (ert-stats-failed-expected stats)
+ (ert-stats-failed-unexpected stats))
+ (ert-stats-failed-unexpected stats)
+ (+ (ert-stats-error-expected stats)
+ (ert-stats-error-unexpected stats))
+ (ert-stats-error-unexpected stats)
+ run-count
+ (ert-stats-total stats)))
+ (insert
+ (format "Started at: %s\n"
+ (ert-format-time-iso8601 (ert-stats-start-time stats))))
+ ;; FIXME: This is ugly. Need to properly define invariants of
+ ;; the `stats' data structure.
+ (let ((state (cond ((ert-stats-aborted-p stats)
+ 'aborted)
+ ((ert-stats-current-test stats)
+ 'running)
+ ((ert-stats-end-time stats)
+ 'finished)
+ (t
+ 'preparing))))
+ (ecase state
+ (preparing
+ (insert ""))
+ (aborted
+ (cond ((ert-stats-current-test stats)
+ (insert "Aborted during test: ")
+ (ert-insert-test-name-button
+ (ert-test-name (ert-stats-current-test stats))))
+ (t
+ (insert "Aborted."))))
+ (running
+ (assert (ert-stats-current-test stats))
+ (insert "Running test: ")
+ (ert-insert-test-name-button (ert-test-name
+ (ert-stats-current-test stats))))
+ (finished
+ (assert (not (ert-stats-current-test stats)))
+ (insert "Finished.")))
+ (insert "\n")
+ (if (ert-stats-end-time stats)
+ (insert
+ (format "%s%s\n"
+ (if (ert-stats-aborted-p stats)
+ "Aborted at: "
+ "Finished at: ")
+ (ert-format-time-iso8601 (ert-stats-end-time stats))))
+ (insert "\n"))
+ (insert "\n"))
+ (let ((progress-bar-string (with-current-buffer results-buffer
+ ert-results-progress-bar-string)))
+ (let ((progress-bar-button-begin
+ (insert-text-button (substring progress-bar-string 0 run-count)
+ :type 'ert-results-progress-bar-button)))
+ (with-current-buffer results-buffer
+ (set (make-local-variable 'ert-results-progress-bar-button-begin)
+ progress-bar-button-begin)))
+ (insert (substring progress-bar-string run-count)))
+ (insert "\n\n")
+ (buffer-string))
+ ;; footer
+ ;;
+ ;; We actually want an empty footer, but that would trigger a bug
+ ;; in ewoc, sometimes clearing the entire buffer.
+ "\n")))
+
+(defun ert-results-update-stats-display (ewoc stats)
+ "Update EWOC and the mode line to show data from STATS."
+ (ert-results-update-ewoc-hf ewoc stats)
+ (force-mode-line-update)
+ (redisplay t))
+
+(defun ert-char-for-test-result (result expectedp)
+ "Return a character that represents the test result RESULT."
+ (let ((char
+ (etypecase result
+ (ert-test-passed ?.)
+ (ert-test-failed ?f)
+ (ert-test-error ?e)
+ (null ?-)
+ (ert-test-aborted-with-non-local-exit ?a))))
+ (if expectedp
+ char
+ (upcase char))))
+
+(defun ert-string-for-test-result (result expectedp)
+ "Return a string that represents the test result RESULT."
+ (etypecase result
+ (ert-test-passed "passed")
+ (ert-test-failed "failed")
+ (ert-test-error "error")
+ (null "unknown")
+ (ert-test-aborted-with-non-local-exit "aborted")))
+
+(defun ert-tests-running-mode-line-indicator ()
+ (let* ((stats ert-current-run-stats)
+ (tests-total (ert-stats-total stats))
+ (tests-completed (+ (ert-stats-passed-expected stats)
+ (ert-stats-passed-unexpected stats)
+ (ert-stats-failed-expected stats)
+ (ert-stats-failed-unexpected stats)
+ (ert-stats-error-expected stats)
+ (ert-stats-error-unexpected stats))))
+ (if (>= tests-completed tests-total)
+ (format " ERT(%s/%s,finished)" tests-completed tests-total)
+ (format " ERT(%s/%s):%s"
+ (1+ tests-completed)
+ tests-total
+ (if (null (ert-stats-current-test stats))
+ "?"
+ (format "%S"
+ (ert-test-name (ert-stats-current-test stats))))))))
+
+(defun ert-pp-with-indentation-and-newline (object)
+ "Pretty-print OBJECT, indenting it to the current column of point.
+Ensures a final newline is inserted."
+ (let ((begin (point)))
+ (pp object (current-buffer))
+ (unless (bolp) (insert "\n"))
+ (save-excursion
+ (goto-char begin)
+ (indent-sexp))))
+
+(defun ert-print-test-for-ewoc (entry)
+ "The ewoc print function for ewoc test entries."
+ (let* ((test (ert-ewoc-entry-test entry))
+ (result (ert-ewoc-entry-result entry))
+ (hiddenp (ert-ewoc-entry-hidden-p entry))
+ (expandedp (ert-ewoc-entry-expanded-p entry))
+ (extended-printer-limits-p (ert-ewoc-entry-extended-printer-limits-p
+ entry)))
+ (cond (hiddenp)
+ (t
+ (insert-text-button (format "%c"
+ (ert-char-for-test-result
+ result
+ (ert-test-result-expected-p test
+ result)))
+ :type 'ert-results-expand-collapse-button)
+ (insert " ")
+ (ert-insert-test-name-button (ert-test-name test))
+ (insert "\n")
+ (when (and expandedp (not (eql result 'nil)))
+ (etypecase result
+ (ert-test-passed
+ (insert " passed\n")
+ (insert ""))
+ (ert-test-result-with-condition
+ (insert " ")
+ (let ((print-escape-newlines t)
+ (print-level (if extended-printer-limits-p 10 5))
+ (print-length (if extended-printer-limits-p 100 10)))
+ (let ((begin (point)))
+ (ert-pp-with-indentation-and-newline
+ (ert-test-result-with-condition-condition result))
+ (save-restriction
+ (narrow-to-region begin (point))
+ ;; Inhibit optimization in `debugger-make-xrefs'
+ ;; that sometimes inserts unrelated backtrace
+ ;; info into our buffer.
+ (let ((debugger-previous-backtrace nil))
+ (debugger-make-xrefs))))))
+ (ert-test-aborted-with-non-local-exit
+ (insert " aborted\n")))
+ (insert "\n")))))
+ nil)
+
+(defun ert-setup-results-buffer (stats listener buffer-name)
+ "Set up a test results buffer."
+ (unless buffer-name (setq buffer-name "*ert*"))
+ (let ((buffer (let ((default-major-mode 'fundamental-mode))
+ (get-buffer-create buffer-name))))
+ (with-current-buffer buffer
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (ert-results-mode)
+ (set (make-local-variable 'ert-results-ewoc)
+ (ewoc-create 'ert-print-test-for-ewoc nil nil t))
+ (set (make-local-variable 'ert-results-stats) stats)
+ (set (make-local-variable 'ert-results-progress-bar-string)
+ (make-string (ert-stats-total stats)
+ (ert-char-for-test-result nil t)))
+ (set (make-local-variable 'ert-results-listener) listener)
+ (ert-results-update-ewoc-hf ert-results-ewoc ert-results-stats)
+ (goto-char (1- (point-max)))
+ buffer))))
+
+(defun ert-run-or-rerun-test (stats test listener)
+ "Run the single test TEST and record the result using STATS and LISTENER."
+ (let ((ert-current-run-stats stats)
+ (pos (ert-stats-test-index stats test))
+ (results (ert-stats-test-results stats))
+ (expected (ert-stats-test-results-expected stats)))
+ ;; Adjust stats to remove previous result.
+ (if (aref expected pos)
+ (etypecase (aref results pos)
+ (ert-test-passed (decf (ert-stats-passed-expected stats)))
+ (ert-test-failed (decf (ert-stats-failed-expected stats)))
+ (ert-test-error (decf (ert-stats-error-expected stats)))
+ (null)
+ (ert-test-aborted-with-non-local-exit))
+ (etypecase (aref results pos)
+ (ert-test-passed (decf (ert-stats-passed-unexpected stats)))
+ (ert-test-failed (decf (ert-stats-failed-unexpected stats)))
+ (ert-test-error (decf (ert-stats-error-unexpected stats)))
+ (null)
+ (ert-test-aborted-with-non-local-exit)))
+ (setf (aref results pos) nil)
+ ;; Call listener after setting/before resetting
+ ;; (ert-stats-current-test stats); the listener might refresh the
+ ;; mode line display, and if the value is not set yet/any more
+ ;; during this refresh, the mode line will flicker unnecessarily.
+ (setf (ert-stats-current-test stats) test)
+ (funcall listener 'test-started stats test)
+ (setf (ert-test-most-recent-result test) nil)
+ (unwind-protect
+ (ert-run-test test)
+ (let* ((result (ert-test-most-recent-result test))
+ (expectedp (typep result (ert-test-expected-result-type test))))
+ ;; Adjust stats to add new result.
+ (if expectedp
+ (etypecase result
+ (ert-test-passed (incf (ert-stats-passed-expected stats)))
+ (ert-test-failed (incf (ert-stats-failed-expected stats)))
+ (ert-test-error (incf (ert-stats-error-expected stats)))
+ (null)
+ (ert-test-aborted-with-non-local-exit))
+ (etypecase result
+ (ert-test-passed (incf (ert-stats-passed-unexpected stats)))
+ (ert-test-failed (incf (ert-stats-failed-unexpected stats)))
+ (ert-test-error (incf (ert-stats-error-unexpected stats)))
+ (null)
+ (ert-test-aborted-with-non-local-exit)))
+ (setf (aref results pos) result
+ (aref expected pos) expectedp)
+ (funcall listener 'test-ended stats test result))
+ (setf (ert-stats-current-test stats) nil))))
+
+(defun ert-run-tests (selector listener)
+ "Run the tests specified by SELECTOR, sending progress updates to LISTENER."
+ (let* ((tests (coerce (ert-select-tests selector t) 'vector))
+ (map (let ((map (make-hash-table :size (length tests))))
+ (loop for i from 0
+ for test across tests
+ for key = (or (ert-test-name test) test) do
+ (assert (not (gethash key map)))
+ (setf (gethash key map) i))
+ map))
+ (stats (make-ert-stats :selector selector
+ :tests tests
+ :test-map map
+ :test-results (make-vector (length tests) nil)
+ :test-results-expected (make-vector
+ (length tests) nil)
+ :total (length tests)
+ :start-time (current-time))))
+ (funcall listener 'run-started stats)
+ (let ((abortedp t))
+ (let ((ert-current-run-stats stats))
+ (force-mode-line-update)
+ (unwind-protect
+ (progn
+ (loop for test across tests do
+ (ert-run-or-rerun-test stats test listener))
+ (setq abortedp nil))
+ (setf (ert-stats-aborted-p stats) abortedp)
+ (setf (ert-stats-end-time stats) (current-time))
+ (funcall listener 'run-ended stats abortedp)))
+ stats)))
+
+(defun ert-stats-test-index (stats test)
+ "Return the index of TEST in the run represented by STATS."
+ (gethash (or (ert-test-name test) test) (ert-stats-test-map stats)))
+
+(defvar ert-selector-history nil
+ "List of recent test selectors read from terminal.")
+
+;; Fix-me: return (regep (list of matches))?
+;; Fix-me: Add prompt parameter?
+(defun ert-read-test-selector ()
+ "Read a regexp for test selection from minibuffer.
+The user can use TAB to see which tests match."
+ (let* ((all-tests
+ (mapcar (lambda (rec) (format "%s" (elt rec 1)))
+ (ert-select-tests "" t))
+ ;;'("ert-group1-1" "ert-group1-2" "ert-other")
+ )
+ regexp
+ ret
+ (get-completions
+ (lambda ()
+ (let* ((ret (save-match-data
+ (mapcar (lambda (alt)
+ (when (string-match regexp alt)
+ alt))
+ all-tests))))
+ (setq ret (delq nil ret))
+ ret))))
+ (setq all-tests (append all-tests
+ '(":new"
+ ":failed" ":passed" ":error"
+ )
+ nil))
+ (let ((mini-map (copy-keymap minibuffer-local-map)))
+ (define-key mini-map [?\t]
+ (lambda () (interactive)
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list
+ (progn
+ (setq regexp (minibuffer-contents))
+ (set-text-properties 0 (length regexp) nil regexp)
+ (funcall get-completions))))))
+ (setq regexp
+ (let* ((sym-here (thing-at-point 'symbol))
+ (test-here (when (and sym-here
+ (memq sym-here all-tests))
+ sym-here))
+ (default (if sym-here
+ (substring-no-properties sym-here)
+ (if ert-selector-history
+ (first ert-selector-history)
+ "t"))))
+ (read-from-minibuffer
+ (if (null default)
+ "Run tests, use TAB to see matches: "
+ (format "Run tests, use TAB to see matches (default %s): "
+ default))
+ nil ;; initial-contents
+ mini-map ;; keymap
+ nil ;; read
+ 'ert-selector-history
+ default nil))))
+ (setq ret regexp)
+ (when (string= "t" ret)
+ (setq ret t))
+ ret))
+
+;; Should OUTPUT-BUFFER-NAME and MESSAGE-FN really be arguments here?
+;; They are needed only for our automated self-tests at the moment.
+;; Or should there be some other mechanism?
+;;;###autoload
+(defun ert-run-tests-interactively (selector
+ &optional output-buffer-name message-fn)
+ "Run the tests specified by SELECTOR and display the results in a buffer."
+ (interactive
+;;; (list (let ((default (if ert-selector-history
+;;; (first ert-selector-history)
+;;; "t")))
+;;; (read-from-minibuffer (if (null default)
+;;; "Run tests: "
+;;; (format "Run tests (default %s): " default))
+;;; ;;nil nil t 'ert-selector-history
+;;; ;;
+;;; ;; fix-me: seems like I am misunderstanding Christians intent here.
+;;; nil nil nil 'ert-selector-history
+;;; default nil))
+;;; nil nil))
+ (list (ert-read-test-selector)
+ nil nil))
+ (unless message-fn (setq message-fn 'message))
+ (lexical-let ((output-buffer-name output-buffer-name)
+ buffer
+ listener
+ (message-fn message-fn))
+ (setq listener
+ (lambda (event-type &rest event-args)
+ (ecase event-type
+ (run-started
+ (destructuring-bind (stats) event-args
+ (setq buffer (ert-setup-results-buffer stats
+ listener
+ output-buffer-name))
+ (pop-to-buffer buffer)))
+ (run-ended
+ (destructuring-bind (stats abortedp) event-args
+ (funcall message-fn
+ "%sRan %s tests, %s results were as expected%s"
+ (if (not abortedp)
+ ""
+ "Aborted: ")
+ (ert-stats-total stats)
+ (+ (ert-stats-passed-expected stats)
+ (ert-stats-failed-expected stats)
+ (ert-stats-error-expected stats))
+ (let ((unexpected
+ (+ (ert-stats-passed-unexpected stats)
+ (ert-stats-failed-unexpected stats)
+ (ert-stats-error-unexpected stats))))
+ (if (zerop unexpected)
+ ""
+ (format ", %s unexpected" unexpected))))
+ (ert-results-update-stats-display (with-current-buffer buffer
+ ert-results-ewoc)
+ stats)))
+ (test-started
+ (destructuring-bind (stats test) event-args
+ (with-current-buffer buffer
+ (let* ((ewoc ert-results-ewoc)
+ (pos (ert-stats-test-index stats test))
+ (node (ewoc-nth ewoc pos)))
+ (unless node
+ ;; FIXME: How expensive is this assertion?
+ (assert (or (zerop pos) (ewoc-nth ewoc (1- pos)))
+ t)
+ (setq node (ewoc-enter-last
+ ewoc
+ (make-ert-ewoc-entry :test test
+ :hidden-p t))))
+ (setf (ert-ewoc-entry-test (ewoc-data node)) test)
+ (setf (ert-ewoc-entry-result (ewoc-data node)) nil)
+ (aset ert-results-progress-bar-string pos
+ (ert-char-for-test-result nil t))
+ (ert-results-update-stats-display ewoc stats)
+ (ewoc-invalidate ewoc node)))))
+ (test-ended
+ (destructuring-bind (stats test result) event-args
+ (with-current-buffer buffer
+ (let* ((ewoc ert-results-ewoc)
+ (pos (ert-stats-test-index stats test))
+ (node (ewoc-nth ewoc pos)))
+ (setf (ert-ewoc-entry-result (ewoc-data node)) result)
+ (when (ert-ewoc-entry-hidden-p (ewoc-data node))
+ (setf (ert-ewoc-entry-hidden-p (ewoc-data node))
+ (ert-test-result-expected-p test result)))
+ (aset ert-results-progress-bar-string pos
+ (ert-char-for-test-result result
+ (ert-test-result-expected-p
+ test result)))
+ (ert-results-update-stats-display ewoc stats)
+ (ewoc-invalidate ewoc node))))))))
+ (ert-run-tests
+ selector
+ listener)))
+
+(defvar ert-batch-backtrace-right-margin 70
+ "*The maximum line length for printing backtraces in `ert-run-tests-batch'.")
+
+(defun ert-run-tests-batch (selector)
+ "Run the tests specified by SELECTOR, printing results to the terminal.
+
+Returns the stats object."
+ (ert-run-tests
+ selector
+ (lambda (event-type &rest event-args)
+ (ecase event-type
+ (run-started
+ (destructuring-bind (stats) event-args
+ (message "Running %s tests (%s)"
+ (length (ert-stats-tests stats))
+ (ert-format-time-iso8601 (ert-stats-start-time stats)))))
+ (run-ended
+ (destructuring-bind (stats abortedp) event-args
+ (let ((unexpected (+ (ert-stats-passed-unexpected stats)
+ (ert-stats-failed-unexpected stats)
+ (ert-stats-error-unexpected stats))))
+ (message "\n%sRan %s tests, %s results were as expected%s (%s)\n"
+ (if (not abortedp)
+ ""
+ "Aborted: ")
+ (ert-stats-total stats)
+ (+ (ert-stats-passed-expected stats)
+ (ert-stats-failed-expected stats)
+ (ert-stats-error-expected stats))
+ (if (zerop unexpected)
+ ""
+ (format ", %s unexpected" unexpected))
+ (ert-format-time-iso8601 (ert-stats-end-time stats)))
+ (unless (zerop unexpected)
+ (message "%s unexpected results:" unexpected)
+ (loop for test across (ert-stats-tests stats)
+ for result = (ert-test-most-recent-result test) do
+ (when (not (ert-test-result-expected-p test result))
+ (message "%9s %S"
+ (ert-string-for-test-result result nil)
+ (ert-test-name test))))
+ (message "%s" "")))))
+ (test-started
+ )
+ (test-ended
+ (destructuring-bind (stats test result) event-args
+ (etypecase result
+ (ert-test-passed)
+ (ert-test-result-with-condition
+ (message "Test %S backtrace:" (ert-test-name test))
+ (with-temp-buffer
+ (ert-print-backtrace (ert-test-result-with-condition-backtrace result))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((start (point))
+ (end (progn (end-of-line) (point))))
+ (setq end (min end
+ (+ start ert-batch-backtrace-right-margin)))
+ (message "%s" (buffer-substring-no-properties
+ start end)))
+ (forward-line 1)))
+ (with-temp-buffer
+ (insert " ")
+ (let ((print-escape-newlines t)
+ (print-level 5)
+ (print-length 10))
+ (let ((begin (point)))
+ (ert-pp-with-indentation-and-newline
+ (ert-test-result-with-condition-condition result))))
+ (goto-char (1- (point-max)))
+ (assert (looking-at "\n"))
+ (delete-char 1)
+ (message "Test %S condition:" (ert-test-name test))
+ (message "%s" (buffer-string))))
+ (ert-test-aborted-with-non-local-exit))
+ (let* ((max (prin1-to-string (length (ert-stats-tests stats))))
+ (format-string (concat "%9s %"
+ (prin1-to-string (length max))
+ "s/" max " %S")))
+ (message format-string
+ (ert-string-for-test-result result
+ (ert-test-result-expected-p
+ test result))
+ (1+ (ert-stats-test-index stats test))
+ (ert-test-name test)))))))))
+
+
+;;; Commands and button actions for the results buffer.
+
+(define-derived-mode ert-results-mode fundamental-mode "ERT-Results"
+ "Major mode for viewing results of ERT test runs.")
+
+(loop for (key binding) in
+ '(("j" ert-results-jump-between-summary-and-result)
+ ("." ert-results-find-test-at-point-other-window)
+ ("r" ert-results-rerun-test-at-point)
+ ("d" ert-results-rerun-test-at-point-debugging-errors)
+ ("b" ert-results-pop-to-backtrace-for-test-at-point)
+ ("m" ert-results-pop-to-messages-for-test-at-point)
+ ("p" ert-results-toggle-printer-limits-for-test-at-point)
+ ("D" ert-delete-test)
+ ([?\t] forward-button)
+ ([backtab] backward-button)
+ )
+ do
+ (define-key ert-results-mode-map key binding))
+
+(define-button-type 'ert-results-progress-bar-button
+ 'action #'ert-results-progress-bar-button-action
+ 'help-echo "mouse-2, RET: Reveal test result")
+
+(define-button-type 'ert-test-name-button
+ 'action #'ert-test-name-button-action
+ 'help-echo "mouse-2, RET: Find test definition")
+
+(define-button-type 'ert-results-expand-collapse-button
+ 'action #'ert-results-expand-collapse-button-action
+ 'help-echo "mouse-2, RET: Expand/collapse test result")
+
+(defun ert-results-test-node-or-null-at-point ()
+ "If point is on a valid ewoc node, return it; return nil otherwise.
+
+To be used in the ERT results buffer."
+ (let* ((ewoc ert-results-ewoc)
+ (node (ewoc-locate ewoc)))
+ ;; `ewoc-locate' will return an arbitrary node when point is on
+ ;; header or footer, or when all nodes are invisible. So we need
+ ;; to validate its return value here.
+ (if (and (>= (point) (ewoc-location node))
+ (not (ert-ewoc-entry-hidden-p (ewoc-data node))))
+ node
+ nil)))
+
+(defun ert-results-test-node-at-point ()
+ "If point is on a valid ewoc node, return it; signal an error otherwise.
+
+To be used in the ERT results buffer."
+ (or (ert-results-test-node-or-null-at-point)
+ (error "No test at point")))
+
+(defun ert-results-expand-collapse-button-action (button)
+ "Expand or collapse the test node BUTTON belongs to."
+ (let* ((ewoc ert-results-ewoc)
+ (node (save-excursion
+ (goto-char (ert-button-action-position))
+ (ert-results-test-node-at-point)))
+ (entry (ewoc-data node)))
+ (setf (ert-ewoc-entry-expanded-p entry)
+ (not (ert-ewoc-entry-expanded-p entry)))
+ (ewoc-invalidate ewoc node)))
+
+(defun ert-results-find-test-at-point-other-window ()
+ "Find the definition of the test at point in another window.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((node (ert-results-test-node-at-point))
+ (entry (ewoc-data node))
+ (test (ert-ewoc-entry-test entry))
+ (name (ert-test-name test)))
+ (ert-find-test-other-window name)))
+
+(defun ert-test-name-button-action (button)
+ "Find the definition of the test BUTTON belongs to, in another window."
+ (let ((name (button-get button 'ert-test-name)))
+ (ert-find-test-other-window name)))
+
+(defun ert-ewoc-position (ewoc node)
+ "Return the position of NODE in EWOC, or nil if NODE is not in EWOC."
+ (loop for i from 0
+ for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here)
+ do (when (eql node node-here)
+ (return i))
+ finally (return nil)))
+
+(defun ert-results-jump-between-summary-and-result ()
+ "Jump back and forth between the test run summary and individual test results.
+
+From an ewoc node, jumps to the character that represents the
+same test in the progress bar, and vice versa.
+
+To be used in the ERT results buffer."
+ ;; Maybe this command isn't actually needed much, but if it is, it
+ ;; seems like an indication that the UI design is not optimal. If
+ ;; jumping back and forth between a summary at the top of the buffer
+ ;; and the error log in the remainder of the buffer is useful, then
+ ;; the summary apparently needs to be easily accessible from the
+ ;; error log, and perhaps it would be better to have it in a
+ ;; separate buffer to keep it visible.
+ (interactive)
+ (let ((ewoc ert-results-ewoc)
+ (progress-bar-begin ert-results-progress-bar-button-begin))
+ (cond ((ert-results-test-node-or-null-at-point)
+ (let* ((node (ert-results-test-node-at-point))
+ (pos (ert-ewoc-position ewoc node)))
+ (goto-char (+ progress-bar-begin pos))))
+ ((and (<= progress-bar-begin (point))
+ (< (point) (button-end (button-at progress-bar-begin))))
+ (let* ((node (ewoc-nth ewoc (- (point) progress-bar-begin)))
+ (entry (ewoc-data node)))
+ (when (ert-ewoc-entry-hidden-p entry)
+ (setf (ert-ewoc-entry-hidden-p entry) nil)
+ (ewoc-invalidate ewoc node))
+ (ewoc-goto-node ewoc node)))
+ (t
+ (goto-char progress-bar-begin)))))
+
+(defun ert-button-action-position ()
+ "The buffer position where the last button action was triggered."
+ (cond ((integerp last-command-event)
+ (point))
+ ((eventp last-command-event)
+ (posn-point (event-start last-command-event)))
+ (t (assert nil))))
+
+(defun ert-results-progress-bar-button-action (button)
+ "Find the ewoc node that represents the same test as the character clicked on."
+ (goto-char (ert-button-action-position))
+ (ert-results-jump-between-summary-and-result))
+
+(defun ert-results-rerun-test-at-point ()
+ "Re-run the test at point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((ewoc ert-results-ewoc)
+ (node (ert-results-test-node-at-point))
+ (entry (ewoc-data node))
+ (old-test (ert-ewoc-entry-test entry))
+ (test-name (ert-test-name old-test))
+ ;; FIXME: Write a test for this lookup.
+ (test (if test-name
+ (if (ert-test-boundp test-name)
+ (ert-get-test test-name)
+ (error "No such test: %S" test-name))
+ old-test))
+ (stats ert-results-stats)
+ (pos (gethash test (ert-stats-test-map stats)))
+ (progress-message (format "Running test %S" (ert-test-name test))))
+ ;; Need to save and restore point manually here: When point is on
+ ;; the first visible ewoc entry while the header is updated, point
+ ;; moves to the top of the buffer. This is undesirable, and a
+ ;; simple `save-excursion' doesn't prevent it.
+ (let ((point (point)))
+ (unwind-protect
+ (unwind-protect
+ (progn
+ (message "%s..." progress-message)
+ (ert-run-or-rerun-test stats test
+ ert-results-listener))
+ (ert-results-update-stats-display ewoc stats)
+ (message "%s...%s"
+ progress-message
+ (let ((result (ert-test-most-recent-result test)))
+ (ert-string-for-test-result
+ result (ert-test-result-expected-p test result)))))
+ (goto-char point)))))
+
+(defun ert-results-rerun-test-at-point-debugging-errors ()
+ "Re-run the test at point with `ert-debug-on-error' bound to t.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let ((ert-debug-on-error t))
+ (ert-results-rerun-test-at-point)))
+
+(defun ert-print-backtrace (backtrace)
+ "Format the backtrace BACKTRACE to the current buffer."
+ ;; This is essentially a reimplementation of Fbacktrace
+ ;; (src/eval.c), but for a saved backtrace, not the current one.
+ (let ((print-escape-newlines t)
+ (print-level 8)
+ (print-length 50))
+ (dolist (frame backtrace)
+ (ecase (first frame)
+ ((nil)
+ ;; Special operator.
+ (destructuring-bind (special-operator &rest arg-forms)
+ (cdr frame)
+ (insert
+ (format " %S\n" (list* special-operator arg-forms)))))
+ ((t)
+ ;; Function call.
+ (destructuring-bind (fn &rest args) (cdr frame)
+ (insert (format " %S(" fn))
+ (loop for firstp = t then nil
+ for arg in args do
+ (unless firstp
+ (insert " "))
+ (insert (format "%S" arg)))
+ (insert ")\n")))))))
+
+(defun ert-results-pop-to-backtrace-for-test-at-point ()
+ "Display the backtrace for the test at point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((node (ert-results-test-node-at-point))
+ (entry (ewoc-data node))
+ (test (ert-ewoc-entry-test entry))
+ (result (ert-ewoc-entry-result entry)))
+ (etypecase result
+ (ert-test-passed (error "Test passed, no backtrace available"))
+ (ert-test-result-with-condition
+ (let ((backtrace (ert-test-result-with-condition-backtrace result))
+ (buffer
+ (let ((default-major-mode 'fundamental-mode))
+ (get-buffer-create "*ERT Backtrace*"))))
+ (pop-to-buffer buffer)
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ ;; Use unibyte because `debugger-setup-buffer' also does so.
+ (set-buffer-multibyte nil)
+ (setq truncate-lines t)
+ (ert-print-backtrace backtrace)
+ (debugger-make-xrefs)
+ (goto-char (point-min))))))))
+
+(defun ert-results-pop-to-messages-for-test-at-point ()
+ "Display the part of the *Messages* buffer generated during the test at point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((node (ert-results-test-node-at-point))
+ (entry (ewoc-data node))
+ (test (ert-ewoc-entry-test entry))
+ (result (ert-ewoc-entry-result entry)))
+ (let ((buffer
+ (let ((default-major-mode 'fundamental-mode))
+ (get-buffer-create "*ERT Messages*"))))
+ (pop-to-buffer buffer)
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (ert-test-result-messages result))
+ (goto-char (point-min))
+ (insert "Messages for test `")
+ (ert-insert-test-name-button (ert-test-name test))
+ (insert "':\n")))))
+
+(defun ert-results-toggle-printer-limits-for-test-at-point ()
+ "Toggle how much of the condition to print for the test at point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((ewoc ert-results-ewoc)
+ (node (ert-results-test-node-at-point))
+ (entry (ewoc-data node)))
+ (setf (ert-ewoc-entry-extended-printer-limits-p entry)
+ (not (ert-ewoc-entry-extended-printer-limits-p entry)))
+ (ewoc-invalidate ewoc node)))
+
+(defun ert-activate-font-lock-keywords ()
+ (font-lock-add-keywords
+ nil
+ '(("(\\(\\<ert-deftest\\)\\>\\s *\\(\\sw+\\)?"
+ (1 font-lock-keyword-face nil t)
+ (2 font-lock-function-name-face nil t)))))
+
+(defun* ert-remove-from-list (list-var element &key key test)
+ "Remove ELEMENT from the value of LIST-VAR if present.
+
+This is an inverse of `add-to-list'."
+ (unless key (setq key #'identity))
+ (unless test (setq test #'equal))
+ (setf (symbol-value list-var)
+ (remove* element
+ (symbol-value list-var)
+ :key key
+ :test test)))
+
+
+;;; Actions on load/unload.
+
+(add-to-list 'find-function-regexp-alist '(ert-deftest . ert-find-test-regexp))
+(add-to-list 'minor-mode-alist '(ert-current-run-stats
+ (:eval
+ (ert-tests-running-mode-line-indicator))))
+(add-to-list 'emacs-lisp-mode-hook 'ert-activate-font-lock-keywords)
+
+(defun ert-unload-function ()
+ (ert-remove-from-list 'find-function-regexp-alist 'ert-deftest :key #'car)
+ (ert-remove-from-list 'minor-mode-alist 'ert-current-run-stats :key #'car)
+ (ert-remove-from-list 'emacs-lisp-mode-hook 'ert-activate-font-lock-keywords)
+ nil)
+
+(defvar ert-unload-hook '())
+(add-hook 'ert-unload-hook 'ert-unload-function)
+
+
+;;; Self-tests.
+
+(ert-delete-all-tests)
+
+;; Test that test bodies are actually run.
+(defvar ert-test-body-was-run)
+(ert-deftest ert-test-body-runs ()
+ (setq ert-test-body-was-run t))
+
+
+;; Test that nested test bodies run.
+(ert-deftest ert-nested-test-body-runs ()
+ (lexical-let ((was-run nil))
+ (let ((test (make-ert-test :body (lambda ()
+ (setq was-run t)))))
+ (assert (not was-run))
+ (ert-run-test test)
+ (assert was-run))))
+
+
+;; Test that pass/fail works.
+(ert-deftest ert-test-pass ()
+ (let ((test (make-ert-test :body (lambda ()))))
+ (let ((result (ert-run-test test)))
+ (assert (typep result 'ert-test-passed)))))
+
+(ert-deftest ert-test-fail ()
+ (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
+ (let ((result (let ((ert-debug-on-error nil))
+ (ert-run-test test))))
+ (assert (typep result 'ert-test-failed) t)
+ (assert (equal (ert-test-result-with-condition-condition result)
+ '(ert-test-failed "failure message"))
+ t))))
+
+(ert-deftest ert-test-fail-debug-with-condition-case ()
+ (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
+ (condition-case condition
+ (progn
+ (let ((ert-debug-on-error t))
+ (ert-run-test test))
+ (assert nil))
+ ((error)
+ (assert (equal condition '(ert-test-failed "failure message")) t)))))
+
+(ert-deftest ert-test-fail-debug-with-debugger-1 ()
+ (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
+ (let ((debugger (lambda (&rest debugger-args)
+ (assert nil))))
+ (let ((ert-debug-on-error nil))
+ (ert-run-test test)))))
+
+(ert-deftest ert-test-fail-debug-with-debugger-2 ()
+ (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
+ (block nil
+ (let ((debugger (lambda (&rest debugger-args)
+ (return-from nil nil))))
+ (let ((ert-debug-on-error t))
+ (ert-run-test test))
+ (assert nil)))))
+
+(ert-deftest ert-test-fail-debug-nested-with-debugger ()
+ (let ((test (make-ert-test :body (lambda ()
+ (let ((ert-debug-on-error t))
+ (ert-fail "failure message"))))))
+ (let ((debugger (lambda (&rest debugger-args)
+ (assert nil nil "Assertion a"))))
+ (let ((ert-debug-on-error nil))
+ (ert-run-test test))))
+ (let ((test (make-ert-test :body (lambda ()
+ (let ((ert-debug-on-error nil))
+ (ert-fail "failure message"))))))
+ (block nil
+ (let ((debugger (lambda (&rest debugger-args)
+ (return-from nil nil))))
+ (let ((ert-debug-on-error t))
+ (ert-run-test test))
+ (assert nil nil "Assertion b")))))
+
+(ert-deftest ert-test-error ()
+ (let ((test (make-ert-test :body (lambda () (error "error message")))))
+ (let ((result (let ((ert-debug-on-error nil))
+ (ert-run-test test))))
+ (assert (typep result 'ert-test-error) t)
+ (assert (equal (ert-test-result-with-condition-condition result)
+ '(error "error message"))
+ t))))
+
+(ert-deftest ert-test-error-debug ()
+ (let ((test (make-ert-test :body (lambda () (error "error message")))))
+ (condition-case condition
+ (progn
+ (let ((ert-debug-on-error t))
+ (ert-run-test test))
+ (assert nil))
+ ((error)
+ (assert (equal condition '(error "error message")) t)))))
+
+
+;; Test that `should' works.
+(ert-deftest ert-test-should ()
+ (let ((test (make-ert-test :body (lambda () (ert-should nil)))))
+ (let ((result (let ((ert-debug-on-error nil))
+ (ert-run-test test))))
+ (assert (typep result 'ert-test-failed) t)
+ (assert (equal (ert-test-result-with-condition-condition result)
+ '(ert-test-failed ((ert-should nil) :form nil :value nil)))
+ t)))
+ (let ((test (make-ert-test :body (lambda () (ert-should t)))))
+ (let ((result (ert-run-test test)))
+ (assert (typep result 'ert-test-passed) t))))
+
+(ert-deftest ert-test-should-value ()
+ (ert-should (eql (ert-should 'foo) 'foo))
+ (ert-should (eql (ert-should 'bar) 'bar)))
+
+(ert-deftest ert-test-should-not ()
+ (let ((test (make-ert-test :body (lambda () (ert-should-not t)))))
+ (let ((result (let ((ert-debug-on-error nil))
+ (ert-run-test test))))
+ (assert (typep result 'ert-test-failed) t)
+ (assert (equal (ert-test-result-with-condition-condition result)
+ '(ert-test-failed ((ert-should-not t) :form t :value t)))
+ t)))
+ (let ((test (make-ert-test :body (lambda () (ert-should-not nil)))))
+ (let ((result (ert-run-test test)))
+ (assert (typep result 'ert-test-passed)))))
+
+
+(ert-deftest ert-test-should-error ()
+ ;; No error.
+ (let ((test (make-ert-test :body (lambda () (ert-should-error (progn))))))
+ (let ((result (let ((ert-debug-on-error nil))
+ (ert-run-test test))))
+ (ert-should (typep result 'ert-test-failed))
+ (ert-should (equal (ert-test-result-with-condition-condition result)
+ '(ert-test-failed
+ ((ert-should-error (progn))
+ :form (progn)
+ :value nil
+ :fail-reason "did not signal an error"))))))
+ ;; A simple error.
+ (let ((test (make-ert-test :body (lambda () (ert-should-error (error "foo"))))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-passed))))
+ ;; Error of unexpected type, no test.
+ (let ((test (make-ert-test :body (lambda ()
+ (ert-should-error (error "foo")
+ :type 'singularity-error)))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-failed))
+ (ert-should (equal
+ (ert-test-result-with-condition-condition result)
+ '(ert-test-failed
+ ((ert-should-error (error "foo") :type 'singularity-error)
+ :form (error "foo")
+ :condition (error "foo")
+ :fail-reason
+ "the error signalled did not have the expected type"))))))
+ ;; Error of the expected type, no test.
+ (let ((test (make-ert-test :body (lambda ()
+ (ert-should-error (signal 'singularity-error
+ nil)
+ :type 'singularity-error)))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-passed))))
+ ;; Error that fails the test, no type.
+ (let ((test (make-ert-test :body (lambda ()
+ (ert-should-error
+ (error "foo")
+ :test (lambda (error) nil))))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-failed))
+ (ert-should (equal (ert-test-result-with-condition-condition result)
+ '(ert-test-failed
+ ((ert-should-error (error "foo") :test (lambda (error) nil))
+ :form (error "foo")
+ :condition (error "foo")
+ :fail-reason
+ "the error signalled did not pass the test"))))))
+ ;; Error that passes the test, no type.
+ (let ((test (make-ert-test :body (lambda ()
+ (ert-should-error (error "foo")
+ :test (lambda (error) t))))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-passed))))
+ ;; Error that has the expected type but fails the test.
+ (let ((test (make-ert-test :body (lambda ()
+ (ert-should-error
+ (signal 'singularity-error nil)
+ :type 'singularity-error
+ :test (lambda (error) nil))))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-failed))
+ (ert-should (equal (ert-test-result-with-condition-condition result)
+ '(ert-test-failed
+ ((ert-should-error (signal 'singularity-error nil)
+ :type 'singularity-error
+ :test (lambda (error) nil))
+ :form (signal singularity-error nil)
+ :condition (singularity-error)
+ :fail-reason
+ "the error signalled did not pass the test"))))))
+ ;; Error that has the expected type and passes the test.
+ (let ((test (make-ert-test :body (lambda ()
+ (ert-should-error
+ (signal 'singularity-error nil)
+ :type 'singularity-error
+ :test (lambda (error) t))))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-passed))))
+ )
+
+(ert-deftest ert-test-should-error-subtypes ()
+ (let ((test (make-ert-test
+ :body (lambda ()
+ (ert-should-error (signal 'singularity-error nil)
+ :type 'singularity-error
+ :exclude-subtypes t)))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-passed))))
+ (let ((test (make-ert-test
+ :body (lambda ()
+ (ert-should-error (signal 'arith-error nil)
+ :type 'singularity-error)))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-failed))
+ (ert-should (equal
+ (ert-test-result-with-condition-condition result)
+ '(ert-test-failed
+ ((ert-should-error (signal 'arith-error nil)
+ :type 'singularity-error)
+ :form (signal arith-error nil)
+ :condition (arith-error)
+ :fail-reason
+ "the error signalled did not have the expected type"))))))
+ (let ((test (make-ert-test
+ :body (lambda ()
+ (ert-should-error (signal 'arith-error nil)
+ :type 'singularity-error
+ :exclude-subtypes t)))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-failed))
+ (ert-should (equal
+ (ert-test-result-with-condition-condition result)
+ '(ert-test-failed
+ ((ert-should-error (signal 'arith-error nil)
+ :type 'singularity-error
+ :exclude-subtypes t)
+ :form (signal arith-error nil)
+ :condition (arith-error)
+ :fail-reason
+ "the error signalled did not have the expected type"))))))
+ (let ((test (make-ert-test
+ :body (lambda ()
+ (ert-should-error (signal 'singularity-error nil)
+ :type 'arith-error
+ :exclude-subtypes t)))))
+ (let ((result (ert-run-test test)))
+ (ert-should (typep result 'ert-test-failed))
+ (ert-should (equal
+ (ert-test-result-with-condition-condition result)
+ '(ert-test-failed
+ ((ert-should-error (signal 'singularity-error nil)
+ :type 'arith-error
+ :exclude-subtypes t)
+ :form (signal singularity-error nil)
+ :condition (singularity-error)
+ :fail-reason
+ "the error signalled was a subtype of the expected type"))))))
+ )
+
+;; Test that `should' errors contain the information we expect them to.
+(defmacro ert-test-my-list (&rest args)
+ `(list ,@args))
+
+(ert-deftest ert-test-should-failure-debugging ()
+ (loop for (body expected-condition) in
+ `((,(lambda () (let ((x nil)) (ert-should x)))
+ (ert-test-failed ((ert-should x) :form x :value nil)))
+ (,(lambda () (let ((x t)) (ert-should-not x)))
+ (ert-test-failed ((ert-should-not x) :form x :value t)))
+ (,(lambda () (let ((x t)) (ert-should (not x))))
+ (ert-test-failed ((ert-should (not x)) :form (not t) :value nil)))
+ (,(lambda () (let ((x nil)) (ert-should-not (not x))))
+ (ert-test-failed ((ert-should-not (not x)) :form (not nil) :value t)))
+ (,(lambda () (let ((x t) (y nil)) (ert-should-not (ert-test-my-list x y))))
+ (ert-test-failed
+ ((ert-should-not (ert-test-my-list x y))
+ :form (list t nil)
+ :value (t nil))))
+ (,(lambda () (let ((x t)) (ert-should (error "foo"))))
+ (error "foo")))
+ do
+ (let ((test (make-ert-test :body body)))
+ (condition-case actual-condition
+ (progn
+ (let ((ert-debug-on-error t))
+ (ert-run-test test))
+ (assert nil))
+ ((error)
+ (ert-should (equal actual-condition expected-condition)))))))
+
+(ert-deftest ert-test-messages ()
+ (let* ((message-string "Test message")
+ (messages-buffer (get-buffer-create "*Messages*"))
+ (test (make-ert-test :body (lambda () (message "%s" message-string)))))
+ (with-current-buffer messages-buffer
+ (let ((result (ert-run-test test)))
+ (ert-should (equal (concat message-string "\n")
+ (ert-test-result-messages result)))))))
+
+(defun ert-call-with-temporary-messages-buffer (thunk)
+ (lexical-let ((new-buffer-name (generate-new-buffer-name
+ "*Messages* orig buffer")))
+ (unwind-protect
+ (progn
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (rename-buffer new-buffer-name))
+ (get-buffer-create "*Messages*")
+ (funcall thunk))
+ (kill-buffer "*Messages*")
+ (with-current-buffer new-buffer-name
+ (rename-buffer "*Messages*")))))
+
+(ert-deftest ert-test-messages-on-log-truncation ()
+ (let ((test (make-ert-test
+ :body (lambda ()
+ ;; Emacs would combine messages if we
+ ;; generate the same message multiple
+ ;; times.
+ (message "a")
+ (message "b")
+ (message "c")
+ (message "d")))))
+ (let (result)
+ (ert-call-with-temporary-messages-buffer
+ (lambda ()
+ (let ((message-log-max 2))
+ (setq result (ert-run-test test)))
+ (ert-should (equal (with-current-buffer "*Messages*"
+ (buffer-string))
+ "c\nd\n"))))
+ (ert-should (equal (ert-test-result-messages result) "a\nb\nc\nd\n")))))
+
+;; Test `ert-select-tests'.
+(ert-deftest ert-test-select-regexp ()
+ (ert-should (equal (ert-select-tests "^ert-test-select-regexp$" t)
+ (list (ert-get-test 'ert-test-select-regexp)))))
+
+(ert-deftest ert-test-test-boundp ()
+ (ert-should (ert-test-boundp 'ert-test-test-boundp))
+ (ert-should-not (ert-test-boundp (make-symbol "ert-not-a-test"))))
+
+(ert-deftest ert-test-select-member ()
+ (ert-should (equal (ert-select-tests '(member ert-test-select-member) t)
+ (list (ert-get-test 'ert-test-select-member)))))
+
+(ert-deftest ert-test-select-test ()
+ (ert-should (equal (ert-select-tests (ert-get-test 'ert-test-select-test) t)
+ (list (ert-get-test 'ert-test-select-test)))))
+
+(ert-deftest ert-test-select-symbol ()
+ (ert-should (equal (ert-select-tests 'ert-test-select-symbol t)
+ (list (ert-get-test 'ert-test-select-symbol)))))
+
+(ert-deftest ert-test-select-and ()
+ (let ((test (make-ert-test
+ :name nil
+ :body nil
+ :most-recent-result (make-ert-test-failed
+ :condition nil
+ :backtrace nil))))
+ (ert-should (equal (ert-select-tests `(and (member ,test) :failed) t)
+ (list test)))))
+
+
+;; Test utility functions.
+(ert-deftest ert-proper-list-p ()
+ (ert-should (ert-proper-list-p '()))
+ (ert-should (ert-proper-list-p '(1)))
+ (ert-should (ert-proper-list-p '(1 2)))
+ (ert-should (ert-proper-list-p '(1 2 3)))
+ (ert-should (ert-proper-list-p '(1 2 3 4)))
+ (ert-should (not (ert-proper-list-p 'a)))
+ (ert-should (not (ert-proper-list-p '(1 . a))))
+ (ert-should (not (ert-proper-list-p '(1 2 . a))))
+ (ert-should (not (ert-proper-list-p '(1 2 3 . a))))
+ (ert-should (not (ert-proper-list-p '(1 2 3 4 . a))))
+ (let ((a (list 1)))
+ (setf (cdr (last a)) a)
+ (ert-should (not (ert-proper-list-p a))))
+ (let ((a (list 1 2)))
+ (setf (cdr (last a)) a)
+ (ert-should (not (ert-proper-list-p a))))
+ (let ((a (list 1 2 3)))
+ (setf (cdr (last a)) a)
+ (ert-should (not (ert-proper-list-p a))))
+ (let ((a (list 1 2 3 4)))
+ (setf (cdr (last a)) a)
+ (ert-should (not (ert-proper-list-p a))))
+ (let ((a (list 1 2)))
+ (setf (cdr (last a)) (cdr a))
+ (ert-should (not (ert-proper-list-p a))))
+ (let ((a (list 1 2 3)))
+ (setf (cdr (last a)) (cdr a))
+ (ert-should (not (ert-proper-list-p a))))
+ (let ((a (list 1 2 3 4)))
+ (setf (cdr (last a)) (cdr a))
+ (ert-should (not (ert-proper-list-p a))))
+ (let ((a (list 1 2 3)))
+ (setf (cdr (last a)) (cddr a))
+ (ert-should (not (ert-proper-list-p a))))
+ (let ((a (list 1 2 3 4)))
+ (setf (cdr (last a)) (cddr a))
+ (ert-should (not (ert-proper-list-p a))))
+ (let ((a (list 1 2 3 4)))
+ (setf (cdr (last a)) (cdddr a))
+ (ert-should (not (ert-proper-list-p a)))))
+
+(ert-deftest ert-parse-keys-and-body ()
+ (ert-should (equal (ert-parse-keys-and-body "doc" '(foo))
+ '(nil "doc" (foo))))
+ (ert-should (equal (ert-parse-keys-and-body "doc" '(:bar foo))
+ '((:bar foo) "doc" nil)))
+ (ert-should (equal (ert-parse-keys-and-body nil '(:bar foo))
+ '((:bar foo) nil nil)))
+ (ert-should (equal (ert-parse-keys-and-body "doc" '(:bar foo))
+ '((:bar foo) "doc" nil)))
+ (ert-should (equal (ert-parse-keys-and-body nil '(:bar foo a (b)))
+ '((:bar foo) nil (a (b)))))
+ (ert-should (equal (ert-parse-keys-and-body nil '(:bar foo :a (b)))
+ '((:bar foo :a (b)) nil nil)))
+ (ert-should (equal (ert-parse-keys-and-body nil '(bar foo :a (b)))
+ '(nil nil (bar foo :a (b)))))
+ (ert-should-error (ert-parse-keys-and-body nil '(:bar foo :a))))
+
+
+
+;; Test `ert-run-tests'.
+(ert-deftest ert-test-run-tests ()
+ (let ((passing-test (make-ert-test :name 'passing-test
+ :body (lambda () (ert-pass))))
+ (failing-test (make-ert-test :name 'failing-test
+ :body (lambda () (ert-fail
+ "failure message"))))
+ )
+ (let ((ert-debug-on-error nil))
+ (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*"))
+ (messages nil)
+ (mock-message-fn
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (save-window-excursion
+ (unwind-protect
+ (let ((case-fold-search nil))
+ (ert-run-tests-interactively
+ `(member ,passing-test ,failing-test) buffer-name
+ mock-message-fn)
+ (ert-should (equal messages `(,(concat
+ "Ran 2 tests, 1 results were "
+ "as expected, 1 unexpected"))))
+ (with-current-buffer buffer-name
+ (goto-char (point-min))
+ (ert-should (equal
+ (buffer-substring (point-min)
+ (save-excursion
+ (forward-line 5)
+ (point)))
+ (concat
+ "Selector: (member <passing-test> <failing-test>)\n"
+ "Passed: 1 (0 unexpected)\n"
+ "Failed: 1 (1 unexpected)\n"
+ "Error: 0 (0 unexpected)\n"
+ "Total: 2/2\n")))))
+ (when (get-buffer buffer-name)
+ (kill-buffer buffer-name))))))))
+
+(ert-deftest ert-test-special-operator-p ()
+ (ert-should (ert-special-operator-p 'if))
+ (ert-should-not (ert-special-operator-p 'car))
+ (ert-should-not (ert-special-operator-p 'ert-special-operator-p))
+ (let ((b (gensym)))
+ (ert-should-not (ert-special-operator-p b))
+ (fset b 'if)
+ (ert-should (ert-special-operator-p b))))
+
+;; This test attempts to demonstrate that there is no way to force
+;; immediate truncation of the *Messages* buffer from Lisp (and hence
+;; justifies the existence of
+;; `ert-force-message-log-buffer-truncation'): The only way that came
+;; to my mind was (message ""), which doesn't have the desired effect.
+(ert-deftest ert-test-builtin-message-log-flushing ()
+ (ert-call-with-temporary-messages-buffer
+ (lambda ()
+ (with-current-buffer "*Messages*"
+ (let ((message-log-max 2))
+ (let ((message-log-max t))
+ (loop for i below 4 do
+ (message "%s" i))
+ (ert-should (eql (count-lines (point-min) (point-max)) 4)))
+ (ert-should (eql (count-lines (point-min) (point-max)) 4))
+ (message "")
+ (ert-should (eql (count-lines (point-min) (point-max)) 4))
+ (message "Test message")
+ (ert-should (eql (count-lines (point-min) (point-max)) 2)))))))
+
+(ert-deftest ert-test-force-message-log-buffer-truncation ()
+ (labels ((body ()
+ (loop for i below 5 do
+ (message "%s" i)))
+ (c (x)
+ (ert-call-with-temporary-messages-buffer
+ (lambda ()
+ (let ((message-log-max x))
+ (body))
+ (with-current-buffer "*Messages*"
+ (buffer-string)))))
+ (lisp (x)
+ (ert-call-with-temporary-messages-buffer
+ (lambda ()
+ (let ((message-log-max t))
+ (body))
+ (let ((message-log-max x))
+ (ert-force-message-log-buffer-truncation))
+ (with-current-buffer "*Messages*"
+ (buffer-string))))))
+ (loop for x in '(0 1 2 3 4 5 6 t) do
+ (ert-should (equal (c x) (lisp x))))))
+
+(defun ert-run-self-tests ()
+ ;; Run tests and make sure they actually ran.
+ (let ((window-configuration (current-window-configuration)))
+ (let ((ert-test-body-was-run nil))
+ ;; The buffer name chosen here should not compete with the default
+ ;; results buffer name for completion in `switch-to-buffer'.
+ (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*")))
+ (assert ert-test-body-was-run)
+ (when (zerop (+ (ert-stats-passed-unexpected stats)
+ (ert-stats-failed-unexpected stats)
+ (ert-stats-error-unexpected stats)))
+ ;; Hide results window only when everything went well.
+ (set-window-configuration window-configuration))))))
+
+(provide 'ert)
+
+;;; ert.el ends here
--- /dev/null
+;;; ert2.el --- Additions to ert.el
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-09-02T11:46:03+0200 Tue
+;; Version:
+;; Last-Updated: 2009-01-06 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; Cannot open load file: ert2.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile
+ (let* ((this-file (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+ (this-dir (file-name-directory this-file))
+ (load-path (cons this-dir load-path)))
+ (require 'ert)))
+
+(let* ((this-dir
+ (file-name-directory (if load-file-name load-file-name buffer-file-name)))
+ ;;(load-path (copy-list load-path)))
+ (load-path (copy-sequence load-path)))
+ (add-to-list 'load-path this-dir)
+ (require 'ert))
+
+
+(defvar ert-temp-test-buffer-test nil)
+(make-variable-buffer-local 'ert-temp-test-buffer-test)
+(put 'ert-temp-test-buffer-test 'permanent-local t)
+
+(defvar ert-temp-test-buffer-file nil)
+(make-variable-buffer-local 'ert-temp-test-buffer-file)
+(put 'ert-temp-test-buffer-file 'permanent-local t)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Test buffers
+
+(defvar ert-failed-tests-temp-buffers nil)
+
+(defvar ert-list-failed-buffers-name "*Ert Failed Test Buffers*")
+
+(defun ert-kill-temp-test-buffers ()
+ "Delete test buffers from unsuccessful tests."
+ (interactive)
+ (let ((failed (get-buffer ert-list-failed-buffers-name)))
+ (when failed (kill-buffer failed)))
+ (dolist (buf ert-failed-tests-temp-buffers)
+ (when (buffer-live-p buf)
+ (kill-buffer buf)))
+ (setq ert-failed-tests-temp-buffers nil))
+
+(defun ert-list-temp-test-buffers ()
+ "List test buffers from unsuccessful tests."
+ (interactive)
+ (setq ert-failed-tests-temp-buffers
+ (delq nil
+ (mapcar (lambda (buf)
+ (when (buffer-live-p buf)
+ buf))
+ ert-failed-tests-temp-buffers)))
+ (let ((ert-buffer (get-buffer "*ert*"))
+ (buffers ert-failed-tests-temp-buffers))
+ (when ert-buffer (setq buffers (cons ert-buffer buffers)))
+ (switch-to-buffer
+ (let ((Buffer-menu-buffer+size-width 40))
+ (list-buffers-noselect nil buffers)))
+ (rename-buffer ert-list-failed-buffers-name t))
+ (unless ert-failed-tests-temp-buffers
+ (message "No test buffers from unsuccessful tests")))
+
+(defvar ert-temp-test-buffer-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Add menu bar entries for test buffer and test function
+ (define-key map [(control ?c) ?? ?t] 'ert-temp-test-buffer-go-test)
+ (define-key map [(control ?c) ?? ?f] 'ert-temp-test-buffer-go-file)
+ map))
+(defun ert-temp-test-buffer-go-test ()
+ (interactive)
+ (ert-find-test-other-window ert-temp-test-buffer-test))
+(defun ert-temp-test-buffer-go-file ()
+ (interactive)
+ (find-file-other-window ert-temp-test-buffer-file))
+
+(define-minor-mode ert-temp-test-buffer-minor-mode
+ "Helpers for those buffers ..."
+ )
+(put 'ert-temp-test-buffer-minor-mode 'permanent-local t)
+
+;; Fix-me: doc
+(defvar ert-test-files-root nil)
+(defun ert-get-test-file-name (file-name)
+ (unless ert-test-files-root
+ (error "Please set ert-test-files-root for your tests"))
+ (unless (file-directory-p ert-test-files-root)
+ (error "Can't find directory %s" ert-test-files-root))
+ (expand-file-name file-name ert-test-files-root))
+
+(defmacro* ert-with-temp-buffer-include-file (file-name-form &body body)
+ "Insert FILE-NAME-FORM in a temporary buffer and eval BODY.
+If success then delete the temporary buffer, otherwise keep it.
+
+To access these temporary test buffers use
+- `ert-list-temp-test-buffers': list them
+- `ert-kill-temp-test-buffers': delete them"
+ (declare (indent 1) (debug t))
+ (let ((file-name (make-symbol "file-name-")))
+ `(let* ((,file-name (ert-get-test-file-name ,file-name-form))
+ (mode-line-buffer-identification (list (propertize "%b" 'face 'highlight)))
+ ;; Give the buffer a name that allows us to switch to it
+ ;; quickly when debugging a failure.
+ (temp-buf
+ (generate-new-buffer
+ (format "%s" (ert-this-test)))))
+ (unless (file-readable-p ,file-name)
+ (if (file-exists-p ,file-name)
+ (error "Can't read %s" ,file-name)
+ (error "Can't find %s" ,file-name)))
+ (message "Testing with file %s" ,file-name)
+ (setq ert-failed-tests-temp-buffers (cons temp-buf ert-failed-tests-temp-buffers))
+ (with-current-buffer temp-buf
+ (ert-temp-test-buffer-minor-mode 1)
+ (setq ert-temp-test-buffer-file ,file-name)
+ (setq ert-temp-test-buffer-test (ert-this-test))
+ ;; Avoid global font lock
+ (let ((font-lock-global-modes nil))
+ ;; Turn off font lock in buffer
+ (font-lock-mode -1)
+ (when (> emacs-major-version 22)
+ (assert (not font-lock-mode) t "%s %s" "in ert-with-temp-buffer-include-file"))
+ (insert-file-contents ,file-name)
+ (save-window-excursion
+ ;; Switch to buffer so it will show immediately when
+ ;; debugging a failure.
+ (switch-to-buffer-other-window (current-buffer))
+ ,@body)
+ ;; Fix-me: move to success list?
+ (kill-buffer temp-buf))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Simulate commands
+
+(defvar ert-simulate-command-delay nil)
+
+(defvar ert-simulate-command-post-hook nil
+ "Normal hook to be run at end of `ert-simulate-command'.")
+
+;; Fix-me: use this in all tests where applicable.
+(defun ert-simulate-command (command run-idle-timers)
+ ;; Fix-me: run-idle-timers - use seconds
+ ;; Fix-me: add unread-events
+ "Simulate calling command COMMAND as in Emacs command loop.
+If RUN-IDLE-TIMERS is non-nil then run the idle timers after
+calling everything involved with the command.
+
+COMMAND should be a list where the car is the command symbol and
+the rest are arguments to the command.
+
+NOTE: Since the command is not called by `call-interactively'
+test for `called-interactively' in the command will fail.
+
+Return the value of calling the command, ie
+
+ (apply (car COMMAND) (cdr COMMAND)).
+
+Run the hook `ert-simulate-command-post-hook' at the very end."
+
+ (message "command=%s" command)
+ (ert-should (listp command))
+ (ert-should (commandp (car command)))
+ (ert-should (not unread-command-events))
+ (let (return-value
+ (font-lock-mode t))
+ ;; For the order of things here see command_loop_1 in keyboard.c
+ ;;
+ ;; The command loop will reset the command related variables so
+ ;; there is no reason to let bind them. They are set here however
+ ;; to be able to test several commands in a row and how they
+ ;; affect each other.
+ (setq deactivate-mark nil)
+ (setq this-original-command (car command))
+ ;; remap through active keymaps
+ (setq this-command (or (command-remapping this-original-command)
+ this-original-command))
+ (run-hooks 'pre-command-hook)
+ (setq return-value (apply (car command) (cdr command))) ;; <-----
+ (message "post-command-hook=%s" post-command-hook)
+ (run-hooks 'post-command-hook)
+ (when deferred-action-list
+ (run-hooks 'deferred_action_function))
+ (setq real-last-command (car command))
+ (setq last-repeatable-command real-last-command)
+ (setq last-command this-command)
+ (when (and deactivate-mark transient-mark-mode) (deactivate-mark))
+ ;;(message "ert-simulate-command.before idle-timers, point=%s" (point))
+ (when run-idle-timers
+ ;;(dolist (timer (copy-list timer-idle-list))
+ (dolist (timer (copy-sequence timer-idle-list))
+ (timer-event-handler timer)
+ ;;(message " after timer=%s, point=%s" timer (point))
+ )
+ (redisplay t))
+ ;;(message "ert-simulate-command.after idle-timers, point=%s" (point))
+ (when ert-simulate-command-delay
+ ;; Show user
+ ;;(message "After M-x %s" command)
+ (let ((old-buffer-name (buffer-name)))
+ (rename-buffer (propertize (format "After M-x %s" (car command))
+ 'face 'highlight)
+ t)
+ (sit-for ert-simulate-command-delay)
+ (rename-buffer old-buffer-name)))
+ (ert-should (not unread-command-events))
+ (run-hooks 'ert-simulate-command-post-hook)
+ return-value))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Misc
+
+(defun ert-this-test ()
+ "Return current `ert-deftest' function."
+ (elt test 1))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Self tests
+
+(provide 'ert2)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ert2.el ends here
--- /dev/null
+;;; hfy-test.el --- Test for htmlfontify + hfyview
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-10-17 Fri
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+(require 'winsav)
+(require 'emacsw32 nil t)
+(require 'grep)
+
+(defun hfy-test-setup-frame ()
+ (find-library "htmlfontify")
+ (occur "hfy-tmpfont-stack")
+ (unless grep-template (grep-compute-defaults))
+ (lgrep "hfy-tmpfont-stack" "*.el" ".")
+ (list-faces-display)
+ (list-colors-display)
+ (describe-function 'describe-function)
+ (delete-other-windows)
+
+ (split-window-vertically)
+ (split-window-vertically)
+ (balance-windows)
+ (split-window-vertically)
+ (balance-windows)
+ (split-window-vertically)
+ (balance-windows)
+
+ ;;(winsav-upper-left-window)
+ (frame-first-window)
+ (split-window-horizontally)
+ ;;(winsav-upper-left-window)
+ (frame-first-window)
+ (switch-to-buffer "*scratch*")
+
+ (select-window (next-window))
+ (switch-to-buffer "*Help*")
+
+ (select-window (next-window))
+ (switch-to-buffer "*Faces*")
+ (split-window-horizontally)
+
+ (select-window (next-window))
+ (switch-to-buffer "*Colors*")
+
+ (select-window (next-window))
+ (when (fboundp 'emacsw32-show-custstart)
+ (emacsw32-show-custstart))
+
+ (select-window (next-window))
+ (info)
+
+ (select-window (next-window))
+ (split-window-horizontally)
+ (switch-to-buffer "*grep*")
+
+ (select-window (next-window))
+ (switch-to-buffer "*Occur*")
+ )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; hfy-test.el ends here
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>\r
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"\r
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">\r
+<html xmlns="http://www.w3.org/1999/xhtml">\r
+ <head>\r
+ <title>patika</title>\r
+<meta name="generator" content="emacs 23.0.60.1; htmlfontify 0.20" />\r
+<style type="text/css"><!-- \r
+body { font-family: Courier New; font-stretch: normal; font-weight: 500; font-style: normal; color: #f5deb3; background: #2f4f4f; font-size: 10pt; text-decoration: none; }\r
+span.default { font-family: Courier New; font-stretch: normal; font-weight: 500; font-style: normal; color: #f5deb3; background: #2f4f4f; font-size: 10pt; text-decoration: none; }\r
+span.default a { font-family: Courier New; font-stretch: normal; font-weight: 500; font-style: normal; color: #f5deb3; background: #2f4f4f; font-size: 10pt; text-decoration: underline; }\r
+span.default-0004 { text-decoration: none; }\r
+span.default-0004 a { text-decoration: underline; }\r
+span.default-0002 { text-decoration: none; }\r
+span.default-0002 a { text-decoration: underline; }\r
+ --></style>\r
+\r
+ </head>\r
+ <body>\r
+\r
+ <script type="text/javascript">\r
+ // <![CDATA[\r
+\r
+function getObj(name) {\r
+ if (document.getElementById) {\r
+ this.obj = document.getElementById(name);\r
+ this.style = document.getElementById(name).style;\r
+ }\r
+}\r
+function hfy_toggle_display(name) {\r
+ var x = new getObj("hfy_invis_" + name);\r
+ var flag = x.style.display == 'inline';\r
+ x.style.display = (flag) ? 'none' : 'inline'\r
+}\r
+\r
+ // ]]>\r
+ </script>\r
+\r
+<pre>ajsha a<span class="default-0002">hsahs</span>jha<span class="default-0004">j sah</span>sja </pre>\r
+\r
+ </body>\r
+</html>\r
--- /dev/null
+<h2>CLEO Memorandum Assignment #1. What's Next?</h2>
+<table cellpadding="0" cellspacing="0">
+ <thead>
+ <tr>
+ <th class="first author">Activity</th>
+<!-- <th class="time">Progress</th> -->
+ </tr>
+ </thead>
+
+ <tbody>
+ <?php
+ $AM = $this->activity_model;
+ foreach ($this->focus_transitions as $tran => $satisfied) {
+ $props = $AM->getTransitionProps($tran);
+ $url_params = $props['url_params'];
+ $link_text = $props['link_text'];
+ if (null !== $url_params and null !== $link_text) {
+ // TODO Add $sat class to <td>, style accordingly.
+ ?>
+ <tr>
+ <td class="first author"><a href="<?=
+ $this->url($url_params) ?>"><?= $link_text ?></a></td>
+<!-- <td><?=
+ // TODO $props['allotted']
+ $satisfied ? '✔' : ' '
+ ?></td> -->
+ </tr>
+ <?php }} ?>
+ </tbody>
+</table>
+<!--
+<?php
+print_r($this->acts);
+print_r($this->states);
+print_r($this->payload);
+print_r($this->activity_model);
+?>
+-->
+<?php
+$foo = <<<MY_FOO
+I am a heredoc
+MY_FOO;
+?>
--- /dev/null
+\r
+<%@LANGUAGE="VBScript"%>\r
+\r
+<SCRIPT LANGUAGE="JavaScript" RUNAT="Server">\r
+function JSGreeting()\r
+ {\r
+ return "Greetings from a JavaScript Function";\r
+ }\r
+</SCRIPT>\r
+\r
+<SCRIPT LANGUAGE="VBScript" RUNAT="Server">\r
+Function VBGreeting()\r
+ VBGreeting="Greetings from a VBScript Function"\r
+End Function\r
+\r
+Function toDollars(x)\r
+ toDollars=FormatCurrency(x)\r
+End Function\r
+</SCRIPT>\r
+\r
+<%\r
+var a = 2;\r
+var b = 2;\r
+var c = add(a,b)\r
+c += " (Two numbers are added by JavaScript, "\r
+c += "and then formatted into currency by VBScript.)"\r
+\r
+function add(x,y)\r
+ {\r
+ result = x + y;\r
+ result = toDollars(result);\r
+ return result; \r
+ }\r
+\r
+Response.Write("<HTML>\r")\r
+Response.Write(JSGreeting() + "<BR>\r")\r
+Response.Write(VBGreeting() + "<BR>\r")\r
+Response.Write(c + " <BR>\r")\r
+Response.Write("</HTML>\r")\r
+%>\r
--- /dev/null
+<map version="0.9.0">
+<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->
+<node BACKGROUND_COLOR="#00bfff" CREATED="1248161883687" ID="ID_4621171" MODIFIED="1248162997000" TEXT="test.org">
+<richcontent TYPE="NOTE"><html>
+ <head>
+
+ </head>
+ <body>
+ <p>
+ --org-mode: WHOLE FILE
+ </p>
+ </body>
+</html>
+</richcontent>
+<node CREATED="1248161883687" MODIFIED="1248161883687" POSITION="left" TEXT="Bonjour">
+<node CREATED="1248161883687" MODIFIED="1248161883687" TEXT="Ceci est un test">
+<node BACKGROUND_COLOR="#eeee00" CREATED="1248161883687" MODIFIED="1248161883687" STYLE="bubble">
+<richcontent TYPE="NODE"><html>\r
+<head>\r
+<style type="text/css">\r
+<!--
+p { margin-top: 0 }
+-->\r
+</style>\r
+</head>\r
+<body>\r
+<p><br/> lkxjdflkdsz _lskfdsdf_ alskdjf<br/></p>\r
+</body>\r
+</html></richcontent>
+<richcontent TYPE="NOTE"><html><head/><body><p>-- This is more about "Ceci est un test" --</p></body></html></richcontent>
+</node>
+</node>
+</node>
+<node CREATED="1248161883687" HGAP="-88" ID="ID_901848166" MODIFIED="1248162974171" POSITION="right" TEXT="Rebonjour" VSHIFT="76">
+<node CREATED="1248161883687" HGAP="85" ID="ID_1570634894" MODIFIED="1248162978203" TEXT="Ceci est un autre test" VSHIFT="-109"/>
+</node>
+</node>
+</map>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>News and Notes about nXhtml</title>
+ <link href="wd/grapes/nxhtml-grapes.css" rel="StyleSheet" type="text/css" />
+<style type="text/css">
+#nxhtml-home a {
+ /* Image */
+ display: block;
+ background: transparent url("img/getitbuttons.png") 0 0 no-repeat;
+ overflow: hidden;
+ width: 200px;
+ xheight: 35px;
+ /* Text placement and size, etc */
+ text-align: center;
+ padding-top: 11px;
+ font-size: 12px;
+ padding-bottom: 9px;
+ text-decoration: none;
+ white-space: nowrap;
+ margin: 0;
+ border: none;
+}
+#nxhtml-home a:hover {
+ background-position: 0 -35px;
+ color: yellow;
+}
+
+</style>
+ </head>
+ <body>
+ <div id="container">
+
+ <div id="rgtcol">
+ <p id="nxhtml-home"><a href="nxhtml.html">To nXhtml main page</a></p>
+
+ <h1>News and Notes about nXhtml</h1>
+
+ <dl>
+
+ <dt id="hadron-bugs" style="margin-top:1em;">Thanks for testing!</dt>
+ <dd>
+ <p>
+ I want to thanks the testers (who have been many now),
+ especially to my first testers Hadron Quark and Eric
+ Lilja, for helping me by testing and pointing out bugs
+ and weaknesses, most of them related to editing of PHP.
+ </p>
+ <p>
+ Without testers all kind of problems I just can't
+ imagine myself would still be there in nXhtml. For
+ example Hadron told me once that he got the error
+ <i>(wrong-type-argument stringp nil)</i>. Eh, I replied, are
+ you sure. Yes he was. I tried the same file as him. No
+ error.
+ </p>
+ <p>
+ The error happened during fontification so the error
+ message above was all we had. A real black box for
+ me. Or perhaps black magic? After much confusion and
+ some hard work we finally found out what it was and I
+ implemented a better way to catch such errors. If Hadron
+ would have given up the problem would still have been
+ there. Some problems are just impossible to solve
+ without good cooperation. So, again, thanks Hadron.
+ </p>
+ <p>
+ BTW, I will perhaps add some even better way to Emacs to
+ catch these errors so other can benefit from our
+ insights too, but that requires some time and effort
+ which I can't afford right now.
+ </p>
+ </dd>
+
+ <dt id="state-of-the-art" style="margin-top:1em;
+ background-color: #66cd5c;
+ background-color: #96cd5c;
+ padding: 0.5em;
+ ">The State of the Art</dt>
+ <dd style="background-color: #f9e529; padding: 0.5em">
+ <p>
+ I wrote earlier that I thought that there were two parts
+ in nXhtml, nxhtml-mode and mumamo with a bit different
+ degree of maturity. I believe that is not that valid
+ any more. To my delight the second part, mumamo is now
+ also quite stable (from version 1.27).
+ </p>
+ </dd>
+
+ <dt id="magic-problems" style="margin-top:1em;">Magic major mode selection</dt>
+ <dd>
+ <p>
+ Sometimes the major mode that Emacs opens a file in is
+ not what you expect. This can happen with files like PHP
+ files. The reason might be that magic-mode-alist have
+ choosen a mode based on the content of the file. The way
+ this is done does not take files with mixes a mix of for
+ example XHTML and PHP into account.
+ </p>
+ <p>
+ You may try setting magic-mode-alist to nil if this is a
+ problem for you.
+ </p>
+ <p>
+ <em>
+ This is now no longer necessary since the introduction
+ of magic-fallback-mode-alist in CVS Emacs on 2007-05-16.
+ (If you have an Emacs newer than that, of course.)
+ </em>
+ </p>
+ </dd>
+
+ <dt id="underline-bug" style="margin-top:1em;">Long Red Underlines</dt>
+ <dd>
+ <p>
+ Because of a bug in Emacs 22.1 you can sometimes (at the
+ end of a line) get long red lines instead of just a
+ single underlined character. Many users (me included)
+ find this quite a bit disturbing. I have therefore added
+ a command to quickly hide/show the underlines. This is
+ on <em>C-c C-w</em>.
+ </p>
+ <p>
+ This is particular useful for example in the case where
+ you edit a PHP file and are bound to get a lot of XHTML
+ validation errors.
+ </p>
+ </dd>
+
+ <dt id="php-attribute-values" style="margin-top:1em;">Attribute values computed by PHP</dt>
+ <dd>
+ <p>
+ If you want to have attribute values computed by PHP
+ here is a way how to structure that to avoid breaking
+ completion and validation in the XHTML part unnessecary:
+ </p>
+ <p style="margin-left:2em">
+ <img src="images/linux.png" title="<?php foo("bar");?>"/>
+ </p>
+ <p>
+ Unfortunately that still breaks XHTML validation since
+ < is not allowed in strings. In the long run I
+ believe the XML validator has to be broken up so that it
+ avoids parsing the string here (in PHP files).
+ </p>
+ <p>
+ For now I have implemented a workaround.
+ If you are using constructs like those above then turn on <em>nxhtml-strval-mode</em>.
+ This will temporarily replace the above with
+ </p>
+ <p style="margin-left:2em">
+ <img src="images/linux.png" title="«?php foo("bar");?»"/>
+ </p>
+ <p>
+ However on the screen you will still see the original
+ string and when writing to file the correct characters
+ will be used.
+ </p>
+ </dd>
+
+ <dt id="pi-note" style="margin-top:1em;">A note for PHP and its cousins</dt>
+ <dd>
+ <p>
+ The rules for a process instruction in XML, like <?php
+ ... ?> says that the text can contain any text except
+ <em>?></em>. So if you want to output that string
+ from PHP then break it up so it does not look as ?> in
+ the source file.
+ </p>
+ <p>
+ It might be good to break up the beginning part of the
+ process instructions too. And please note that to use
+ XHTML validation or completion you should avoid using
+ < in strings, since it is not allowed there.
+ </p>
+ </dd>
+
+<!-- <dt id="pi-note" style="margin-top:1em;">Perl Mode slow with Mumamo Mode</dt> -->
+<!-- <dd> -->
+<!-- <p> -->
+<!-- Perl mode used with MuMaMo mode sometimes makes the -->
+<!-- fontification slow for big files. I do not know the -->
+<!-- reason, but I am trying to find a solution for this. If -->
+<!-- you encounter this problem, just turn off mumamo-mode in -->
+<!-- that buffer. -->
+<!-- </p> -->
+<!-- </dd> -->
+
+ <dt id="tab-width-problems" style="margin-top:1em;">Tab width</dt>
+ <dd>
+ <p>
+ Do you have <em>tab-width</em> to something different than 8
+ (the default)? Then please change this to 8. I have got
+ reports of problem with indentation when it is not 8.
+ </p>
+ </dd>
+
+ <dt id="mmm-compat" style="margin-top:1em;">Why the chunks are not compatible with mmm</dt>
+ <dd>
+ <p>
+ Some people have asked why the way to specify chunks in
+ mumamo-mode is not compatible with the old mmm-mode. The
+ answer is that I was not sure that the way used in
+ mmm-mode for specifying the chunks was flexible enough.
+ </p>
+ <p>
+ And I am sure that even the way used in mumamo-mode is
+ not good enough for all cases, but I let it be the way
+ it is until I have a better understanding of the
+ problem. Suggestions and comments are welcome!
+ </p>
+ </dd>
+
+ </dl>
+
+ <h1 id="change-history">nXhtml Changes</h1>
+
+ <div>
+ <a href="#v0.89">v0.89</a>
+ <a href="#v0.90">v0.90</a>
+ <a href="#v0.91">v0.91</a>
+ <a href="#v0.92">v0.92</a>
+ <a href="#v0.93">v0.93</a>
+ <a href="#v0.94">v0.94</a>
+ <a href="#v0.95">v0.95</a>
+ <a href="#v0.96">v0.96</a>
+ <a href="#v0.97">v0.97</a>
+ <a href="#v0.98">v0.98</a>
+ <a href="#v0.99">v0.99</a>
+ <a href="#v1.00">v1.00</a>
+ <a href="#v1.01">v1.01</a>
+ <a href="#v1.02">v1.02</a>
+ <a href="#v1.03">v1.03</a>
+ <a href="#v1.04">v1.04</a>
+ <a href="#v1.10">v1.10</a>
+ <a href="#v1.11">v1.11</a>
+ <a href="#v1.12">v1.12</a>
+ <a href="#v1.13">v1.13</a>
+ <a href="#v1.14">v1.14</a>
+ <a href="#v1.15">v1.15</a>
+ <a href="#v1.16">v1.16</a>
+ <a href="#v1.17">v1.17</a>
+ <a href="#v1.18">v1.18</a>
+ <a href="#v1.19">v1.19</a>
+ <a href="#v1.20">v1.20</a>
+ <a href="#v1.21">v1.21</a>
+ <a href="#v1.22">v1.22</a>
+ <a href="#v1.23">v1.23</a>
+ <a href="#v1.24">v1.24</a>
+ <a href="#v1.25">v1.25</a>
+ <a href="#v1.26">v1.26</a>
+ <a href="#v1.27">v1.27</a>
+ <a href="#v1.28">v1.28</a>
+ <a href="#v1.29">v1.29</a>
+ <a href="#v1.30">v1.30</a>
+ <a href="#v1.31">v1.31</a>
+ <a href="#v1.32">v1.32</a>
+ <a href="#v1.33">v1.33</a>
+ <a href="#v1.34">v1.34</a>
+ <a href="#v1.35">v1.35</a>
+ <a href="#v1.36">v1.36</a>
+ <a href="#v1.37">v1.37</a>
+ <a href="#v1.38">v1.38</a>
+ <a href="#v1.39">v1.39</a>
+ </div>
+
+ <dl>
+ <dt id="v0.89">0.89</dt>
+ <dd>
+ <ul>
+ <li>
+ Corrected autostart for nXhtml when not used together with EmacsW32.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.90">0.90</dt>
+ <dd>
+ <ul>
+ <li>
+ Improved display of XML path.
+ </li>
+ <li>
+ Discontinued xmple-mode.
+ </li>
+ <li>
+ New major modes nxhtml-part-mode/nxml-part-mode replaces
+ minor mode xmlpe-mode. (While moving the code to
+ nxhtml-part.el I also fixed a bug in Xmple minor mode that
+ made Emacs take 99% of the CPU.)
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.91">0.91</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed some calls to perl which prevented uploading of
+ a site of you did not have perl in the same location
+ as me.
+ </li>
+ <li>
+ Glued together things so that editing PHP files works
+ as I intended. (This means that Emacs switches between
+ php-mode and nxhtml-part-mode automatically when
+ moving point. And that you can use completion.)
+ </li>
+ <li>
+ Starting working on the documentation for nXhtml.
+ New layout to the documentation files.
+ Examples with images.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.92">0.92</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixes to make the switching between php and xhtml
+ style editing work better.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.93">0.93</dt>
+ <dd>
+ <ul>
+ <li>
+ Better error handling when switching to editing
+ embedded JavaScript and CSS.
+ </li>
+ <li>
+ Removed PHP spec from embedded switching since they
+ interfered with the automatic switching between php
+ and xhtml.
+ </li>
+ <li>
+ Gives an error message if web host is not defined in
+ site when trying to use View Uploaded File and
+ cousins.
+ </li>
+ <li>
+ Gives a ready message when finished uploading a single
+ file.
+ </li>
+ <li>
+ When using Mode Switching at <? ... ?> mode
+ switching could occur in wrong buffer. Fixed together
+ with some other buffer problems.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.94">0.94</dt>
+ <dd>
+ <ul>
+ <li>
+ Add http://www.w3.org/ to the help sites for CSS.
+ </li>
+ <li>
+ Included a CSS mode.
+ </li>
+ <li>
+ Added a menu entry for bug reporting.
+ </li>
+ <li>
+ Renamed menu bar entry from XHTML to nXhtml for clarity.
+ (But nXml menu bar entry is still called XML.)
+ </li>
+ <li>
+ Added work around for globalized minor modes in the
+ cases of MLinks, XML Path and mode switching at <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.95">0.95</dt>
+ <dd>
+ <ul>
+ <li>
+ Added workaround for the problem with the first
+ keyboard key after automatically switching of mode at
+ <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.96">0.96</dt>
+ <dd>
+ <ul>
+ <li>
+ Added support for multiple major modes with mumamo.el.
+ </li>
+ <li>
+ More conventient handling of links. They can now be
+ opened in the same window, 'other window' or in a new
+ frame.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.97">0.97</dt>
+ <dd>
+ <ul>
+ <li>
+ Schema was not setup after starting new page so
+ completion did not work. Fixed.
+ </li>
+ <li>
+ Added http://xhtml.com/ to help sites for XHTML.
+ </li>
+ <li>
+ Added the concept of <em>fictive XML validation
+ headers</em>. These are just text parsed by the nXml
+ validation parser to get a start state before starting
+ parsing a buffer. This allows the use of the nXml
+ completion in buffers where there are no XML header.
+ Such a header is often lacking for example in PHP code
+ since the XHTML header is often generated dynamically.
+ </li>
+ <li>
+ Because of the change above <em>nxhtml-part-mode</em>
+ is no longer needed and is therefore declared
+ obsolete.
+ </li>
+ <li>
+ Corrected a bug in mlinks.el that prevented opening an
+ HTML link in a other window or a new frame.
+ </li>
+ <li>
+ Added support for JSP, eRuby and some support for perl
+ in mumamo.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.98">0.98</dt>
+ <dd>
+ <ul>
+ <li>
+ Mumamo was not found when nXhtml was installed with
+ just the zip file. Corrected. (nXhtml is also
+ installed when you install EmacsW32.)
+ </li>
+ <li>
+ Enhancement to mumamo error handling when a bad mode
+ specifier for an embedded mode is found.
+ </li>
+ <li>
+ Introduced a bug for empty XHTML documents in
+ 0.97. Corrected.
+ </li>
+ <li>
+ Corrected a bug for chunks 1 character long.
+ </li>
+ <li>
+ There is what I consider is a bug in Emacs 22.1 in the
+ handling of global minor mode that are not distributed
+ with Emacs. If they are turned on by customization,
+ but loaded after Emacs have loaded the customizations
+ (usually in .emacs) then they are not turned on
+ correctly. Added work-around for this.
+ </li>
+ <li>
+ <em>Fictive XHTML Validation Header</em>:
+ <ul>
+ <li>
+ <em>Fictive XHTML Validation Header</em> state was not saved when moving between chunks. Fixed.
+ </li>
+ <li>
+ Tried to make the concept of <em>Fictive XHTML Validation Header</em>
+ more clear. Added this visually to the buffer.
+ </li>
+ <li>
+ <em>Fictive XHTML Validation Headers</em> can now be turned on
+ automatically based on file name.
+ </li>
+ </ul>
+ </li>
+ <li>
+ <em>nXhtml menu:</em>
+ <ul>
+ <li>
+ Reorganized the nXhtml menu.
+ </li>
+ <li>
+ Added <em>customization</em> groups for help libraries to nXhtml.
+ </li>
+ <li>
+ Added an entry for customization of nXhtml to the menus.
+ </li>
+ <li>
+ Added <em>Tidy</em> to the menus again.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Corrected bug in <em>XML Path</em> (nxml-where) for single tags.
+ Other small fixes to nxhtml-where.
+ </li>
+ <li>
+ Documentation enhancements.
+ Added <em>The Quick Guide</em>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.99">0.99</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed a serious bug in the cooperation between nxhtml-mode and mumamo-mode.
+ </li>
+ <li>
+ Turn on mumamo-mode by file name (mumamo-global-mode).
+ </li>
+ <li>
+ Fictive XHTML Validation Header:
+ <ul>
+ <li>
+ The Fictive XHTML Validation Header state were not saved when changing major mode in MuMaMo. Corrected.
+ </li>
+ <li>
+ Added more alternatives to the Fictive XHTML Validation Header list.
+ This should make it easier to use completion with for example PHP.
+ </li>
+ <li>
+ Added default value for the Fictive XHTML Validation Header.
+ </li>
+ <li>
+ Tried to make the use of Fictive XHTML Validation Header more automatic and therefore useful.
+ Also tried to make it play better with setting schema file.
+ (There is no need normally to set schema file by hand.)
+ </li>
+ <li>
+ To turn this on by default customize nxhtml-global-validation-header-mode.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Possible to hide validation warnings without turning
+ on validation (which would make completion in the
+ XHTML part impossible).
+ </li>
+ <li>
+ Some fixes to php-mode:
+ <ul>
+ <li>Using the character # for comments now works for most cases.</li>
+ <li>Now uses the fontification faces in a more standard way which calms down the look.</li>
+ <li>Initialization bug fixes.</li>
+ <li>Renamed php-mode-user-hook to php-mode-hook to follow standard.</li>
+ </ul>
+ </li>
+ <li>
+ Indentation fixes:
+ <ul>
+ <li>
+ Various corrections to indentation in mumamo.
+ </li>
+ <li>
+ Added the possibility to use TAB to indent regions
+ (indent-region-mode).
+ </li>
+ <li>
+ Warn about bad indentation in mixed PHP/HTML code
+ when using php-mode only.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fontification now fontifies all text first in main
+ major mode and thereafter applies submodes. (This
+ avoids some problems with around a submode chunk.)
+ </li>
+ <li>
+ Reorganized the nXhtml menu:
+ <ul>
+ <li>
+ There is now a minor mode for the nXhtml
+ menu. This makes it possible to easier use common
+ features when in buffers not in nxhtml-mode.
+ </li>
+ <li>
+ The nXhtml menu does not disappear when moving
+ into a chunk where the major mode is not
+ nxhtml-mode. The changes also makes it easy to
+ access uploading functions functions etc from
+ other modes than nxhtml-mode since the
+ <em>nXhtml</em> may also be shown in them.
+ </li>
+ <li>
+ The nXhtml menu can be turned on globally by default.
+ Customize nxhtml-menu-mode for that.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.00">1.00</dt>
+ <dd>
+ <ul>
+ <li>
+ Reached version number 1.00 - which you maybe believe
+ means the bugs should be gone? Sorry, it is just that
+ I ran out of version numbers. However it looks like
+ much fewer bugs at least.
+ </li>
+ <li>
+ Fixed problems mostly related to global turn on of different features in nXhtml.
+ </li>
+ <li>
+ Small fixes to indentation.
+ <ul>
+ <li>
+ nxhtml-mode could get confused by php tags.
+ </li>
+ <li>
+ nxhtml-mode did not indent <!DOCTYPE in a sensible way.
+ </li>
+ <li>
+ Electric keys now works in embedded php when using mumamo-mode.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Tidy was very misbehaving since the output buffer was
+ not erased between different files. But I have got no
+ bug reports on this.
+ </li>
+ <li>
+ Fixed a bug in validation that should up when using muamo-mode.
+ </li>
+ <li>
+ Fixed bug in <script ...> and <style ...> chunk dividing.
+ </li>
+ <li>
+ Added support for OpenLaszlo.
+ </li>
+ <li>
+ Corrections to mlinks-mode (visible mostly as links in
+ XHTML buffers):
+ <ul>
+ <li>
+ Links disappeared when a new file was
+ opened. Corrected.
+ </li>
+ <li>
+ Links were not correctly updated at changes in the
+ buffer when mumamo-mode was used. Fixed.
+ </li>
+ </ul>
+ </li>
+ <li>
+ The welcome message for nXhtml could be shown too
+ early sometimes when loading, before nXhtml actually
+ knew if it should be shown or not. Tried to fix it.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.01">1.01</dt>
+ <dd>
+ <ul>
+ <li>
+ Reported wrong version number for nXhtml in the menus. Fixed.
+ </li>
+ <li>
+ <em>If you use the zip file to install nXhtml please
+ notice that it has now a top level nxml.</em> Sorry for not
+ having zipped it like that before!
+ </li>
+ <li>
+ The url links in <em>Welcome to nXhtml</em> was a bit
+ incorrect and did not work on all OS:es. Fixed.
+ </li>
+ <li>
+ Added customization of popup completion to the 'nxhtml
+ customization group so they are easier to find.
+ </li>
+ <li>
+ MuMaMo
+ <ul>
+ <li>
+ Struggled a bit with the load sequences of the elisp
+ libraries used by nXhtml when using MuMaMo.
+ </li>
+ <li>
+ Tried to get the global turn on of mumam-mode to work
+ in all cases.
+ </li>
+ <li>
+ The screen was blinking when changing overlays after
+ changes in the buffer. Tried to fix this.
+ </li>
+ <li>
+ Minor fixes do syntax highlighting, like taking care of single ':s.
+ </li>
+ <li>
+ Fixes to the support for JSP and eRuby.
+ </li>
+ <li>
+ Made the support for perl here documents a bit better.
+ Large perl documents are however still quite slow when
+ using mumamo-mode. I do not know the reason yet.
+ </li>
+ <li>
+ Refontification could miss some parts when buffer
+ changes caused chunk division changes. Complex,
+ tried to fix it, but I am a bit unsure that it
+ always works.
+ </li>
+ <li>
+ Cleaned up mumamo.el a bit.
+ </li>
+ <li>
+ Rewrote mumamo-test.el and functions called from it in
+ mumamo.el a bit to make tracebacks from errors more
+ useful. Changed keybindings in mumamo-test.el from
+ global to a minor mode <em>mumamo-test-mode</em>.
+ Renamed mumamo-notest.el to mumamo-test.el. Added it
+ to the zipped distribution of nXhtml.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fixed a bug related to links and buffer changes.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.02">1.02</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed a refontification bug that occured after changes.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.03">1.03</dt>
+ <dd>
+ <ul>
+ <li>
+ Added the possibility to call GIMP.
+ </li>
+ <li>
+ Reworked the messages for fontification errors to try
+ to catch an error that shows up sometimes. Tried to
+ avoid disturbing normal use in spite of that error.
+ </li>
+ <li>
+ Reverted to using a short delay before switching major
+ mode when moving between buffers.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.04">1.04</dt>
+ <dd id="v1.04-dd">
+ <ul>
+ <li>
+ Enhanced the documentation for nXhtml. Starting from
+ <i>C-h f nxhtml-mode</i> it should now be easier to
+ get an overview.
+ </li>
+ <li>
+ Bug fixes etc:
+ <ul id="v1.04-bugs">
+ <li>
+ Completion on an empty page gave a faulty frameset page. Fixed.
+ </li>
+ <li>
+ Insert end tag did not work with a fictive
+ validation header. Fixed.
+ </li>
+ <li>
+ Insert end tag when all preceding tags where
+ closed gave a strange error message. Fixed.
+ </li>
+ <li>
+ Changed some key bindings to comply with
+ <i>(info "(elisp) Key Binding Conventions")</i>
+ </li>
+ <li>
+ Completion in empty buffers with a completion
+ header did not work. Fixed.
+ </li>
+ <li id="mumamo-bugs">
+ Multiple major modes:
+ <ul>
+ <li>
+ Fixed a bug that prevented mumamo-global-mode from
+ beeing turned on in a file opened in
+ fundamental-mode.
+ </li>
+ <li>
+ Better error tracing for some functions,
+ including the call of major mode functions.
+ </li>
+ <li>
+ Position was garbled when a ;-char was inserted in php-mode chunk. Fixed.
+ </li>
+ <li>
+ A bad check for if mlinks-mode where available was fixed.
+ </li>
+ <li>
+ Some bugs concerning turning off mumamo-mode was fixed.
+ </li>
+ <li>
+ Fixed a bug in <i>perl here doc</i> chunks. Suddenly the
+ problem with slowness when using mumamo-mode in
+ perl buffers seems gone. (Note quite sure, but I
+ can't see any problems now.)
+ </li>
+ <li>
+ Fixed a bug in mumamo-mode when current buffer was
+ switched before the major mode had been set from
+ the current chunk.
+ </li>
+ <li>
+ Fixed a long standing bug in php fontification of
+ strings and comments.
+ </li>
+ <li>
+ Fixed a bug where <i>sgml-xml-mode</i> was not defined.
+ </li>
+ <li>
+ Fixed a bug related to get-text-property which
+ gives an error when buffer is narrowed.
+ </li>
+ <li>
+ Tried to refontify things outside of a narrowed part. Fixed.
+ </li>
+ <li>
+ Too little where refontified after changes. I hope I have fixed this.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fictive XHTML Validation Header:
+ <ul id="v1.04-fic-bugs">
+ <li>
+ View File did not work correctly when a fictive
+ XHTML validation header was used. Corrected.
+ </li>
+ <li>
+ Fictive XHTML validation headers are no longer
+ turned on by default in any buffers.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Indentation:
+ <ul>
+ <li>
+ Tried to fix a problem when using
+ newline-and-indent. When this was in a mode
+ derived from C the indentation sometimes became 0.
+ </li>
+ <li>
+ Speeded up the indentation of regions a bit when
+ using <i>mumamo-mode</i>.
+ </li>
+ <li>
+ Indentation: TAB now only indents a region if it
+ is visibly marked (see transient-mark-mode and
+ cua-mode).
+ </li>
+ <li>
+ Simplified the indentation code.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fixed a problem where string fontification got out
+ of phase so that wrong parts of buffer could be
+ fontified as a string.
+ </li>
+ <li>
+ Added a workaround for <a
+ href="#php-attribute-values">Attribute values
+ computed by PHP</a>
+ </li>
+ <li>
+ Added .nosearch to subdirectories with no elisp files.
+ </li>
+ <li>
+ Fixed incorrect checks for mlinks-mode in menu building.
+ </li>
+ <li>
+ File extensions where used in a case sensitive way
+ in some places. Fixed.
+ </li>
+ <li>
+ appmenu: Worked only in html files. Fixed.
+ </li>
+ <li>
+ html-site: Fixed the error <em>Error
+ (html-site-current): Can't find site:
+ your-site-name</em>.
+ </li>
+ <li>
+ Fixed a problem with longlines-mode in the support
+ for Firefox add-on It's All Text. (Note however
+ that there are some bugs in longlines-mode
+ itself.) Rewrote the support to be more
+ general. It is now in the file as-external.el, see
+ this file.
+ </li>
+ <li>
+ Fixed an encoding problem in
+ <i>tidy-buffer</i>. Output from tidy was not read
+ using the same coding system as tidy was using.
+ </li>
+ <li>
+ Fixed some problems with face definitions, possibly bugs (not sure).
+ </li>
+ <li>
+ Made the fontification faster when using mumamo-mode.
+ (It is still slower than single mode fontification of course.)
+ </li>
+ <li>
+ nxml-where.el: Made it aware of mumamo.el.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Menu changes:
+ <ul>
+ <li>
+ Completion menu: Renamed to <i>Completion and
+ Validation</i> menu and reorganized a little bit to
+ make it more clear.
+ </li>
+ <li>
+ Renamed <i>view</i> to <i>browse</i> since this is
+ the normal emacs name for showing files in a web
+ browser. Also made corresponding changes to
+ function names. Put back the possibility to view
+ only the region in a web browser.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Uploading:
+ <ul>
+ <li>
+ Added remote dired to the menus.
+ </li>
+ <li>
+ Fixed problems with file names starting with ~.
+ </li>
+ <li>
+ Fixed more problems with file names with spaces.
+ </li>
+ </ul>
+ </li>
+ <li>
+ nxml-where:
+ <ul>
+ <li>
+ nxml-where now uses a timeout for more smooth performance.
+ </li>
+ <li>
+ nxml-where can now recognizes both id and name attribute.
+ </li>
+ <li>
+ Hyphens are now accepted in tag names.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Ruby
+ <ul>
+ <li>
+ Multiple major mode turned on by default for .rhtml files when this mode is global.
+ </li>
+ <li>
+ Multiple major mode is no longer turned on when rub-mode is turned on.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added support for switching major mode dependent on if
+ Emacs was called as an external editor. This makes it
+ possible for example to switch to relevant major and
+ minor modes when Firefox add-on It's All Text.
+ </li>
+ <li>
+ Added the possibility to easily view the output of scripts on the server (if they require no parameters).
+ You can now do that from the nXhtml menu.
+ Previously only html files on the server could be viewed that way.
+ Image files can also be viewed this way.
+ </li>
+ <li>
+ Filling:
+ <ul>
+ <li>
+ Added functions for unfilling.
+ </li>
+ <li>
+ Added keybindings and menu entries for longlines-mode, fill-paragraph and unfill-paragraph.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Quoting:
+ Added HTML quoting of & and < in text areas. Bound to C-c C-q.
+ </li>
+ <li>
+ Images:
+ <ul>
+ <li>
+ Added image-mode to those that are encompassed by
+ nxhtml-global-minor-mode so that images can be
+ uploaded more easily.
+ </li>
+ <li>
+ Added <em>edit with GIMP</em> and <em>upload</em> to the popup menu for links.
+ This avoids the need to load the linked files in Emacs first.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added <em>nxml-untag-element</em>.
+ </li>
+ <li>
+ Added a modified version of wikipedia-mode.el. Seems likely to be useful if you are doing web editing.
+ </li>
+ <li>
+ Added html-imenu.el
+ </li>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Removed the lighter <i>"MuMaMo"</i> for
+ mumamo-mode. Instead the active major mode now has
+ <b>"/m"</b> appended to mode-name (that is what you see
+ in the mode line).
+ </li>
+ <li>
+ The normal way to turn on <i>mumamo-mode</i> has
+ changed. There are now functions that you can use
+ in <i>auto-mode-alist</i> to directly set up the
+ buffer for mumamo-mode. The available functions
+ are in the
+ variable <i>mumamo-defined-turn-on-functions</i>.
+ <p>
+ You are not supposed to call mumamo-mode
+ yourself any more and mumamo-global-mode is
+ gone. So is also mumamo-chunk-family-by-mode and
+ mumamo-filenames-list. The functionality those
+ gave are all replaced by the new functions for
+ turning on mumamo mode.
+ </p>
+ </li>
+ <li>
+ Added support for buffer local values in
+ hooks. This is necessary for example to support
+ minor modes that are meant to be buffer local but
+ not major mode specific. Instructions for authors
+ of this kind of minor modes are in the file
+ mumamo.el.
+ </li>
+ <li>
+ Added support for Django.
+ </li>
+ <li>
+ Added support for Embperl.
+ </li>
+ <li>
+ Added support for PHP Smarty. The <i>{literal}
+ ... {/literal}</i> construct is not supported.
+ This mean that you can not use <style ..> or <script ..>.
+ </li>
+ <li>
+ Added support for imenu for the main major mode.
+ Turned on this by default in nxhtml-mode.
+ </li>
+ <li>
+ Made the temporary replacement of the
+ attr="<?php ... ?>" a bit better. They are
+ now more visible and also still mumamo chunks
+ during the temporary replacement.
+ </li>
+ <li>
+ Added support for <i>flymake-mode</i>.
+ Maybe add support for checking chunks?
+ </li>
+ <li>
+ Printing: Added htmlfontify.el and
+ hfyview.el. These makes if possible to print a
+ buffer fontified with <i>mumamo-mode</i> on in
+ colors (through your web browser). There is an
+ example of the capabilities of htmlfontify <a
+ href="htmlfontify-example.html">here</a> (made
+ with a little function in hfyview.el).
+ </li>
+ </ul>
+ </li>
+ <li>
+ PHP:
+ <ul>
+ <li>
+ Did a first merge with Aaron Hawleys fixes for php-mode.el.
+ </li>
+ </ul>
+ </li>
+ <li>
+ CSS: Upgraded to Stefan's latest css-mode.el.
+ </li>
+ <li>
+ Fictive XHTML Validation Headers: Changed the way they
+ are turned on. They may now be turned on when
+ mumamo-mode is turned on.
+ </li>
+ <li>
+ Some users want to use their own patched version of
+ nXml. Next version of Emacs will come with
+ nXml. Therefore, the loading routine for nXhtml now
+ checks if nXml is is already loaded. Thanks to Eric
+ Lilja for testing this. Eric also made me aware of
+ that if nXhtml was placed in the site-lisp directory
+ tree then things did not work as I expected. I think I
+ have corrected that by placing a <i>.nosearch</i> file
+ at the top of the nxml tree in nXhtml.
+ </li>
+ <li>
+ Restructured the directories. Moved some files out of
+ the <i>nxhtml</i> subdir. Some of them went into the
+ <i>util</i> subdir (those are written by me) and some
+ to the new subdir <i>related</i> (those that are
+ inherited from others, maybe changed by me - most
+ often to work with mumamo-mode).
+ </li>
+ <li>
+ Changed all licenses to be GNU GPL.
+ </li>
+ <li>
+ Additions to tidy support: It is now possible to use
+ the tidy support to tidy the XHTML part of php etc.
+ (Thanks to Hadron for this suggestion.)
+ </li>
+ <li>
+ Added <i>winsize.el</i> which allows interactive resizing of
+ windows. Also added <i>winsav.el</i> which adds the
+ capability to rotate window configurations and also to
+ save window configuration to file.
+ </li>
+ <li>
+ Made nXhtml work with CVS Emacs 23.0.50.1.
+ </li>
+ <li>
+ Added freemind.el to the parcel. After all FreeMind
+ supports web publishing too so why not have the Emacs
+ support here ...
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.10">1.10</dt>
+ <dd id="v1.10-dd">
+ Just jumped the version number for the new release of
+ nXhtml. There are really significant changes in this
+ release, not only minor bug fixes.
+ </dd>
+ <dt id="v1.11">1.11</dt>
+ <dd id="v1.11-dd">
+ Minor bug fixes to completion. Added fictive validation
+ header to completion alternatives when buffer is empty and
+ mumamo is used.
+ </dd>
+ <dt id="v1.12">1.12</dt>
+ <dd id="v1.12-dd">
+ <ul>
+ <li>
+ Fixed a bug in image link insertion in nxhtml-mode, thanks Niels Giesen!
+ </li>
+ <li>
+ Restructured, reordered and documented mumamo.el. It is now two
+ separate files, mumamo.el and mumamo-fun.el.
+ </li>
+ <li>
+ Added move by chunk to the nXhtml menu.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.13">1.13</dt>
+ <dd id="v1.13-dd">
+ <ul>
+ <li>
+ Better handling of the case when no validation header
+ is needed and the user tries to turn it on.
+ </li>
+ <li>
+ Added .phtml as php file.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.14">1.14</dt>
+ <dd id="v1.14-dd">
+ <ul>
+ <li>
+ Completion of links in XHTML was broken. Fixed, thanks
+ to Niels Giesen.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.15">1.15</dt>
+ <dd id="v1.15-dd">
+ <ul>
+ <li>
+ Added `mumamo-map' keymap.
+ </li>
+ <li>
+ Added a keymap to all multi major modes.
+ </li>
+ <li>
+ Some more refinement to fictive validation headers.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.16">1.16</dt>
+ <dd id="v1.16-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Changes to indentation:
+ <ul>
+ <li>
+ Removed indent-region-mode since that
+ functionality is now in indent-for-tab-command in
+ Emacs 22.
+ </li>
+ <li>
+ Removed some code that checked if indentation was 0.
+ </li>
+ <li>
+ Added indent-for-tab-command to mumamo-map.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Reordering and renaming:
+ <ul>
+ <li>
+ Reordered and move some functions in mumamo.el et al.
+ Added new file nxhtml-mumamo.el.
+ </li>
+ <li>
+ Renamed <i>define-mumamo-turn-on</i> to
+ <i>define-mumamo-multi-major-mode</i>.
+ </li>
+ <li>
+ Removed the ending <i>-turn-on</i> from the
+ functions defined by the macro above.
+ </li>
+ <li>
+ Introduced <i>multi major mode</i> as a name for
+ the functions defined by the macro above. Those
+ works in many respects like major mode functions,
+ but they support multiple major modes in a buffer.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added support for noweb as multiple major mode.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.17">1.17</dt>
+ <dd id="v1.17-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Added support for flyspell.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Bug fixes to the version of find-recursive.el that
+ ships with nXhtml. Thanks to Cezar Halmagean.
+ </li>
+ <li>
+ Added tabkey2.el which tries to make it easy to use
+ the Tab key for completion. (You must load it and turn
+ on tabkey2-mode to use it.)
+ </li>
+ <li>
+ Folding:
+ <ul>
+ <li>
+ Added <i>nxhtml-heading-element-name-regexp</i> as
+ default for nxml style folding.
+ </li>
+ <li>
+ Some changes to fold-dwim.el.
+ </li>
+ </ul>
+ </li>
+ <li>
+ AppMenu:
+ <ul>
+ <li>
+ Simplified: Removed the possibility to
+ automatically show minor and major mode menus.
+ There is now only one list, <i>appmenu-alist</i>.
+ </li>
+ <li>
+ Added menu item <i>At Current Point</i> for
+ bindings found in character and overlay keymaps at
+ point. Those you always forget.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Physical line:
+ <ul>
+ <li>
+ Added physical-line.el to nXhtml.
+ </li>
+ <li>
+ Added new functions to move to beginning and end
+ of line to ourcomments-util.el that supports
+ physical-line.el.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.18">1.18</dt>
+ <dd id="v1.18-dd">
+ <ul>
+ <li>
+ Better Tab completion in tabkey2.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.19">1.19</dt>
+ <dd id="v1.19-dd">
+ <ul>
+ <li>
+ Even better Tab completion in tabkey2.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.20">1.20</dt>
+ <dd id="v1.20-dd">
+ <ul>
+ <li>
+ Once again even better Tab completion in tabkey2.el.
+ </li>
+ <li>
+ Fixed bug in hiding of validation errors (they could
+ disappear totally).
+ </li>
+ <li>
+ Cleaned up menus in nXhtml.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.21">1.21</dt>
+ <dd id="v1.21-dd">
+ <ul>
+ <li>
+ Added a bit support for dired (upload, browse, browse
+ remote).
+ </li>
+ <li>
+ Fixed some strange menu problems (i hope).
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.22">1.22</dt>
+ <dd id="v1.22-dd">
+ <ul>
+ <li>
+ Bug fix.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.23">1.23</dt>
+ <dd id="v1.23-dd">
+ <ul>
+ <li>
+ Bug fix.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.24">1.24</dt>
+ <dd id="v1.24-dd">
+ <ul>
+ <li>
+ Tried again to make hexcolor-mode more readable.
+ </li>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Added support for <i>hi-lock-mode</i>. At present
+ it might however be very puzzling. The hilight
+ added by hi-lock-mode may be hidden by the
+ overlays used by mumamo. Tip: you can always use
+ the face <span
+ style="font-size:1.5em;">hi-black-hb</span>.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.25">1.25</dt>
+ <dd id="v1.25-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Handle hi-lock-mode in a more general way
+ using <i>font-lock-mode-hook</i>.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.26">1.26</dt>
+ <dd id="v1.26-dd">
+ <ul>
+ <li>
+ nxhtml-mode:
+ <ul>
+ <li>
+ Removed the indent line patch for nxml-mode.
+ </li>
+ <li>
+ Better test for empty page during completion.
+ </li>
+ </ul>
+ </li>
+ <li>
+ tabkey2-mode:
+ <ul>
+ <li>
+ A lot of improvements.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.27">1.27</dt>
+ <dd id="v1.27-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Worked with bugs in mumamo.el that was due to bad
+ handling of syntax-ppss et el. Looks like most of
+ them are fixed.
+ </li>
+ <li>
+ Fixed documentation and reordered code in mumamo.el
+ and mumamo-fun.el.
+ </li>
+ <li>
+ Changed javascript.el indentation to make it work with
+ mumamo.el.
+ </li>
+ <li>
+ Introduced the function
+ <i>mumamo-make-variable-buffer-permanent</i> as an aid for
+ minor mode authors.
+ </li>
+ <li>
+ Fixed quite a few indentation bugs.
+ There was one bug that could make Emacs loop after indentation.
+ </li>
+ </ul>
+ </li>
+ <li>
+ nxml-where, mlinks
+ <ul>
+ <li>
+ Fixed bugs with left over idle timers when buffer had
+ been killed (nxml-where.el, mlinks.el).
+ </li>
+ </ul>
+ </li>
+ <li>
+ html-site
+ <ul>
+ <li>
+ Fixed a bug in html-site when comparing file
+ names. File names where not made unique before
+ comparision.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Tabkey2
+ <ul>
+ <li>
+ Fixed tabkey2 bugs.
+ </li>
+ </ul>
+ </li>
+ <li>
+ freemind.el
+ <ul>
+ <li>
+ Fixed a problem in freemind-to-org-mode that
+ caused the error "wrong-type-argument string: nil"
+ in string-match("\\(?:^--org-mode: WHOLE FILE$\\)"
+ nil).
+ </li>
+ </ul>
+ </li>
+ <li>
+ Made nXhtml menu available in sub-chunks.
+ </li>
+ <li>
+ Included a slightly changed version of Steve Yegge's
+ js2.el + js2-fl-mode.el from 2008-04-24 with support for
+ jit-lock-mode. This support has some flaws and maybe
+ js2 is not ready for use, I am not sure. However if you want
+ to use this instead of Karl Landströms javascript-mode
+ then please customize <i>mumamo-major-modes</i>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.28">1.28</dt>
+ <dd id="v1.28-dd">
+ <ul>
+ <li>
+ New version with mostly minor bug fixes from 1.27.
+ Unfortunately I put out 1.27 a bit too early.
+ Please upgrade.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.29">1.29</dt>
+ <dd id="v1.29-dd">
+ <ul>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Fixed a bug causing emacs to loop when <?>
+ was encountered in an html style buffer.
+ </li>
+ <li>
+ Fixed some problems with <? and ?> in
+ strings in html style buffers.
+ </li>
+ <li>
+ Tried to avoid chunk dividers in strings and comments. (There are still some bugs there.)
+ </li>
+ <li>
+ Fixed an error that prevented byte compiling nxhtml-mumamo.el.
+ (Thanks Christoph Conrad.)
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.30">1.30</dt>
+ <dd id="v1.30-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Added support to handle specific rng
+ schemacs. With the help of this Genshi and MJT
+ templating languages are now handled.
+ </li>
+ <li>
+ Let the rng schema file name survive mumamo major
+ mode changes.
+ </li>
+ <li>
+ Added support for to let nxml-mode skip chunks it
+ can not parse. (This requires a patch to
+ rng-valid.el too which is not included, but which
+ I hope can go into Emacs soon.)
+ </li>
+ <li>
+ Chunk dividers can now be a part on their own. (Ie
+ there will be no parsing or syntax highlighting of
+ them by the chunk major mode. This is optional and
+ specified for each chunk types.)
+ </li>
+ <li>
+ Added support for Genshi and MJT. These multi
+ major modes support completion and error checking
+ in the XML/XHTML part according to their DTD
+ (which has some additions to the XHTML DTD).
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.31">1.31</dt>
+ <dd id="v1.31-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Fixed a bug that caused multi major modes to loop sometimes.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.32">1.32</dt>
+ <dd id="v1.32-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Fixed a bug in syntax-ppss advice.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.33">1.33</dt>
+ <dd id="v1.33-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Fixed another bug in syntax-ppss advice.
+ </li>
+ <li>
+ Added support for <i>fill-forward-paragraph-function</i>.
+ </li>
+ <li>
+ Made <i>longlines-mode</i> survive major mode changes in mumamo buffers.
+ </li>
+ <li>
+ Fixed a bug that made Emacs loop when it found
+ <??> in for example nxhtml-mumamo.
+ </li>
+ <li>
+ Made it usable with Emacs 22 again.
+ </li>
+ <li>
+ Moved some changes from rng-valid.el to
+ mumamo.el. This makes it possible to let nxml-mode
+ (and derivates) jump over parts when parsing the
+ buffer even if not using the patched version of
+ Emacs+EmacsW32.
+ </li>
+ </ul>
+ </li>
+ <li>
+ nxhtml:
+ <ul>
+ <li>
+ Added command to add CSS rollover images.
+ </li>
+ </ul>
+ </li>
+ <li>
+ mlinks:
+ <ul>
+ <li>
+ Tried to fix the error <i>invalid-read-syntax "]
+ in a list"</i> when loading <i>mlinks.el</i>
+ reported by some Asian users.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.34">1.34</dt>
+ <dd id="v1.34-dd">
+ <ul>
+ <li>
+ <span style="font-size: 1.2em; color: red ()"
+ >Changed top directory name from nxml to nxhtml</span>
+ <p>
+ This will of course case some problems if you do not
+ notice it when you upgrade nXhtml. If you are using
+ EmacsW32 and upgrade nXhtml you should change the
+ file <i>emacsw32.el</i>.
+ </p>
+ <p>
+ The reason for this change is that nXml will soon
+ normally not be part of nXhtml so keeping the old
+ top directory name would be confusing.
+ </p>
+ </li>
+ <li>
+ Added a test suite. See the file <i>nxml/tests/test-Q.el</i>.
+ </li>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Fixed indentation when the whole line is a sub chunk.
+ </li>
+ <li>
+ Tried a bit more to stop nxml from parsing non-xml
+ mode chunks. Because of this php support was
+ changed a bit (for the better I hope).
+ </li>
+ </ul>
+ </li>
+ <li>
+ GIMP:
+ <ul>
+ <li>
+ Registry value location for GIMP had changed.
+ </li>
+ </ul>
+ </li>
+ <li>
+ nXhtml:
+ <ul>
+ <li>
+ Added support for
+ <a href="http://hyperstruct.net/projects/mozlab">MozLab</a>. If
+ you install MozLab in Firefox then you can
+ directly use it from javascript mode without any
+ additional setup.
+ </li>
+ <li>
+ Added <a href="http://www.oak.homeunix.org/~marcel/blog/articles/2008/07/18/nested-imenu-for-php">php-imenu.el</a>.
+ </li>
+ <li>
+ Fixed a bug where I inadvertently
+ added <i>../../lisp</i> to load-path.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.35">1.35</dt>
+ <dd id="v1.35-dd">
+ <ul>
+ <li>
+ Fixed a small bug in sex-mode.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.36">1.36</dt>
+ <dd id="v1.36-dd">
+ <ul>
+ <li>
+ Added the function <i>emacs-Q-nxhtml</i> for easier
+ testing. It does the equivalent of <i>emacs -Q --load
+ PATH-TO/nxhtml/autostart.el</i>.
+ </li>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Forgot to return php-mode in php short tags. Fixed.
+ </li>
+ <li>
+ Borders where not correctly calculated with php short tags. Fixed.
+ </li>
+ <li>
+ Subchunks not parseable by nxml-mode where marked as parseable. Fixed.
+ </li>
+ <li>
+ Debug messages from mumamo where not silenced.
+ </li>
+ <li>
+ Forgot font-lock-syntactic-keywords. This showed up in
+ bad fontification for strings sometimes. Fixed.
+ </li>
+ <li>
+ To fontify keywords font-lock-syntactically-fontified
+ must be set in each chunk. Fixed.
+ </li>
+ <li>
+ Find a way to at least temporarily work around the
+ problem with the last "e; char in
+ syntax="e;..."e; that could be seen in
+ large XHTML files, for example this file. The
+ drawback with the work around is that it bypasses
+ the cache for syntax-ppss, but this happens only
+ in multi major mode buffers and I notice no
+ performance problems here.
+ </li>
+ <li>
+ Fixed a number of problems with the defadvice for the syntax functions.
+ (I am afraid there are more left.)
+ </li>
+ <li>
+ Took a new grab on the indentation problems.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.37">1.37</dt>
+ <dd id="v1.37-dd">
+ <ul>
+ <li>
+ The command <i>emacs-Q-nxhtml</i> and cousins did not
+ work on all platform. Tried to fix it.
+ </li>
+ <li>
+ Got a report that editing Django was to slow. Tried to fix this.
+ </li>
+ <li>
+ Added a test to the unit test suite that test
+ scrolling and jumping.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.38">1.38</dt>
+ <dd id="v1.38-dd">
+ <ul>
+ <li>
+ Added a workaround that removes validation error marking in non-xhtml chunks.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.39">1.39</dt>
+ <dd id="v1.39-dd">
+ <ul>
+ <li>
+ Multi major modes where not allowed in defcustoms
+ nxhtml-magic-mode-alist and
+ nxhtml-auto-mode-alist. Fixed.
+ </li>
+ <li>
+ Added tests for the use of the lists above.
+ </li>
+ <li>
+ Fixed some bugs that could make a buffer became
+ modified during mumamo fontification actions.
+ </li>
+ </ul>
+ </dd>
+ </dl>
+ </div>
+ </div>
+
+ <hr class="footer"/>
+ <p class="footer">
+ Copyright © <!-- this year -->2008<!-- end this year --> OurComments.org
+ --
+ Latest update <!-- today -->2008-06-28<!-- end today -->
+ </p>
+ </body>
+</html>
--- /dev/null
+# blorgit --- blogging with org-mode
+require 'rubygems'
+require 'sinatra'
+require 'backend/rewrite_content_disposition'
+require 'yaml'
+$global_config ||= YAML.load(File.read(File.join(File.dirname(__FILE__), 'blorgit.yml')))
+$blogs_dir ||= File.expand_path($global_config[:blogs_dir])
+$url_prefix ||= $global_config[:url_prefix]
+require 'backend/init.rb'
+
+# Configuration (http://sinatra.rubyforge.org/book.html#configuration)
+#--------------------------------------------------------------------------------
+use RewriteContentDisposition, {"org" => "attachment"}
+set(:public, $blogs_dir)
+enable(:static)
+set(:app_file, __FILE__)
+set(:haml, { :format => :html5, :attr_wrapper => '"' })
+set(:url_prefix, $url_prefix)
+use_in_file_templates!
+mime(:org, 'text/org')
+
+# Routes (http://sinatra.rubyforge.org/book.html#routes)
+#--------------------------------------------------------------------------------
+get('/') do
+ if config['index']
+ redirect(path_for(config['index']))
+ else
+ "It seems you haven't yet configured a blogs directory. Try"+
+ " running <tt>rake new</tt> from the root. of your blorgit directory"
+ end
+end
+
+post(/^\/.search/) do
+ @query = params[:query]
+ @results = Blog.search(params[:query])
+ haml :results
+end
+
+get(/^\/\.edit\/(.*)?$/) do
+ pass unless config['editable']
+ path, format = split_format(params[:captures].first)
+ if @blog = Blog.find(path)
+ @title = @blog.title
+ @files = (Blog.files(path) or [])
+ haml :edit
+ else
+ "Nothing here to edit."
+ end
+end
+
+get(/^\/(.*)?$/) do
+ path, format = split_format(params[:captures].first)
+ @files = (Blog.files(path) or [])
+ @blog = Blog.find(path)
+ if @blog or File.directory?(Blog.expand(path))
+ if format == 'html'
+ @title = @blog ? @blog.title : path
+ haml :blog
+ elsif @blog
+ content_type(format)
+ attachment extension(@blog.path, format)
+ @blog.send("to_#{format}")
+ else
+ pass
+ end
+ elsif config['editable'] and extension(path, 'org').match(Blog.location_regexp)
+ pass if path.match(/^\./)
+ protected!
+ @path = path
+ haml :confirm_create
+ else
+ "Can't create a new page at #{path}"
+ end
+end
+
+post(/^\/(.*)?$/) do
+ path, format = split_format(params[:captures].first)
+ @blog = Blog.find(path)
+ if params[:comment]
+ pass unless (@blog and config['commentable'])
+ return "Sorry, review your math..." unless params[:checkout] == params[:captca]
+ @blog.add_comment(Comment.build(2, params[:title], params[:author], params[:body]))
+ @blog.save
+ redirect(path_for(@blog))
+ elsif config['editable']
+ protected!
+ if @blog and params[:edit]
+ @blog.body = params[:body]
+ @blog.change_log = params[:change_log] if params[:change_log]
+ @blog.save
+ redirect(path_for(@blog))
+ elsif extension(path, 'org').match(Blog.location_regexp)
+ @blog = Blog.new(:path => extension(path, 'org'),
+ :body => "# -*- mode: org -*-\n#+TITLE: #{File.basename(path)}\n#+OPTIONS: toc:nil ^:nil\n\n")
+ @blog.save
+ redirect(path_for(@blog))
+ elsif path.match(/^\./)
+ pass
+ else
+ "Can't create a new page at #{path}"
+ end
+ else
+ pass
+ end
+end
+
+# Helpers (http://sinatra.rubyforge.org/book.html#helpers)
+#--------------------------------------------------------------------------------
+helpers do
+ def config
+ $local_config_file ||= File.join($blogs_dir, '.blorgit.yml')
+ $local_config ||= $global_config[:config].merge(File.exists?($local_config_file) ? YAML.load(File.read($local_config_file)) : {})
+ config_file = File.join(File.dirname(File.join($blogs_dir, (params[:captures] ? params[:captures].first : ''))), '.blorgit.yml')
+ $local_config.merge((File.exists?(config_file)) ? YAML.load(File.read(config_file)) : {})
+ end
+
+ def split_format(url) url.match(/(.+)\.(.+)/) ? [$1, $2] : [url, 'html'] end
+
+ def path_for(path, opts ={})
+ path = (path.class == Blog ? path.path : path)
+ File.join(options.url_prefix, extension(path, (opts[:format] or nil)))
+ end
+
+ def show(blog, options={}) haml("%a{ :href => '#{path_for(blog)}' } #{blog.title}", :layout => false) end
+
+ def comment(blog, parent_comment) end
+
+ def extension(path, format = nil) (path.match(/^(.+)\..+$/) ? $1 : path)+(format ? "."+format : '') end
+
+ def time_ago(from_time)
+ distance_in_minutes = (((Time.now - from_time.to_time).abs)/60).round
+ case distance_in_minutes
+ when 0..1 then 'about a minute'
+ when 2..44 then "#{distance_in_minutes} minutes"
+ when 45..89 then 'about 1 hour'
+ when 90..1439 then "about #{(distance_in_minutes.to_f / 60.0).round} hours"
+ when 1440..2879 then '1 day'
+ when 2880..43199 then "#{(distance_in_minutes / 1440).round} days"
+ when 43200..86399 then 'about 1 month'
+ when 86400..525599 then "#{(distance_in_minutes / 43200).round} months"
+ when 525600..1051199 then 'about 1 year'
+ else "over #{(distance_in_minutes / 525600).round} years"
+ end
+ end
+
+ # from http://www.sinatrarb.com/faq.html#auth
+ def protected!
+ response['WWW-Authenticate'] = %(Basic realm="username and password required") and \
+ throw(:halt, [401, "Not authorized\n"]) and \
+ return unless ((not config['auth']) or authorized?)
+ end
+
+ def authorized?
+ @auth ||= Rack::Auth::Basic::Request.new(request.env)
+ @auth.provided? && @auth.basic? && @auth.credentials && @auth.credentials == config['auth']
+ end
+
+end
+
+# HAML Templates (http://haml.hamptoncatlin.com/)
+#--------------------------------------------------------------------------------
+__END__
+@@ layout
+!!!
+%html
+ %head
+ %meta{'http-equiv' => "content-type", :content => "text/html;charset=UTF-8"}
+ :javascript
+ function toggle(item) {
+ el = document.getElementById(item);
+ if(el.style.display == "none") { document.getElementById(item).style.display = "block" }
+ else { document.getElementById(item).style.display = "none" }
+ }
+ - if config['favicon']
+ %link{:rel => "icon", :type => "image/x-icon", :href => path_for(config['favicon'], :format => 'ico')}
+ %link{:rel => "stylesheet", :type => "text/css", :href => path_for(config['style'], :format => 'css')}
+ %title= "#{config['title']}: #{@title}"
+ %body
+ #container
+ #titlebar= render(:haml, :titlebar, :layout => false)
+ #insides
+ #sidebar= render(:haml, :sidebar, :locals => { :files => @files }, :layout => false)
+ #contents= yield
+
+@@ titlebar
+#title_pre
+#title
+ %a{ :href => path_for(''), :title => 'home' }= config['title']
+#title_post
+#search= haml :search, :layout => false
+- if @blog
+ #actions
+ %ul
+ - if config['editable']
+ %li
+ %a{ :href => path_for(File.join(".edit", @blog.path)), :title => "edit #{@title}" } edit
+ %li
+ %a{ :href => path_for(@blog, :format => 'org'), :title => 'download as org-mode' } .org
+ %li
+ %a{ :href => path_for(@blog, :format => 'tex'), :title => 'download as LaTeX' } .tex
+ %li
+ %a{ :href => path_for(@blog, :format => 'pdf'), :title => 'download as PDF' } .pdf
+#title_separator
+
+@@ sidebar
+- if (config['recent'] and (config['recent'] > 0))
+ #recent= haml :recent, :layout => false
+- if (config['dir_list'] and @files)
+ #dir= haml :dir, :locals => { :files => files }, :layout => false
+
+@@ search
+%form{ :action => path_for('.search'), :method => :post, :id => :search }
+ %ul
+ %li
+ %input{ :id => :query, :name => :query, :type => :text, :size => 12 }
+ %li
+ %input{ :id => :search, :name => :search, :value => :search, :type => :submit }
+
+@@ recent
+%label Recent
+%ul
+ - Blog.all.sort_by(&:ctime).reverse[(0..(config['recent'] - 1))].each do |blog|
+ %li
+ %a{ :href => path_for(blog)}= blog.title
+
+@@ dir
+%label Directory
+%ul
+ - files.each do |file|
+ %li
+ %a{ :href => path_for(file) + (File.directory?(Blog.expand(file)) ? "/" : "") }= File.basename(file)
+
+@@ results
+#results_list
+ %h1
+ Search Results for
+ %em= "/" + @query + "/"
+ %ul
+ - @results.sort_by{ |b,h| -h }.each do |blog, hits|
+ %li
+ %a{ :href => path_for(blog) }= blog.name
+ = "(#{hits})"
+
+@@ edit
+%h1= "Edit #{@title}"
+%form{ :action => path_for(@blog), :method => :post, :id => :comment_form }
+ %textarea{ :id => :body, :name => :body, :rows => 28, :cols => 82 }= @blog.body
+ %br
+ Change log:
+ %input{ :id => :change_log, :name => :change_log, :type => :text }
+ %input{ :id => :submit, :name => :edit, :value => :update, :type => :submit }
+ %a{ :href => path_for(@blog) } Cancel
+
+@@ blog
+- if @blog
+ #blog_body= @blog.to_html
+ - if (config['commentable'] and (not @blog.commentable == 'disabled'))
+ #comments= render(:haml, :comments, :locals => {:comments => @blog.comments, :commentable => @blog.commentable}, :layout => false)
+- else
+ #dir= haml :dir, :locals => { :files => @files }, :layout => false
+
+@@ comments
+#existing_commment
+ %label= "Comments (#{comments.size})"
+ %ul
+ - comments.each do |comment|
+ %li
+ %ul
+ %li
+ %label title
+ = comment.title
+ %li
+ %label author
+ = comment.author
+ %li
+ %label date
+ = time_ago(comment.date) + " ago"
+ %li
+ %label comment
+ %div= Blog.string_to_html(comment.body)
+- unless commentable == 'closed'
+ #new_comment
+ %label{ :onclick => "toggle('comment_form');"} Post a new Comment
+ %form{ :action => path_for(@blog), :method => :post, :id => :comment_form, :style => 'display:none' }
+ - equation = "#{rand(10)} #{['+', '*', '-'].sort_by{rand}.first} #{rand(10)}"
+ %ul
+ %li
+ %label name
+ %input{ :id => :author, :name => :author, :type => :text }
+ %li
+ %label title
+ %input{ :id => :title, :name => :title, :type => :text, :size => 36 }
+ %li
+ %label comment
+ %textarea{ :id => :body, :name => :body, :rows => 8, :cols => 68 }
+ %li
+ %input{ :id => :checkout, :name => :checkout, :type => :hidden, :value => eval(equation) }
+ %span
+ %p to protect against spam, please answer the following
+ = equation + " = "
+ %input{ :id => :captca, :name => :captca, :type => :text, :size => 4 }
+ %li
+ %input{ :id => :submit, :name => :comment, :value => :comment, :type => :submit }
+
+@@ confirm_create
+%form{ :action => path_for(@path), :method => 'post', :id => 'creation_form'}
+ %label
+ Create a new page at
+ %em= @path
+ ?
+ %input{ :id => 'submit', :name => 'submit', :value => 'create', :type => 'submit' }
+ %a{ :href => path_for('/') } cancel
+
--- /dev/null
+<html>\r
+ <head>\r
+ <script>\r
+ function x () { return 1 > 0; }\r
+ </script>\r
+ </head>\r
+ <body class="foo">\r
+ </body>\r
+</html>\r
--- /dev/null
+<?php\r
+\r
+$parent_id = 5;\r
+var_dump($parent_id);\r
+\r
+?>\r
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>\r
+<map version="0.9.0">\r
+<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\r
+<node text="Title">\r
+<node text="Node 1">\r
+</node><!-- a -->\r
+<node text="Node 2">\r
+</node><!-- b -->\r
+</node><!-- c cl=3, bl=1, odd=t -->\r
+</map>\r
--- /dev/null
+* Title\r
+*** Node 1\r
+*** Node 2\r
--- /dev/null
+<?php
+include 'HTML/QuickForm.php';
+
+echo '<script type="text/javascript" src="library/javascript/prototype.js" language="javascript"></script>';
+echo '<script type="text/javascript" src="library/javascript/scriptaculous.js" language="javascript"></script>';
+echo '<script type="text/javascript" src="library/cropper/cropper.js" language="javascript"></script>';
+
+
+
+echo ' <img src="test.jpg" alt="Test image" id="testImage" width="500" height="333" />';
+
+echo ' <script type="text/javascript" language="javascript">';
+
+echo ' function onEndCrop( coords, dimensions ) {';
+// echo ' $( "x1" ).value = coords.x1;';
+// echo ' $( "y1" ).value = coords.y1;';
+// echo ' $( "x2" ).value = coords.x2;';
+// echo ' $( "y2" ).value = coords.y2;';
+// echo ' $( "width" ).value = dimensions.width;';
+// echo ' $( "height" ).value = dimensions.height;';
+// echo 'console.log(coords.x1);';
+// echo 'console.log(coords.x2);';
+// echo ' style = clip:rect( + coords.x1 + "px " + coords.y1 + "px " + coords.x2 + "px " + coords.y2 + "px)\n"';
+?>
+style = "clip:rect(0px 130px 130px 0px)";
+$("hidden_0").value = new Array (coords.x1, coords.x2, coords.y1, coords.y2);
+$("testImage").writeAttribute("style=" style);
+}
+function js_init () {
+ Event.observe( "button_0", "click", function() { } );
+ // $("file_0").writeAttribute("src", "")
+
+ new Cropper.Img("testImage", {minWidth: 220,previewWrap: "previewWrap", onEndCrop: onEndCrop });
+}
+
+
+
+Event.observe( window, "load", function() {
+ js_init ();
+ } );
+?>
+echo ' </script>';
+
+echo '<h1> Cropper votre image v0.1</h1>';
+
+$label = 'file_default';
+
+$form = new HTML_QuickForm ('cropper_form', "", "img-cropped.php", '', 'enctype=multipart/form-data');
+
+$form->addElement ('file', 'file_0', $label);
+$form->addElement ('hidden', 'hidden_0');
+$form->addElement ('button', 'button_0');
+$form->updateElementAttr(array('button_0'), array ('id' => 'button_0'));
+$form->addElement ('submit', 'submit_0', 'Envoyer!');
+$form->updateElementAttr(array('file_0'), array ('id' => 'file_0'));
+$form->updateElementAttr(array('hidden_0'), array ('id' => 'hidden_0'));
+echo $form->toHtml ();
+
+if (isset ($_POST['file_0'])):
+$image = $_POST['file_0'];
+tmpfile ($image);
+echo $_POST['file_0'];
+endif;
+echo sys_get_temp_dir ();
+var_dump ($_POST);
+?>
\ No newline at end of file
--- /dev/null
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">\r
+<html>\r
+\r
+<head>\r
+<meta http-equiv="expires" content="Monday, February 2nd, 2004 7:51:17pm">\r
+<title>The ACSys Group Home Page</title>\r
+</head>\r
+ <frameset rows="113,*" framespacing="0" frameborder="0">\r
+\r
+ <frame name="logo" target="logo" src="logo.htm" marginwidth="4" marginheight="0">\r
+\r
+ <frameset cols="17%,*" framespacing="0" frameborder="0">\r
+ <frame name="menu" target="content" src="menu.htm" marginwidth="4" marginheight="0">\r
+ <frame name="content" target="_self" src="mission.htm" marginwidth="0" marginheight="0">\r
+ </frameset>\r
+ \r
+ <noframes>\r
+ <body>\r
+ <p>This page uses frames, but your browser doesn't support them.</p>\r
+ </body>\r
+ </noframes>\r
+\r
+ </frameset>\r
+</html>\r
--- /dev/null
+<script type="text/javascript">
+ // Set this to the URL you used to fetch recommendations, whether you
+ // fetched them on the client or the server.
+ var request_url = '%(json_url)s';
+
+ // This function is used track click-throughs by fetching a web
+ // beacon.n
+ function trackClickThrough(elem) {
+ var img = new Image();
+ img.src = '%(beacon_url)s' +
+ '?request_url=' + escape(request_url) +
+ '&click_through_url=' + escape(elem.href);
+ return true;
+ }
+</script>
+
+<p>
+ <!--
+ Imagine this is one of the recommendations that was returned.
+ Just add an onclick handler that calls trackClickThrough.
+ -->
+ <a href="http://www.google.com"
+ onclick="return trackClickThrough(this);">Click me!</a>
+</p>
--- /dev/null
+<?
+
+try {
+} catch (PDOException $e) {
+ }
+
+?>
\ No newline at end of file
--- /dev/null
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
+ <head>
+ <title>Flipbook (draft)</title>
+ <style type="text/css">
+ body {
+ background-color: black;
+ color: white;
+ }
+
+ .ui-effects-transfer {
+ border: 2px dotted gray;
+ }
+ </style>
+ <script type="text/javascript" src="jquery.js"></script>
+ <script type="text/javascript" src="jquery-ui.js"></script>
+ <script type="text/javascript" src="jquery.event.special.gesture.js"></script>
+ <script type="text/javascript" src="jquery.gestureable.js"></script>
+ <script type="text/javascript">
+ /* Code to do some fancy book-like effects
+ */
+
+ /* a closure-based class */
+ var ImageManager = function (images) {
+ var self = this;
+ var currentPage = 0;
+
+ self.getCurrentPages = function () {
+ return [images[currentPage],
+ images[currentPage+1]];
+ };
+
+ self.turnNext = function () {
+ currentPage += 2;
+ return self.getCurrentPages();
+ };
+
+ self.turnPrevious = function () {
+ currentPage -= 2;
+ return self.getCurrentPages();
+ };
+ };
+
+ function style_element(element) {
+ element.css('background-color', 'black');
+ element.css('width', '900px');
+ element.css('height', '650px');
+ element.css('border', '2px dashed white');
+ }
+
+ function small_gesture(event) {
+ /* called in mousedown of small images */
+ var container = $(event.target).closest('div');
+ var manager = container.data('manager');
+ var large = $(event.target).
+ attr('src').
+ replace(/small/, 'large');
+
+ switch (event.gesture) {
+ case 'U':
+ case 'D':
+ container.data('left').hide();
+ container.data('right').hide();
+ container.data('spacer').hide();
+ container.data('zoomed').attr('src', large).show('clip');
+ break;
+ case 'L':
+ var images = manager.turnPrevious();
+ container.data('left').attr('src', images[0] + '_small.jpg');
+ container.data('right').attr('src', images[1] + '_small.jpg');
+ break;
+ case 'R':
+ var images = manager.turnNext();
+ container.data('left').attr('src', images[0] + '_small.jpg');
+ container.data('right').attr('src', images[1] + '_small.jpg');
+ break;
+ }
+ }
+
+ function large_gesture(event) {
+ var container = $(event.target).closest('div');
+ switch (event.gesture) {
+ case 'U':
+ case 'D':
+ $(event.target).hide();
+ container.data('spacer').show();
+ container.data('left').show();
+ container.data('right').show();
+ }
+ }
+
+ function disable_scroll(event) {
+ /* Simply disables the dragging of elements */
+ return false;
+ }
+
+ function flipbook(element, images) {
+ var manager = new ImageManager(images);
+ element.data('manager', manager);
+
+ // apply the style
+ style_element(element);
+
+ // create a spacer div and attach it
+ var spacer = $('<div class="spacer"></div>');
+ spacer.css('height', '162px');
+ element.data('spacer', spacer);
+ element.append(spacer);
+
+ var zoomed = $('<img />');
+ zoomed.gestureable();
+ zoomed.mouseup(large_gesture).
+ mousedown(disable_scroll).
+ hide();
+
+ element.data('zoomed', zoomed);
+ element.append(zoomed);
+
+ // create the images
+ var currentImages = manager.getCurrentPages();
+ var left = $('<img src="' + currentImages[0] + '_small.jpg" />');
+ var right = $('<img src="' + currentImages[1] + '_small.jpg" />');
+ element.data('left', left);
+ element.data('right', right);
+
+ $([left, right]).each(function (key, value) {
+ // enable gestures
+ value.gestureable();
+ value.mouseup(small_gesture);
+ value.mousedown(disable_scroll);
+ // add to the display
+ element.append(value);
+ });
+ }
+
+ $(document).ready(function () {
+ flipbook($('#flipbook'),
+ ['image_01', 'image_02', 'image_03', 'image_04',
+ 'image_05', 'image_06', 'image_07', 'image_08',
+ 'image_09', 'image_10', 'image_11', 'image_12',
+ 'image_13', 'image_14', 'image_15']);
+ });
+ </script>
+ </head>
+ <body>
+ <div id="flipbook"></div>
+ <p>Usage: gesture left/right to change images, up/down to zoom in/out</p>
+ <p>The flipbook uses a number of libs:</p>
+ <p>
+ <ul>
+ <li>jQuery</li>
+ <li>jQuery UI</li>
+ <li>jQuery Special Event Gestures</li>
+ </ul>
+ </p>
+ </body>
+</html>
--- /dev/null
+;; 3. Add a new c-indentation-style:
+
+(defconst drupal
+ '((c-basic-offset . 2)
+ (c-offsets-alist . ((arglist-close . c-lineup-close-paren)
+ (case-label . +)
+ (arglist-intro . +)
+ (arglist-cont-nonempty . c-lineup-math))))
+ "My Drupal Programming style")
+
+(c-add-style "drupal" drupal)
+
+;; 4. Open file test.php, attached.
+
+;; 5. Run `c-set-style' and select "drupal"
+
+;; 6. Select the whole buffer and press "C-M-\" (or any other indentation command,
+;; for that matter) and watch as the array elements are lined up with "array(",
+;; whereas they should be indented by 2.
+
+;; 7. Run M-x php-mode and c-set-style to drupal
+
+;; 8. Try indenting again to see that indentation now works properly.
--- /dev/null
+<?php
+$a = array(
+ 'foo' => 'bar',
+ 'gaz' => 'gazonk',
+);
+?>
\ No newline at end of file
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <meta content="text/html;charset=utf-8" http-equiv="Content-Type" />
+ <link rel="icon" href="/favicon.ico" />
+
+ <%= include_stylesheets :blueprint, :application, :media => 'all' %>
+<!--[if lt IE 8]>
+ <%= include_stylesheets :ie, :media => 'all' %>
+ <![endif]-->
+<%= include_javascripts :mootools, :application %>
+ </head>
+ <body>
+ <div id="container">
+ <%= render :partial => "layouts/application/header" %>
+<%= render :partial => "layouts/application/menu" %>
+ <%= render :partial => "layouts/application/search_bar" %>
+<%= render :partial => "layouts/application/contents" %>
+ <%= render :partial => "layouts/application/footer" %>
+</div>
+ </body>
+</html>
--- /dev/null
+!!! Strict\r
+%html\r
+ %head\r
+ %title= t("site.title")\r
+ %meta{"http-equiv" => "Content-Type", :content => "text/html;charset=utf-8"}\r
+ = javascript_include_merged :mootools, :application\r
+ = stylesheet_link_merged :application\r
+ /[if lt IE 8]\r
+ = stylesheet_link_merged :ie\r
+\r
+ %body\r
+ = render :partial => "shared/fork"\r
+ #container\r
+ #logo\r
+ = link_to image_tag("logo.png"), root_url\r
+\r
+ = render :partial => "shared/user_panel"\r
+ = render :partial => "shared/menu"\r
+\r
+ #body\r
+ #contents\r
+ = render :partial => "shared/flash", :object => flash\r
+\r
+ .padder\r
+ #search_results\r
+\r
+ = yield\r
+\r
+ #sidebar\r
+ .padder\r
+ = render :partial => "shared/sidebar"\r
+\r
+ #footer\r
+ %p= t("site.copyright")\r
--- /dev/null
+\r
+<% semantic_form_for @user_session do |form| %>\r
+<%= form.error_messages :header_tag => :h3 %>\r
+<%#= authlogic_facebook_login_button %>\r
+\r
+<% form.inputs do %>\r
+<%= form.input :email %>\r
+<%= form.input :password %>\r
+<% end %>\r
+\r
+<% form.buttons do %>\r
+<%= form.commit_button %>\r
+<% end %>\r
+<% end %>\r
--- /dev/null
+<% collection.each do |item| %>\r
+<%= item.method %>\r
+<% end %>\r
+\r
--- /dev/null
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+ xmlns:py="http://genshi.edgewall.org/"
+ xmlns:xi="http://www.w3.org/2001/XInclude"
+ lang="en">
+ <xi:include href="../layout.html" />
+ <head>
--- /dev/null
+;;; bug271497.el --- For bug report 271497 at Launchpad
+(require 'ada-mode)
+(require 'mumamo)
+
+(eval-and-compile
+ (defun mumamo-chunk-embjava (pos min max)
+ "Find JAVA_ON ... JAVA_OFF, return range and java-mode."
+ (mumamo-quick-static-chunk pos min max "JAVA_ON" "JAVA_OFF" nil 'java-mode nil))
+ )
+
+(define-mumamo-multi-major-mode bug271497-mumamo
+ "docstring"
+ ("ADA Mode" ada-mode
+ (mumamo-chunk-embjava)))
--- /dev/null
+This is supposed to be ada code
+
+JAVA_ON
+and this is supposed to be java code
+JAVA_OFF
+
+This is also supposed to be ada code
--- /dev/null
+<?php
+function a()
+{
+ b($a, $b);
+ c($b, $c);
+}
+?>
\ No newline at end of file
--- /dev/null
+("/usr/bin/emacs22-gtk")
+Loading 00debian-vars...
+No /etc/mailname. Reverting to default...
+Loading 00debian-vars...done
+Loading /etc/emacs/site-start.d/20apel.el (source)...done
+Loading /etc/emacs/site-start.d/50cedet-common.el (source)...
+Loading advice...done
+Loading /etc/emacs/site-start.d/50cedet-common.el (source)...done
+Loading /etc/emacs/site-start.d/50css-mode.el (source)...done
+Loading /etc/emacs/site-start.d/50devhelp.el (source)...done
+Loading /etc/emacs/site-start.d/50dictionaries-common.el (source)...
+Loading debian-ispell...
+Loading /var/cache/dictionaries-common/emacsen-ispell-default.el (source)...done
+Loading debian-ispell...done
+Loading /var/cache/dictionaries-common/emacsen-ispell-dicts.el (source)...done
+Loading /etc/emacs/site-start.d/50dictionaries-common.el (source)...done
+Loading /etc/emacs/site-start.d/50eieio.el (source)...done
+Loading /etc/emacs/site-start.d/50eldav.el (source)...done
+Loading /etc/emacs/site-start.d/50elserv.el (source)...done
+Loading /etc/emacs/site-start.d/50emacs-extra.el (source)...done
+Loading /etc/emacs/site-start.d/50emacs-goodies-el.el (source)...done
+Loading /etc/emacs/site-start.d/50erc.el (source)...
+Loading erc-auto...done
+Loading /etc/emacs/site-start.d/50erc.el (source)...done
+Loading /etc/emacs/site-start.d/50flim.el (source)...done
+Loading /etc/emacs/site-start.d/50gettext.el (source)...done
+Loading /etc/emacs/site-start.d/50html-helper-mode.el (source)...done
+Loading /etc/emacs/site-start.d/50mmm-mode.el (source)...done
+Loading /etc/emacs/site-start.d/50php-elisp.el (source)...done
+Loading /etc/emacs/site-start.d/50php-mode.el (source)...done
+Loading /etc/emacs22/site-start.d/50psgml-init.el (source)...done
+Loading /etc/emacs/site-start.d/50psvn.el (source)...done
+Loading /etc/emacs/site-start.d/50tramp.el (source)...done
+Loading /etc/emacs/site-start.d/50w3m-el.el (source)...done
+Loading /etc/emacs/site-start.d/51ede.el (source)...done
+Loading /etc/emacs/site-start.d/51speedbar.el (source)...done
+Loading /etc/emacs/site-start.d/52semantic.el (source)...done
+Loading /etc/emacs/site-start.d/53cedet-contrib.el (source)...done
+Loading /etc/emacs/site-start.d/53cogre.el (source)...done
+Loading /etc/emacs/site-start.d/55ecb.el (source)...
+"/usr/share/emacs22/site-lisp/cedet-common/" added to `load-path'
+Setting up cedet...done
+Setting up cogre...done
+Setting up ede...
+Loading ede...
+Loading ede-speedbar...done
+Loading ede...done
+Setting up ede...done
+Setting up eieio...done
+Setting up semantic...
+Loading derived...done
+Setting up semantic...done
+Setting up speedbar...done
+Setting up cedet-contrib...done
+Loading /etc/emacs/site-start.d/55ecb.el (source)...done
+Loading /etc/emacs22/site-start.d/60nxml-mode.el (source)...
+Loading /usr/share/emacs22/site-lisp/nxml-mode/rng-auto.el (source)...done
+Loading /etc/emacs22/site-start.d/60nxml-mode.el (source)...done
+Loading /etc/emacs/site-start.d/60wysihtml-el.el (source)...done
+Loading /home/guillaume/elisp/nxhtml/autostart.el (source)...
+Nxml/Nxhtml Autostart.el loading ...
+Loading edmacro...done
+Loading easy-mmode...done
+Loading /home/guillaume/elisp/nxhtml/nxhtml-loaddefs.el (source)...done
+Loading /home/guillaume/elisp/nxhtml/etc/schema/schema-path-patch.el (source)...done
+xhtml-loader.rnc was ok
+(No changes need to be saved)
+Loading /home/guillaume/elisp/nxhtml/nxhtml/nxhtml-autoload.el (source)...
+Loading /home/guillaume/elisp/nxhtml/util/majmodpri.el (source)...done
+majmodpri-sort-lists running ...
+Loading /home/guillaume/elisp/nxhtml/nxhtml/nxhtml-autoload.el (source)...done
+Loading /home/guillaume/elisp/nxhtml/autostart.el (source)...done
+Loading /home/guillaume/elisp/nxhtml/nxhtml/nxhtml.el (source)...
+html-site-current (information): No current site set
+Loading /home/guillaume/elisp/nxhtml/nxhtml/nxhtml.el (source)...done
+Loading nxml-uchnm...done
+Loading rng-nxml...done
+Loading rng-cmpct...done
+Loading rng-xsd...done
+Using vacuous schema
+Loading /home/guillaume/elisp/nxhtml/nxhtml/nxhtml-menu.el (source)...done
+Loading /home/guillaume/elisp/nxhtml/util/mlinks.el (source)...done
+Loading imenu...done
+Loading /home/guillaume/elisp/nxhtml/nxhtml/nxhtml-mumamo.el (source)...
+Loading byte-opt...done
+Loading /home/guillaume/elisp/nxhtml/nxhtml/nxhtml-mumamo.el (source)...done
+Showing all blocks ... done
+Loading semantic-html...done
+Loading /home/guillaume/elisp/geben/geben.el (source)...done
+ispell.el is already loaded
+Using vacuous schema [4 times]
+Loading semantic-el...done
+let: Wrong type argument: stringp, nil [2 times]
+Making completion list...
+Loading eieio-opt...done
+Making completion list...
+let: Wrong type argument: stringp, nil
\ No newline at end of file
--- /dev/null
+<?php
+ define('APPLICATION_PATH', realpath(dirname(__FILE__) . '/../application/'));
+set_include_path(
+ APPLICATION_PATH . '/../library'
+ . PATH_SEPARATOR . get_include_path()
+ );
+
+if(true){
+ echo 'test';
+ }
+else
+ {
+
+ }
+
+require_once "Zend/Loader.php";
+Zend_Loader::registerAutoload();
+
+try
+{
+ require '../application/bootstrap.php';
+ }
+catch(Exception $exception)
+{
+ echo '<html><body><center>'
+ . 'An exception occured while bootstrapping the application.';
+ if(defined('APPLICATION_ENVIRONMENT')
+ && APPLICATION_ENVIRONMENT != 'production'
+ ) {
+ echo '<br /><br />' . $exception->getMessage() . '<br />'
+ . '<div align="left">Stack Trace:'
+ . '<pre>' . $exception->getTraceAsString() . '</pre></div>';
+ }
+ echo '</center><body></html>';
+ exit(1);
+ }
+
+Zend_Controller_Front::getInstance()->dispatch();
--- /dev/null
+<?php
+echo 'test';
+?>
--- /dev/null
+load-history is a variable defined in `C source code'.
+Its value is shown below.
+
+Documentation:
+Alist mapping file names to symbols and features.
+Each alist element is a list that starts with a file name,
+except for one element (optional) that starts with nil and describes
+definitions evaluated from buffers not visiting files.
+
+The file name is absolute and is the true file name (i.e. it doesn't
+contain symbolic links) of the loaded file.
+
+The remaining elements of each list are symbols defined as variables
+and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
+`(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
+and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
+`(defun . FUNCTION)', and means that SYMBOL was an autoload before
+this file redefined it as a function.
+
+During preloading, the file name recorded is relative to the main Lisp
+directory. These file names are converted to absolute at startup.
+
+Value:
+(("/home/hobbes/nxhtml/autostart.el" nxhtml-install-dir
+ (defun . nxhtml-custom-autoload)
+ (defun . nxhtml-list-loaded-features)
+ (provide . nxhtml-autostart))
+ ("/home/hobbes/nxhtml/nxhtml/nxhtml-autoload.el"
+ (require . majmodpri)
+ (require . moz)
+ (defun . javascript-moz-setup)
+ nxhtml-src-dir
+ (provide . nxhtml-autoload))
+ ("/home/hobbes/nxhtml/related/moz.el"
+ (require . comint)
+ (require . cc-cmds)
+ moz-minor-mode-map moz-minor-mode
+ (t . moz-minor-mode)
+ (defun . moz-minor-mode)
+ (defun . run-mozilla)
+ moz-repl-name moz-input-separator moz-repl-host moz-repl-port moz-temporary-file
+ (defun . moz-temporary-file)
+ (defun . moz-send-region)
+ (defun . moz-send-defun)
+ (defun . moz-send-defun-and-go)
+ (defun . moz-save-buffer-and-send)
+ inferior-moz-buffer
+ (defun . inferior-moz-insert-moz-repl)
+ inferior-moz-mode-map inferior-moz-mode-map inferior-moz-mode-syntax-table inferior-moz-mode-abbrev-table inferior-moz-mode-abbrev-table
+ (t . inferior-moz-mode)
+ (defun . inferior-moz-mode)
+ (defun . inferior-moz-track-repl-name)
+ (defun . inferior-moz-self-insert-or-repl-name)
+ (defun . inferior-moz-input-sender)
+ (defun . inferior-moz-switch-to-mozilla)
+ (defun . inferior-moz-process)
+ (defun . inferior-moz-start-process)
+ (provide . moz))
+ ("/usr/share/emacs/23.0.93/lisp/progmodes/cc-cmds.elc"
+ (require . cc-defs)
+ (require . cc-vars)
+ (require . cc-engine)
+ c-fix-backslashes
+ (defun . c-indent-line)
+ (defun . c-newline-and-indent)
+ (defun . c-show-syntactic-information)
+ (defun . c-syntactic-information-on-region)
+ (defun . c-update-modeline)
+ (defun . c-toggle-syntactic-indentation)
+ (defun . c-toggle-auto-newline)
+ (defun . c-toggle-auto-state)
+ (defun . c-toggle-hungry-state)
+ (defun . c-toggle-auto-hungry-state)
+ (defun . c-toggle-electric-state)
+ (defun . c-electric-backspace)
+ (defun . c-hungry-delete-backwards)
+ (defun . c-hungry-backspace)
+ (defun . c-electric-delete-forward)
+ (defun . c-hungry-delete-forward)
+ (defun . c-electric-delete)
+ (defun . c-hungry-delete)
+ (defun . c-electric-pound)
+ (defun . c-point-syntax)
+ (defun . c-brace-newlines)
+ (defun . c-try-one-liner)
+ (defun . c-electric-brace)
+ (defun . c-electric-slash)
+ (defun . c-electric-star)
+ (defun . c-electric-semi&comma)
+ (defun . c-electric-colon)
+ (defun . c-electric-lt-gt)
+ (defun . c-electric-paren)
+ (defun . c-electric-continued-statement)
+ (defun . c-forward-into-nomenclature)
+ (defun . c-backward-into-nomenclature)
+ (defun . c-scope-operator)
+ (defun . c-in-function-trailer-p)
+ (defun . c-where-wrt-brace-construct)
+ (defun . c-backward-to-nth-BOF-{)
+ (defun . c-beginning-of-defun)
+ (defun . c-forward-to-nth-EOF-})
+ (defun . c-end-of-defun)
+ (defun . c-defun-name)
+ (defun . c-declaration-limits)
+ (defun . c-mark-function)
+ (defun . c-cpp-define-name)
+ (defun . c-in-comment-line-prefix-p)
+ (defun . c-narrow-to-comment-innards)
+ (defun . c-beginning-of-sentence-in-comment)
+ (defun . c-end-of-sentence-in-comment)
+ (defun . c-beginning-of-sentence-in-string)
+ (defun . c-end-of-sentence-in-string)
+ (defun . c-ascertain-preceding-literal)
+ (defun . c-ascertain-following-literal)
+ (defun . c-after-statement-terminator-p)
+ (defun . c-back-over-illiterals)
+ (defun . c-forward-over-illiterals)
+ (defun . c-one-line-string-p)
+ (defun . c-beginning-of-statement)
+ (defun . c-end-of-statement)
+ (defun . c-calc-comment-indent)
+ (defun . c-comment-indent)
+ (defun . c-outline-level)
+ (defun . c-up-conditional)
+ (defun . c-up-conditional-with-else)
+ (defun . c-down-conditional)
+ (defun . c-down-conditional-with-else)
+ (defun . c-backward-conditional)
+ (defun . c-forward-conditional)
+ (defun . c-indent-command)
+ (defun . c-indent-exp)
+ (defun . c-indent-defun)
+ (defun . c-indent-region)
+ (defun . c-fn-region-is-active-p)
+ (defun . c-indent-line-or-region)
+ c-progress-info
+ (defun . c-progress-init)
+ (defun . c-progress-update)
+ (defun . c-progress-fini)
+ (defun . c-backslash-region)
+ (defun . c-append-backslashes-forward)
+ (defun . c-delete-backslashes-forward)
+ c-auto-fill-prefix c-lit-limits c-lit-type
+ (defun . c-guess-fill-prefix)
+ (defun . c-mask-paragraph)
+ (defun . c-fill-paragraph)
+ (defun . c-do-auto-fill)
+ (defun . c-indent-new-comment-line)
+ (defun . c-comment-line-break-function)
+ (defun . c-context-line-break)
+ (defun . c-context-open-line)
+ (provide . cc-cmds))
+ ("/usr/share/emacs/23.0.93/lisp/progmodes/cc-engine.elc"
+ (require . cc-defs)
+ (require . cc-vars)
+ (defun . c-declare-lang-variables)
+ c++-template-syntax-table c-identifier-syntax-modifications c-identifier-syntax-table c-get-state-before-change-function c-before-font-lock-function c-symbol-start c-symbol-key c-nonsymbol-chars c-opt-identifier-concat-key c-identifier-start c-identifier-key c-string-escaped-newlines c-multiline-string-start-char c-opt-cpp-prefix c-anchored-cpp-prefix c-opt-cpp-start c-opt-cpp-macro-define-start c-opt-cpp-macro-define-id c-overloadable-operators-regexp c-opt-op-identifier-prefix c-nonsymbol-token-regexp c-assignment-op-regexp c-<>-multichar-token-regexp c-<-op-cont-regexp c->-op-cont-regexp c-stmt-delim-chars c-stmt-delim-chars-with-comma c-line-comment-starter c-comment-start-regexp c-block-comment-start-regexp c-literal-start-regexp c-doc-comment-start-regexp c-syntactic-ws-start c-syntactic-ws-end c-syntactic-eol c-at-vsemi-p-fn c-vsemi-status-unknown-p-fn c-paragraph-start c-paragraph-separate c-primitive-type-key c-type-prefix-key c-opt-type-modifier-key c-opt-type-component-key c-class-key c-brace-list-key c-other-decl-block-key c-other-decl-block-key-in-symbols-alist c-decl-hangon-key c-prefix-spec-kwds-re c-specifier-key c-not-decl-init-keywords c-opt-block-decls-with-vars-key c-colon-type-list-re c-opt-<>-sexp-key c-block-stmt-1-key c-block-stmt-2-key c-opt-block-stmt-key c-simple-stmt-key c-paren-stmt-key c-opt-asm-stmt-key c-case-kwds-regexp c-label-kwds-regexp c-opt-inexpr-brace-list-key c-decl-block-key c-opt-bitfield-key c-keywords-regexp c-keywords-obarray c-regular-keywords-regexp c-primary-expr-regexp c-decl-prefix-re c-decl-start-re c-decl-prefix-or-start-re c-cast-parens c-block-prefix-charset c-type-decl-prefix-key c-type-decl-suffix-key c-after-suffixed-type-decl-key c-after-suffixed-type-maybe-decl-key c-opt-type-concat-key c-opt-type-suffix-key c-known-type-key c-special-brace-lists c-recognize-knr-p c-recognize-typeless-decls c-recognize-<>-arglists c-recognize-paren-inits c-recognize-paren-inexpr-blocks c-opt-<>-arglist-start c-opt-<>-arglist-start-in-paren c-opt-postfix-decl-spec-key c-recognize-colon-labels c-label-prefix-re c-nonlabel-token-key c-opt-extra-label-key c-opt-friend-key c-opt-method-key c-type-decl-end-used c-hungry-delete-key c-electric-flag c-auto-newline
+ (defun . c-calculate-state)
+ c-in-literal-cache c-macro-start
+ (defun . c-query-and-set-macro-start)
+ (defun . c-query-macro-start)
+ (defun . c-beginning-of-macro)
+ (defun . c-end-of-macro)
+ (defun . c-forward-over-cpp-define-id)
+ (defun . c-forward-to-cpp-define-body)
+ (defun . c-syntactic-content)
+ (defun . c-shift-line-indentation)
+ (defun . c-keyword-sym)
+ (defun . c-keyword-member)
+ c-string-syntax c-string-syntax c-string-limit-regexp c-string-limit-regexp c-ws*-string-limit-regexp c-ws*-string-limit-regexp c-parsing-error
+ (defun . c-echo-parsing-error)
+ c-literal-faces
+ (defun . c-put-c-type-property)
+ (defun . c-clear-c-type-property)
+ (defun . c-debug-add-face)
+ (defun . c-debug-remove-face)
+ (defun . c-bos-push-state)
+ (defun . c-bos-pop-state)
+ (defun . c-bos-pop-state-and-retry)
+ (defun . c-bos-save-pos)
+ (defun . c-bos-restore-pos)
+ (defun . c-bos-save-error-info)
+ (defun . c-bos-report-error)
+ (defun . c-beginning-of-statement-1)
+ (defun . c-crosses-statement-barrier-p)
+ (defun . c-at-statement-start-p)
+ (defun . c-at-expression-start-p)
+ (defun . c-forward-single-comment)
+ (defun . c-forward-comments)
+ (defun . c-backward-single-comment)
+ (defun . c-backward-comments)
+ (defun . c-debug-sws-msg)
+ (defun . c-put-is-sws)
+ (defun . c-put-in-sws)
+ (defun . c-remove-is-sws)
+ (defun . c-remove-in-sws)
+ (defun . c-remove-is-and-in-sws)
+ (defun . c-invalidate-sws-region-after)
+ (defun . c-forward-sws)
+ (defun . c-backward-sws)
+ (defun . c-partial-ws-p)
+ c-state-cache c-state-cache-start c-state-cache-good-pos
+ (defun . c-invalidate-state-cache)
+ (defun . c-get-fallback-start-pos)
+ (defun . c-parse-state)
+ c-debug-parse-state
+ (defun . c-debug-parse-state)
+ (defun . c-toggle-parse-state-debug)
+ (defun . c-whack-state-before)
+ (defun . c-whack-state-after)
+ (defun . c-most-enclosing-brace)
+ (defun . c-least-enclosing-brace)
+ (defun . c-safe-position)
+ (defun . c-beginning-of-syntax)
+ (defun . c-on-identifier)
+ (defun . c-simple-skip-symbol-backward)
+ (defun . c-beginning-of-current-token)
+ (defun . c-end-of-current-token)
+ c-jump-syntax-balanced c-jump-syntax-balanced c-jump-syntax-unbalanced c-jump-syntax-unbalanced
+ (defun . c-forward-token-2)
+ (defun . c-backward-token-2)
+ (defun . c-forward-token-1)
+ (defun . c-backward-token-1)
+ (defun . c-syntactic-re-search-forward)
+ (defun . c-syntactic-skip-backward)
+ (defun . c-slow-in-literal)
+ (defun . c-fast-in-literal)
+ (defun . c-in-literal)
+ (defun . c-literal-limits)
+ (defun . c-literal-limits-fast)
+ (defun . c-collect-line-comments)
+ (defun . c-literal-type)
+ c-find-decl-syntactic-pos c-find-decl-match-pos
+ (defun . c-invalidate-find-decl-cache)
+ (defun . c-debug-put-decl-spot-faces)
+ (defun . c-debug-remove-decl-spot-faces)
+ (defun . c-find-decl-prefix-search)
+ (defun . c-find-decl-spots)
+ c-found-types
+ (defun . c-clear-found-types)
+ (defun . c-add-type)
+ (defun . c-unfind-type)
+ (defun . c-check-type)
+ (defun . c-list-found-types)
+ (defun . c-trim-found-types)
+ (defun . c-after-change-check-<>-operators)
+ c-promote-possible-types c-parse-and-markup-<>-arglists c-restricted-<>-arglists c-record-type-identifiers c-record-ref-identifiers c-last-identifier-range
+ (defun . c-record-type-id)
+ (defun . c-record-ref-id)
+ c-record-found-types
+ (defun . c-forward-keyword-prefixed-id)
+ (defun . c-forward-id-comma-list)
+ (defun . c-forward-keyword-clause)
+ (defun . c-forward-<>-arglist)
+ (defun . c-forward-<>-arglist-recur)
+ (defun . c-backward-<>-arglist)
+ (defun . c-forward-name)
+ (defun . c-forward-type)
+ (defun . c-fdoc-shift-type-backward)
+ (defun . c-forward-decl-or-cast-1)
+ (defun . c-forward-label)
+ (defun . c-forward-objc-directive)
+ (defun . c-beginning-of-inheritance-list)
+ (defun . c-in-method-def-p)
+ (defun . c-in-gcc-asm-p)
+ (defun . c-at-toplevel-p)
+ (defun . c-just-after-func-arglist-p)
+ (defun . c-in-knr-argdecl)
+ (defun . c-skip-conditional)
+ (defun . c-after-conditional)
+ (defun . c-after-special-operator-id)
+ (defun . c-backward-to-block-anchor)
+ (defun . c-backward-to-decl-anchor)
+ (defun . c-search-decl-header-end)
+ (defun . c-beginning-of-decl-1)
+ (defun . c-end-of-decl-1)
+ (defun . c-looking-at-decl-block)
+ (defun . c-search-uplist-for-classkey)
+ (defun . c-inside-bracelist-p)
+ (defun . c-looking-at-special-brace-list)
+ (defun . c-looking-at-bos)
+ (defun . c-looking-at-inexpr-block)
+ (defun . c-looking-at-inexpr-block-backward)
+ c-auto-newline-analysis
+ (defun . c-brace-anchor-point)
+ (defun . c-add-syntax)
+ (defun . c-append-syntax)
+ (defun . c-add-stmt-syntax)
+ (defun . c-add-class-syntax)
+ (defun . c-guess-continued-construct)
+ (t . c-guess-basic-syntax)
+ (defun . c-guess-basic-syntax)
+ (defun . c-evaluate-offset)
+ (defun . c-calc-offset)
+ (defun . c-get-offset)
+ (defun . c-get-syntactic-indentation)
+ (provide . cc-engine))
+ ("/usr/share/emacs/23.0.93/lisp/progmodes/cc-vars.elc"
+ (require . cc-defs)
+ (defun . c-constant-symbol)
+ c-style-variables c-fallback-style
+ (defun . c-set-stylevar-fallback)
+ (defun . defcustom-c-stylevar)
+ (defun . c-valid-offset)
+ c-strict-syntax-p c-echo-syntactic-information-p c-report-syntactic-errors c-basic-offset c-tab-always-indent c-insert-tab-function c-syntactic-indentation c-syntactic-indentation-in-macros c-comment-only-line-offset c-indent-comment-alist c-indent-comments-syntactically-p c-block-comment-prefix c-comment-prefix-regexp c-doc-comment-style c-ignore-auto-fill c-cleanup-list c-hanging-braces-alist c-max-one-liner-length c-hanging-colons-alist c-hanging-semi&comma-criteria c-backslash-column c-backslash-max-column c-auto-align-backslashes c-backspace-function c-delete-function c-require-final-newline c-electric-pound-behavior c-special-indent-hook c-label-minimum-indentation c-progress-interval c-objc-method-arg-min-delta-to-bracket c-objc-method-arg-unfinished-offset c-objc-method-parameter-offset c-default-style c-offsets-alist c-inside-block-syms c-inside-block-syms c-style-variables-are-local-p c-mode-hook c++-mode-hook objc-mode-hook java-mode-hook idl-mode-hook pike-mode-hook awk-mode-hook c-mode-common-hook c-initialization-hook c-enable-xemacs-performance-kludge-p c-old-style-variable-behavior
+ (defun . c-make-font-lock-extra-types-blurb)
+ c-font-lock-extra-types c++-font-lock-extra-types objc-font-lock-extra-types java-font-lock-extra-types idl-font-lock-extra-types pike-font-lock-extra-types c-file-style c-file-offsets c-indentation-style c-current-comment-prefix c-string-par-start c-string-par-separate c-sentence-end-with-esc-eol
+ (provide . cc-vars))
+ ("/usr/share/emacs/23.0.93/lisp/progmodes/cc-defs.elc"
+ (require . regexp-opt)
+ c-version c-version-sym c-version-sym c-buffer-is-cc-mode c-inside-eval-when-compile
+ (defun . cc-eval-when-compile)
+ (defun . c-point)
+ (defun . c-region-is-active-p)
+ (defun . c-set-region-active)
+ (defun . c-delete-and-extract-region)
+ (defun . c-safe)
+ (defun . c-int-to-char)
+ (defun . c-sentence-end)
+ (defun . c-default-value-sentence-end)
+ (defun . c-save-buffer-state)
+ (defun . c-tentative-buffer-changes)
+ (defun . c-tnt-chng-record-state)
+ (defun . c-tnt-chng-cleanup)
+ (defun . c-forward-syntactic-ws)
+ (defun . c-backward-syntactic-ws)
+ (defun . c-forward-sexp)
+ (defun . c-backward-sexp)
+ (defun . c-safe-scan-lists)
+ (defun . c-go-list-forward)
+ (defun . c-go-list-backward)
+ (defun . c-up-list-forward)
+ (defun . c-up-list-backward)
+ (defun . c-down-list-forward)
+ (defun . c-down-list-backward)
+ (defun . c-go-up-list-forward)
+ (defun . c-go-up-list-backward)
+ (defun . c-go-down-list-forward)
+ (defun . c-go-down-list-backward)
+ (defun . c-beginning-of-defun-1)
+ (defun . c-at-vsemi-p)
+ (defun . c-vsemi-status-unknown-p)
+ (defun . c-benign-error)
+ (defun . c-with-syntax-table)
+ (defun . c-skip-ws-forward)
+ (defun . c-skip-ws-backward)
+ c-langs-are-parametric
+ (defun . c-major-mode-is)
+ c-use-extents c-use-extents
+ (defun . c-put-char-property-fun)
+ (defun . c-put-char-property)
+ (defun . c-get-char-property)
+ (defun . c-clear-char-property-fun)
+ (defun . c-clear-char-property)
+ (defun . c-clear-char-properties)
+ (defun . c-clear-char-property-with-value-function)
+ (defun . c-clear-char-property-with-value)
+ (defun . c-put-overlay)
+ (defun . c-delete-overlay)
+ (defun . c-end-of-defun-1)
+ c-<-as-paren-syntax c-<-as-paren-syntax
+ (defun . c-mark-<-as-paren)
+ c->-as-paren-syntax c->-as-paren-syntax
+ (defun . c-mark->-as-paren)
+ (defun . c-intersect-lists)
+ (defun . c-lookup-lists)
+ (defun . c-langelem-sym)
+ (defun . c-langelem-pos)
+ (defun . c-langelem-col)
+ (defun . c-langelem-2nd-pos)
+ (defun . c-keep-region-active)
+ (defun . c-mode-symbol)
+ (defun . c-mode-var)
+ (defun . c-got-face-at)
+ (defun . c-face-name-p)
+ (defun . c-concat-separated)
+ (defun . c-make-keywords-re)
+ (defun . c-make-bare-char-alt)
+ (defun . c-regexp-opt)
+ (defun . c-regexp-opt-depth)
+ c-emacs-features c-alpha c-alpha c-alnum c-alnum c-digit c-digit c-upper c-upper c-lower c-lower
+ (defun . c-add-language)
+ c-lang-constants c-lang-const-expansion
+ (defun . c-get-current-file)
+ (defun . c-lang-defconst-eval-immediately)
+ (defun . c-lang-defconst)
+ (defun . c-define-lang-constant)
+ (defun . c-lang-const)
+ c-lang-constants-under-evaluation
+ (defun . c-get-lang-constant)
+ (defun . c-find-assignment-for-mode)
+ (defun . c-lang-major-mode-is)
+ (provide . cc-defs))
+ ("/home/hobbes/nxhtml/util/majmodpri.el" majmodpri:version majmodpri-idle-sort-timer
+ (defun . majmodpri-cancel-idle-sort)
+ (defun . majmodpri-start-idle-sort)
+ (defun . majmodpri-sort-lists-in-timer)
+ majmodpri-schwarzian-ordnum
+ (defun . majmodpri-schwarzian-in)
+ (defun . majmodpri-schwarzian-out)
+ majmodpri-no-nxml
+ (defun . majmodpri-priority)
+ (defun . majmodpri-compare-auto-modes)
+ (defun . majmodpri-sort-auto-mode-alist)
+ (defun . majmodpri-sort-magic-list)
+ (t . majmodpri-sort-lists)
+ (defun . majmodpri-sort-lists)
+ (t . majmodpri-apply)
+ (defun . majmodpri-apply)
+ (defun . majmodpri-sort-apply-to-current)
+ (t . majmodpri-apply-priorities)
+ (defun . majmodpri-apply-priorities)
+ majmodpri-mode-priorities majmodpri-lists-to-sort majmodpri-sort-after-load
+ (provide . majmodpri))
+ ("/home/hobbes/nxhtml/etc/schema/schema-path-patch.el" rncpp-this-dir
+ (defun . rncpp-get-nxml-schema-dir)
+ (defun . rncpp-patch-xhtml-loader))
+ ("/home/hobbes/nxhtml/nxhtml/nxhtml-menu.el" nxhtml-menu:version
+ (require . cl)
+ (require . cus-edit)
+ (require . dired)
+ (require . gimp)
+ (require . html-site)
+ (require . nxhtml-mode)
+ (require . css-color)
+ (require . flymake)
+ (require . flymake-php)
+ (require . flymake-js)
+ (require . udev-ecb)
+ (require . udev-cedet)
+ (require . udev-rinari)
+ (defun . nxhtml-nxhtml-in-buffer)
+ (defun . nxhtml-nxml-in-buffer)
+ (defun . nxhtml-html-in-buffer)
+ (defun . nxhtml-nxml-html-in-buffer)
+ (defun . nxhtml-this-file-can-have-toc)
+ (defun . nxhtml-buffer-possibly-local-viewable)
+ (defun . nxhtml-buffer-possibly-remote-viewable)
+ (defun . nxhtml-insert-menu-dynamically)
+ (defun . nxhtml-menu-image-file)
+ (defun . nxhtml-gimp-can-edit)
+ (t . nxhtml-edit-with-gimp)
+ (defun . nxhtml-edit-with-gimp)
+ (t . nxhtml-browse-file)
+ (defun . nxhtml-browse-file)
+ (t . nxhtml-browse-region)
+ (defun . nxhtml-browse-region)
+ nxhtml-browseable-buffer-file
+ (defun . nxhtml-save-browseable-temp-file)
+ nxhtml-minor-mode-menu-map nxhtml-minor-mode-map nxhtml-minor-mode
+ (defun . nxhtml-minor-mode)
+ nxhtml-minor-mode-modes
+ (defun . nxhtml-maybe-turn-on-minor-mode)
+ nxhtml-minor-mode-major-mode nxhtml-global-minor-mode
+ (t . nxhtml-global-minor-mode)
+ (defun . nxhtml-global-minor-mode)
+ nxhtml-global-minor-mode-buffers
+ (defun . nxhtml-global-minor-mode-enable-in-buffers)
+ (defun . nxhtml-global-minor-mode-check-buffers)
+ (defun . nxhtml-global-minor-mode-cmhh)
+ (defun . nxhtml-docfile)
+ (defun . nxhtml-docfile-url)
+ (defun . nxhtml-overview)
+ (defun . nxhtml-tutorials)
+ (defun . nxhtml-custom-valfaced)
+ (defun . nxhtml-custom-insert-nxhtml-row)
+ (defun . nxhtml-custom-h1)
+ (defun . widget-button-notify)
+ (defun . widget-insert-link)
+ (defun . widget-insert-button)
+ (defun . nxhtml-custom-url-link)
+ (defun . nxhtml-custom-describe-defun)
+ (defun . custom-set-and-prepare-save)
+ (defun . nxhtml-welcome)
+ nxhtml-skip-welcome
+ (defun . nxhtml-skip-welcome)
+ (defun . nxhtml-say-welcome-unless-skip)
+ (provide . nxhtml-menu))
+ ("/home/hobbes/nxhtml/util/udev-rinari.el" udev-rinari:version
+ (require . udev)
+ udev-rinari-dir udev-rinari-load-rinari udev-rinari-steps udev-rinari-update-buffer
+ (defun . udev-rinari-buffer-name)
+ (defun . udev-rinari-check-conflicts)
+ (defun . udev-rinari-setup-when-finished)
+ (t . udev-rinari-update)
+ (defun . udev-rinari-update)
+ udev-rinari-fetch-buffer
+ (defun . udev-rinari-fetch)
+ udev-rinari-diff-file udev-rinari-fetch-diff-buffer
+ (defun . udev-rinari-fetch-diff)
+ (defun . udev-rinari-check-diff)
+ (provide . udev-rinari))
+ ("/home/hobbes/nxhtml/util/udev-cedet.el" udev-cedet:version
+ (require . udev)
+ udev-cedet-dir
+ (defun . udev-cedet-load-cedet)
+ udev-cedet-load-cedet udev-cedet-steps
+ (defun . udev-cedet-buffer-name)
+ udev-cedet-update-buffer
+ (defun . udev-cedet-setup-when-finished)
+ (t . udev-cedet-update)
+ (defun . udev-cedet-update)
+ (defun . udev-cedet-fetch)
+ (defun . udev-cedet-cvs-dir)
+ (defun . udev-cedet-fetch-diff)
+ (defun . udev-cedet-check-diff)
+ (defun . udev-cedet-install-add-debug)
+ (defun . udev-cedet-install)
+ (provide . udev-cedet))
+ ("/home/hobbes/nxhtml/util/udev-ecb.el" udev-ecb:version
+ (require . udev)
+ udev-ecb-dir
+ (defun . udev-ecb-load-ecb)
+ udev-ecb-load-ecb udev-ecb-steps
+ (defun . udev-ecb-buffer-name)
+ udev-ecb-update-buffer
+ (defun . udev-ecb-check-cedet)
+ (defun . udev-ecb-setup-when-finished)
+ (t . udev-ecb-update)
+ (defun . udev-ecb-update)
+ (defun . udev-ecb-fetch)
+ (defun . udev-ecb-cvs-dir)
+ (defun . udev-ecb-fetch-diff)
+ (defun . udev-ecb-check-diff)
+ (defun . udev-ecb-install)
+ (provide . udev-ecb))
+ ("/home/hobbes/nxhtml/util/udev.el" udev:version
+ (require . cl)
+ (require . cus-edit)
+ udev-log-buffer udev-is-log-buffer
+ (defun . udev-check-is-log-buffer)
+ udev-this-chain udev-last-error
+ (defun . udev-set-last-error)
+ (defun . udev-chain)
+ (defun . udev-this-step)
+ (defun . udev-goto-next-step)
+ (defun . udev-num-steps)
+ (defun . udev-step-num)
+ (defun . udev-finish-function)
+ udev-control-mode-map udev-control-mode-map udev-control-mode-syntax-table udev-control-mode-abbrev-table udev-control-mode-abbrev-table
+ (defun . udev-control-mode)
+ (defun . udev-call-first-step)
+ udev-step-keymap
+ (defun . udev-step-at-point)
+ (defun . udev-rerun-this-step)
+ (defun . udev-continue-from-this-step)
+ (defun . udev-goto-this-step-source)
+ (defun . udev-call-this-step)
+ (defun . udev-call-next-step)
+ udev-orig-sentinel
+ (defun . udev-compilation-sentinel)
+ (defun . udev-set-compilation-end-message)
+ udev-continue-on-error-function
+ (defun . udev-buffer-name)
+ udev-this-dir
+ (defun . udev-batch-compile)
+ (defun . udev-fetch-cvs-diff)
+ (defun . udev-cvs-diff-continue)
+ (defun . udev-check-cvs-diff)
+ (defun . udev-send-buffer-process)
+ (provide . udev))
+ ("/home/hobbes/nxhtml/related/flymake-js.el"
+ (require . flymake)
+ flymake-allowed-js-file-name-masks flymake-js-err-line-pattern-re flymake-js-rhino-jar flymake-js-rhino-js flymake-js-engine
+ (defun . flymake-js-init)
+ (defun . flymake-js-load)
+ flymake-js-has-engine
+ (defun . flymake-js-has-engine)
+ (defun . flymake-js-turn-on)
+ flymake-js-on
+ (provide . flymake-js))
+ ("/home/hobbes/nxhtml/related/flymake-php.el"
+ (require . flymake)
+ flymake-allowed-php-file-name-masks flymake-php-err-line-pattern-re
+ (defun . flymake-php-init)
+ flymake-php-has-engine
+ (defun . flymake-php-has-engine)
+ (defun . flymake-php-turn-on)
+ flymake-php-on
+ (defun . flymake-php-load)
+ (provide . flymake-php))
+ ("/usr/share/emacs/23.0.93/lisp/progmodes/flymake.elc" flymake-is-running flymake-timer flymake-last-change-time flymake-check-start-time flymake-check-was-interrupted flymake-err-info flymake-new-err-info
+ (defun . flymake-makehash)
+ (defun . flymake-float-time)
+ (defun . flymake-replace-regexp-in-string)
+ (defun . flymake-split-string)
+ (defun . flymake-get-temp-dir)
+ (defun . flymake-line-beginning-position)
+ (defun . flymake-line-end-position)
+ (defun . flymake-posn-at-point-as-event)
+ (defun . flymake-popup-menu)
+ (defun . flymake-make-emacs-menu)
+ flymake-log-level
+ (defun . flymake-log)
+ (defun . flymake-ins-after)
+ (defun . flymake-set-at)
+ flymake-processes flymake-output-residual flymake-allowed-file-name-masks
+ (defun . flymake-get-file-name-mode-and-masks)
+ (defun . flymake-can-syntax-check-file)
+ (defun . flymake-get-init-function)
+ (defun . flymake-get-cleanup-function)
+ (defun . flymake-get-real-file-name-function)
+ flymake-find-buildfile-cache
+ (defun . flymake-get-buildfile-from-cache)
+ (defun . flymake-add-buildfile-to-cache)
+ (defun . flymake-clear-buildfile-cache)
+ (defun . flymake-find-buildfile)
+ (defun . flymake-fix-file-name)
+ (defun . flymake-same-files)
+ flymake-master-file-dirs flymake-master-file-count-limit
+ (defun . flymake-find-possible-master-files)
+ (defun . flymake-master-file-compare)
+ flymake-check-file-limit
+ (defun . flymake-check-patch-master-file-buffer)
+ (defun . flymake-replace-region)
+ (defun . flymake-read-file-to-temp-buffer)
+ (defun . flymake-copy-buffer-to-temp-buffer)
+ (defun . flymake-check-include)
+ (defun . flymake-find-buffer-for-file)
+ (defun . flymake-create-master-file)
+ (defun . flymake-save-buffer-in-file)
+ (defun . flymake-save-string-to-file)
+ (defun . flymake-read-file-to-string)
+ (defun . flymake-process-filter)
+ (defun . flymake-process-sentinel)
+ (defun . flymake-post-syntax-check)
+ (defun . flymake-parse-output-and-residual)
+ (defun . flymake-parse-residual)
+ (defun . flymake-er-make-er)
+ (defun . flymake-er-get-line)
+ (defun . flymake-er-get-line-err-info-list)
+ (defun . flymake-ler-file)
+ (defun . flymake-ler-line)
+ (defun . flymake-ler-type)
+ (defun . flymake-ler-text)
+ (defun . flymake-ler-full-file)
+ (defun . flymake-ler-p)
+ (defun . copy-flymake-ler)
+ (defun . flymake-ler-make-ler)
+ (defun . flymake-ler-set-file)
+ (defun . flymake-ler-set-full-file)
+ (defun . flymake-ler-set-line)
+ (defun . flymake-get-line-err-count)
+ (defun . flymake-get-err-count)
+ (defun . flymake-fix-line-numbers)
+ (defun . flymake-highlight-err-lines)
+ (defun . flymake-overlay-p)
+ (defun . flymake-make-overlay)
+ (defun . flymake-delete-own-overlays)
+ (defun . flymake-region-has-flymake-overlays)
+ (defface . flymake-errline)
+ (defface . flymake-warnline)
+ (defun . flymake-highlight-line)
+ (defun . flymake-parse-err-lines)
+ (defun . flymake-split-output)
+ (defun . flymake-reformat-err-line-patterns-from-compile-el)
+ (require . compile)
+ flymake-err-line-patterns
+ (defun . flymake-parse-line)
+ (defun . flymake-find-err-info)
+ (defun . flymake-line-err-info-is-less-or-equal)
+ (defun . flymake-add-line-err-info)
+ (defun . flymake-add-err-info)
+ (defun . flymake-get-project-include-dirs-imp)
+ flymake-get-project-include-dirs-function
+ (defun . flymake-get-project-include-dirs)
+ (defun . flymake-get-system-include-dirs)
+ flymake-project-include-dirs-cache
+ (defun . flymake-get-project-include-dirs-from-cache)
+ (defun . flymake-add-project-include-dirs-to-cache)
+ (defun . flymake-clear-project-include-dirs-cache)
+ (defun . flymake-get-include-dirs)
+ (defun . flymake-safe-delete-file)
+ (defun . flymake-safe-delete-directory)
+ flymake-compilation-prevents-syntax-check
+ (defun . flymake-start-syntax-check)
+ (defun . flymake-start-syntax-check-process)
+ (defun . flymake-kill-process)
+ (defun . flymake-stop-all-syntax-checks)
+ (defun . flymake-compilation-is-running)
+ (defun . flymake-compile)
+ flymake-no-changes-timeout
+ (defun . flymake-on-timer-event)
+ (defun . flymake-current-line-no)
+ (defun . flymake-count-lines)
+ (defun . flymake-display-err-menu-for-current-line)
+ (defun . flymake-make-err-menu-data)
+ (defun . flymake-goto-file-and-line)
+ flymake-mode-line flymake-mode-line-e-w flymake-mode-line-status
+ (defun . flymake-report-status)
+ (defun . flymake-display-warning)
+ flymake-gui-warnings-enabled
+ (defun . flymake-report-fatal-status)
+ flymake-start-syntax-check-on-find-file flymake-mode
+ (t . flymake-mode)
+ (defun . flymake-mode)
+ (t . flymake-mode-on)
+ (defun . flymake-mode-on)
+ (t . flymake-mode-off)
+ (defun . flymake-mode-off)
+ flymake-start-syntax-check-on-newline
+ (defun . flymake-after-change-function)
+ (defun . flymake-after-save-hook)
+ (defun . flymake-kill-buffer-hook)
+ (defun . flymake-find-file-hook)
+ (defun . flymake-get-first-err-line-no)
+ (defun . flymake-get-last-err-line-no)
+ (defun . flymake-get-next-err-line-no)
+ (defun . flymake-get-prev-err-line-no)
+ (defun . flymake-skip-whitespace)
+ (defun . flymake-goto-line)
+ (defun . flymake-goto-next-error)
+ (defun . flymake-goto-prev-error)
+ (defun . flymake-patch-err-text)
+ (defun . flymake-create-temp-inplace)
+ (defun . flymake-create-temp-with-folder-structure)
+ (defun . flymake-delete-temp-directory)
+ flymake-temp-source-file-name flymake-master-file-name flymake-temp-master-file-name flymake-base-dir
+ (defun . flymake-init-create-temp-buffer-copy)
+ (defun . flymake-simple-cleanup)
+ (defun . flymake-get-real-file-name)
+ (defun . flymake-get-full-patched-file-name)
+ (defun . flymake-get-full-nonpatched-file-name)
+ (defun . flymake-init-find-buildfile-dir)
+ (defun . flymake-init-create-temp-source-and-master-buffer-copy)
+ (defun . flymake-master-cleanup)
+ (defun . flymake-get-syntax-check-program-args)
+ (defun . flymake-get-make-cmdline)
+ (defun . flymake-get-ant-cmdline)
+ (defun . flymake-simple-make-init-impl)
+ (defun . flymake-simple-make-init)
+ (defun . flymake-master-make-init)
+ (defun . flymake-find-make-buildfile)
+ (defun . flymake-master-make-header-init)
+ (defun . flymake-simple-make-java-init)
+ (defun . flymake-simple-ant-java-init)
+ (defun . flymake-simple-java-cleanup)
+ (defun . flymake-perl-init)
+ (defun . flymake-php-init)
+ (defun . flymake-get-tex-args)
+ (defun . flymake-simple-tex-init)
+ (defun . flymake-master-tex-init)
+ (defun . flymake-get-include-dirs-dot)
+ (defun . flymake-xml-init)
+ (provide . flymake))
+ ("/home/hobbes/nxhtml/util/css-color.el" css-color:version
+ (require . cl)
+ (defun . css-color-turn-on-in-buffer)
+ css-color-mode-major-mode css-color-global-mode
+ (t . css-color-global-mode)
+ (defun . css-color-global-mode)
+ css-color-global-mode-buffers
+ (defun . css-color-global-mode-enable-in-buffers)
+ (defun . css-color-global-mode-check-buffers)
+ (defun . css-color-global-mode-cmhh)
+ css-color-hex-chars css-color-hex-re css-color-hsl-re css-color-rgb-re css-color-html-colors css-color-html-re css-color-color-re css-color-keywords css-color-mode
+ (t . css-color-mode)
+ (defun . css-color-mode)
+ (defun . css-color-font-lock-hook-fun)
+ css-color-map css-color-generic-map
+ (defun . css-color-pal-lumsig)
+ (defun . css-color-foreground-color)
+ (defun . css-color-normalize-hue)
+ (defun . css-color-within-bounds)
+ (defun . css-color-hex-to-rgb)
+ (defun . css-color-hex-to-hsv)
+ (defun . css-color-rgb-to-hex)
+ (defun . css-color-rgb-to-hsv)
+ (defun . css-color-rgb-to-hsl)
+ (defun . css-color-hsv-to-hsl)
+ (defun . css-color-hsv-to-hex)
+ (defun . css-color-hsv-to-rgb)
+ (defun . css-color-hsv-to-prop-hexstring)
+ (defun . css-color-hsl-to-rgb-fractions)
+ (defun . css-color-hsl-to-rgb)
+ (defun . css-color-hsl-to-hex)
+ (defun . css-color-hue-to-rgb)
+ (defun . css-color-parse-hsl)
+ (defun . css-color-inchue)
+ (defun . css-color-incsat)
+ (defun . css-color-incval)
+ (defun . css-color-hexval-beginning)
+ (defun . css-color-replcolor-at-p)
+ (defun . css-color-get-color-at-point)
+ (defun . css-color-adj-hue-at-p)
+ (defun . css-color-adj-saturation-at-p)
+ (defun . css-color-adj-value-at-p)
+ (defun . css-color-what-channel)
+ (defun . css-color-adjust-hex-at-p)
+ (defun . css-color-up)
+ (defun . css-color-down)
+ (defun . css-color-hue-up)
+ (defun . css-color-hue-down)
+ (defun . css-color-saturation-up)
+ (defun . css-color-saturation-down)
+ (defun . css-color-value-up)
+ (defun . css-color-value-down)
+ (defun . css-color-num-up)
+ (defun . css-color-num-down)
+ (defun . css-color-beginning-of-color)
+ (defun . css-color-end-of-color)
+ (defun . css-color-color-info)
+ css-color-type-circle
+ (defun . css-color-next-type)
+ (defun . css-color-cycle-type)
+ (defun . css-color-string-hex-to-hsl)
+ (defun . css-color-string-hsl-to-rgb)
+ (defun . css-color-string-rgb-to-name)
+ (defun . css-color-string-name-to-hex)
+ (defun . css-color-string-rgb-to-hex)
+ (defun . css-color-string-hsl-to-hex)
+ (defun . css-color-next-channel)
+ (defun . css-color-hexify-anystring)
+ (defun . css-color-toggle-percentage)
+ css-color-fg-history css-color-bg-history
+ (defun . css-color-test)
+ (defun . css-color-run-tests)
+ (provide . css-color))
+ ("/home/hobbes/nxhtml/nxhtml/nxhtml-mode.el"
+ (require . mumamo)
+ (require . cl)
+ (require . appmenu-fold)
+ (require . fold-dwim)
+ (require . typesetter)
+ (require . button)
+ (require . loadhist)
+ (require . nxml-mode)
+ (require . rngalt)
+ (require . url-parse)
+ (require . url-expand)
+ (require . popcmp)
+ (require . html-imenu)
+ (require . tidy-xhtml)
+ (require . html-quote)
+ (defun . nxhtml-version)
+ (defun . nxhtml-setup-for-fold-dwim)
+ (defun . nxhtml-outline-level)
+ (defun . nxhtml-hs-forward-element)
+ nxhtml-use-imenu nxhtml-default-encoding
+ (defun . nxhtml-insert-empty-frames-page)
+ (defun . nxhtml-insert-empty-page)
+ (defun . nxhtml-empty-page-completion)
+ nxhtml-mode-hook
+ (defun . nxhtml-help)
+ nxhtml-current-validation-header tidy-menu-symbol
+ (defun . tidy-menu-symbol)
+ (defun . nxhtml-change-mode)
+ nxhtml-heading-element-name-regexp nxhtml-mode-map nxhtml-mode-syntax-table nxhtml-mode-abbrev-table nxhtml-mode-abbrev-table
+ (t . nxhtml-mode)
+ (defun . nxhtml-mode)
+ (defun . nxhtml-quote-html)
+ nxhtml-single-tags
+ (defun . nxthml-is-single-tag)
+ nxhtml-help-attribute-name nxhtml-help-attribute-name-tag nxhtml-help-tag
+ (t . nxhtml-short-tag-help)
+ (defun . nxhtml-short-tag-help)
+ nxhtml-no-single-tags nxhtml-no-end-tags nxhtml-predicate-error
+ (defun . nxhtml-find-ids)
+ (defun . nxhtml-read-url)
+ (defun . nxhtml-read-url-type)
+ nxhtml-read-url-history nxhtml-read-web-url-history nxhtml-read-mail-url-history nxhtml-in-xml-attribute-value-regex
+ (defun . nxhtml-mailto-predicate)
+ nxhtml-image-completion-pattern
+ (defun . nxhtml-image-url-predicate)
+ nxhtml-css-completion-pattern
+ (defun . nxhtml-css-url-predicate)
+ nxhtml-script-completion-pattern
+ (defun . nxhtml-script-url-predicate)
+ (defun . nxhtml-coding-systems-complete)
+ nxhtml-in-proc-instr-back-regex nxhtml-in-proc-instr-forw-regex rngalt-in-pre-attribute-value-regex
+ (defun . nxhtml-check-where)
+ nxhtml-tag-sets nxhtml-attr-sets
+ (defun . nxhtml-complete-last-try)
+ (defun . nxhtml-img-tag-do-also)
+ (defun . nxhtml-redisplay-complete)
+ (defun . nxhtml-read-from-minibuffer)
+ (defun . nxhtml-meta-tag-do-also)
+ (defun . nxhtml-style-tag-do-also)
+ (defun . nxhtml-script-tag-do-also)
+ (defun . nxhtml-link-tag-do-also)
+ (defun . nxhtml-input-tag-do-also)
+ (defun . nxhtml-do-also-value)
+ (defun . nxhtml-form-tag-do-also)
+ nxhtml-complete-tag-do-also
+ (defun . nxhtml-complete-tag-do-also)
+ (defun . nxhtml-turn-onoff-tag-do-also)
+ nxhtml-tag-do-also
+ (defun . nxhtml-tag-do-also-toggle)
+ (defun . nxhtml-check-tag-do-also)
+ nxhtml-validation-header-mode
+ (t . nxhtml-validation-header-mode)
+ (defun . nxhtml-validation-header-mode)
+ (defun . nxhtml-can-insert-page-here)
+ (defun . nxhtml-complete-first-try)
+ (defun . nxhtml-completing-read-tag)
+ (defun . nxhtml-add-required-to-attr-set)
+ (defun . nxhtml-get-tag-specific-attr-help)
+ nxhtml-in-start-tag-regex
+ (defun . nxhtml-completing-read-attribute-name)
+ (defun . nxhtml-completing-read-attribute-value)
+ (defun . nxhtml-read-link-type)
+ (defun . nxhtml-read-link-media)
+ (defun . nxhtml-read-link-rel)
+ (defun . nxhtml-read-meta-name)
+ (defun . nxhtml-read-meta-content)
+ (defun . nxhtml-read-meta-scheme)
+ (defun . nxhtml-read-meta-http-equiv)
+ nxhtml-validation-headers nxhtml-default-validation-header
+ (defun . nxhtml-must-have-validation-headers)
+ nxhtml-set-validation-header-hist nxhtml-guess-validation-header-alist
+ (defun . nxhtml-guess-validation-header)
+ (defun . nxhtml-open-dir-saved-validation-headers)
+ (defun . nxhtml-get-saved-validation-header)
+ (defun . nxhtml-remove-saved-validation-header)
+ (defun . nxhtml-save-validation-header)
+ (defun . nxhtml-update-saved-validation-header)
+ (defun . nxhtml-get-default-validation-header)
+ (defun . nxhtml-set-validation-header)
+ (defun . nxhtml-apply-validation-header)
+ (defun . nxhtml-update-validation-header)
+ (defun . nxhtml-vhm-change-major)
+ (defun . nxhtml-recheck-validation-header)
+ (defun . nxhtml-validation-header-empty)
+ (defun . nxhtml-turn-on-validation-header-mode)
+ (defun . nxhtml-vhm-mumamo-change-major)
+ (defun . nxhtml-vhm-mumamo-after-change-major)
+ nxhtml-validation-headers-check nxhtml-validation-header-mumamo-modes
+ (defun . nxhtml-add-validation-header-if-mumamo)
+ nxhtml-validation-header-if-mumamo
+ (defun . nxhtml-validation-header-if-mumamo-toggle)
+ (defun . nxhtml-warnings-are-visible)
+ nxhtml-old-rng-error-face
+ (defun . nxhtml-toggle-visible-warnings)
+ nxml-untag-select
+ (defun . nxml-untag-element)
+ (defun . nxhtml-rollover-insert-2v)
+ (provide . nxhtml-mode))
+ ("/home/hobbes/nxhtml/nxhtml/html-quote.el" html-quote-html
+ (defun . html-quote-html-char)
+ (defun . html-quote-html-string)
+ (provide . html-quote))
+ ("/home/hobbes/nxhtml/nxhtml/tidy-xhtml.el" tidy-xhtml:version
+ (require . cl)
+ (require . ediff)
+ (require . mumamo)
+ (require . html-site)
+ (require . easymenu)
+ (require . compile)
+ (require . cus-edit)
+ (require . help-mode)
+ (defun . tidy-xemacs-p)
+ (defun . tidy-windows-p)
+ (defun . tidy-x-event-function)
+ (defun . tidy-x-event-object)
+ (defun . tidy-x-find-menu-item)
+ (defun . tidy-x-get-popup-menu-response)
+ (defun . tidy-x-make-event)
+ (defun . tidy-x-misc-user-event-p)
+ tidy-warnings tidy-errors tidy-message tidy-batch-last-file tidy-default-config-file tidy-config-file-parsed tidy-config-file tidy-shell-program tidy-temp-directory tidy-menu-lock tidy-menu-x-position tidy-debug
+ (defun . tidy-toggle-debug)
+ tidy-options-alist
+ (defun . tidy-build-options-alist)
+ tidy-xhtml-values
+ (defun . tidy-xhtml-options-ok)
+ (defun . tidy-show-xhtml-options)
+ (defun . tidy-set-xhtml-options)
+ current-menubar
+ (defun . tidy-menu-position)
+ (defun . tidy-menu-lock)
+ (defun . tidy-menu-lookup)
+ tidy-menu tidy-menu-position tidy-menu-state
+ (defun . tidy-menu-position)
+ (defun . tidy-menu-lock)
+ (defun . tidy-menu-lookup)
+ (defun . tidy-set)
+ (defun . tidy-boolean-entry)
+ (defun . tidy-list-entry)
+ (defun . tidy-set-string)
+ (defun . tidy-set-integer)
+ (defun . tidy-string-entry)
+ (defun . tidy-integer-entry)
+ (defun . tidy-exe-found)
+ tidy-top-menu tidy-newline-menu tidy-doctype-menu tidy-emacs-encoding-lbl
+ (defun . tidy-create-encoding-menu)
+ tidy-output-encoding-menu tidy-menu-symbol
+ (t . tidy-build-menu)
+ (defun . tidy-build-menu)
+ (defun . event-point)
+ (defun . tidy-describe-this-option-mouse)
+ (defun . tidy-describe-this-option)
+ (defun . tidy-quit-describe-options)
+ (defun . tidy-current-line)
+ (defun . tidy-describe-options)
+ (defun . tidy-parse-config-file)
+ (defun . tidy-save-settings)
+ tidy-markup
+ (defun . tidy-set-buffer-unmodified)
+ tidy-encodings-mime-charset-list
+ (defun . tidy-get-buffer-encoding)
+ (defun . tidy-get-tidy-encoding)
+ (defun . tidy-temp-config-file)
+ tidy-output-buf-name tidy-tidied-buffer
+ (defun . tidy-check-is-tidied)
+ tidy-control-buffer-name
+ (defun . tidy-buffer)
+ (defun . tidy-after-ediff)
+ (defun . tidy-ediff-buffers)
+ (defun . tidy-remove-ctrl-m)
+ tidy-html-files-re
+ (defun . tidy-is-html-file)
+ (defun . tidy-contains)
+ tidy-tree-files
+ (defun . tidy-tree-next)
+ (defun . tidy-tree)
+ (defun . tidy-html-site)
+ (defun . tidy-batch-sentinel)
+ (defun . tidy-batch-output-filter)
+ (defun . tidy-batch)
+ (defun . wab-compilation-button-at)
+ (defun . wab-click)
+ wab-errors-supress
+ (defun . wab-fb-errmsg)
+ (defun . wab-fb-helper)
+ wab-button-list
+ (defun . wab-fb)
+ (defun . wab-backward)
+ (defun . wab-forward)
+ wab-compilation-mode-map wab-compilation-mode-syntax-table wab-compilation-mode-abbrev-table wab-compilation-mode-abbrev-table
+ (defun . wab-compilation-mode)
+ tidy-menu-mode-map tidy-menu-mode
+ (defun . tidy-menu-mode)
+ (provide . tidy-xhtml))
+ ("/usr/share/emacs/23.0.93/lisp/ediff.elc" ediff-version ediff-date
+ (provide . ediff)
+ (require . ediff-init)
+ (require . ediff-mult)
+ ediff-use-last-dir ediff-last-dir-A ediff-last-dir-B ediff-last-dir-C ediff-last-dir-ancestor ediff-last-merge-autostore-dir
+ (defun . ediff-set-read-only-in-buf-A)
+ (defun . ediff-get-default-file-name)
+ (t . ediff-files)
+ (defun . ediff-files)
+ (t . ediff-files3)
+ (defun . ediff-files3)
+ (defun . ediff3)
+ (defun . ediff-find-file)
+ (defun . ediff-files-internal)
+ (defun . ediff)
+ (t . ediff-backup)
+ (defun . ediff-backup)
+ (t . ediff-buffers)
+ (defun . ediff-buffers)
+ (defun . ebuffers)
+ (t . ediff-buffers3)
+ (defun . ediff-buffers3)
+ (defun . ebuffers3)
+ (defun . ediff-buffers-internal)
+ (defun . ediff-get-default-directory-name)
+ (t . ediff-directories)
+ (defun . ediff-directories)
+ (defun . edirs)
+ (t . ediff-directory-revisions)
+ (defun . ediff-directory-revisions)
+ (defun . edir-revisions)
+ (t . ediff-directories3)
+ (defun . ediff-directories3)
+ (defun . edirs3)
+ (t . ediff-merge-directories)
+ (defun . ediff-merge-directories)
+ (defun . edirs-merge)
+ (t . ediff-merge-directories-with-ancestor)
+ (defun . ediff-merge-directories-with-ancestor)
+ (t . ediff-merge-directory-revisions)
+ (defun . ediff-merge-directory-revisions)
+ (defun . edir-merge-revisions)
+ (t . ediff-merge-directory-revisions-with-ancestor)
+ (defun . ediff-merge-directory-revisions-with-ancestor)
+ (defun . edir-merge-revisions-with-ancestor)
+ (defun . edirs-merge-with-ancestor)
+ (defun . ediff-directories-internal)
+ (defun . ediff-directory-revisions-internal)
+ (t . ediff-windows-wordwise)
+ (defun . ediff-windows-wordwise)
+ (t . ediff-windows-linewise)
+ (defun . ediff-windows-linewise)
+ (defun . ediff-windows)
+ (t . ediff-regions-wordwise)
+ (defun . ediff-regions-wordwise)
+ (t . ediff-regions-linewise)
+ (defun . ediff-regions-linewise)
+ (defun . ediff-regions-internal)
+ (defun . ediff-merge)
+ (defun . ediff-merge-on-startup)
+ (t . ediff-merge-files)
+ (defun . ediff-merge-files)
+ (t . ediff-merge-files-with-ancestor)
+ (defun . ediff-merge-files-with-ancestor)
+ (defun . ediff-merge-with-ancestor)
+ (t . ediff-merge-buffers)
+ (defun . ediff-merge-buffers)
+ (t . ediff-merge-buffers-with-ancestor)
+ (defun . ediff-merge-buffers-with-ancestor)
+ (t . ediff-merge-revisions)
+ (defun . ediff-merge-revisions)
+ (t . ediff-merge-revisions-with-ancestor)
+ (defun . ediff-merge-revisions-with-ancestor)
+ (t . ediff-patch-file)
+ (defun . ediff-patch-file)
+ (t . ediff-patch-buffer)
+ (defun . ediff-patch-buffer)
+ (defun . epatch)
+ (defun . epatch-buffer)
+ (t . ediff-revision)
+ (defun . ediff-revision)
+ (defun . erevision)
+ (defun . ediff-load-version-control)
+ (t . ediff-version)
+ (defun . ediff-version)
+ (t . ediff-documentation)
+ (defun . ediff-documentation)
+ (require . ediff-util))
+ ("/usr/share/emacs/23.0.93/lisp/ediff-util.elc"
+ (provide . ediff-util)
+ ediff-after-quit-hook-internal
+ (require . ediff-init)
+ (require . ediff-help)
+ (require . ediff-mult)
+ (require . ediff-wind)
+ (require . ediff-diff)
+ (require . ediff-merg)
+ (defun . ediff-mode)
+ ediff-mode-map
+ (defun . ediff-set-keys)
+ (defun . ediff-reload-keymap)
+ (defun . ediff-setup-keymap)
+ (defun . ediff-setup)
+ (defun . ediff-setup-control-buffer)
+ (defun . ediff-arrange-autosave-in-merge-jobs)
+ (defun . ediff-update-diffs)
+ (defun . ediff-revert-buffers-then-recompute-diffs)
+ (defun . ediff-recenter)
+ (defun . ediff-recenter-one-window)
+ (defun . ediff-recenter-ancestor)
+ (defun . ediff-toggle-split)
+ (defun . ediff-toggle-hilit)
+ (defun . ediff-toggle-autorefine)
+ (defun . ediff-show-ancestor)
+ (defun . ediff-make-or-kill-fine-diffs)
+ (defun . ediff-toggle-help)
+ (defun . ediff-toggle-read-only)
+ (defun . ediff-maybe-checkout)
+ (defun . ediff-file-checked-out-p)
+ (defun . ediff-file-checked-in-p)
+ (defun . ediff-file-compressed-p)
+ (defun . ediff-swap-buffers)
+ (defun . ediff-toggle-wide-display)
+ (t . ediff-toggle-multiframe)
+ (defun . ediff-toggle-multiframe)
+ (t . ediff-toggle-use-toolbar)
+ (defun . ediff-toggle-use-toolbar)
+ (defun . ediff-kill-bottom-toolbar)
+ (defun . ediff-make-bottom-toolbar)
+ (defun . ediff-toggle-show-clashes-only)
+ (defun . ediff-toggle-skip-changed-regions)
+ (defun . ediff-toggle-narrow-region)
+ (defun . ediff-visible-region)
+ (defun . ediff-operate-on-windows)
+ (defun . ediff-scroll-vertically)
+ (defun . ediff-scroll-horizontally)
+ (defun . ediff-position-region)
+ (defun . ediff-get-lines-to-region-end)
+ (defun . ediff-get-lines-to-region-start)
+ (defun . ediff-get-region-size-coefficient)
+ (defun . ediff-next-difference)
+ (defun . ediff-previous-difference)
+ (defun . ediff-jump-to-difference)
+ (defun . ediff-jump-to-difference-at-point)
+ (defun . ediff-diff-at-point)
+ (defun . ediff-diff-to-diff)
+ (defun . ediff-copy-A-to-B)
+ (defun . ediff-copy-B-to-A)
+ (defun . ediff-copy-A-to-C)
+ (defun . ediff-copy-B-to-C)
+ (defun . ediff-copy-C-to-B)
+ (defun . ediff-copy-C-to-A)
+ (defun . ediff-copy-diff)
+ (defun . ediff-save-diff-region)
+ (defun . ediff-test-save-region)
+ (defun . ediff-pop-diff)
+ (defun . ediff-restore-diff)
+ (defun . ediff-restore-diff-in-merge-buffer)
+ (defun . ediff-toggle-regexp-match)
+ (defun . ediff-toggle-skip-similar)
+ (defun . ediff-focus-on-regexp-matches)
+ (defun . ediff-hide-regexp-matches)
+ (defun . ediff-quit)
+ (defun . ediff-really-quit)
+ (defun . ediff-good-frame-under-mouse)
+ (defun . ediff-delete-temp-files)
+ (defun . ediff-cleanup-mess)
+ (defun . ediff-janitor)
+ (defun . ediff-dispose-of-variant-according-to-user)
+ (defun . ediff-maybe-save-and-delete-merge)
+ (defun . ediff-write-merge-buffer-and-maybe-kill)
+ (defun . ediff-default-suspend-function)
+ (defun . ediff-suspend)
+ (defun . ediff-status-info)
+ (defun . ediff-select-difference)
+ (defun . ediff-unselect-difference)
+ (defun . ediff-unselect-and-select-difference)
+ (defun . ediff-highlight-diff-in-one-buffer)
+ (defun . ediff-unhighlight-diff-in-one-buffer)
+ (defun . ediff-unhighlight-diffs-totally-in-one-buffer)
+ (defun . ediff-highlight-diff)
+ (defun . ediff-unhighlight-diff)
+ (defun . ediff-unhighlight-diffs-totally)
+ (defun . ediff-read-file-name)
+ (defun . ediff-make-temp-file)
+ (defun . ediff-make-empty-tmp-file)
+ (defun . ediff-verify-file-buffer)
+ (defun . ediff-verify-file-merge-buffer)
+ (defun . ediff-filename-magic-p)
+ (defun . ediff-save-buffer)
+ (defun . ediff-clone-buffer-for-region-comparison)
+ (defun . ediff-clone-buffer-for-window-comparison)
+ (defun . ediff-clone-buffer-for-current-diff-comparison)
+ (defun . ediff-make-cloned-buffer)
+ (defun . ediff-make-indirect-buffer)
+ (defun . ediff-compute-custom-diffs-maybe)
+ (defun . ediff-show-diff-output)
+ (defun . ediff-inferior-compare-regions)
+ (defun . ediff-remove-flags-from-buffer)
+ (defun . ediff-place-flags-in-buffer)
+ (defun . ediff-place-flags-in-buffer1)
+ (defun . ediff-empty-diff-region-p)
+ (defun . ediff-whitespace-diff-region-p)
+ (defun . ediff-get-region-contents)
+ (defun . ediff-get-diff-posn)
+ (defun . ediff-restore-highlighting)
+ (defun . ediff-clear-diff-vector)
+ (defun . ediff-make-bullet-proof-overlay)
+ (defun . ediff-make-current-diff-overlay)
+ (defun . ediff-other-buffer)
+ (defun . ediff-get-selected-buffers)
+ (defun . ediff-unique-buffer-name)
+ (defun . ediff-submit-report)
+ (defun . ediff-choose-syntax-table)
+ (defun . ediff-deactivate-mark)
+ (defun . ediff-activate-mark)
+ (defun . ediff-nuke-selective-display)
+ (defun . ediff-save-variables)
+ (defun . ediff-restore-variables)
+ (defun . ediff-change-saved-variable)
+ (defun . ediff-save-protected-variables)
+ (defun . ediff-restore-protected-variables)
+ (defun . ediff-save-buffer-in-file)
+ ediff-command-begin-time
+ (defun . ediff-calc-command-time)
+ (defun . ediff-save-time)
+ (defun . ediff-profile)
+ (defun . ediff-print-diff-vector)
+ (defun . ediff-debug-info)
+ (defun . ediff-member)
+ (defun . ediff-format-bindings-of)
+ (defun . ediff-intersection)
+ (defun . ediff-union)
+ (defun . ediff-set-difference)
+ (defun . ediff-add-to-history)
+ (defun . ediff-copy-list))
+ ("/usr/share/emacs/23.0.93/lisp/ediff-merg.elc"
+ (require . ediff-init)
+ ediff-quit-merge-hook ediff-default-variant ediff-combination-pattern ediff-show-clashes-only ediff-skip-merge-regions-that-differ-from-default
+ (defun . ediff-merge-region-is-non-clash)
+ (defun . ediff-merge-region-is-non-clash-to-skip)
+ (defun . ediff-skip-merge-region-if-changed-from-default-p)
+ (defun . ediff-get-combined-region)
+ (defun . ediff-set-state-of-all-diffs-in-all-buffers)
+ (defun . ediff-set-state-of-diff-in-all-buffers)
+ (defun . ediff-set-merge-mode)
+ (defun . ediff-do-merge)
+ (defun . ediff-re-merge)
+ (defun . ediff-shrink-window-C)
+ (defun . ediff-combine-diffs)
+ (defun . ediff-looks-like-combined-merge)
+ (defun . ediff-merge-changed-from-default-p)
+ (provide . ediff-merg))
+ ("/usr/share/emacs/23.0.93/lisp/ediff-diff.elc"
+ (provide . ediff-diff)
+ (require . ediff-init)
+ ediff-diff-program ediff-diff3-program ediff-shell ediff-cmp-program ediff-cmp-options
+ (defun . ediff-set-diff-options)
+ ediff-diff-options ediff-ignore-case ediff-ignore-case-option ediff-ignore-case-option3 ediff-actual-diff-options ediff-custom-diff-program ediff-custom-diff-options ediff-match-diff3-line ediff-diff3-options ediff-actual-diff3-options ediff-diff3-ok-lines-regexp ediff-diff-status ediff-auto-refine ediff-ignore-similar-regions ediff-auto-refine-limit ediff-diff-ok-lines-regexp ediff-match-diff-line ediff-setup-diff-regions-function
+ (defun . ediff-setup-diff-regions)
+ (defun . ediff-make-diff2-buffer)
+ (defun . ediff-setup-fine-diff-regions)
+ (defun . ediff-prepare-error-list)
+ (defun . ediff-extract-diffs)
+ (defun . ediff-convert-diffs-to-overlays)
+ (defun . ediff-set-diff-overlays-in-one-buffer)
+ (defun . ediff-make-fine-diffs)
+ (defun . ediff-install-fine-diff-if-necessary)
+ (defun . ediff-set-fine-diff-properties)
+ (defun . ediff-set-fine-diff-properties-in-one-buffer)
+ (defun . ediff-set-fine-overlays-for-combined-merge)
+ (defun . ediff-set-fine-overlays-in-one-buffer)
+ (defun . ediff-convert-fine-diffs-to-overlays)
+ (defun . ediff-get-diff3-group)
+ (defun . ediff-extract-diffs3)
+ (defun . ediff-setup-diff-regions3)
+ (defun . ediff-exec-process)
+ (defun . ediff-process-filter)
+ (defun . ediff-process-sentinel)
+ ediff-forward-word-function ediff-whitespace ediff-word-1 ediff-word-2 ediff-word-3 ediff-word-4
+ (defun . ediff-forward-word)
+ (defun . ediff-wordify)
+ (defun . ediff-copy-to-buffer)
+ (defun . ediff-goto-word)
+ (defun . ediff-same-file-contents)
+ (defun . ediff-same-contents)
+ (defun . ediff-same-file-contents-lists)
+ (defun . ediff-delete-all-matches)
+ (defun . ediff-set-actual-diff-options)
+ (defun . ediff-toggle-ignore-case))
+ ("/usr/share/emacs/23.0.93/lisp/ediff-wind.elc"
+ (require . ediff-init)
+ (defun . ediff-compute-toolbar-width)
+ (defun . ediff-choose-window-setup-function-automatically)
+ ediff-window-setup-function ediff-multiframe ediff-merge-window-share ediff-control-window ediff-window-A ediff-window-B ediff-window-C ediff-window-config-saved ediff-window-alist ediff-window-alist ediff-split-window-function ediff-merge-split-window-function ediff-control-frame-parameters ediff-mouse-pixel-position ediff-mouse-pixel-threshold ediff-grab-mouse ediff-control-frame-position-function ediff-control-frame-upward-shift ediff-narrow-control-frame-leftward-shift ediff-wide-control-frame-rightward-shift ediff-wide-display-p ediff-wide-display-orig-parameters ediff-wide-display-frame ediff-make-wide-display-function ediff-control-frame ediff-prefer-iconified-control-frame
+ (defun . ediff-get-window-by-clicking)
+ (defun . ediff-select-lowest-window)
+ (defun . ediff-setup-windows)
+ (defun . ediff-setup-windows-plain)
+ (defun . ediff-setup-windows-plain-merge)
+ (defun . ediff-setup-windows-plain-compare)
+ (defun . ediff-setup-windows-multiframe)
+ (defun . ediff-setup-windows-multiframe-merge)
+ (defun . ediff-setup-windows-multiframe-compare)
+ (defun . ediff-skip-unsuitable-frames)
+ (defun . ediff-frame-has-dedicated-windows)
+ (defun . ediff-window-ok-for-display)
+ (defun . ediff-setup-control-frame)
+ (defun . ediff-destroy-control-frame)
+ (defun . ediff-make-frame-position)
+ (defun . ediff-xemacs-select-frame-hook)
+ (defun . ediff-make-wide-display)
+ (defun . ediff-refresh-mode-lines)
+ (defun . ediff-refresh-control-frame)
+ (defun . ediff-make-narrow-control-buffer-id)
+ (defun . ediff-make-base-title)
+ (defun . ediff-make-wide-control-buffer-id)
+ (defun . ediff-get-visible-buffer-window)
+ (defun . ediff-keep-window-config)
+ (provide . ediff-wind))
+ ("/usr/share/emacs/23.0.93/lisp/ediff-help.elc"
+ (require . ediff-init)
+ ediff-long-help-message-head ediff-long-help-message-tail ediff-long-help-message-compare3 ediff-long-help-message-compare2 ediff-long-help-message-narrow2 ediff-long-help-message-word-mode ediff-long-help-message-merge ediff-long-help-message ediff-brief-message-string ediff-brief-help-message ediff-brief-help-message-function ediff-long-help-message-function ediff-use-long-help-message ediff-help-message ediff-help-region-map
+ (defun . ediff-set-help-overlays)
+ (defun . ediff-help-for-quick-help)
+ (defun . ediff-help-message-line-length)
+ (defun . ediff-indent-help-message)
+ (defun . ediff-set-help-message)
+ (t . ediff-customize)
+ (defun . ediff-customize)
+ (provide . ediff-help))
+ ("/usr/share/emacs/23.0.93/lisp/ediff-mult.elc"
+ (provide . ediff-mult)
+ (require . ediff-init)
+ ediff-meta-buffer ediff-parent-meta-buffer ediff-registry-buffer ediff-meta-buffer-brief-message ediff-meta-buffer-brief-message ediff-meta-buffer-verbose-message ediff-meta-buffer-verbose-message ediff-meta-buffer-map ediff-dir-diffs-buffer-map ediff-meta-action-function ediff-meta-redraw-function ediff-session-action-function ediff-metajob-name ediff-meta-diff-buffer ediff-recurse-to-subdirectories ediff-filtering-regexp-history ediff-default-filtering-regexp ediff-meta-list ediff-meta-session-number ediff-dir-difference-list ediff-dir-diffs-buffer ediff-session-registry ediff-meta-truncate-filenames ediff-meta-mode-hook ediff-registry-setup-hook ediff-before-session-group-setup-hooks ediff-after-session-group-setup-hook ediff-quit-session-group-hook ediff-show-registry-hook ediff-show-session-group-hook ediff-meta-buffer-keymap-setup-hook ediff-meta-patchbufer
+ (defun . ediff-get-group-buffer)
+ (defun . ediff-get-group-regexp)
+ (defun . ediff-get-group-objA)
+ (defun . ediff-get-group-objB)
+ (defun . ediff-get-group-objC)
+ (defun . ediff-get-group-merge-autostore-dir)
+ (defun . ediff-get-group-comparison-func)
+ (defun . ediff-get-session-buffer)
+ (defun . ediff-get-session-status)
+ (defun . ediff-set-session-status)
+ (defun . ediff-get-session-objA)
+ (defun . ediff-get-session-objB)
+ (defun . ediff-get-session-objC)
+ (defun . ediff-get-session-objA-name)
+ (defun . ediff-get-session-objB-name)
+ (defun . ediff-get-session-objC-name)
+ (defun . ediff-get-file-eqstatus)
+ (defun . ediff-set-file-eqstatus)
+ (defun . ediff-make-new-meta-list-element)
+ (defun . ediff-make-new-meta-list-header)
+ (defun . ediff-get-session-activity-marker)
+ (defun . ediff-meta-session-p)
+ ediff-verbose-help-enabled
+ (defun . ediff-toggle-verbose-help-meta-buffer)
+ (defun . ediff-setup-meta-map)
+ (defun . ediff-meta-mode)
+ (defun . ediff-next-meta-item)
+ (defun . ediff-next-meta-item1)
+ (defun . ediff-previous-meta-item)
+ (defun . ediff-previous-meta-item1)
+ (defun . ediff-add-slash-if-directory)
+ (defun . ediff-toggle-filename-truncation)
+ ediff-membership-code1 ediff-membership-code2 ediff-membership-code3 ediff-product-of-memcodes
+ (defun . ediff-intersect-directories)
+ (defun . ediff-get-directory-files-under-revision)
+ (defun . ediff-prepare-meta-buffer)
+ (defun . ediff-insert-session-activity-marker-in-meta-buffer)
+ (defun . ediff-insert-session-status-in-meta-buffer)
+ (defun . ediff-replace-session-activity-marker-in-meta-buffer)
+ (defun . ediff-replace-session-status-in-meta-buffer)
+ (defun . ediff-insert-session-info-in-meta-buffer)
+ (defun . ediff-redraw-directory-group-buffer)
+ (defun . ediff-update-markers-in-dir-meta-buffer)
+ (defun . ediff-update-session-marker-in-dir-meta-buffer)
+ (defun . ediff-problematic-session-p)
+ (defun . ediff-meta-insert-file-info1)
+ ediff-months
+ (defun . ediff-fill-leading-zero)
+ (defun . ediff-format-date)
+ (defun . ediff-insert-dirs-in-meta-buffer)
+ (defun . ediff-draw-dir-diffs)
+ (defun . ediff-bury-dir-diffs-buffer)
+ (defun . ediff-show-dir-diffs)
+ (defun . ediff-dir-diff-copy-file)
+ (defun . ediff-up-meta-hierarchy)
+ (defun . ediff-redraw-registry-buffer)
+ (defun . ediff-set-meta-overlay)
+ (defun . ediff-mark-for-hiding-at-pos)
+ (defun . ediff-mark-session-for-hiding)
+ (defun . ediff-mark-for-operation-at-pos)
+ (defun . ediff-mark-session-for-operation)
+ (defun . ediff-hide-marked-sessions)
+ (defun . ediff-operate-on-marked-sessions)
+ (defun . ediff-append-custom-diff)
+ (defun . ediff-collect-custom-diffs)
+ (defun . ediff-meta-show-patch)
+ (defun . ediff-filegroup-action)
+ (defun . ediff-registry-action)
+ (defun . ediff-show-meta-buffer)
+ (defun . ediff-show-current-session-meta-buffer)
+ (defun . ediff-show-meta-buff-from-registry)
+ (t . ediff-show-registry)
+ (defun . ediff-show-registry)
+ (defun . eregistry)
+ (defun . ediff-update-meta-buffer)
+ (defun . ediff-update-registry)
+ (defun . ediff-cleanup-meta-buffer)
+ (defun . ediff-safe-to-quit)
+ (defun . ediff-quit-meta-buffer)
+ (defun . ediff-dispose-of-meta-buffer)
+ (defun . ediff-get-meta-info)
+ (defun . ediff-get-meta-overlay-at-pos)
+ (defun . ediff-get-session-number-at-pos)
+ (defun . ediff-next-meta-overlay-start)
+ (defun . ediff-previous-meta-overlay-start)
+ (defun . ediff-patch-file-form-meta)
+ (defun . ediff-unmark-all-for-operation)
+ (defun . ediff-unmark-all-for-hiding)
+ (defun . ediff-meta-mark-equal-files)
+ (defun . ediff-mark-if-equal))
+ ("/usr/share/emacs/23.0.93/lisp/ediff-init.elc" ediff-force-faces
+ (defun . ediff-device-type)
+ (defun . ediff-window-display-p)
+ (defun . ediff-has-face-support-p)
+ (defun . ediff-has-toolbar-support-p)
+ (defun . ediff-has-gutter-support-p)
+ (defun . ediff-use-toolbar-p)
+ (defun . ediff-defvar-local)
+ ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-ancestor-buffer ediff-control-buffer ediff-temp-indirect-buffer ediff-buffer-alist ediff-buffer-alist
+ (defun . ediff-odd-p)
+ (defun . ediff-buffer-live-p)
+ (defun . ediff-get-buffer)
+ (defun . ediff-get-value-according-to-buffer-type)
+ (defun . ediff-char-to-buftype)
+ (defun . ediff-get-symbol-from-alist)
+ ediff-difference-vector-alist ediff-difference-vector-alist
+ (defun . ediff-get-difference)
+ (defun . ediff-no-fine-diffs-p)
+ (defun . ediff-get-diff-overlay-from-diff-record)
+ (defun . ediff-get-diff-overlay)
+ (defun . ediff-get-fine-diff-vector-from-diff-record)
+ (defun . ediff-set-fine-diff-vector)
+ (defun . ediff-get-state-of-diff)
+ (defun . ediff-set-state-of-diff)
+ (defun . ediff-get-state-of-merge)
+ (defun . ediff-set-state-of-merge)
+ (defun . ediff-get-state-of-ancestor)
+ (defun . ediff-mark-diff-as-space-only)
+ (defun . ediff-get-fine-diff-vector)
+ (defun . ediff-with-current-buffer)
+ (defun . ediff-multiframe-setup-p)
+ (defun . ediff-narrow-control-frame-p)
+ (defun . ediff-3way-comparison-job)
+ ediff-3way-comparison-job
+ (defun . ediff-merge-job)
+ ediff-merge-job
+ (defun . ediff-patch-job)
+ (defun . ediff-merge-with-ancestor-job)
+ ediff-merge-with-ancestor-job
+ (defun . ediff-3way-job)
+ ediff-3way-job
+ (defun . ediff-diff3-job)
+ ediff-diff3-job
+ (defun . ediff-windows-job)
+ ediff-windows-job
+ (defun . ediff-word-mode-job)
+ ediff-word-mode-job
+ (defun . ediff-narrow-job)
+ ediff-narrow-job
+ (defun . ediff-ancestor-metajob)
+ (defun . ediff-revision-metajob)
+ (defun . ediff-patch-metajob)
+ (defun . ediff-one-filegroup-metajob)
+ (defun . ediff-collect-diffs-metajob)
+ (defun . ediff-merge-metajob)
+ (defun . ediff-metajob3)
+ (defun . ediff-comparison-metajob3)
+ (defun . ediff-in-control-buffer-p)
+ (defun . ediff-barf-if-not-control-buffer)
+ ediff-before-setup-hook ediff-before-setup-windows-hook ediff-after-setup-windows-hook ediff-before-setup-control-frame-hook ediff-after-setup-control-frame-hook ediff-startup-hook ediff-select-hook ediff-unselect-hook ediff-prepare-buffer-hook ediff-load-hook ediff-mode-hook ediff-keymap-setup-hook ediff-display-help-hook ediff-suspend-hook ediff-quit-hook ediff-cleanup-hook ediff-KILLED-VITAL-BUFFER ediff-KILLED-VITAL-BUFFER ediff-NO-DIFFERENCES ediff-NO-DIFFERENCES ediff-BAD-DIFF-NUMBER ediff-BAD-DIFF-NUMBER ediff-BAD-INFO ediff-BAD-INFO ediff-skip-diff-region-function ediff-hide-regexp-matches-function ediff-focus-on-regexp-matches-function ediff-regexp-focus-A ediff-regexp-focus-B ediff-regexp-focus-C ediff-focus-regexp-connective ediff-regexp-hide-A ediff-regexp-hide-B ediff-regexp-hide-C ediff-hide-regexp-connective ediff-killed-diffs-alist ediff-syntax-table ediff-before-flag-bol ediff-after-flag-eol ediff-before-flag-mol ediff-after-flag-mol ediff-use-faces ediff-use-faces ediff-word-mode ediff-job-name ediff-narrow-bounds ediff-wide-bounds ediff-visible-bounds ediff-start-narrowed ediff-quit-widened ediff-keep-variants ediff-highlight-all-diffs ediff-highlight-all-diffs ediff-control-buffer-suffix ediff-control-buffer-number ediff-buffer-values-orig-A ediff-buffer-values-orig-B ediff-buffer-values-orig-C ediff-buffer-values-orig-Ancestor ediff-buffer-values-orig-alist ediff-buffer-values-orig-alist ediff-protected-variables ediff-protected-variables ediff-difference-vector-A ediff-difference-vector-B ediff-difference-vector-C ediff-difference-vector-Ancestor ediff-difference-vector-alist ediff-difference-vector-alist ediff-state-of-merge ediff-current-difference ediff-number-of-differences ediff-diff-buffer ediff-custom-diff-buffer ediff-fine-diff-buffer ediff-tmp-buffer ediff-msg-buffer ediff-error-buffer ediff-debug-buffer ediff-this-buffer-ediff-sessions ediff-disturbed-overlays ediff-shadow-overlay-priority ediff-version-control-package ediff-coding-system-for-read ediff-coding-system-for-write
+ (defun . ediff-read-event)
+ (defun . ediff-overlayp)
+ (defun . ediff-make-overlay)
+ (defun . ediff-delete-overlay)
+ (defun . ediff-check-version)
+ (defun . ediff-color-display-p)
+ ediff-highlighting-style
+ (defun . ediff-valid-color-p)
+ (defun . ediff-get-face)
+ (defun . ediff-display-pixel-width)
+ (defun . ediff-display-pixel-height)
+ ediff-current-diff-overlay-alist ediff-current-diff-overlay-alist ediff-current-diff-face-alist ediff-current-diff-face-alist
+ (defun . ediff-set-overlay-face)
+ (defun . ediff-region-help-echo)
+ (defun . ediff-set-face-pixmap)
+ (defun . ediff-hide-face)
+ (defface . ediff-current-diff-A)
+ ediff-current-diff-face-A
+ (defface . ediff-current-diff-B)
+ ediff-current-diff-face-B
+ (defface . ediff-current-diff-C)
+ ediff-current-diff-face-C
+ (defface . ediff-current-diff-Ancestor)
+ ediff-current-diff-face-Ancestor
+ (defface . ediff-fine-diff-A)
+ ediff-fine-diff-face-A
+ (defface . ediff-fine-diff-B)
+ ediff-fine-diff-face-B
+ (defface . ediff-fine-diff-C)
+ ediff-fine-diff-face-C
+ (defface . ediff-fine-diff-Ancestor)
+ ediff-fine-diff-face-Ancestor stipple-pixmap
+ (defface . ediff-even-diff-A)
+ ediff-even-diff-face-A
+ (defface . ediff-even-diff-B)
+ ediff-even-diff-face-B
+ (defface . ediff-even-diff-C)
+ ediff-even-diff-face-C
+ (defface . ediff-even-diff-Ancestor)
+ ediff-even-diff-face-Ancestor ediff-even-diff-face-alist ediff-even-diff-face-alist
+ (defface . ediff-odd-diff-A)
+ ediff-odd-diff-face-A
+ (defface . ediff-odd-diff-B)
+ ediff-odd-diff-face-B
+ (defface . ediff-odd-diff-C)
+ ediff-odd-diff-face-C
+ (defface . ediff-odd-diff-Ancestor)
+ ediff-odd-diff-face-Ancestor ediff-odd-diff-face-alist ediff-odd-diff-face-alist ediff-fine-diff-face-alist ediff-fine-diff-face-alist ediff-current-diff-overlay-A ediff-current-diff-overlay-B ediff-current-diff-overlay-C ediff-current-diff-overlay-Ancestor
+ (defun . ediff-highest-priority)
+ ediff-toggle-read-only-function ediff-make-buffers-readonly-at-startup ediff-verbose-p ediff-autostore-merges ediff-merge-store-file ediff-merge-filename-prefix ediff-no-emacs-help-in-control-buffer ediff-temp-file-prefix ediff-temp-file-mode ediff-metachars ediff-H-glyph ediff-temp-file-A ediff-temp-file-B ediff-temp-file-C
+ (defun . ediff-file-remote-p)
+ (defun . ediff-listable-file)
+ (defun . ediff-frame-unsplittable-p)
+ (defun . ediff-get-next-window)
+ (defun . ediff-kill-buffer-carefully)
+ (defun . ediff-background-face)
+ (defun . ediff-paint-background-regions-in-one-buffer)
+ (defun . ediff-paint-background-regions)
+ (defun . ediff-clear-fine-diff-vector)
+ (defun . ediff-clear-fine-differences-in-one-buffer)
+ (defun . ediff-clear-fine-differences)
+ (defun . ediff-mouse-event-p)
+ (defun . ediff-key-press-event-p)
+ (defun . ediff-event-point)
+ (defun . ediff-event-buffer)
+ (defun . ediff-event-key)
+ (defun . ediff-frame-iconified-p)
+ (defun . ediff-window-visible-p)
+ (defun . ediff-frame-char-width)
+ (defun . ediff-reset-mouse)
+ (defun . ediff-spy-after-mouse)
+ (defun . ediff-user-grabbed-mouse)
+ (defun . ediff-frame-char-height)
+ (defun . ediff-overlay-start)
+ (defun . ediff-overlay-end)
+ (defun . ediff-empty-overlay-p)
+ (defun . ediff-overlay-buffer)
+ (defun . ediff-overlay-get)
+ (defun . ediff-move-overlay)
+ (defun . ediff-overlay-put)
+ (defun . ediff-abbreviate-file-name)
+ (defun . ediff-strip-last-dir)
+ (defun . ediff-truncate-string-left)
+ (defun . ediff-nonempty-string-p)
+ (defun . ediff-abbrev-jobname)
+ (defun . ediff-strip-mode-line-format)
+ (defun . ediff-valid-difference-p)
+ (defun . ediff-show-all-diffs)
+ (defun . ediff-message-if-verbose)
+ (defun . ediff-file-attributes)
+ (defun . ediff-file-size)
+ (defun . ediff-file-modtime)
+ (defun . ediff-convert-standard-filename)
+ (defun . ediff-with-syntax-table)
+ (provide . ediff-init))
+ ("/home/hobbes/nxhtml/nxhtml/html-imenu.el" html-imenu:version
+ (require . imenu)
+ html-imenu-title html-imenu-regexp
+ (defun . html-imenu-index)
+ (defun . html-imenu-setup)
+ (defun . html-imenu-update-menubar)
+ (defun . html-imenu-update-menubar-1)
+ (provide . html-imenu))
+ ("/usr/share/emacs/23.0.93/lisp/imenu.elc" imenu-use-markers imenu-max-item-length imenu-auto-rescan imenu-auto-rescan-maxout imenu-always-use-completion-buffer-p imenu-use-popup-menu imenu-eager-completion-buffer imenu-after-jump-hook imenu-sort-function imenu-max-items imenu-space-replacement imenu-level-separator imenu-generic-expression imenu-create-index-function imenu-prev-index-position-function imenu-extract-index-name-function imenu-name-lookup-function imenu-default-goto-function
+ (defun . imenu--subalist-p)
+ (defun . imenu-progress-message)
+ (defun . imenu-example--name-and-position)
+ (defun . imenu-example--lisp-extract-index-name)
+ (defun . imenu-example--create-lisp-index)
+ imenu-example--function-name-regexp-c
+ (defun . imenu-example--create-c-index)
+ imenu--rescan-item imenu--rescan-item imenu--index-alist imenu--last-menubar-index-alist imenu--history-list
+ (defun . imenu--sort-by-name)
+ (defun . imenu--sort-by-position)
+ (defun . imenu--relative-position)
+ (defun . imenu--split)
+ (defun . imenu--split-menu)
+ (defun . imenu--split-submenus)
+ (defun . imenu--truncate-items)
+ (defun . imenu--make-index-alist)
+ (defun . imenu--cleanup)
+ (defun . imenu--create-keymap)
+ (defun . imenu--in-alist)
+ imenu-syntax-alist
+ (defun . imenu-default-create-index-function)
+ imenu-case-fold-search
+ (defun . imenu--generic-function)
+ (defun . imenu-find-default)
+ (defun . imenu--completion-buffer)
+ (defun . imenu--mouse-menu)
+ (defun . imenu-choose-buffer-index)
+ (t . imenu-add-to-menubar)
+ (defun . imenu-add-to-menubar)
+ (t . imenu-add-menubar-index)
+ (defun . imenu-add-menubar-index)
+ imenu-buffer-menubar imenu-menubar-modified-tick
+ (defun . imenu-update-menubar)
+ (defun . imenu--menubar-select)
+ (defun . imenu-default-goto-function)
+ (t . imenu)
+ (defun . imenu)
+ (provide . imenu))
+ ("/home/hobbes/nxhtml/util/popcmp.el"
+ (require . ourcomments-util)
+ popcmp-popup-completion
+ (defun . popcmp-popup-completion-toggle)
+ popcmp-short-help-beside-alts
+ (defun . popcmp-short-help-beside-alts-toggle)
+ popcmp-group-alternatives
+ (defun . popcmp-group-alternatives-toggle)
+ (defun . popcmp-getsets)
+ (defun . popcmp-getset-alts)
+ popcmp-completing-with-help
+ (defun . popcmp-add-help)
+ (defun . popcmp-remove-help)
+ (defun . popcmp-completing-read-nopop)
+ (defun . popcmp-completing-read-pop)
+ (defun . popcmp-completing-read)
+ popcmp-mark-completing-ovl
+ (defun . popcmp-mark-completing)
+ (defun . popcmp-unmark-completing)
+ (provide . popcmp))
+ ("/home/hobbes/nxhtml/nxhtml/rngalt.el" rngalt:version
+ (require . rng-valid)
+ (require . rng-nxml)
+ rngalt-complete-first-try rngalt-complete-last-try rngalt-completing-read-tag rngalt-completing-read-attribute-name rngalt-completing-read-attribute-value
+ (defun . rngalt-finish-element)
+ (defun . rngalt-finish-element-1)
+ (defun . rngalt-complete)
+ (defun . rngalt-validate)
+ rngalt-region-ovl rngalt-region-prepared
+ (defun . rngalt-complete-tag-region-prepare)
+ (defun . rngalt-complete-tag-region-cleanup)
+ (defun . rngalt-complete-tag-region-finish)
+ (defun . rngalt-complete-tag)
+ rngalt-complete-tag-hooks
+ (defun . rngalt-complete-attribute-name)
+ (defun . rngalt-complete-attribute-value)
+ (defun . rngalt-complete-before-point)
+ (defun . rngalt-get-missing-required-attr)
+ rngalt-validation-header rngalt-current-schema-file-name rngalt-validation-header-overlay rngalt-major-mode
+ (defun . rngalt-after-change-major)
+ rngalt-validation-header-keymap
+ (defun . rngalt-update-validation-header-overlay)
+ (defun . rngalt-update-validation-header-overlay-everywhere)
+ rngalt-display-validation-header
+ (defun . rngalt-display-validation-header-toggle)
+ rngalt-minimal-validation-header
+ (defun . rngalt-minimal-validation-header-toggle)
+ (defface . rngalt-validation-header-top)
+ (defface . rngalt-validation-header-bottom)
+ (require . bytecomp)
+ (defun . advice-compilation)
+ (t . rngalt-set-validation-header)
+ (defun . rngalt-set-validation-header)
+ (defun . rngalt-reapply-validation-header)
+ (defun . rngalt-get-validation-header-buffer)
+ (defun . rngalt-get-state-after)
+ (defun . rngalt-show-validation-header)
+ (defun . rngalt-update-validation-header-buffer)
+ (provide . rngalt))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/rng-nxml.elc"
+ (require . easymenu)
+ (require . xmltok)
+ (require . nxml-util)
+ (require . nxml-ns)
+ (require . rng-match)
+ (require . rng-util)
+ (require . rng-valid)
+ (require . nxml-mode)
+ (require . rng-loc)
+ rng-nxml-auto-validate-flag rng-preferred-prefix-alist rng-complete-end-tags-after-< rng-nxml-easy-menu
+ (t . rng-nxml-mode-init)
+ (defun . rng-nxml-mode-init)
+ rng-tag-history rng-attribute-name-history rng-attribute-value-history rng-complete-target-names rng-complete-name-attribute-flag rng-complete-extra-strings
+ (defun . rng-complete)
+ rng-in-start-tag-name-regex rng-in-start-tag-name-regex
+ (defun . rng-complete-tag)
+ rng-in-end-tag-name-regex rng-in-end-tag-name-regex
+ (defun . rng-complete-end-tag)
+ rng-in-attribute-regex rng-in-attribute-regex rng-undeclared-prefixes
+ (defun . rng-complete-attribute-name)
+ rng-in-attribute-value-regex rng-in-attribute-value-regex
+ (defun . rng-complete-attribute-value)
+ (defun . rng-possible-namespace-uris)
+ rng-qname-regexp rng-qname-regexp
+ (defun . rng-qname-p)
+ (defun . rng-expand-qname)
+ (defun . rng-start-tag-expand-recover)
+ (defun . rng-split-qname)
+ (defun . rng-in-mixed-content-p)
+ (defun . rng-set-state-after)
+ (defun . rng-adjust-state-for-attribute)
+ (defun . rng-find-undeclared-prefixes)
+ (defun . rng-prune-attribute-at)
+ (defun . rng-adjust-state-for-attribute-value)
+ (defun . rng-complete-qname-function)
+ (defun . rng-generate-qname-list)
+ (defun . rng-get-preferred-unused-prefix)
+ (defun . rng-strings-to-completion-alist)
+ (provide . rng-nxml))
+ ("/usr/share/emacs/23.0.93/lisp/loadhist.elc"
+ (defun . feature-symbols)
+ (defun . feature-file)
+ (defun . file-loadhist-lookup)
+ (defun . file-provides)
+ (defun . file-requires)
+ (defun . file-set-intersect)
+ (defun . file-dependents)
+ (defun . read-feature)
+ loadhist-hook-functions unload-feature-special-hooks unload-function-defs-list unload-hook-features-list
+ (t . unload-feature)
+ (defun . unload-feature)
+ (provide . loadhist))
+ ("/home/hobbes/nxhtml/util/appmenu-fold.el" appmenu-fold:version
+ (require . fold-dwim)
+ (require . appmenu)
+ (defun . appmenu-fold-no-hs-minor-mode)
+ (defun . appmenu-fold-no-outline-minor-mode)
+ (defun . appmenu-fold-setup)
+ (provide . appmenu-fold))
+ ("/home/hobbes/nxhtml/related/fold-dwim.el" fold-dwim:version
+ (require . outline)
+ (require . hideshow)
+ fold-dwim-outline-style-default fold-dwim-toggle-selective-display
+ (defun . fold-dwim-maybe-recenter)
+ (defun . fold-dwim-toggle-selective-display)
+ (defun . fold-dwim-hide-all)
+ (defun . fold-dwim-show-all)
+ (defun . fold-dwim-hide)
+ (defun . fold-dwim-show)
+ (defun . fold-dwim-toggle)
+ (defun . fold-dwim-auctex-env-or-macro)
+ (defun . fold-dwim-outline-invisible-p)
+ (defun . fold-dwim-outline-nested-p)
+ (provide . fold-dwim))
+ ("/usr/share/emacs/23.0.93/lisp/progmodes/hideshow.elc" hs-hide-comments-when-hiding-all hs-minor-mode-hook hs-isearch-open hs-special-modes-alist hs-hide-all-non-comment-function hs-allow-nesting hs-hide-hook hs-show-hook hs-set-up-overlay hs-minor-mode hs-minor-mode-map hs-minor-mode-menu
+ (defun . hs-minor-mode-menu)
+ hs-c-start-regexp hs-block-start-regexp hs-block-start-mdata-select hs-block-end-regexp hs-forward-sexp-func hs-adjust-block-beginning hs-headline
+ (defun . hs-discard-overlays)
+ (defun . hs-make-overlay)
+ (defun . hs-isearch-show)
+ (defun . hs-isearch-show-temporary)
+ (defun . hs-forward-sexp)
+ (defun . hs-hide-comment-region)
+ (defun . hs-hide-block-at-point)
+ (defun . hs-inside-comment-p)
+ (defun . hs-grok-mode-type)
+ (defun . hs-find-block-beginning)
+ (defun . hs-hide-level-recursive)
+ (defun . hs-life-goes-on)
+ (defun . hs-overlay-at)
+ (defun . hs-already-hidden-p)
+ (defun . hs-c-like-adjust-block-beginning)
+ (defun . hs-hide-all)
+ (defun . hs-show-all)
+ (defun . hs-hide-block)
+ (defun . hs-show-block)
+ (defun . hs-hide-level)
+ (defun . hs-toggle-hiding)
+ (defun . hs-mouse-toggle-hiding)
+ (defun . hs-hide-initial-comment-block)
+ hs-minor-mode
+ (t . hs-minor-mode)
+ (defun . hs-minor-mode)
+ (t . turn-off-hideshow)
+ (defun . turn-off-hideshow)
+ (provide . hideshow))
+ ("/usr/share/emacs/23.0.93/lisp/outline.elc" outline-regexp outline-heading-end-regexp outline-mode-prefix-map outline-mode-menu-bar-map outline-minor-mode-menu-bar-map outline-mode-map outline-font-lock-keywords
+ (defface . outline-1)
+ (defface . outline-2)
+ (defface . outline-3)
+ (defface . outline-4)
+ (defface . outline-5)
+ (defface . outline-6)
+ (defface . outline-7)
+ (defface . outline-8)
+ outline-font-lock-faces
+ (defun . outline-font-lock-face)
+ outline-view-change-hook outline-mode-hook outline-blank-line outline-mode-map outline-mode-syntax-table outline-mode-abbrev-table outline-mode-abbrev-table
+ (t . outline-mode)
+ (defun . outline-mode)
+ outline-minor-mode-prefix outline-minor-mode
+ (t . outline-minor-mode)
+ (defun . outline-minor-mode)
+ outline-minor-mode-map outline-level outline-heading-alist
+ (defun . outline-level)
+ (defun . outline-next-preface)
+ (defun . outline-next-heading)
+ (defun . outline-previous-heading)
+ (defun . outline-invisible-p)
+ (defun . outline-visible)
+ (defun . outline-back-to-heading)
+ (defun . outline-on-heading-p)
+ (defun . outline-insert-heading)
+ (defun . outline-invent-heading)
+ (defun . outline-promote)
+ (defun . outline-demote)
+ (defun . outline-head-from-level)
+ (defun . outline-map-region)
+ (defun . outline-move-subtree-up)
+ (defun . outline-move-subtree-down)
+ (defun . outline-end-of-heading)
+ (defun . outline-next-visible-heading)
+ (defun . outline-previous-visible-heading)
+ (defun . outline-mark-subtree)
+ outline-isearch-open-invisible-function
+ (defun . outline-flag-region)
+ (defun . outline-reveal-toggle-invisible)
+ (defun . outline-isearch-open-invisible)
+ (defun . hide-entry)
+ (defun . show-entry)
+ (defun . hide-body)
+ (defun . hide-region-body)
+ (defun . show-all)
+ (defun . hide-subtree)
+ (defun . hide-leaves)
+ (defun . show-subtree)
+ (defun . outline-show-heading)
+ (defun . hide-sublevels)
+ (defun . hide-other)
+ (defun . outline-toggle-children)
+ (defun . outline-flag-subtree)
+ (defun . outline-end-of-subtree)
+ (defun . show-branches)
+ (defun . show-children)
+ (defun . outline-up-heading)
+ (defun . outline-forward-same-level)
+ (defun . outline-get-next-sibling)
+ (defun . outline-backward-same-level)
+ (defun . outline-get-last-sibling)
+ (defun . outline-headers-as-kill)
+ (provide . outline)
+ (provide . noutline))
+ ("/home/hobbes/nxhtml/util/mumamo.el" mumamo:version
+ (require . cl)
+ (require . flyspell)
+ (require . mlinks)
+ (require . nxml-mode)
+ (require . rng-valid)
+ (require . sgml-mode)
+ msgtrc-buffer
+ (defun . msgtrc)
+ mumamo-message-file-buffer
+ (defun . mumamo-msgtrc-to-file)
+ (defun . mumamo-msgfntfy)
+ (defun . mumamo-msgindent)
+ mumamo-display-error-lwarn mumamo-display-error-stop
+ (defun . mumamo-message-with-face)
+ (defun . mumamo-show-report-message)
+ (defun . mumamo-display-error)
+ (defun . mumamo-debug-to-backtrace)
+ mumamo-use-condition-case mumamo-debugger
+ (defun . mumamo-condition-case)
+ mumamo-warned-once
+ (defun . mumamo-warn-once)
+ (defun . mumamo-add-help-tabs)
+ (defun . mumamo-insert-describe-button)
+ (defface . mumamo-border-face-in)
+ (defface . mumamo-border-face-out)
+ mumamo-set-major-mode-delay
+ (defface . mumamo-background-chunk-submode)
+ mumamo-background-chunk-major
+ (defface . mumamo-background-chunk-major)
+ mumamo-background-chunk-submode mumamo-background-colors
+ (defun . mumamo-background-color)
+ mumamo-chunk-coloring mumamo-submode-indent-offset mumamo-submode-indent-offset-0 mumamo-major-mode-indent-specials mumamo-check-chunk-major-same mumamo-major-modes
+ (defun . mumamo-jit-lock-function)
+ (defun . mumamo-jit-lock-register)
+ (defun . mumamo-jit-with-buffer-unmodified)
+ (defun . mumamo-with-buffer-prepared-for-jit-lock)
+ mumamo-find-chunks-timer mumamo-find-chunk-delay
+ (defun . mumamo-stop-find-chunks-timer)
+ (defun . mumamo-start-find-chunks-timer)
+ (defun . mumamo-find-chunks-in-timer)
+ mumamo-last-chunk mumamo-last-new-chunk mumamo-last-chunk-change-pos mumamo-old-chunks mumamo-find-chunk-is-active mumamo-use-new-chunks
+ (defun . mumamo-toggle-use-new-chunks)
+ mumamo-use-both-chunks
+ (defun . mumamo-toggle-use-both-chunks)
+ (defun . mumamo-make-old-chunks)
+ (defun . mumamo-make-new-chunks)
+ (defun . mumamo-toggle-and-normal-mode-and-what-at-cursor)
+ mumamo-find-chunks-level
+ (defun . mumamo-find-chunks)
+ (defun . mumamo-find-chunk-after-change)
+ (defun . mumamo-after-change)
+ (defun . mumamo-jit-lock-after-change)
+ (defun . mumamo-jit-lock-after-change-1)
+ (defun . mumamo-mark-chunk)
+ (defun . mumamo-save-buffer-state)
+ (t . mumamo-mark-for-refontification)
+ (defun . mumamo-mark-for-refontification)
+ mumamo-internal-major-modes-alist mumamo-ppss-last-chunk mumamo-ppss-last-major mumamo-major-mode-substitute
+ (defun . mumamo-get-major-mode-substitute)
+ (defun . mumamo-with-major-mode-setup)
+ (defun . mumamo-with-major-mode-fontification)
+ (defun . mumamo-with-major-mode-indentation)
+ (defun . mumamo-assert-fontified-t)
+ (defun . mumamo-do-fontify)
+ (defun . mumamo-do-unfontify)
+ (defun . mumamo-fontify-region-with)
+ (defun . mumamo-unfontify-region-with)
+ (defun . mumamo-unfontify-buffer)
+ (defun . mumamo-fontify-buffer)
+ (defun . mumamo-unfontify-chunk)
+ mumamo-just-changed-major
+ (defun . mumamo-fontify-region)
+ mumamo-dbg-pretend-fontified
+ (defun . mumamo-exc-mode)
+ (defun . mumamo-chunk-value-set-min)
+ (defun . mumamo-chunk-value-set-max)
+ (defun . mumamo-chunk-value-set-syntax-min)
+ (defun . mumamo-chunk-value-set-syntax-max)
+ (defun . mumamo-chunk-value-min)
+ (defun . mumamo-chunk-value-max)
+ (defun . mumamo-chunk-value-major)
+ (defun . mumamo-chunk-value-syntax-min)
+ (defun . mumamo-chunk-value-syntax-max)
+ (defun . mumamo-chunk-value-parseable-by)
+ (defun . mumamo-chunk-value-fw-exc-fun)
+ mumamo-chunks-to-remove
+ (defun . mumamo-flush-chunk-syntax)
+ (defun . mumamo-fontify-region-1)
+ (defun . mumamo-remove-old-overlays)
+ mumamo-known-buffer-local-fontifications mumamo-irrelevant-buffer-local-vars
+ (defun . mumamo-get-relevant-buffer-local-vars)
+ mumamo-major-modes-local-maps
+ (defun . mumamo-fetch-major-mode-setup)
+ (defun . mumamo-bad-mode)
+ (defun . mumamo-get-major-mode-setup)
+ (defun . mumamo-remove-chunk-overlays)
+ (defun . mumamo-remove-all-chunk-overlays)
+ (defun . mumamo-create-chunk-values-at)
+ (defun . mumamo-define-no-mode)
+ (defun . mumamo-major-mode-from-modespec)
+ (defun . mumamo-chunk-equal-chunk-values)
+ (defun . mumamo-create-chunk-from-chunk-values)
+ (defun . mumamo-create-chunk-at)
+ (defun . mumamo-get-existing-chunk-at)
+ (defun . mumamo-get-existing-new-chunk-at)
+ (defun . mumamo-get-chunk-save-buffer-state)
+ (defun . mumamo-chunk-major-mode)
+ (defun . mumamo-chunk-syntax-min)
+ (defun . mumamo-chunk-syntax-max)
+ (defun . mumamo-syntax-maybe-completable)
+ mumamo-current-chunk-family
+ (defun . mumamo-main-major-mode)
+ (defun . mumamo-chunk-start-fw-str)
+ (defun . mumamo-chunk-start-fw-re)
+ (defun . mumamo-chunk-start-fw-str-inc)
+ (defun . mumamo-chunk-start-bw-str)
+ (defun . mumamo-chunk-start-bw-re)
+ (defun . mumamo-chunk-start-bw-str-inc)
+ (defun . mumamo-chunk-end-fw-str)
+ (defun . mumamo-chunk-end-fw-re)
+ (defun . mumamo-chunk-end-fw-str-inc)
+ (defun . mumamo-chunk-end-bw-str)
+ (defun . mumamo-chunk-end-bw-re)
+ (defun . mumamo-chunk-end-bw-str-inc)
+ mumamo-string-syntax-table
+ (defun . mumamo-guess-in-string)
+ mumamo-find-possible-chunk-new
+ (defun . mumamo-find-possible-chunk)
+ (defun . mumamo-find-possible-chunk-new)
+ (defun . mumamo-find-possible-chunk-old)
+ (defun . temp-overlays-here)
+ (defun . temp-cursor-pos)
+ (defun . temp-test-new-create-chunk)
+ (defun . temp-create-last-chunk)
+ (defun . mumamo-delete-new-chunks)
+ (defun . mumamo-new-create-chunk)
+ (defun . mumamo-new-chunk-value-min)
+ (defun . mumamo-new-chunk-value-max)
+ (defun . mumamo-new-chunk-equal-chunk-values)
+ (defun . mumamo-find-next-chunk-values)
+ (defun . mumamo-valid-nxml-point)
+ (defun . mumamo-valid-nxml-chunk)
+ (defun . mumamo-end-chunk-is-valid)
+ (defun . mumamo-quick-static-chunk)
+ mumamo-unread-command-events-timer
+ (defun . mumamo-unread-command-events)
+ mumamo-idle-set-major-mode-timer
+ (defun . mumamotemp-pre-command)
+ (defun . mumamotemp-post-command)
+ (defun . mumamotemp-start)
+ (defun . mumamo-idle-set-major-mode)
+ (defun . mumamo-request-idle-set-major-mode)
+ mumamo-done-first-set-major mumamo-multi-major-mode mumamo-safe-commands-in-wrong-major
+ (defun . mumamo-set-major-pre-command)
+ (defun . mumamo-fetch-local-map)
+ (defun . mumamo-set-major-post-command)
+ (defun . mumamo-post-command-1)
+ (defun . mumamo-post-command)
+ mumamo-set-major-running
+ (defun . mumamo-change-major-function)
+ (defun . mumamo-derived-from-mode)
+ mumamo-test-add-hook mumamo-survive-hooks mumamo-survive
+ (defun . mumamo-make-variable-buffer-permanent)
+ mumamo-survive-done-by-me
+ (defun . mumamo-hook-p)
+ mumamo-major-mode mumamo-change-major-mode-no-nos mumamo-after-change-major-mode-no-nos mumamo-removed-from-hook
+ (defun . mumamo-remove-from-hook)
+ (defun . mumamo-addback-to-hooks)
+ (defun . mumamo-addback-to-hook)
+ mumamo-buffer-locals-dont-set
+ (defun . mumamo-save-most-buffer-locals)
+ mumamo-restore-most-buffer-locals-in-hook-major
+ (defun . mumamo-restore-most-buffer-locals-in-hook)
+ (defun . mumamo-restore-most-buffer-locals)
+ mumamo-buffer-locals-per-major
+ (defun . mumamo-get-hook-value)
+ (defun . mumamo-set-major)
+ (defun . mumamo-setup-local-fontification-vars)
+ (defun . mumamo-set-fontification-functions)
+ (defun . mumamo-initialize-state)
+ (defun . mumamo-turn-on-actions)
+ (defun . mumamo-turn-off-actions)
+ mumamo-turn-on-hook mumamo-change-major-mode-hook mumamo-after-change-major-mode-hook mumamo-defined-turn-on-functions
+ (defun . mumamo-describe-chunks)
+ (defun . mumamo-add-multi-keymap)
+ mumamo-map
+ (defun . define-mumamo-multi-major-mode)
+ (defun . mumamo-indent-line-function)
+ (defun . mumamo-indent-line-chunks)
+ (defun . mumamo-indent-line-function-1)
+ (defun . mumamo-indent-use-widen)
+ (defun . mumamo-indent-special-or-default)
+ (defun . mumamo-call-indent-line)
+ (defun . mumamo-indent-region-function)
+ (defun . mumamo-fill-forward-paragraph-function)
+ (defun . mumamo-fill-paragraph-function)
+ (defun . mumamo-forward-chunk)
+ (defun . mumamo-backward-chunk)
+ (defun . mumamo-flyspell-verify)
+ (defun . flyspell-mumamo-mode)
+ (require . bytecomp)
+ (defun . advice-compilation)
+ mumamo-syntax-chunk-at-pos
+ (defun . advice-compilation)
+ mumamo-syntax-ppss-major
+ (defun . advice-compilation)
+ rng-get-major-mode-chunk-function rng-valid-nxml-major-mode-chunk-function rng-end-major-mode-chunk-function
+ (defun . advice-compilation)
+ (defun . advice-compilation)
+ (defun . advice-compilation)
+ (provide . mumamo))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/byte-opt.elc"
+ (require . bytecomp)
+ (defun . byte-compile-log-lap-1)
+ (defun . byte-compile-log-lap)
+ (defun . byte-optimize-inline-handler)
+ (defun . byte-inline-lapcode)
+ (t . byte-compile-inline-expand)
+ (defun . byte-compile-inline-expand)
+ (t . byte-compile-unfold-lambda)
+ (defun . byte-compile-unfold-lambda)
+ (defun . byte-optimize-form-code-walker)
+ (defun . byte-optimize-all-constp)
+ (t . byte-optimize-form)
+ (defun . byte-optimize-form)
+ (defun . byte-optimize-body)
+ (defun . byte-compile-trueconstp)
+ (defun . byte-compile-nilconstp)
+ (defun . byte-optimize-associative-math)
+ (defun . byte-optimize-nonassociative-math)
+ (defun . byte-optimize-approx-equal)
+ (defun . byte-optimize-delay-constants-math)
+ (defun . byte-compile-butlast)
+ (defun . byte-optimize-plus)
+ (defun . byte-optimize-minus)
+ (defun . byte-optimize-multiply)
+ (defun . byte-optimize-divide)
+ (defun . byte-optimize-logmumble)
+ (defun . byte-optimize-binary-predicate)
+ (defun . byte-optimize-predicate)
+ (defun . byte-optimize-identity)
+ (defun . byte-optimize-quote)
+ (defun . byte-optimize-zerop)
+ (defun . byte-optimize-and)
+ (defun . byte-optimize-or)
+ (defun . byte-optimize-cond)
+ (defun . byte-optimize-if)
+ (defun . byte-optimize-while)
+ (defun . byte-optimize-funcall)
+ (defun . byte-optimize-apply)
+ (defun . byte-optimize-letX)
+ (defun . byte-optimize-nth)
+ (defun . byte-optimize-nthcdr)
+ (defun . byte-optimize-featurep)
+ (defun . byte-optimize-set)
+ (defun . byte-compile-splice-in-already-compiled-code)
+ byte-constref-ops byte-constref-ops
+ (defun . disassemble-offset)
+ (t . byte-decompile-bytecode)
+ (defun . byte-decompile-bytecode)
+ (defun . byte-decompile-bytecode-1)
+ byte-tagref-ops byte-tagref-ops byte-conditional-ops byte-conditional-ops byte-after-unbind-ops byte-compile-side-effect-and-error-free-ops byte-compile-side-effect-and-error-free-ops byte-compile-side-effect-free-ops byte-compile-side-effect-free-ops
+ (t . byte-optimize-lapcode)
+ (defun . byte-optimize-lapcode)
+ (provide . byte-opt))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/bytecomp.elc"
+ (require . backquote)
+ (defun . byte-compile-single-version)
+ (defun . byte-compile-version-cond)
+ emacs-lisp-file-regexp
+ (defun . byte-compiler-base-file-name)
+ (defun . byte-compile-dest-file)
+ (autoload . byte-compile-inline-expand)
+ (autoload . byte-optimize-form)
+ (autoload . byte-optimize-lapcode)
+ (autoload . byte-compile-unfold-lambda)
+ (autoload . byte-decompile-bytecode)
+ byte-compile-verbose byte-compile-compatibility byte-optimize byte-compile-delete-errors byte-compile-dynamic byte-compile-disable-print-circle byte-compile-dynamic-docstrings byte-optimize-log byte-compile-error-on-warn byte-compile-warning-types byte-compile-warnings
+ (t . byte-compile-warnings-safe-p)
+ (defun . byte-compile-warnings-safe-p)
+ (defun . byte-compile-warning-enabled-p)
+ (t . byte-compile-disable-warning)
+ (defun . byte-compile-disable-warning)
+ (t . byte-compile-enable-warning)
+ (defun . byte-compile-enable-warning)
+ byte-compile-interactive-only-functions byte-compile-not-obsolete-var byte-compile-generate-call-tree byte-compile-call-tree byte-compile-call-tree-sort byte-compile-debug byte-compile-constants byte-compile-variables byte-compile-bound-variables byte-compile-const-variables byte-compile-initial-macro-environment byte-compile-macro-environment byte-compile-function-environment byte-compile-unresolved-functions byte-compile-noruntime-functions byte-compile-tag-number byte-compile-output byte-compile-depth byte-compile-maxdepth byte-code-vector byte-stack+-info
+ (defun . byte-defop)
+ (defun . byte-extrude-byte-code-vectors)
+ byte-varref byte-varset byte-varbind byte-call byte-unbind byte-nth byte-nth byte-symbolp byte-symbolp byte-consp byte-consp byte-stringp byte-stringp byte-listp byte-listp byte-eq byte-eq byte-memq byte-memq byte-not byte-not byte-car byte-car byte-cdr byte-cdr byte-cons byte-cons byte-list1 byte-list1 byte-list2 byte-list2 byte-list3 byte-list3 byte-list4 byte-list4 byte-length byte-length byte-aref byte-aref byte-aset byte-aset byte-symbol-value byte-symbol-value byte-symbol-function byte-symbol-function byte-set byte-set byte-fset byte-fset byte-get byte-get byte-substring byte-substring byte-concat2 byte-concat2 byte-concat3 byte-concat3 byte-concat4 byte-concat4 byte-sub1 byte-sub1 byte-add1 byte-add1 byte-eqlsign byte-eqlsign byte-gtr byte-gtr byte-lss byte-lss byte-leq byte-leq byte-geq byte-geq byte-diff byte-diff byte-negate byte-negate byte-plus byte-plus byte-max byte-max byte-min byte-min byte-mult byte-mult byte-point byte-point byte-goto-char byte-goto-char byte-insert byte-insert byte-point-max byte-point-max byte-point-min byte-point-min byte-char-after byte-char-after byte-following-char byte-following-char byte-preceding-char byte-preceding-char byte-current-column byte-current-column byte-indent-to byte-indent-to byte-scan-buffer-OBSOLETE byte-scan-buffer-OBSOLETE byte-eolp byte-eolp byte-eobp byte-eobp byte-bolp byte-bolp byte-bobp byte-bobp byte-current-buffer byte-current-buffer byte-set-buffer byte-set-buffer byte-save-current-buffer byte-set-mark-OBSOLETE byte-set-mark-OBSOLETE byte-interactive-p byte-interactive-p byte-forward-char byte-forward-char byte-forward-word byte-forward-word byte-skip-chars-forward byte-skip-chars-forward byte-skip-chars-backward byte-skip-chars-backward byte-forward-line byte-forward-line byte-char-syntax byte-char-syntax byte-buffer-substring byte-buffer-substring byte-delete-region byte-delete-region byte-narrow-to-region byte-narrow-to-region byte-widen byte-widen byte-end-of-line byte-end-of-line byte-constant2 byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop byte-return byte-discard byte-dup byte-save-excursion byte-save-window-excursion byte-save-restriction byte-catch byte-unwind-protect byte-condition-case byte-condition-case byte-temp-output-buffer-setup byte-temp-output-buffer-setup byte-temp-output-buffer-show byte-temp-output-buffer-show byte-unbind-all byte-unbind-all byte-set-marker byte-set-marker byte-match-beginning byte-match-beginning byte-match-end byte-match-end byte-upcase byte-upcase byte-downcase byte-downcase byte-string= byte-string= byte-string< byte-string< byte-equal byte-equal byte-nthcdr byte-nthcdr byte-elt byte-elt byte-member byte-member byte-assq byte-assq byte-nreverse byte-nreverse byte-setcar byte-setcar byte-setcdr byte-setcdr byte-car-safe byte-car-safe byte-cdr-safe byte-cdr-safe byte-nconc byte-nconc byte-quo byte-quo byte-rem byte-rem byte-numberp byte-numberp byte-integerp byte-integerp byte-listN byte-listN byte-concatN byte-concatN byte-insertN byte-insertN byte-constant byte-constant-limit byte-goto-ops byte-goto-always-pop-ops byte-goto-always-pop-ops
+ (defun . byte-compile-lapcode)
+ (defun . byte-compile-eval)
+ (defun . byte-compile-eval-before-compile)
+ byte-compile-current-form byte-compile-dest-file byte-compile-current-file byte-compile-current-group byte-compile-current-buffer
+ (defun . byte-compile-log)
+ (defun . byte-compile-log-1)
+ byte-compile-read-position byte-compile-last-position
+ (defun . byte-compile-delete-first)
+ (defun . byte-compile-set-symbol-position)
+ byte-compile-last-warned-form byte-compile-last-logged-file
+ (defun . byte-compile-warning-prefix)
+ (defun . byte-compile-warning-series)
+ (defun . byte-compile-log-file)
+ (defun . byte-compile-log-warning)
+ (defun . byte-compile-warn)
+ (defun . byte-compile-warn-obsolete)
+ (defun . byte-compile-report-error)
+ (defun . byte-compile-obsolete)
+ (defun . byte-compile-fdefinition)
+ (defun . byte-compile-arglist-signature)
+ (defun . byte-compile-arglist-signatures-congruent-p)
+ (defun . byte-compile-arglist-signature-string)
+ (defun . byte-compile-callargs-warn)
+ (defun . byte-compile-format-warn)
+ (defun . byte-compile-nogroup-warn)
+ (defun . byte-compile-arglist-warn)
+ byte-compile-cl-functions
+ (defun . byte-compile-find-cl-functions)
+ (defun . byte-compile-cl-warn)
+ (defun . byte-compile-print-syms)
+ (defun . byte-compile-warn-about-unresolved-functions)
+ (defun . byte-compile-const-symbol-p)
+ (defun . byte-compile-constp)
+ (defun . byte-compile-close-variables)
+ (defun . displaying-byte-compile-warnings)
+ (t . byte-force-recompile)
+ (defun . byte-force-recompile)
+ (t . byte-recompile-directory)
+ (defun . byte-recompile-directory)
+ no-byte-compile
+ (t . byte-compile-file)
+ (defun . byte-compile-file)
+ (t . compile-defun)
+ (defun . compile-defun)
+ (defun . byte-compile-from-buffer)
+ (defun . byte-compile-fix-header)
+ (defun . byte-compile-insert-header)
+ (defun . byte-compile-output-file-form)
+ (defun . byte-compile-output-docform)
+ (defun . byte-compile-keep-pending)
+ (defun . byte-compile-flush-pending)
+ (defun . byte-compile-file-form)
+ (defun . byte-compile-file-form-defsubst)
+ (defun . byte-compile-file-form-autoload)
+ (defun . byte-compile-file-form-defvar)
+ (defun . byte-compile-file-form-define-abbrev-table)
+ (defun . byte-compile-file-form-custom-declare-variable)
+ (defun . byte-compile-file-form-require)
+ (defun . byte-compile-file-form-progn)
+ (defun . byte-compile-file-form-eval)
+ (defun . byte-compile-file-form-defun)
+ (defun . byte-compile-file-form-defmacro)
+ (defun . byte-compile-file-form-defmumble)
+ (defun . byte-compile-output-as-comment)
+ (t . byte-compile)
+ (defun . byte-compile)
+ (defun . byte-compile-sexp)
+ (defun . byte-compile-byte-code-maker)
+ (defun . byte-compile-byte-code-unmake)
+ (defun . byte-compile-check-lambda-list)
+ (defun . byte-compile-lambda)
+ (defun . byte-compile-constants-vector)
+ (defun . byte-compile-top-level)
+ (defun . byte-compile-out-toplevel)
+ (defun . byte-compile-top-level-body)
+ (defun . byte-compile-declare-function)
+ (defun . byte-compile-form)
+ (defun . byte-compile-normal-call)
+ (defun . byte-compile-variable-ref)
+ (defun . byte-compile-get-constant)
+ (defun . byte-compile-constant)
+ (defun . byte-compile-push-constant)
+ (defun . byte-defop-compiler)
+ (defun . byte-defop-compiler19)
+ (defun . byte-defop-compiler-1)
+ (defun . byte-compile-subr-wrong-args)
+ (defun . byte-compile-no-args)
+ (defun . byte-compile-one-arg)
+ (defun . byte-compile-two-args)
+ (defun . byte-compile-three-args)
+ (defun . byte-compile-zero-or-one-arg)
+ (defun . byte-compile-one-or-two-args)
+ (defun . byte-compile-two-or-three-args)
+ (defun . byte-compile-noop)
+ (defun . byte-compile-discard)
+ (defun . byte-compile-associative)
+ (defun . byte-compile-char-before)
+ (defun . byte-compile-backward-char)
+ (defun . byte-compile-backward-word)
+ (defun . byte-compile-list)
+ (defun . byte-compile-concat)
+ (defun . byte-compile-minus)
+ (defun . byte-compile-quo)
+ (defun . byte-compile-nconc)
+ (defun . byte-compile-fset)
+ (defun . byte-compile-funarg)
+ (defun . byte-compile-funarg-2)
+ (defun . byte-compile-function-form)
+ (defun . byte-compile-indent-to)
+ (defun . byte-compile-insert)
+ (defun . byte-compile-setq)
+ (defun . byte-compile-setq-default)
+ (defun . byte-compile-quote)
+ (defun . byte-compile-quote-form)
+ (defun . byte-compile-body)
+ (defun . byte-compile-body-do-effect)
+ (defun . byte-compile-form-do-effect)
+ (defun . byte-compile-progn)
+ (defun . byte-compile-prog1)
+ (defun . byte-compile-prog2)
+ (defun . byte-compile-goto-if)
+ (defun . byte-compile-find-bound-condition)
+ (defun . byte-compile-maybe-guarded)
+ (defun . byte-compile-if)
+ (defun . byte-compile-cond)
+ (defun . byte-compile-and)
+ (defun . byte-compile-and-recursion)
+ (defun . byte-compile-or)
+ (defun . byte-compile-or-recursion)
+ (defun . byte-compile-while)
+ (defun . byte-compile-funcall)
+ (defun . byte-compile-let)
+ (defun . byte-compile-let*)
+ (defun . byte-compile-negated)
+ (defun . byte-compile-negation-optimizer)
+ (defun . byte-compile-catch)
+ (defun . byte-compile-unwind-protect)
+ (defun . byte-compile-track-mouse)
+ (defun . byte-compile-condition-case)
+ (defun . byte-compile-save-excursion)
+ (defun . byte-compile-save-restriction)
+ (defun . byte-compile-save-current-buffer)
+ (defun . byte-compile-save-window-excursion)
+ (defun . byte-compile-with-output-to-temp-buffer)
+ (defun . byte-compile-defun)
+ (defun . byte-compile-defmacro)
+ (defun . byte-compile-defvar)
+ (defun . byte-compile-autoload)
+ (defun . byte-compile-lambda-form)
+ (defun . byte-compile-file-form-defalias)
+ (defun . byte-compile-defalias-warn)
+ (defun . byte-compile-no-warnings)
+ (defun . byte-compile-make-variable-buffer-local)
+ (defun . byte-compile-form-make-variable-buffer-local)
+ (defun . byte-compile-make-tag)
+ (defun . byte-compile-out-tag)
+ (defun . byte-compile-goto)
+ (defun . byte-compile-out)
+ (defun . byte-compile-annotate-call-tree)
+ (t . display-call-tree)
+ (defun . display-call-tree)
+ (t . batch-byte-compile-if-not-done)
+ (defun . batch-byte-compile-if-not-done)
+ (t . batch-byte-compile)
+ (defun . batch-byte-compile)
+ (defun . batch-byte-compile-file)
+ (t . batch-byte-recompile-directory)
+ (defun . batch-byte-recompile-directory)
+ (provide . byte-compile)
+ (provide . bytecomp)
+ (defun . byte-compile-report-ops))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/cl-macs.elc"
+ (require . cl)
+ (defun . cl-pop2)
+ (require . bytecomp)
+ cl-old-bc-file-form cl-simple-funcs cl-simple-funcs cl-safe-funcs cl-safe-funcs
+ (defun . cl-simple-expr-p)
+ (defun . cl-simple-exprs-p)
+ (defun . cl-safe-expr-p)
+ (defun . cl-const-expr-p)
+ (defun . cl-const-exprs-p)
+ (defun . cl-const-expr-val)
+ (defun . cl-expr-access-order)
+ (defun . cl-expr-contains)
+ (defun . cl-expr-contains-any)
+ (defun . cl-expr-depends-p)
+ (defun . gensym)
+ (defun . gentemp)
+ (defun . defun*)
+ (defun . defmacro*)
+ (defun . function*)
+ (defun . cl-transform-function-property)
+ lambda-list-keywords lambda-list-keywords cl-macro-environment
+ (defun . cl-transform-lambda)
+ (defun . cl-do-arglist)
+ (defun . cl-arglist-args)
+ (defun . destructuring-bind)
+ cl-not-toplevel
+ (defun . eval-when)
+ (defun . cl-compile-time-too)
+ (defun . load-time-value)
+ (defun . case)
+ (defun . ecase)
+ (defun . typecase)
+ (defun . etypecase)
+ (defun . block)
+ cl-active-block-names
+ (defun . cl-byte-compile-block)
+ (defun . cl-byte-compile-throw)
+ (defun . return)
+ (defun . return-from)
+ (defun . loop)
+ (defun . cl-parse-loop-clause)
+ (defun . cl-loop-let)
+ (defun . cl-loop-handle-accum)
+ (defun . cl-loop-build-ands)
+ (defun . do)
+ (defun . do*)
+ (defun . cl-expand-do-loop)
+ (defun . dolist)
+ (defun . dotimes)
+ (defun . do-symbols)
+ (defun . do-all-symbols)
+ (defun . psetq)
+ (defun . progv)
+ (defun . flet)
+ (defun . labels)
+ (defun . macrolet)
+ (defun . symbol-macrolet)
+ cl-closure-vars
+ (defun . lexical-let)
+ (defun . lexical-let*)
+ (defun . cl-defun-expander)
+ (defun . multiple-value-bind)
+ (defun . multiple-value-setq)
+ (defun . locally)
+ (defun . the)
+ cl-proclaim-history cl-declare-stack
+ (defun . cl-do-proclaim)
+ (defun . declare)
+ (defun . define-setf-method)
+ (defun . define-setf-expander)
+ (defun . defsetf)
+ (defun . cl-setf-make-apply)
+ (defun . get-setf-method)
+ (defun . cl-setf-do-modify)
+ (defun . cl-setf-do-store)
+ (defun . cl-setf-simple-store-p)
+ (defun . setf)
+ (defun . psetf)
+ (defun . cl-do-pop)
+ (defun . remf)
+ (defun . shiftf)
+ (defun . rotatef)
+ (defun . letf)
+ (defun . letf*)
+ (defun . callf)
+ (defun . callf2)
+ (defun . define-modify-macro)
+ (defun . defstruct)
+ (defun . cl-struct-setf-expander)
+ (defun . deftype)
+ (defun . cl-make-type-test)
+ (defun . typep)
+ (defun . check-type)
+ (defun . assert)
+ (defun . define-compiler-macro)
+ (defun . compiler-macroexpand)
+ (defun . cl-byte-compile-compiler-macro)
+ (defun . defsubst*)
+ (defun . cl-defsubst-expand))
+ ("/usr/share/emacs/23.0.93/lisp/textmodes/sgml-mode.elc" sgml-basic-offset sgml-transformation-function sgml-transformation sgml-mode-hook sgml-specials sgml-quick-keys sgml-mode-map
+ (defun . sgml-make-syntax-table)
+ sgml-mode-syntax-table sgml-tag-syntax-table sgml-name-8bit-mode sgml-char-names sgml-char-names-table sgml-validate-command sgml-saved-validate-command sgml-slash-distance sgml-namespace-re sgml-namespace-re sgml-name-re sgml-name-re sgml-tag-name-re sgml-tag-name-re sgml-attrs-re sgml-attrs-re sgml-start-tag-regex
+ (defface . sgml-namespace)
+ sgml-namespace-face sgml-font-lock-keywords-1 sgml-font-lock-keywords-1 sgml-font-lock-keywords-2 sgml-font-lock-keywords-2 sgml-font-lock-keywords sgml-font-lock-syntactic-keywords sgml-face-tag-alist sgml-tag-face-alist sgml-display-text sgml-tags-invisible sgml-tag-alist sgml-tag-help sgml-xml-mode sgml-empty-tags sgml-unclosed-tags
+ (defun . sgml-xml-guess)
+ (defun . sgml-comment-indent-new-line)
+ (defun . sgml-mode-facemenu-add-face-function)
+ (defun . sgml-fill-nobreak)
+ sgml-mode-map sgml-mode-syntax-table sgml-mode-abbrev-table sgml-mode-abbrev-table
+ (t . sgml-mode)
+ (defun . sgml-mode)
+ (defun . xml-mode)
+ (defun . sgml-comment-indent)
+ (defun . sgml-slash)
+ (defun . sgml-slash-matching)
+ (defun . sgml-name-char)
+ (defun . sgml-namify-char)
+ (defun . sgml-name-self)
+ (defun . sgml-maybe-name-self)
+ (defun . sgml-name-8bit-mode)
+ sgml-tag-last sgml-tag-history
+ (defun . sgml-tag)
+ (autoload . skeleton-read)
+ (defun . sgml-attributes)
+ (defun . sgml-auto-attributes)
+ (defun . sgml-tag-help)
+ (defun . sgml-maybe-end-tag)
+ (defun . sgml-skip-tag-backward)
+ sgml-electric-tag-pair-overlays sgml-electric-tag-pair-timer
+ (defun . sgml-electric-tag-pair-before-change-function)
+ (defun . sgml-electric-tag-pair-flush-overlays)
+ sgml-electric-tag-pair-mode
+ (defun . sgml-electric-tag-pair-mode)
+ (defun . sgml-skip-tag-forward)
+ (defun . sgml-delete-tag)
+ (defun . sgml-tags-invisible)
+ (defun . sgml-point-entered)
+ (defun . sgml-validate)
+ (defun . sgml-at-indentation-p)
+ (defun . sgml-lexical-context)
+ (defun . sgml-beginning-of-tag)
+ (defun . sgml-value)
+ (defun . sgml-quote)
+ (defun . sgml-pretty-print)
+ (defun . sgml-tag-type)
+ (defun . sgml-tag-start)
+ (defun . sgml-tag-end)
+ (defun . sgml-tag-name)
+ (defun . sgml-tag-p)
+ (defun . copy-sgml-tag)
+ (defun . make-sgml-tag)
+ (defun . sgml-make-tag)
+ (defun . sgml-parse-tag-name)
+ (defun . sgml-looking-back-at)
+ (defun . sgml-tag-text-p)
+ (defun . sgml-parse-tag-backward)
+ (defun . sgml-get-context)
+ (defun . sgml-show-context)
+ (defun . sgml-close-tag)
+ (defun . sgml-empty-tag-p)
+ (defun . sgml-unclosed-tag-p)
+ (defun . sgml-calculate-indent)
+ (defun . sgml-indent-line)
+ (defun . sgml-guess-indent)
+ (defun . sgml-parse-dtd)
+ html-mode-hook html-quick-keys html-mode-map html-face-tag-alist html-tag-face-alist html-display-text html-tag-alist html-tag-help html-mode-map html-mode-syntax-table html-mode-abbrev-table html-mode-abbrev-table
+ (t . html-mode)
+ (defun . html-mode)
+ html-imenu-regexp
+ (defun . html-imenu-index)
+ html-autoview-mode
+ (defun . html-autoview-mode)
+ (defun . html-href-anchor)
+ (defun . html-name-anchor)
+ (defun . html-headline-1)
+ (defun . html-headline-2)
+ (defun . html-headline-3)
+ (defun . html-headline-4)
+ (defun . html-headline-5)
+ (defun . html-headline-6)
+ (defun . html-horizontal-rule)
+ (defun . html-image)
+ (defun . html-line)
+ (defun . html-ordered-list)
+ (defun . html-unordered-list)
+ (defun . html-list-item)
+ (defun . html-paragraph)
+ (defun . html-checkboxes)
+ (defun . html-radio-buttons)
+ (provide . sgml-mode))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/rng-valid.elc"
+ (require . xmltok)
+ (require . nxml-enc)
+ (require . nxml-util)
+ (require . nxml-ns)
+ (require . rng-match)
+ (require . rng-util)
+ (require . rng-loc)
+ (defface . rng-error)
+ rng-state-cache-distance rng-validate-chunk-size rng-validate-delay rng-validate-quick-delay rng-validate-timer rng-validate-quick-timer rng-error-count rng-message-overlay rng-message-overlay-inhibit-point rng-message-overlay-current rng-open-elements rng-pending-contents rng-collecting-text rng-validate-up-to-date-end rng-conditional-up-to-date-start rng-conditional-up-to-date-end rng-parsing-for-state rng-validate-mode rng-dtd
+ (t . rng-validate-mode)
+ (defun . rng-validate-mode)
+ (defun . rng-set-schema-file-and-validate)
+ (defun . rng-set-document-type-and-validate)
+ (defun . rng-auto-set-schema-and-validate)
+ (defun . rng-after-change-function)
+ (defun . rng-compute-mode-line-string)
+ (defun . rng-cancel-timers)
+ (defun . rng-kill-timers)
+ (defun . rng-activate-timers)
+ (defun . rng-validate-clear)
+ rng-validate-display-point rng-validate-display-modified-p
+ (defun . rng-validate-while-idle-continue-p)
+ (defun . rng-validate-while-idle)
+ (defun . rng-validate-quick-while-idle)
+ (defun . rng-validate-done)
+ (defun . rng-do-some-validation)
+ (defun . rng-validate-prepare)
+ (defun . rng-do-some-validation-1)
+ (defun . rng-clear-conditional-region)
+ (defun . rng-clear-cached-state)
+ (defun . rng-cache-state)
+ (defun . rng-state-matches-current)
+ (defun . rng-get-state)
+ (defun . rng-restore-state)
+ (defun . rng-set-initial-state)
+ (defun . rng-clear-overlays)
+ (defun . rng-mark-xmltok-dependent-regions)
+ (defun . rng-mark-xmltok-dependent-region)
+ (defun . rng-dependent-region-changed)
+ (defun . rng-mark-xmltok-errors)
+ (defun . rng-mark-invalid)
+ (defun . rng-mark-not-well-formed)
+ (defun . rng-mark-error)
+ (defun . rng-error-modified)
+ (defun . rng-echo-area-clear-function)
+ (defun . rng-maybe-echo-error-at-point)
+ (defun . rng-error-overlay-after)
+ (defun . rng-first-error)
+ (defun . rng-mouse-first-error)
+ (defun . rng-next-error)
+ (defun . rng-previous-error)
+ (defun . rng-next-error-1)
+ (defun . rng-previous-error-1)
+ (defun . rng-goto-error-overlay)
+ (defun . rng-error-overlay-message)
+ (defun . rng-current-message-from-error-overlay-p)
+ (defun . rng-find-next-error-overlay)
+ (defun . rng-find-previous-error-overlay)
+ (defun . rng-forward)
+ (defun . rng-process-start-tag)
+ (defun . rng-process-namespaces)
+ (defun . rng-process-tag-name)
+ (defun . rng-process-attributes)
+ (defun . rng-process-start-tag-close)
+ (defun . rng-mark-start-tag-close)
+ (defun . rng-recover-bad-element-prefix)
+ (defun . rng-recover-bad-attribute-prefix)
+ (defun . rng-recover-duplicate-attribute-name)
+ (defun . rng-recover-start-tag-open)
+ (defun . rng-recover-attribute-value)
+ (defun . rng-recover-attribute-name)
+ (defun . rng-missing-attributes-message)
+ (defun . rng-process-end-tag)
+ (defun . rng-end-element)
+ (defun . rng-missing-element-message)
+ (defun . rng-recover-mismatched-end-tag)
+ (defun . rng-mark-missing-end-tags)
+ (defun . rng-mark-mismatched-end-tag)
+ (defun . rng-push-tag)
+ (defun . rng-pop-tag)
+ (defun . rng-contents-string)
+ (defun . rng-segment-string)
+ (defun . rng-segment-blank-p)
+ (defun . rng-contents-region)
+ (defun . rng-process-text)
+ (defun . rng-process-unknown-char)
+ (defun . rng-process-unknown-entity)
+ (defun . rng-region-blank-p)
+ (defun . rng-flush-text)
+ (defun . rng-process-end-document)
+ (defun . rng-process-encoding-name)
+ (defun . rng-name-to-string)
+ (provide . rng-valid))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/rng-loc.elc"
+ (require . nxml-util)
+ (require . nxml-parse)
+ (require . rng-parse)
+ (require . rng-uri)
+ (require . rng-util)
+ (require . xmltok)
+ rng-current-schema-file-name rng-schema-locating-files-default rng-schema-locating-file-schema-file rng-schema-locating-file-schema rng-schema-locating-files rng-schema-loader-alist rng-cached-document-element rng-document-type-history
+ (defun . rng-set-document-type)
+ (defun . rng-read-type-id)
+ (defun . rng-set-schema-file)
+ (defun . rng-set-vacuous-schema)
+ (defun . rng-set-schema-file-1)
+ (defun . rng-load-schema)
+ (defun . rng-what-schema)
+ (defun . rng-auto-set-schema)
+ (defun . rng-locate-schema-file)
+ (defun . rng-possible-type-ids)
+ (defun . rng-locate-schema-file-using)
+ (defun . rng-match-document-element-rule)
+ (defun . rng-match-namespace-rule)
+ (defun . rng-document-element)
+ (defun . rng-get-start-tag-namespace)
+ (defun . rng-match-transform-uri-rule)
+ (defun . rng-match-uri-rule)
+ (defun . rng-file-name-matches-uri-pattern-p)
+ (defun . rng-match-default-rule)
+ (defun . rng-possible-type-ids-using)
+ (defun . rng-locate-schema-file-from-type-id)
+ rng-schema-locating-file-alist
+ (defun . rng-get-parsed-schema-locating-file)
+ rng-locate-namespace-uri rng-locate-namespace-uri
+ (defun . rng-parse-schema-locating-file)
+ (defun . rng-save-schema-location)
+ (defun . rng-save-schema-location-1)
+ (provide . rng-loc))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/rng-uri.elc"
+ (defun . rng-file-name-uri)
+ (defun . rng-uri-escape-multibyte)
+ (defun . rng-percent-encode)
+ (defun . rng-uri-file-name)
+ (defun . rng-uri-pattern-file-name-regexp)
+ (defun . rng-uri-pattern-file-name-replace-match)
+ (defun . rng-uri-file-name-1)
+ (defun . rng-uri-error)
+ (defun . rng-uri-split)
+ (defun . rng-uri-join)
+ (defun . rng-uri-resolve)
+ (defun . rng-resolve-path)
+ (defun . rng-relative-uri)
+ (defun . rng-relative-path)
+ (defun . rng-split-path)
+ (defun . rng-join-path)
+ (defun . rng-uri-unescape-multibyte)
+ (defun . rng-multibyte-percent-decode)
+ (defun . rng-uri-unescape-unibyte)
+ (defun . rng-uri-unescape-unibyte-match)
+ (defun . rng-uri-unescape-unibyte-replace)
+ (provide . rng-uri))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/rng-parse.elc"
+ (require . nxml-parse)
+ (require . rng-match)
+ (require . rng-dt)
+ rng-parse-prev-was-start-tag
+ (defun . rng-parse-validate-file)
+ (defun . rng-parse-do-validate)
+ (defun . rng-parse-to-match-name)
+ (provide . rng-parse))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/nxml-parse.elc"
+ (require . nxml-util)
+ (require . xmltok)
+ (require . nxml-enc)
+ (require . nxml-ns)
+ nxml-parse-file-name nxml-validate-function
+ (defun . nxml-parse-file)
+ (defun . nxml-parse-find-file)
+ (defun . nxml-parse-instance)
+ (defun . nxml-parse-instance-1)
+ (defun . nxml-parse-start-tag)
+ (defun . nxml-validate-tag)
+ (defun . nxml-validate-error-position)
+ (defun . nxml-make-name)
+ (defun . nxml-current-text-string)
+ (defun . nxml-parse-error)
+ (defun . nxml-check-xmltok-errors)
+ (provide . nxml-parse))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/rng-match.elc"
+ (require . rng-pttrn)
+ (require . rng-util)
+ (require . rng-dt)
+ rng-not-allowed-ipattern rng-empty-ipattern rng-text-ipattern rng-compile-table rng-being-compiled rng-ipattern-table rng-last-ipattern-index rng-match-state
+ (defun . rng-update-match-state)
+ (defun . rng-ipattern-defslot)
+ (defun . rng-ipattern-get-type)
+ (defun . rng-ipattern-set-type)
+ (defun . rng-ipattern-get-index)
+ (defun . rng-ipattern-set-index)
+ (defun . rng-ipattern-get-name-class)
+ (defun . rng-ipattern-set-name-class)
+ (defun . rng-ipattern-get-datatype)
+ (defun . rng-ipattern-set-datatype)
+ (defun . rng-ipattern-get-after)
+ (defun . rng-ipattern-set-after)
+ (defun . rng-ipattern-get-child)
+ (defun . rng-ipattern-set-child)
+ (defun . rng-ipattern-get-value-object)
+ (defun . rng-ipattern-set-value-object)
+ (defun . rng-ipattern-get-nullable)
+ (defun . rng-ipattern-set-nullable)
+ (defun . rng-ipattern-get-memo-text-typed)
+ (defun . rng-ipattern-set-memo-text-typed)
+ (defun . rng-ipattern-get-memo-map-start-tag-open-deriv)
+ (defun . rng-ipattern-set-memo-map-start-tag-open-deriv)
+ (defun . rng-ipattern-get-memo-map-start-attribute-deriv)
+ (defun . rng-ipattern-set-memo-map-start-attribute-deriv)
+ (defun . rng-ipattern-get-memo-start-tag-close-deriv)
+ (defun . rng-ipattern-set-memo-start-tag-close-deriv)
+ (defun . rng-ipattern-get-memo-text-only-deriv)
+ (defun . rng-ipattern-set-memo-text-only-deriv)
+ (defun . rng-ipattern-get-memo-mixed-text-deriv)
+ (defun . rng-ipattern-set-memo-mixed-text-deriv)
+ (defun . rng-ipattern-get-memo-map-data-deriv)
+ (defun . rng-ipattern-set-memo-map-data-deriv)
+ (defun . rng-ipattern-get-memo-end-tag-deriv)
+ (defun . rng-ipattern-set-memo-end-tag-deriv)
+ rng-memo-map-alist-max rng-memo-map-alist-max
+ (defun . rng-memo-map-get)
+ (defun . rng-memo-map-add)
+ (defun . rng-make-ipattern)
+ (defun . rng-ipattern-maybe-init)
+ (defun . rng-ipattern-clear)
+ (defun . rng-gen-ipattern-index)
+ (defun . rng-put-ipattern)
+ (defun . rng-get-ipattern)
+ rng-const-ipatterns rng-const-ipatterns
+ (defun . rng-intern-after)
+ (defun . rng-intern-attribute)
+ (defun . rng-intern-data)
+ (defun . rng-intern-data-except)
+ (defun . rng-intern-value)
+ (defun . rng-intern-one-or-more)
+ (defun . rng-intern-one-or-more-shortcut)
+ (defun . rng-intern-list)
+ (defun . rng-intern-group)
+ (defun . rng-intern-group-shortcut)
+ (defun . rng-normalize-group-list)
+ (defun . rng-intern-interleave)
+ (defun . rng-normalize-interleave-list)
+ (defun . rng-intern-choice)
+ (defun . rng-intern-optional)
+ (defun . rng-intern-choice1)
+ (defun . rng-intern-choice-shortcut)
+ (defun . rng-normalize-choice-list)
+ (defun . rng-compare-ipattern)
+ (defun . rng-name-class-contains)
+ (defun . rng-name-class-contains1)
+ (defun . rng-name-class-possible-names)
+ (defun . rng-ipattern-to-string)
+ (defun . rng-name-class-to-string)
+ (defun . rng-compile-maybe-init)
+ (defun . rng-compile-clear)
+ (defun . rng-compile)
+ (defun . rng-compile-not-allowed)
+ (defun . rng-compile-empty)
+ (defun . rng-compile-text)
+ (defun . rng-compile-element)
+ (defun . rng-element-get-child)
+ (defun . rng-compile-attribute)
+ (defun . rng-compile-ref)
+ (defun . rng-compile-one-or-more)
+ (defun . rng-compile-zero-or-more)
+ (defun . rng-compile-optional)
+ (defun . rng-compile-mixed)
+ (defun . rng-compile-list)
+ (defun . rng-compile-choice)
+ (defun . rng-compile-group)
+ (defun . rng-compile-interleave)
+ (defun . rng-compile-dt)
+ (defun . rng-compile-data)
+ (defun . rng-compile-data-except)
+ (defun . rng-compile-value)
+ (defun . rng-compile-name-class)
+ (defun . rng-map-element-attribute)
+ (defun . rng-find-element-content-pattern)
+ (defun . rng-search-name)
+ (defun . rng-find-name-class-uris)
+ (defun . rng-accum-namespace-uri)
+ (defun . rng-ipattern-text-typed-p)
+ (defun . rng-ipattern-compute-text-typed-p)
+ (defun . rng-start-tag-open-deriv)
+ (defun . rng-ipattern-memo-start-tag-open-deriv)
+ (defun . rng-compute-start-tag-open-deriv)
+ (defun . rng-start-attribute-deriv)
+ (defun . rng-ipattern-memo-start-attribute-deriv)
+ (defun . rng-compute-start-attribute-deriv)
+ (defun . rng-cons-group-after)
+ (defun . rng-subst-group-after)
+ (defun . rng-subst-interleave-after)
+ (defun . rng-apply-after)
+ (defun . rng-start-tag-close-deriv)
+ rng-transform-map rng-transform-map
+ (defun . rng-compute-start-tag-close-deriv)
+ (defun . rng-ignore-attributes-deriv)
+ (defun . rng-text-only-deriv)
+ (defun . rng-compute-text-only-deriv)
+ (defun . rng-mixed-text-deriv)
+ (defun . rng-compute-mixed-text-deriv)
+ (defun . rng-end-tag-deriv)
+ (defun . rng-compute-end-tag-deriv)
+ (defun . rng-data-deriv)
+ (defun . rng-namespace-context-tracer)
+ (defun . rng-namespace-context-get-no-trace)
+ rng-memo-data-deriv-max-length
+ (defun . rng-ipattern-memo-data-deriv)
+ (defun . rng-compute-data-deriv)
+ (defun . rng-transform-multi)
+ (defun . rng-transform-choice)
+ (defun . rng-transform-group)
+ (defun . rng-transform-interleave)
+ (defun . rng-transform-one-or-more)
+ (defun . rng-transform-after-child)
+ (defun . rng-transform-interleave-single)
+ (defun . rng-transform-group-nullable)
+ (defun . rng-transform-group-nullable-gen-choices)
+ (defun . rng-members-eq)
+ (defun . rng-ipattern-after)
+ (defun . rng-unknown-start-tag-open-deriv)
+ (defun . rng-ipattern-optionalize-elements)
+ (defun . rng-ipattern-empty-before-p)
+ (defun . rng-ipattern-possible-start-tags)
+ (defun . rng-ipattern-start-tag-possible-p)
+ (defun . rng-ipattern-possible-attributes)
+ (defun . rng-ipattern-possible-values)
+ (defun . rng-ipattern-required-element)
+ (defun . rng-ipattern-required-attributes)
+ (defun . rng-compile-error)
+ (defun . rng-match-state)
+ (defun . rng-set-match-state)
+ (defun . rng-match-state-equal)
+ (defun . rng-schema-changed)
+ (defun . rng-match-init-buffer)
+ (defun . rng-match-start-document)
+ (defun . rng-match-start-tag-open)
+ (defun . rng-match-attribute-name)
+ (defun . rng-match-attribute-value)
+ (defun . rng-match-element-value)
+ (defun . rng-match-start-tag-close)
+ (defun . rng-match-mixed-text)
+ (defun . rng-match-end-tag)
+ (defun . rng-match-after)
+ (defun . rng-match-out-of-context-start-tag-open)
+ (defun . rng-match-possible-namespace-uris)
+ (defun . rng-match-unknown-start-tag-open)
+ (defun . rng-match-optionalize-elements)
+ (defun . rng-match-ignore-attributes)
+ (defun . rng-match-text-typed-p)
+ (defun . rng-match-empty-content)
+ (defun . rng-match-empty-before-p)
+ (defun . rng-match-infer-start-tag-namespace)
+ (defun . rng-match-nullable-p)
+ (defun . rng-match-possible-start-tag-names)
+ (defun . rng-match-start-tag-possible-p)
+ (defun . rng-match-possible-attribute-names)
+ (defun . rng-match-possible-value-strings)
+ (defun . rng-match-required-element-name)
+ (defun . rng-match-required-attribute-names)
+ (defun . rng-match-save)
+ (defun . rng-match-with-schema)
+ (provide . rng-match))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/rng-dt.elc"
+ (require . rng-util)
+ rng-dt-error-reporter
+ (defun . rng-dt-error)
+ rng-dt-namespace-context-getter
+ (defun . rng-dt-make-value)
+ (defun . rng-dt-builtin-compile)
+ (provide . rng-dt))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/rng-util.elc"
+ (defun . rng-make-datatypes-uri)
+ rng-xsd-datatypes-uri rng-xsd-datatypes-uri rng-builtin-datatypes-uri rng-builtin-datatypes-uri
+ (defun . rng-uniquify-eq)
+ (defun . rng-uniquify-equal)
+ (defun . rng-blank-p)
+ (defun . rng-substq)
+ (defun . rng-complete-before-point)
+ (defun . rng-completion-exact-p)
+ (defun . rng-quote-string)
+ (defun . rng-escape-string)
+ (defun . rng-collapse-space)
+ (provide . rng-util))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/rng-pttrn.elc" rng-schema-change-hook rng-current-schema
+ (defun . rng-make-ref)
+ (defun . rng-ref-set)
+ (defun . rng-ref-get)
+ (defun . rng-make-choice)
+ (defun . rng-make-group)
+ (defun . rng-make-interleave)
+ (defun . rng-make-zero-or-more)
+ (defun . rng-make-one-or-more)
+ (defun . rng-make-optional)
+ (defun . rng-make-mixed)
+ (defun . rng-make-value)
+ (defun . rng-make-data)
+ (defun . rng-make-data-except)
+ (defun . rng-make-list)
+ (defun . rng-make-element)
+ (defun . rng-make-attribute)
+ (defun . rng-make-text)
+ (defun . rng-make-empty)
+ (defun . rng-make-not-allowed)
+ (defun . rng-make-any-name-name-class)
+ (defun . rng-make-any-name-except-name-class)
+ (defun . rng-make-ns-name-name-class)
+ (defun . rng-make-ns-name-except-name-class)
+ (defun . rng-make-name-name-class)
+ (defun . rng-make-choice-name-class)
+ rng-any-content rng-any-element
+ (defun . rng-make-name)
+ (defun . rng-make-datatype)
+ (provide . rng-pttrn))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/nxml-ns.elc"
+ (require . nxml-util)
+ nxml-ns-state nxml-ns-initial-state
+ (defun . nxml-ns-state)
+ (defun . nxml-ns-set-state)
+ (defun . nxml-ns-state-equal)
+ (defun . nxml-ns-save)
+ (defun . nxml-ns-init)
+ (defun . nxml-ns-push-state)
+ (defun . nxml-ns-pop-state)
+ (defun . nxml-ns-get-prefix)
+ (defun . nxml-ns-set-prefix)
+ (defun . nxml-ns-get-default)
+ (defun . nxml-ns-set-default)
+ (defun . nxml-ns-get-context)
+ (defun . nxml-ns-prefixes-for)
+ (defun . nxml-ns-prefix-for)
+ (defun . nxml-ns-changed-prefixes)
+ (provide . nxml-ns))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/nxml-mode.elc"
+ (require . xmltok)
+ (require . nxml-enc)
+ (require . nxml-glyph)
+ (require . nxml-util)
+ (require . nxml-rap)
+ (require . nxml-outln)
+ nxml-char-ref-display-glyph-flag nxml-mode-hook nxml-sexp-element-flag nxml-slash-auto-complete-flag nxml-child-indent nxml-attribute-indent nxml-bind-meta-tab-to-complete-flag nxml-prefer-utf-16-to-utf-8-flag nxml-prefer-utf-16-little-to-big-endian-flag nxml-default-buffer-file-coding-system nxml-auto-insert-xml-declaration-flag
+ (defface . nxml-delimited-data)
+ (defface . nxml-name)
+ (defface . nxml-ref)
+ (defface . nxml-delimiter)
+ (defface . nxml-text)
+ (defface . nxml-comment-content)
+ (defface . nxml-comment-delimiter)
+ (defface . nxml-processing-instruction-delimiter)
+ (defface . nxml-processing-instruction-target)
+ (defface . nxml-processing-instruction-content)
+ (defface . nxml-cdata-section-delimiter)
+ (defface . nxml-cdata-section-CDATA)
+ (defface . nxml-cdata-section-content)
+ (defface . nxml-char-ref-number)
+ (defface . nxml-char-ref-delimiter)
+ (defface . nxml-entity-ref-name)
+ (defface . nxml-entity-ref-delimiter)
+ (defface . nxml-tag-delimiter)
+ (defface . nxml-tag-slash)
+ (defface . nxml-element-prefix)
+ (defface . nxml-element-colon)
+ (defface . nxml-element-local-name)
+ (defface . nxml-attribute-prefix)
+ (defface . nxml-attribute-colon)
+ (defface . nxml-attribute-local-name)
+ (defface . nxml-namespace-attribute-xmlns)
+ (defface . nxml-namespace-attribute-colon)
+ (defface . nxml-namespace-attribute-prefix)
+ (defface . nxml-attribute-value)
+ (defface . nxml-attribute-value-delimiter)
+ (defface . nxml-namespace-attribute-value)
+ (defface . nxml-namespace-attribute-value-delimiter)
+ (defface . nxml-prolog-literal-delimiter)
+ (defface . nxml-prolog-literal-content)
+ (defface . nxml-prolog-keyword)
+ (defface . nxml-markup-declaration-delimiter)
+ (defface . nxml-hash)
+ (defface . nxml-glyph)
+ nxml-prolog-regions nxml-last-fontify-end nxml-degraded nxml-completion-hook nxml-in-mixed-content-hook nxml-mixed-scan-distance nxml-end-tag-indent-scan-distance nxml-char-ref-extra-display nxml-mode-map nxml-font-lock-keywords
+ (defun . nxml-set-face)
+ (t . nxml-mode)
+ (defun . nxml-mode)
+ (defun . nxml-cleanup)
+ (defun . nxml-degrade)
+ (defun . nxml-debug-region)
+ (defun . nxml-after-change)
+ (defun . nxml-after-change1)
+ (defun . nxml-insert-xml-declaration)
+ (defun . nxml-prepare-to-save)
+ (defun . nxml-select-coding-system)
+ (defun . nxml-unsuitable-coding-system-message)
+ nxml-utf-16-coding-systems nxml-utf-16-coding-systems nxml-utf-coding-systems nxml-utf-coding-systems
+ (defun . nxml-coding-system-unicode-p)
+ (defun . nxml-coding-system-name)
+ (defun . nxml-fix-encoding-declaration)
+ (defun . nxml-choose-suitable-coding-system)
+ (defun . nxml-choose-utf-coding-system)
+ (defun . nxml-choose-utf-16-coding-system)
+ (defun . nxml-coding-system-member)
+ (defun . nxml-unfontify-region)
+ (defun . nxml-extend-region)
+ (defun . nxml-extend-after-change-region)
+ (defun . nxml-extend-after-change-region1)
+ (defun . nxml-fontify-matcher)
+ (defun . nxml-fontify-prolog)
+ (defun . nxml-apply-fontify-rule)
+ (defun . nxml-fontify-attributes)
+ (defun . nxml-fontify-attribute)
+ (defun . nxml-fontify-qname)
+ (defun . nxml-electric-slash)
+ (defun . nxml-balanced-close-start-tag-block)
+ (defun . nxml-balanced-close-start-tag-inline)
+ (defun . nxml-balanced-close-start-tag)
+ (defun . nxml-finish-element)
+ nxml-last-split-position
+ (defun . nxml-split-element)
+ (defun . nxml-finish-element-1)
+ (defun . nxml-indent-line)
+ (defun . nxml-compute-indent)
+ (defun . nxml-compute-indent-from-matching-start-tag)
+ (defun . nxml-compute-indent-from-previous-line)
+ (defun . nxml-merge-indent-context-type)
+ (defun . nxml-compute-indent-in-token)
+ (defun . nxml-compute-indent-in-start-tag)
+ (defun . nxml-attribute-value-boundary)
+ (defun . nxml-compute-indent-in-delimited-token)
+ (defun . nxml-complete)
+ (defun . nxml-forward-balanced-item)
+ (defun . nxml-forward-single-balanced-item)
+ (defun . nxml-backward-single-balanced-item)
+ (defun . nxml-scan-forward-within)
+ (defun . nxml-scan-backward-within)
+ (defun . nxml-scan-forward-in-attribute-value)
+ (defun . nxml-scan-backward-in-attribute-value)
+ (defun . nxml-find-following-attribute)
+ (defun . nxml-find-preceding-attribute)
+ (defun . nxml-up-element)
+ (defun . nxml-backward-up-element)
+ (defun . nxml-down-element)
+ (defun . nxml-backward-down-element)
+ (defun . nxml-forward-element)
+ (defun . nxml-backward-element)
+ (defun . nxml-mark-token-after)
+ (defun . nxml-mark-paragraph)
+ (defun . nxml-forward-paragraph)
+ (defun . nxml-backward-paragraph)
+ (defun . nxml-forward-single-paragraph)
+ (defun . nxml-backward-single-paragraph)
+ (defun . nxml-token-contains-data-p)
+ (defun . nxml-paragraph-end-pos)
+ (defun . nxml-paragraph-start-pos)
+ (defun . nxml-token-ends-line-p)
+ (defun . nxml-token-begins-line-p)
+ (defun . nxml-in-mixed-content-p)
+ (defun . nxml-preceding-sibling-data-p)
+ (defun . nxml-following-sibling-data-p)
+ (defun . nxml-do-fill-paragraph)
+ (defun . nxml-newline-and-indent)
+ nxml-dynamic-markup-prev-pos nxml-dynamic-markup-prev-lengths nxml-dynamic-markup-prev-found-marker nxml-dynamic-markup-prev-start-tags
+ (defun . nxml-dynamic-markup-word)
+ (defun . nxml-try-copy-markup)
+ nxml-char-name-ignore-case nxml-char-name-alist nxml-char-name-table nxml-autoload-char-name-set-list
+ (defun . nxml-enable-char-name-set)
+ (defun . nxml-disable-char-name-set)
+ (defun . nxml-char-name-set-enabled-p)
+ (defun . nxml-autoload-char-name-set)
+ (defun . nxml-define-char-name-set)
+ (defun . nxml-get-char-name)
+ nxml-named-char-history
+ (defun . nxml-insert-named-char)
+ (defun . nxml-maybe-load-char-name-set)
+ (defun . nxml-toggle-char-ref-extra-display)
+ (defun . nxml-char-ref-display-extra)
+ (defun . nxml-clear-char-ref-extra-display)
+ (defun . nxml-start-delimiter-length)
+ (defun . nxml-end-delimiter-length)
+ (defun . nxml-token-type-friendly-name)
+ (provide . nxml-mode))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/nxml-outln.elc"
+ (require . xmltok)
+ (require . nxml-util)
+ (require . nxml-rap)
+ nxml-section-element-name-regexp nxml-heading-element-name-regexp nxml-outline-child-indent
+ (defface . nxml-heading)
+ (defface . nxml-outline-indicator)
+ (defface . nxml-outline-active-indicator)
+ (defface . nxml-outline-ellipsis)
+ nxml-heading-scan-distance nxml-outline-prefix-map
+ (defun . nxml-show-all)
+ (defun . nxml-hide-all-text-content)
+ (defun . nxml-show-direct-text-content)
+ (defun . nxml-show-direct-subheadings)
+ (defun . nxml-hide-direct-text-content)
+ (defun . nxml-hide-subheadings)
+ (defun . nxml-show)
+ (defun . nxml-hide-text-content)
+ (defun . nxml-show-subheadings)
+ (defun . nxml-hide-other)
+ nxml-outline-state-transform-exceptions nxml-target-section-pos nxml-depth-in-target-section nxml-outline-state-transform-alist
+ (defun . nxml-transform-buffer-outline)
+ (defun . nxml-transform-subtree-outline)
+ (defun . nxml-outline-pre-adjust-point)
+ (defun . nxml-outline-adjust-point)
+ (defun . nxml-transform-outline-state)
+ (defun . nxml-section-tag-transform-outline-state)
+ (defun . nxml-get-outline-state)
+ (defun . nxml-set-outline-state)
+ (defun . nxml-mouse-show-direct-text-content)
+ (defun . nxml-mouse-hide-direct-text-content)
+ (defun . nxml-mouse-hide-subheadings)
+ (defun . nxml-mouse-show-direct-subheadings)
+ (defun . nxml-mouse-set-point)
+ (defun . nxml-token-start-tag-p)
+ (defun . nxml-token-end-tag-p)
+ (defun . nxml-refresh-outline)
+ nxml-outline-display-section-tag-function
+ (defun . nxml-outline-display-rest)
+ nxml-highlighted-less-than nxml-highlighted-less-than nxml-highlighted-greater-than nxml-highlighted-greater-than nxml-highlighted-colon nxml-highlighted-colon nxml-highlighted-slash nxml-highlighted-slash nxml-highlighted-ellipsis nxml-highlighted-ellipsis nxml-highlighted-empty-end-tag nxml-highlighted-empty-end-tag nxml-highlighted-inactive-minus nxml-highlighted-inactive-minus nxml-highlighted-active-minus nxml-highlighted-active-minus nxml-highlighted-active-plus nxml-highlighted-active-plus
+ (defun . nxml-display-section)
+ (defun . nxml-highlighted-qname)
+ (defun . nxml-outline-display-single-line-end-tag)
+ (defun . nxml-outline-display-multi-line-end-tag)
+ nxml-outline-show-map nxml-outline-show-help nxml-outline-hiding-tag-map nxml-outline-hiding-tag-help nxml-outline-showing-tag-map nxml-outline-showing-tag-help
+ (defun . nxml-outline-set-overlay)
+ (defun . nxml-end-of-heading)
+ (defun . nxml-token-starts-line-p)
+ nxml-cached-section-tag-regexp nxml-cached-section-element-name-regexp
+ (defun . nxml-make-section-tag-regexp)
+ (defun . nxml-make-section-tag-regexp-1)
+ (defun . nxml-section-tag-forward)
+ (defun . nxml-section-tag-backward)
+ (defun . nxml-section-start-position)
+ (defun . nxml-back-to-section-start)
+ (defun . nxml-after-section-start-tag)
+ (defun . nxml-heading-start-position)
+ (defun . nxml-report-outline-error)
+ (defun . nxml-outline-error)
+ (defun . nxml-debug-overlays)
+ (provide . nxml-outln))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/nxml-rap.elc"
+ (require . xmltok)
+ (require . nxml-util)
+ nxml-prolog-end nxml-scan-end
+ (defun . nxml-get-inside)
+ (defun . nxml-clear-inside)
+ (defun . nxml-set-inside)
+ (defun . nxml-inside-end)
+ (defun . nxml-inside-start)
+ (defun . nxml-scan-after-change)
+ (defun . nxml-scan-prolog)
+ (defun . nxml-adjust-start-for-dependent-regions)
+ (defun . nxml-mark-parse-dependent-regions)
+ (defun . nxml-mark-parse-dependent-region)
+ (defun . nxml-clear-dependent-regions)
+ (defun . nxml-token-after)
+ (defun . nxml-token-before)
+ (defun . nxml-tokenize-forward)
+ (defun . nxml-move-tag-backwards)
+ (defun . nxml-move-outside-backwards)
+ (defun . nxml-ensure-scan-up-to-date)
+ (defun . nxml-scan-element-forward)
+ (defun . nxml-scan-element-backward)
+ (defun . nxml-scan-error)
+ (provide . nxml-rap))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/nxml-util.elc" nxml-debug
+ (defun . nxml-debug)
+ (defun . nxml-debug-change)
+ (defun . nxml-debug-set-inside)
+ (defun . nxml-debug-clear-inside)
+ (defun . nxml-make-namespace)
+ (defun . nxml-namespace-name)
+ nxml-xml-namespace-uri nxml-xml-namespace-uri nxml-xmlns-namespace-uri nxml-xmlns-namespace-uri
+ (defun . nxml-with-degradation-on-error)
+ (defun . nxml-with-unmodifying-text-property-changes)
+ (defun . nxml-with-invisible-motion)
+ (defun . nxml-display-file-parse-error)
+ (defun . nxml-signal-file-parse-error)
+ (provide . nxml-util))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/nxml-glyph.elc" nxml-ascii-glyph-set nxml-ascii-glyph-set nxml-latin1-glyph-set nxml-latin1-glyph-set nxml-misc-fixed-1-glyph-set nxml-misc-fixed-2-glyph-set nxml-misc-fixed-3-glyph-set nxml-wgl4-glyph-set nxml-glyph-set-hook nxml-glyph-set
+ (defun . nxml-x-set-glyph-set)
+ (defun . nxml-w32-set-glyph-set)
+ (defun . nxml-window-system-set-glyph-set)
+ (defun . nxml-terminal-set-glyph-set)
+ (t . nxml-glyph-display-string)
+ (defun . nxml-glyph-display-string)
+ (defun . nxml-glyph-set-contains-p)
+ (provide . nxml-glyph))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/nxml-enc.elc" nxml-file-name-ignore-case nxml-cached-file-name-auto-coding-regexp nxml-cached-auto-mode-alist
+ (defun . nxml-file-name-auto-coding-regexp)
+ nxml-non-xml-set-auto-coding-function
+ (defun . nxml-set-auto-coding)
+ (defun . nxml-set-xml-coding)
+ (defun . nxml-detect-coding-system)
+ (defun . nxml-mime-charset-coding-system)
+ (defun . nxml-start-auto-coding)
+ (defun . nxml-stop-auto-coding)
+ (provide . nxml-enc))
+ ("/usr/share/emacs/23.0.93/lisp/nxml/xmltok.elc" xmltok-type xmltok-start xmltok-name-colon xmltok-name-end xmltok-replacement xmltok-attributes xmltok-namespace-attributes xmltok-dtd xmltok-dependent-regions xmltok-errors
+ (defun . xmltok-save)
+ (defun . xmltok-attribute-name-start)
+ (defun . xmltok-attribute-name-colon)
+ (defun . xmltok-attribute-name-end)
+ (defun . xmltok-attribute-value-start)
+ (defun . xmltok-attribute-value-end)
+ (defun . xmltok-attribute-raw-normalized-value)
+ (defun . xmltok-attribute-refs)
+ (defun . xmltok-attribute-prefix)
+ (defun . xmltok-attribute-local-name)
+ (defun . xmltok-attribute-value)
+ (defun . xmltok-start-tag-prefix)
+ (defun . xmltok-start-tag-local-name)
+ (defun . xmltok-end-tag-prefix)
+ (defun . xmltok-end-tag-local-name)
+ (defun . xmltok-start-tag-qname)
+ (defun . xmltok-end-tag-qname)
+ (defun . xmltok-make-attribute)
+ (defun . xmltok-error-message)
+ (defun . xmltok-error-start)
+ (defun . xmltok-error-end)
+ (defun . xmltok-make-error)
+ (defun . xmltok-add-error)
+ (defun . xmltok-add-dependent)
+ (defun . xmltok-forward)
+ (defun . xmltok-forward-special)
+ xmltok-ncname-regexp xmltok-ncname-regexp
+ (defun . xmltok-scan-after-lt)
+ (defun . xmltok-scan-after-processing-instruction-open)
+ (defun . xmltok-scan-after-comment-open)
+ (defun . xmltok-scan-attributes)
+ (defun . xmltok-add-attribute)
+ (defun . xmltok-normalize-attribute)
+ (defun . xmltok-scan-after-amp)
+ xmltok-entity-error-messages xmltok-entity-error-messages
+ (defun . xmltok-handle-entity)
+ (defun . xmltok-scan-char-ref)
+ (defun . xmltok-char-number)
+ (defun . xmltok-unclosed-reparse-p)
+ (defun . xmltok-semi-closed-reparse-p)
+ (defun . xmltok-valid-char-p)
+ (defun . xmltok-unicode-to-char)
+ xmltok-contains-doctype xmltok-doctype-external-subset-flag xmltok-internal-subset-start xmltok-had-param-entity-ref xmltok-prolog-regions xmltok-standalone xmltok-markup-declaration-doctype-flag xmltok-predefined-entity-alist xmltok-predefined-entity-alist
+ (defun . xmltok-forward-prolog)
+ xmltok-bad-xml-decl-regexp xmltok-bad-xml-decl-regexp
+ (t . xmltok-get-declared-encoding-position)
+ (defun . xmltok-get-declared-encoding-position)
+ (defun . xmltok-scan-xml-declaration)
+ xmltok-markup-declaration-alist xmltok-markup-declaration-alist
+ (defun . xmltok-parse-prolog-item)
+ (defun . xmltok-parse-doctype)
+ (defun . xmltok-parse-attlist-declaration)
+ (defun . xmltok-parse-nmtoken-group)
+ (defun . xmltok-parse-element-declaration)
+ (defun . xmltok-parse-model-group)
+ (defun . xmltok-parse-model-group-member)
+ (defun . xmltok-parse-entity-declaration)
+ (defun . xmltok-define-entity)
+ (defun . xmltok-parse-entity-value)
+ (defun . xmltok-parse-notation-declaration)
+ (defun . xmltok-parse-external-id)
+ (defun . xmltok-require-next-token)
+ (defun . xmltok-require-token)
+ (defun . xmltok-current-token-string)
+ (defun . xmltok-markup-declaration-parse-error)
+ (defun . xmltok-skip-markup-declaration)
+ (defun . xmltok-prolog-region-type)
+ (defun . xmltok-next-prolog-token)
+ (defun . xmltok-scan-prolog-literal)
+ (defun . xmltok-scan-prolog-after-processing-instruction-open)
+ (defun . xmltok-parse-entities)
+ (defun . xmltok-parse-entity)
+ (defun . xmltok-parse-entity-replacement)
+ (defun . xmltok-handle-nested-entity)
+ (defun . xmltok-append-entity-def)
+ (defun . xmltok-add-prolog-region)
+ (defun . xmltok-merge-attributes)
+ (defun . xmltok-forward-test)
+ (defun . xmltok-next-prolog-token-test)
+ (provide . xmltok))
+ ("/home/hobbes/nxhtml/util/mlinks.el" mlinks:version
+ (require . cl)
+ (require . ourcomments-util)
+ (require . url-parse)
+ (require . url-expand)
+ (require . appmenu)
+ mlinks-mode-functions mlinks-mode-map
+ (defun . mlinks-want-marked-links)
+ (defun . mlinks-after-change-major-mode)
+ mlinks-hilight-this-buffer mlinks-hilight-point-ovl mlinks-hilighter-timer
+ (defun . mlinks-toggle-hilight)
+ (defun . mlinks-stop-hilighter)
+ (defun . mlinks-start-hilighter)
+ (defun . mlinks-make-point-ovl)
+ (defun . mlinks-link-at-point)
+ (defun . mlinks-hilighter)
+ mlinks-active-hilight-keymap mlinks-inactive-hilight-keymap
+ (defun . mlinks-pre-command)
+ (defun . mlinks-activate-hilight)
+ (defun . mlinks-deactivate-hilight)
+ (defun . mlinks-someactivate-hilight)
+ (defun . mlinks-backward-link)
+ (defun . mlinks-forward-link)
+ (defun . mlinks-goto)
+ (defun . mlinks-goto-other-window)
+ (defun . mlinks-goto-other-frame)
+ (defun . mlinks-goto-1)
+ (defun . mlinks-get-boolean)
+ (defun . mlinks-get-action)
+ (defun . mlinks-prev-saved-position)
+ (defun . mlinks-next-saved-position)
+ (defun . mlinks-goto-n)
+ mlinks-places-n mlinks-places mlinks-temp-buffer-where
+ (defun . mlinks-switch-to-buffer)
+ (defun . mlinks-switch-to-buffer-1)
+ (defun . mlinks-custom)
+ (defun . mlinks-appmenu)
+ (defun . mlinks-add-appmenu)
+ (defun . mlinks-remove-overlays)
+ mlinks-mode
+ (t . mlinks-mode)
+ (defun . mlinks-mode)
+ (defun . mlinks-turn-on-in-buffer)
+ mlinks-mode-major-mode mlinks-global-mode
+ (defun . mlinks-global-mode)
+ mlinks-global-mode-buffers
+ (defun . mlinks-global-mode-enable-in-buffers)
+ (defun . mlinks-global-mode-check-buffers)
+ (defun . mlinks-global-mode-cmhh)
+ mlinks-active-links
+ (defun . mlinks-active-links-toggle)
+ (defface . mlinks-link)
+ mlinks-link
+ (defun . mlinks-mark-link)
+ mlinks-mark-links-timer
+ (defun . mlinks-mark-next-link)
+ mlinks-link-update-pos-min mlinks-link-update-pos-max
+ (defun . mlinks-stop-marking-links)
+ (defun . mlinks-start-marking-links)
+ mlinks-after-change-extra
+ (defun . mlinks-after-change)
+ (defun . mlinks-html-style-goto)
+ (defun . mlinks-html-style-hili)
+ (require . rx)
+ mlinks-html-link-regex
+ (defun . mlinks-html-forward-link)
+ (defun . mlinks-html-backward-link)
+ (defun . mlinks-html-style-mode-fun)
+ (defun . mlink-check-file-to-edit)
+ (defun . mlinks-html-edit-at)
+ (defun . mlinks-html-mail-to)
+ (defun . mlinks-html-href-act-on)
+ (defun . mlinks-html-possible-href-actions)
+ (defun . mlinks-html-find-base-href)
+ (defun . mlinks-elisp-custom-goto)
+ (defun . mlinks-custom-next-mark)
+ (defun . mlinks-elisp-goto)
+ (defun . mlinks-elisp-hili)
+ (defun . mlinks-elisp-mode-fun)
+ (defun . mlinks-elisp-function)
+ (defun . mlinks-elisp-mode-symbol)
+ (defun . mlinks-elisp-mode-require)
+ (defun . mlinks-hit-test)
+ (defun . mlinks-handle-reg-fun-list)
+ (provide . mlinks))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/rx.elc" rx-constituents rx-syntax rx-categories rx-greedy-flag
+ (defun . rx-info)
+ (defun . rx-check)
+ (defun . rx-group-if)
+ (defun . rx-and)
+ (defun . rx-or)
+ (defun . rx-anything)
+ (defun . rx-any-delete-from-range)
+ (defun . rx-any-condense-range)
+ (defun . rx-check-any-string)
+ (defun . rx-check-any)
+ (defun . rx-any)
+ (defun . rx-check-not)
+ (defun . rx-not)
+ (defun . rx-not-char)
+ (defun . rx-not-syntax)
+ (defun . rx-trans-forms)
+ (defun . rx-=)
+ (defun . rx->=)
+ (defun . rx-**)
+ (defun . rx-repeat)
+ (defun . rx-submatch)
+ (defun . rx-backref)
+ (defun . rx-check-backref)
+ (defun . rx-kleene)
+ (defun . rx-atomic-p)
+ (defun . rx-syntax)
+ (defun . rx-check-category)
+ (defun . rx-category)
+ (defun . rx-eval)
+ (defun . rx-greedy)
+ (defun . rx-regexp)
+ (defun . rx-form)
+ (t . rx-to-string)
+ (defun . rx-to-string)
+ (t . rx)
+ (defun . rx)
+ (provide . rx))
+ ("/home/hobbes/nxhtml/util/appmenu.el" appmenu:version
+ (require . cl)
+ appmenu-show-help appmenu-show-point-menu appmenu-alist
+ (defun . appmenu-sort-by-priority)
+ (t . appmenu-add)
+ (defun . appmenu-add)
+ (defun . appmenu-remove)
+ (defun . appmenu-help)
+ (defun . appmenu-keymap-len)
+ appmenu-mouse-only
+ (defun . appmenu-make-menu-for-point)
+ (defun . appmenu-map)
+ (defun . appmenu-popup)
+ appmenu-mode-map appmenu-mode
+ (defun . appmenu-mode)
+ (provide . appmenu))
+ ("/usr/share/emacs/23.0.93/lisp/textmodes/flyspell.elc"
+ (require . ispell)
+ flyspell-highlight-flag flyspell-mark-duplications-flag flyspell-mark-duplications-exceptions flyspell-sort-corrections flyspell-duplicate-distance flyspell-delay flyspell-persistent-highlight flyspell-highlight-properties flyspell-default-delayed-commands flyspell-delayed-commands flyspell-default-deplacement-commands flyspell-deplacement-commands flyspell-issue-welcome-flag flyspell-issue-message-flag flyspell-incorrect-hook flyspell-default-dictionary flyspell-tex-command-regexp flyspell-check-tex-math-command flyspell-dictionaries-that-consider-dash-as-word-delimiter flyspell-abbrev-p flyspell-use-global-abbrev-table-p flyspell-mode-line-string flyspell-large-region flyspell-insert-function flyspell-before-incorrect-word-string flyspell-after-incorrect-word-string flyspell-use-meta-tab flyspell-auto-correct-binding flyspell-generic-check-word-predicate flyspell-generic-check-word-p
+ (defun . mail-mode-flyspell-verify)
+ (defun . texinfo-mode-flyspell-verify)
+ (defun . tex-mode-flyspell-verify)
+ (defun . sgml-mode-flyspell-verify)
+ flyspell-prog-text-faces
+ (defun . flyspell-generic-progmode-verify)
+ (t . flyspell-prog-mode)
+ (defun . flyspell-prog-mode)
+ flyspell-mouse-map flyspell-mode-map flyspell-consider-dash-as-word-delimiter-flag flyspell-dash-dictionary flyspell-dash-local-dictionary
+ (defface . flyspell-incorrect)
+ (defface . flyspell-duplicate)
+ flyspell-overlay flyspell-mode
+ (t . flyspell-mode)
+ (defun . flyspell-mode)
+ (t . turn-on-flyspell)
+ (defun . turn-on-flyspell)
+ (t . turn-off-flyspell)
+ (defun . turn-off-flyspell)
+ flyspell-buffers
+ (defun . flyspell-minibuffer-p)
+ flyspell-last-buffer
+ (defun . flyspell-accept-buffer-local-defs)
+ (defun . flyspell-hack-local-variables-hook)
+ (defun . flyspell-kill-ispell-hook)
+ (defun . flyspell-mode-on)
+ (defun . flyspell-delay-commands)
+ (defun . flyspell-delay-command)
+ (defun . flyspell-deplacement-commands)
+ (defun . flyspell-deplacement-command)
+ flyspell-word-cache-start flyspell-word-cache-end flyspell-word-cache-word flyspell-word-cache-result flyspell-pre-buffer flyspell-pre-point flyspell-pre-column flyspell-pre-pre-buffer flyspell-pre-pre-point flyspell-previous-command
+ (defun . flyspell-pre-command-hook)
+ (t . flyspell-mode-off)
+ (defun . flyspell-mode-off)
+ (defun . flyspell-check-pre-word-p)
+ flyspell-changes
+ (defun . flyspell-after-change-function)
+ (defun . flyspell-check-changed-word-p)
+ (defun . flyspell-check-word-p)
+ (defun . flyspell-debug-signal-no-check)
+ (defun . flyspell-debug-signal-pre-word-checked)
+ (defun . flyspell-debug-signal-word-checked)
+ (defun . flyspell-debug-signal-changed-checked)
+ (defun . flyspell-post-command-hook)
+ (defun . flyspell-notify-misspell)
+ (defun . flyspell-word-search-backward)
+ (defun . flyspell-word-search-forward)
+ (defun . flyspell-word)
+ (defun . flyspell-math-tex-command-p)
+ (defun . flyspell-tex-command-p)
+ flyspell-casechars-cache flyspell-ispell-casechars-cache
+ (defun . flyspell-get-casechars)
+ flyspell-not-casechars-cache flyspell-ispell-not-casechars-cache
+ (defun . flyspell-get-not-casechars)
+ (defun . flyspell-get-word)
+ (defun . flyspell-small-region)
+ flyspell-external-ispell-process flyspell-external-ispell-buffer flyspell-large-region-buffer flyspell-large-region-beg flyspell-large-region-end
+ (defun . flyspell-external-point-words)
+ (defun . flyspell-process-localwords)
+ (defun . flyspell-check-region-doublons)
+ (defun . flyspell-large-region)
+ (t . flyspell-region)
+ (defun . flyspell-region)
+ (t . flyspell-buffer)
+ (defun . flyspell-buffer)
+ flyspell-old-buffer-error flyspell-old-pos-error
+ (defun . flyspell-goto-next-error)
+ (defun . flyspell-overlay-p)
+ (defun . flyspell-delete-region-overlays)
+ (defun . flyspell-delete-all-overlays)
+ (defun . flyspell-unhighlight-at)
+ (defun . flyspell-properties-at-p)
+ (defun . make-flyspell-overlay)
+ (defun . flyspell-highlight-incorrect-region)
+ (defun . flyspell-highlight-duplicate-region)
+ flyspell-auto-correct-pos flyspell-auto-correct-region flyspell-auto-correct-ring flyspell-auto-correct-word
+ (defun . flyspell-check-previous-highlighted-word)
+ (defun . flyspell-display-next-corrections)
+ (defun . flyspell-abbrev-table)
+ (defun . flyspell-define-abbrev)
+ (defun . flyspell-auto-correct-word)
+ flyspell-auto-correct-previous-pos
+ (defun . flyspell-auto-correct-previous-hook)
+ (defun . flyspell-auto-correct-previous-word)
+ (defun . flyspell-correct-word)
+ (defun . flyspell-correct-word-before-point)
+ (defun . flyspell-do-correct)
+ (defun . flyspell-ajust-cursor-point)
+ (defun . flyspell-emacs-popup)
+ (defun . flyspell-xemacs-popup)
+ (defun . flyspell-maybe-correct-transposition)
+ (defun . flyspell-maybe-correct-doubling)
+ (defun . flyspell-already-abbrevp)
+ (defun . flyspell-change-abbrev)
+ (provide . flyspell))
+ ("/usr/share/emacs/23.0.93/lisp/textmodes/ispell.elc"
+ (defun . ispell-check-minver)
+ (defun . check-ispell-version)
+ ispell-highlight-p ispell-lazy-highlight ispell-highlight-face ispell-check-comments ispell-query-replace-choices ispell-skip-tib ispell-tib-ref-beginning ispell-tib-ref-end ispell-keep-choices-win ispell-choices-win-default-height ispell-program-name ispell-alternate-dictionary ispell-complete-word-dict ispell-message-dictionary-alist ispell-message-fcc-skip ispell-grep-command ispell-grep-options ispell-look-command ispell-look-p ispell-have-new-look ispell-look-options ispell-use-ptys-p ispell-following-word ispell-help-in-bufferp ispell-quietly ispell-format-word-function ispell-format-word ispell-use-framepop-p ispell-personal-dictionary ispell-silently-savep ispell-local-dictionary-overridden ispell-local-dictionary ispell-extra-args ispell-skip-html ispell-local-dictionary-alist ispell-dictionary-base-alist ispell-dictionary-alist ispell-really-aspell ispell-really-hunspell ispell-encoding8-command ispell-aspell-supports-utf8 ispell-required-version ispell-offset ispell-version ispell-version
+ (defun . ispell-check-version)
+ (defun . ispell-call-process)
+ (defun . ispell-call-process-region)
+ ispell-menu-map ispell-menu-xemacs ispell-menu-map-needed ispell-library-directory ispell-process ispell-async-processp ispell-aspell-dictionary-alist
+ (defun . ispell-find-aspell-dictionaries)
+ ispell-aspell-data-dir ispell-aspell-dict-dir
+ (defun . ispell-get-aspell-config-value)
+ (defun . ispell-aspell-find-dictionary)
+ (defun . ispell-aspell-add-aliases)
+ ispell-last-program-name ispell-initialize-spellchecker-hook
+ (defun . ispell-set-spellchecker-params)
+ (defun . ispell-valid-dictionary-list)
+ (defun . ispell-int-char)
+ ispell-current-dictionary ispell-current-personal-dictionary ispell-dictionary
+ (defun . ispell-decode-string)
+ (defun . ispell-get-decoded-string)
+ (defun . ispell-get-casechars)
+ (defun . ispell-get-not-casechars)
+ (defun . ispell-get-otherchars)
+ (defun . ispell-get-many-otherchars-p)
+ (defun . ispell-get-ispell-args)
+ (defun . ispell-get-extended-character-mode)
+ (defun . ispell-get-coding-system)
+ ispell-pdict-modified-p ispell-quit ispell-process-directory ispell-filter ispell-filter-continue ispell-output-buffer ispell-session-buffer ispell-cmd-args ispell-query-replace-marker ispell-recursive-edit-marker ispell-checking-message ispell-choices-buffer ispell-choices-buffer ispell-overlay ispell-words-keyword ispell-dictionary-keyword ispell-pdict-keyword ispell-parsing-keyword ispell-skip-region-alist ispell-tex-skip-alists ispell-html-skip-alists ispell-local-pdict ispell-buffer-local-name ispell-parser ispell-region-end ispell-check-only
+ (defun . ispell-accept-output)
+ (defun . ispell-send-replacement)
+ (defun . ispell-send-string)
+ (defun . ispell-insert-word)
+ (t . ispell-word)
+ (defun . ispell-word)
+ (defun . ispell-get-word)
+ (t . ispell-pdict-save)
+ (defun . ispell-pdict-save)
+ (defun . ispell-command-loop)
+ (defun . ispell-show-choices)
+ (t . ispell-help)
+ (defun . ispell-help)
+ (defun . lookup-words)
+ (defun . ispell-filter)
+ (defun . ispell-highlight-spelling-error-generic)
+ (defun . ispell-highlight-spelling-error-xemacs)
+ (defun . ispell-highlight-spelling-error-overlay)
+ (defun . ispell-highlight-spelling-error)
+ (defun . ispell-adjusted-window-height)
+ (defun . ispell-overlay-window)
+ (defun . ispell-parse-output)
+ (defun . ispell-process-status)
+ (defun . ispell-start-process)
+ (defun . ispell-init-process)
+ (t . ispell-kill-ispell)
+ (defun . ispell-kill-ispell)
+ (t . ispell-change-dictionary)
+ (defun . ispell-change-dictionary)
+ (defun . ispell-internal-change-dictionary)
+ (t . ispell-region)
+ (defun . ispell-region)
+ (defun . ispell-begin-skip-region-regexp)
+ (defun . ispell-begin-skip-region)
+ (defun . ispell-begin-tex-skip-regexp)
+ (defun . ispell-skip-region-list)
+ (defun . ispell-tex-arg-end)
+ (defun . ispell-ignore-fcc)
+ (defun . ispell-skip-region)
+ (defun . ispell-get-line)
+ (defun . ispell-looking-at)
+ (defun . ispell-process-line)
+ (t . ispell-comments-and-strings)
+ (defun . ispell-comments-and-strings)
+ (t . ispell-buffer)
+ (defun . ispell-buffer)
+ (t . ispell-continue)
+ (defun . ispell-continue)
+ (defun . ispell-horiz-scroll)
+ (t . ispell-complete-word)
+ (defun . ispell-complete-word)
+ (t . ispell-complete-word-interior-frag)
+ (defun . ispell-complete-word-interior-frag)
+ (t . ispell)
+ (defun . ispell)
+ ispell-minor-mode ispell-minor-keymap
+ (t . ispell-minor-mode)
+ (defun . ispell-minor-mode)
+ (defun . ispell-minor-check)
+ ispell-message-text-end
+ (defun . ispell-mime-multipartp)
+ (defun . ispell-mime-skip-part)
+ (t . ispell-message)
+ (defun . ispell-message)
+ (defun . ispell-non-empty-string)
+ (defun . ispell-accept-buffer-local-defs)
+ (defun . ispell-buffer-local-parsing)
+ (defun . ispell-buffer-local-dict)
+ (defun . ispell-buffer-local-words)
+ (defun . ispell-add-per-file-word-list)
+ (provide . ispell))
+ ("/home/hobbes/nxhtml/nxhtml/html-site.el" html-site:version
+ (require . ourcomments-util)
+ (require . cl)
+ (require . dired)
+ (require . ffip)
+ (require . grep)
+ (defun . html-site-looks-like-local-url)
+ (require . url-parse)
+ (require . url-http)
+ (defun . html-site-dir-contains)
+ (defun . html-site-lwarn)
+ (defun . html-site-chk-wtocdir)
+ (t . html-site-buffer-or-dired-file-name)
+ (defun . html-site-buffer-or-dired-file-name)
+ (t . html-site-set-site)
+ (defun . html-site-set-site)
+ (t . html-site-dired-current)
+ (defun . html-site-dired-current)
+ (t . html-site-find-file)
+ (defun . html-site-find-file)
+ (t . html-site-rgrep)
+ (defun . html-site-rgrep)
+ (t . html-site-query-replace)
+ (defun . html-site-query-replace)
+ (defun . html-site-ensure-site-defined)
+ (defun . html-site-current-ensure-site-defined)
+ (defun . html-site-remote-contains)
+ (defun . html-site-current-remote-contains)
+ (defun . html-site-ensure-file-in-site)
+ (defun . html-site-current-ensure-file-in-site)
+ (defun . html-site-ensure-buffer-in-site)
+ (defun . html-site-current-ensure-buffer-in-site)
+ (defun . html-site-site-dir)
+ (defun . html-site-current-site-dir)
+ (defun . html-site-contains)
+ (defun . html-site-current-contains)
+ (defun . html-site-page-list)
+ (defun . html-site-current-page-list)
+ (defun . html-site-frames-file)
+ (defun . html-site-current-frames-file)
+ (defun . html-site-toc-file)
+ (defun . html-site-current-toc-file)
+ (defun . html-site-merge-dir)
+ (defun . html-site-current-merge-dir)
+ (defun . html-site-merge-template)
+ (defun . html-site-current-merge-template)
+ (defun . html-site-extra-fun)
+ (defun . html-site-current-extra-fun)
+ (defun . html-site-ftp-host)
+ (defun . html-site-current-ftp-host)
+ (defun . html-site-ftp-user)
+ (defun . html-site-current-ftp-user)
+ (defun . html-site-ftp-password)
+ (defun . html-site-current-ftp-password)
+ (defun . html-site-ftp-dir)
+ (defun . html-site-current-ftp-dir)
+ (defun . html-site-ftp-wtoc-dir)
+ (defun . html-site-current-ftp-wtoc-dir)
+ (defun . html-site-web-host)
+ (defun . html-site-current-web-host)
+ (defun . html-site-web-dir)
+ (defun . html-site-current-web-dir)
+ (defun . html-site-web-wtoc-dir)
+ (defun . html-site-current-web-wtoc-dir)
+ (defun . html-site-web-full)
+ (defun . html-site-current-web-full)
+ html-site-ftp-temporary-passwords
+ (defun . html-site-get-ftp-pw)
+ (defun . html-site-path-in-mirror)
+ (defun . html-site-local-to-web)
+ (defun . html-site-current-local-to-web)
+ (defun . html-site-remote-root)
+ (defun . html-site-current-remote-root)
+ (defun . html-site-local-to-remote)
+ (defun . html-site-current-local-to-remote)
+ (defun . html-site-remote-to-local)
+ (defun . html-site-current-remote-to-local)
+ html-site-files-re
+ (defun . html-site-edit-pages-file)
+ (defun . html-site-get-sub-files)
+ (defun . html-site-file-is-local)
+ html-site-list html-site-current noshell-procbuf-name noshell-proc-name
+ (defun . noshell-procbuf-setup)
+ (defun . noshell-procbuf-teardown)
+ (defun . noshell-procbuf-run)
+ (defun . noshell-sentinel)
+ (defun . noshell-procbuf-syncrun)
+ noshell-process-mode-map noshell-process-mode-syntax-table noshell-process-mode-abbrev-table noshell-process-mode-abbrev-table
+ (defun . noshell-process-mode)
+ (defun . noshell-quit)
+ (defun . noshell-kill-subprocess)
+ (provide . html-site)
+ (require . html-upl)
+ html-site-mode-menu-map html-site-mode-map html-site-mode
+ (defun . html-site-mode)
+ html-site-mode-off-list html-site-mode-major-mode html-site-global-mode
+ (defun . html-site-global-mode)
+ html-site-global-mode-buffers
+ (defun . html-site-global-mode-enable-in-buffers)
+ (defun . html-site-global-mode-check-buffers)
+ (defun . html-site-global-mode-cmhh))
+ ("/home/hobbes/nxhtml/nxhtml/html-upl.el" html-upl:version
+ (require . html-site)
+ html-upl-dir
+ (defun . html-upl-browse-remote)
+ (defun . html-upl-browse-remote-with-toc)
+ (defun . html-upl-browse-remote-frames)
+ (defun . html-upl-upload-site-with-toc)
+ (defun . html-upl-upload-site)
+ (defun . html-upl-upload-site1)
+ (defun . html-upl-ensure-site-has-host)
+ (defun . html-upl-remote-dired)
+ (defun . html-upl-upload-file)
+ (defun . html-upl-edit-remote-file)
+ (defun . html-upl-edit-remote-file-with-toc)
+ (defun . html-upl-edit-remote-file1)
+ (defun . html-upl-ediff-file)
+ (provide . html-upl))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/derived.elc"
+ (defun . derived-mode-hook-name)
+ (defun . derived-mode-map-name)
+ (defun . derived-mode-syntax-table-name)
+ (defun . derived-mode-abbrev-table-name)
+ (t . define-derived-mode)
+ (defun . define-derived-mode)
+ (defun . derived-mode-class)
+ (defun . derived-mode-make-docstring)
+ (defun . derived-mode-setup-function-name)
+ (t . derived-mode-init-mode-variables)
+ (defun . derived-mode-init-mode-variables)
+ (defun . derived-mode-set-keymap)
+ (defun . derived-mode-set-syntax-table)
+ (defun . derived-mode-set-abbrev-table)
+ (defun . derived-mode-run-hooks)
+ (defun . derived-mode-merge-keymaps)
+ (defun . derived-mode-merge-syntax-tables)
+ (defun . derived-mode-merge-abbrev-tables)
+ (provide . derived))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-http.elc"
+ (require . url-gw)
+ (require . url-util)
+ (require . url-parse)
+ (require . url-cookie)
+ (require . mail-parse)
+ (require . url-auth)
+ (require . url)
+ (autoload . url-cache-create-filename)
+ url-http-default-port url-http-asynchronous-p
+ (defun . url-http-expand-file-name)
+ url-http-real-basic-auth-storage url-http-proxy-basic-auth-storage url-http-open-connections url-http-version url-http-attempt-keepalives
+ (defun . url-http-debug)
+ (defun . url-http-mark-connection-as-busy)
+ (defun . url-http-mark-connection-as-free)
+ (defun . url-http-find-free-connection)
+ (defun . url-http-user-agent-string)
+ (defun . url-http-create-request)
+ (defun . url-http-clean-headers)
+ (defun . url-http-handle-authentication)
+ (defun . url-http-parse-response)
+ (defun . url-http-handle-cookies)
+ (defun . url-http-parse-headers)
+ (defun . url-http-activate-callback)
+ (defun . url-http-idle-sentinel)
+ (defun . url-http-end-of-document-sentinel)
+ (defun . url-http-simple-after-change-function)
+ (defun . url-http-content-length-after-change-function)
+ (defun . url-http-chunked-encoding-after-change-function)
+ (defun . url-http-wait-for-headers-change-function)
+ (t . url-http)
+ (defun . url-http)
+ (defun . url-http-async-sentinel)
+ (defun . url-http-generic-filter)
+ (defun . url-http-symbol-value-in-buffer)
+ (defun . url-http-head)
+ (t . url-http-file-exists-p)
+ (defun . url-http-file-exists-p)
+ (defun . url-http-file-readable-p)
+ (defun . url-http-head-file-attributes)
+ (t . url-http-file-attributes)
+ (defun . url-http-file-attributes)
+ (t . url-http-options)
+ (defun . url-http-options)
+ (require . tls)
+ url-https-default-port url-https-asynchronous-p
+ (defun . url-https-expand-file-name)
+ (defun . url-https-create-secure-wrapper)
+ (t . url-https)
+ (defun . url-https)
+ (t . url-https-file-exists-p)
+ (defun . url-https-file-exists-p)
+ (t . url-https-file-readable-p)
+ (defun . url-https-file-readable-p)
+ (t . url-https-file-attributes)
+ (defun . url-https-file-attributes)
+ (provide . url-http))
+ ("/usr/share/emacs/23.0.93/lisp/net/tls.elc"
+ (autoload . format-spec)
+ (autoload . format-spec-make)
+ tls-end-of-info tls-program tls-process-connection-type tls-success tls-checktrust tls-untrusted tls-hostmismatch tls-certtool-program
+ (defun . tls-certificate-information)
+ (t . open-tls-stream)
+ (defun . open-tls-stream)
+ (provide . tls))
+ ("/usr/share/emacs/23.0.93/lisp/url/url.elc"
+ (require . mailcap)
+ (require . url-vars)
+ (require . url-cookie)
+ (require . url-history)
+ (require . url-expand)
+ (require . url-privacy)
+ (require . url-methods)
+ (require . url-proxy)
+ (require . url-parse)
+ (require . url-util)
+ url-configuration-directory
+ (t . url-do-setup)
+ (defun . url-do-setup)
+ url-redirect-buffer
+ (t . url-retrieve)
+ (defun . url-retrieve)
+ (defun . url-retrieve-internal)
+ (t . url-retrieve-synchronously)
+ (defun . url-retrieve-synchronously)
+ (defun . url-mm-callback)
+ (defun . url-mm-url)
+ url-dead-buffer-list
+ (defun . url-mark-buffer-as-dead)
+ (defun . url-gc-dead-buffers)
+ (t . url-warn)
+ (defun . url-warn)
+ (provide . url))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-proxy.elc"
+ (require . url-parse)
+ (autoload . url-warn)
+ (defun . url-default-find-proxy-for-url)
+ url-proxy-locator
+ (defun . url-find-proxy-for-url)
+ (defun . url-proxy)
+ (provide . url-proxy))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-privacy.elc"
+ (require . url-vars)
+ (defun . url-device-type)
+ (t . url-setup-privacy-info)
+ (defun . url-setup-privacy-info)
+ (provide . url-privacy))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-expand.elc"
+ (require . url-methods)
+ (require . url-util)
+ (require . url-parse)
+ (defun . url-expander-remove-relative-links)
+ (defun . url-expand-file-name)
+ (defun . url-identity-expander)
+ (t . url-default-expander)
+ (defun . url-default-expander)
+ (provide . url-expand))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-history.elc"
+ (require . url-parse)
+ (autoload . url-do-setup)
+ url-history-track url-history-file url-history-save-interval url-history-timer url-history-changed-since-last-save url-history-hash-table
+ (defun . url-history-setup-save-timer)
+ (defun . url-history-parse-history)
+ (defun . url-history-update-url)
+ (defun . url-history-save-history)
+ (defun . url-have-visited-url)
+ (defun . url-completion-function)
+ (provide . url-history))
+ ("/usr/share/emacs/23.0.93/lisp/gnus/mailcap.elc"
+ (defun . mailcap-delete-duplicates)
+ (defun . mailcap-replace-in-string)
+ mailcap-parse-args-syntax-table mailcap-print-command mailcap-mime-data mailcap-download-directory mailcap-poor-system-types
+ (defun . mailcap-save-binary-file)
+ mailcap-maybe-eval-warning
+ (defun . mailcap-maybe-eval)
+ (defun . mailcap-replace-regexp)
+ mailcap-parsed-p
+ (defun . mailcap-parse-mailcaps)
+ (defun . mailcap-parse-mailcap)
+ (defun . mailcap-parse-mailcap-extras)
+ (defun . mailcap-mailcap-entry-passes-test)
+ (defun . mailcap-possible-viewers)
+ (defun . mailcap-unescape-mime-test)
+ mailcap-viewer-test-cache
+ (defun . mailcap-viewer-passes-test)
+ (defun . mailcap-add-mailcap-entry)
+ (defun . mailcap-add)
+ (defun . mailcap-viewer-lessp)
+ (defun . mailcap-mime-info)
+ mailcap-mime-extensions mailcap-mimetypes-parsed-p
+ (defun . mailcap-parse-mimetypes)
+ (defun . mailcap-parse-mimetype-file)
+ (defun . mailcap-extension-to-mime)
+ (defun . mailcap-command-p)
+ (defun . mailcap-mime-types)
+ (defun . mailcap-file-default-commands)
+ (provide . mailcap))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-auth.elc"
+ (require . url-vars)
+ (require . url-parse)
+ (autoload . url-warn)
+ (autoload . auth-source-user-or-password)
+ (defun . url-auth-user-prompt)
+ url-basic-auth-storage
+ (defun . url-basic-auth)
+ url-digest-auth-storage
+ (defun . url-digest-auth-create-key)
+ (defun . url-digest-auth)
+ url-registered-auth-schemes
+ (t . url-get-authentication)
+ (defun . url-get-authentication)
+ (t . url-register-auth-scheme)
+ (defun . url-register-auth-scheme)
+ (defun . url-auth-registered)
+ (provide . url-auth))
+ ("/usr/share/emacs/23.0.93/lisp/gnus/mail-parse.elc"
+ (require . mail-prsvr)
+ (require . ietf-drums)
+ (require . rfc2231)
+ (require . rfc2047)
+ (require . rfc2045)
+ (defun . mail-header-parse-content-type)
+ (defun . mail-header-parse-content-disposition)
+ (defun . mail-content-type-get)
+ (defun . mail-header-encode-parameter)
+ (t . mail-header-remove-comments)
+ (defun . mail-header-remove-comments)
+ (t . mail-header-remove-whitespace)
+ (defun . mail-header-remove-whitespace)
+ (defun . mail-header-strip)
+ (defun . mail-header-get-comment)
+ (defun . mail-header-parse-address)
+ (defun . mail-header-parse-addresses)
+ (defun . mail-header-parse-date)
+ (defun . mail-narrow-to-head)
+ (defun . mail-quote-string)
+ (defun . mail-header-make-address)
+ (defun . mail-header-fold-field)
+ (defun . mail-header-unfold-field)
+ (defun . mail-header-narrow-to-field)
+ (defun . mail-header-field-value)
+ (defun . mail-encode-encoded-word-region)
+ (defun . mail-encode-encoded-word-buffer)
+ (defun . mail-encode-encoded-word-string)
+ (defun . mail-decode-encoded-word-region)
+ (defun . mail-decode-encoded-word-string)
+ (defun . mail-decode-encoded-address-region)
+ (defun . mail-decode-encoded-address-string)
+ (provide . mail-parse))
+ ("/usr/share/emacs/23.0.93/lisp/gnus/rfc2231.elc"
+ (require . ietf-drums)
+ (require . rfc2047)
+ (autoload . mm-encode-body)
+ (autoload . mail-header-remove-whitespace)
+ (autoload . mail-header-remove-comments)
+ (defun . rfc2231-get-value)
+ (defun . rfc2231-parse-qp-string)
+ (defun . rfc2231-parse-string)
+ (defun . rfc2231-decode-encoded-string)
+ (defun . rfc2231-encode-string)
+ (provide . rfc2231))
+ ("/usr/share/emacs/23.0.93/lisp/gnus/rfc2047.elc"
+ (require . qp)
+ (require . mm-util)
+ (require . ietf-drums)
+ (require . mail-prsvr)
+ (require . rfc2045)
+ (autoload . mm-body-7-or-8)
+ rfc2047-header-encoding-alist rfc2047-charset-encoding-alist rfc2047-encode-function-alist rfc2047-encode-encoded-words rfc2047-allow-irregular-q-encoded-words rfc2047-encoded-word-regexp rfc2047-encoded-word-regexp-loose
+ (defun . rfc2047-qp-or-base64)
+ (defun . rfc2047-narrow-to-field)
+ (defun . rfc2047-field-value)
+ (defun . rfc2047-quote-special-characters-in-quoted-strings)
+ rfc2047-encoding-type
+ (defun . rfc2047-encode-message-header)
+ (defun . rfc2047-encodable-p)
+ rfc2047-syntax-table rfc2047-syntax-table
+ (defun . rfc2047-encode-region)
+ (defun . rfc2047-encode-string)
+ rfc2047-encode-max-chars
+ (defun . rfc2047-encode-1)
+ (defun . rfc2047-encode)
+ (defun . rfc2047-fold-field)
+ (defun . rfc2047-fold-region)
+ (defun . rfc2047-unfold-field)
+ (defun . rfc2047-unfold-region)
+ (defun . rfc2047-b-encode-string)
+ (defun . rfc2047-q-encode-string)
+ (defun . rfc2047-encode-parameter)
+ rfc2047-quote-decoded-words-containing-tspecials rfc2047-allow-incomplete-encoded-text
+ (defun . rfc2047-strip-backslashes-in-quoted-strings)
+ (defun . rfc2047-charset-to-coding-system)
+ (defun . rfc2047-decode-encoded-words)
+ (defun . rfc2047-decode-region)
+ (defun . rfc2047-decode-address-region)
+ (defun . rfc2047-decode-string)
+ (defun . rfc2047-decode-address-string)
+ (defun . rfc2047-pad-base64)
+ (provide . rfc2047))
+ ("/usr/share/emacs/23.0.93/lisp/gnus/rfc2045.elc"
+ (require . ietf-drums)
+ (defun . rfc2045-encode-string)
+ (provide . rfc2045))
+ ("/usr/share/emacs/23.0.93/lisp/gnus/qp.elc"
+ (require . mm-util)
+ (t . quoted-printable-decode-region)
+ (defun . quoted-printable-decode-region)
+ (defun . quoted-printable-decode-string)
+ (defun . quoted-printable-encode-region)
+ (defun . quoted-printable-encode-string)
+ (provide . qp))
+ ("/usr/share/emacs/23.0.93/lisp/gnus/ietf-drums.elc"
+ (require . time-date)
+ (require . mm-util)
+ ietf-drums-no-ws-ctl-token ietf-drums-text-token ietf-drums-specials-token ietf-drums-quote-token ietf-drums-wsp-token ietf-drums-fws-regexp ietf-drums-atext-token ietf-drums-dot-atext-token ietf-drums-qtext-token ietf-drums-tspecials ietf-drums-syntax-table
+ (defun . ietf-drums-token-to-list)
+ (defun . ietf-drums-init)
+ (defun . ietf-drums-remove-comments)
+ (defun . ietf-drums-remove-whitespace)
+ (defun . ietf-drums-get-comment)
+ (defun . ietf-drums-strip)
+ (defun . ietf-drums-parse-address)
+ (defun . ietf-drums-parse-addresses)
+ (defun . ietf-drums-unfold-fws)
+ (defun . ietf-drums-parse-date)
+ (defun . ietf-drums-narrow-to-header)
+ (defun . ietf-drums-quote-string)
+ (defun . ietf-drums-make-address)
+ (provide . ietf-drums))
+ ("/usr/share/emacs/23.0.93/lisp/calendar/time-date.elc"
+ (defun . with-decoded-time-value)
+ (defun . encode-time-value)
+ (autoload . parse-time-string)
+ (t . date-to-time)
+ (defun . date-to-time)
+ (t . time-to-seconds)
+ (defun . time-to-seconds)
+ (t . seconds-to-time)
+ (defun . seconds-to-time)
+ (t . time-less-p)
+ (defun . time-less-p)
+ (t . days-to-time)
+ (defun . days-to-time)
+ (t . time-since)
+ (defun . time-since)
+ (defun . subtract-time)
+ (t . time-subtract)
+ (defun . time-subtract)
+ (t . time-add)
+ (defun . time-add)
+ (t . date-to-day)
+ (defun . date-to-day)
+ (t . days-between)
+ (defun . days-between)
+ (t . date-leap-year-p)
+ (defun . date-leap-year-p)
+ (t . time-to-day-in-year)
+ (defun . time-to-day-in-year)
+ (t . time-to-days)
+ (defun . time-to-days)
+ (defun . time-to-number-of-days)
+ (t . safe-date-to-time)
+ (defun . safe-date-to-time)
+ (t . format-seconds)
+ (defun . format-seconds)
+ (provide . time-date))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-cookie.elc"
+ (require . timezone)
+ (require . url-util)
+ (require . url-parse)
+ (defun . url-cookie-tag)
+ (defun . url-cookie-name)
+ (defun . url-cookie-value)
+ (defun . url-cookie-expires)
+ (defun . url-cookie-localpart)
+ (defun . url-cookie-domain)
+ (defun . url-cookie-secure)
+ (defun . url-cookie-create)
+ url-cookie-storage url-cookie-secure-storage url-cookie-file url-cookie-confirmation url-cookie-multiple-line url-cookies-changed-since-last-save
+ (defun . url-cookie-parse-file)
+ (defun . url-cookie-clean-up)
+ (defun . url-cookie-write-file)
+ (defun . url-cookie-store)
+ (defun . url-cookie-expired-p)
+ (defun . url-cookie-retrieve)
+ (defun . url-cookie-generate-header-lines)
+ url-cookie-two-dot-domains url-cookie-trusted-urls url-cookie-untrusted-urls
+ (defun . url-cookie-host-can-set-p)
+ (defun . url-cookie-handle-set-cookie)
+ url-cookie-timer url-cookie-save-interval
+ (defun . url-cookie-setup-save-timer)
+ (provide . url-cookie))
+ ("/usr/share/emacs/23.0.93/lisp/timezone.elc" timezone-world-timezones timezone-months-assoc
+ (t . timezone-make-date-arpa-standard)
+ (defun . timezone-make-date-arpa-standard)
+ (defun . timezone-make-date-sortable)
+ (defun . timezone-make-arpa-date)
+ (defun . timezone-make-sortable-date)
+ (defun . timezone-make-time-string)
+ (t . timezone-parse-date)
+ (defun . timezone-parse-date)
+ (defun . timezone-parse-time)
+ (defun . timezone-zone-to-minute)
+ (defun . timezone-time-from-absolute)
+ (defun . timezone-time-zone-from-absolute)
+ (defun . timezone-fix-time)
+ (defun . timezone-last-day-of-month)
+ (defun . timezone-leap-year-p)
+ (defun . timezone-day-number)
+ (defun . timezone-absolute-from-gregorian)
+ (provide . timezone))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-util.elc"
+ (require . url-parse)
+ (autoload . timezone-parse-date)
+ (autoload . timezone-make-date-arpa-standard)
+ (autoload . mail-header-extract)
+ url-parse-args-syntax-table url-debug
+ (t . url-debug)
+ (defun . url-debug)
+ (t . url-parse-args)
+ (defun . url-parse-args)
+ (t . url-insert-entities-in-string)
+ (defun . url-insert-entities-in-string)
+ (t . url-normalize-url)
+ (defun . url-normalize-url)
+ (t . url-lazy-message)
+ (defun . url-lazy-message)
+ (t . url-get-normalized-date)
+ (defun . url-get-normalized-date)
+ (t . url-eat-trailing-space)
+ (defun . url-eat-trailing-space)
+ (t . url-strip-leading-spaces)
+ (defun . url-strip-leading-spaces)
+ (t . url-pretty-length)
+ (defun . url-pretty-length)
+ (t . url-display-percentage)
+ (defun . url-display-percentage)
+ (t . url-percentage)
+ (defun . url-percentage)
+ (defun . url-basepath)
+ (t . url-file-directory)
+ (defun . url-file-directory)
+ (t . url-file-nondirectory)
+ (defun . url-file-nondirectory)
+ (t . url-parse-query-string)
+ (defun . url-parse-query-string)
+ (defun . url-unhex)
+ (t . url-unhex-string)
+ (defun . url-unhex-string)
+ url-unreserved-chars
+ (t . url-hexify-string)
+ (defun . url-hexify-string)
+ (t . url-file-extension)
+ (defun . url-file-extension)
+ (t . url-truncate-url-for-viewing)
+ (defun . url-truncate-url-for-viewing)
+ (t . url-view-url)
+ (defun . url-view-url)
+ url-get-url-filename-chars
+ (defun . url-get-url-at-point)
+ (defun . url-generate-unique-filename)
+ (defun . url-extract-mime-headers)
+ (defun . url-make-private-file)
+ (provide . url-util))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-gw.elc"
+ (require . url-vars)
+ (autoload . socks-open-network-stream)
+ (autoload . open-ssl-stream)
+ (autoload . open-tls-stream)
+ url-gateway-local-host-regexp url-gateway-prompt-pattern url-gateway-rlogin-host url-gateway-rlogin-user-name url-gateway-rlogin-parameters url-gateway-telnet-host url-gateway-telnet-parameters url-gateway-telnet-login-prompt url-gateway-telnet-password-prompt url-gateway-telnet-user-name url-gateway-telnet-password url-gateway-broken-resolution url-gateway-nslookup-program
+ (t . url-gateway-nslookup-host)
+ (defun . url-gateway-nslookup-host)
+ (defun . url-wait-for-string)
+ (defun . url-open-rlogin)
+ (defun . url-open-telnet)
+ (t . url-open-stream)
+ (defun . url-open-stream)
+ (provide . url-gw))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-methods.elc"
+ (require . url-parse)
+ url-scheme-registry url-scheme-methods url-scheme-default-properties url-scheme-default-properties
+ (defun . url-scheme-default-loader)
+ (defun . url-scheme-register-proxy)
+ (t . url-scheme-get-property)
+ (defun . url-scheme-get-property)
+ (provide . url-methods))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-parse.elc"
+ (require . url-vars)
+ (autoload . url-scheme-get-property)
+ (defun . url-type)
+ (defun . url-user)
+ (defun . url-password)
+ (defun . url-host)
+ (defun . url-portspec)
+ (defun . url-filename)
+ (defun . url-target)
+ (defun . url-attributes)
+ (defun . url-fullness)
+ (defun . url-p)
+ (defun . url-parse-make-urlobj)
+ (defun . url-port)
+ (t . url-recreate-url)
+ (defun . url-recreate-url)
+ (defun . url-recreate-url-attributes)
+ (t . url-generic-parse-url)
+ (defun . url-generic-parse-url)
+ (provide . url-parse))
+ ("/usr/share/emacs/23.0.93/lisp/url/url-vars.elc"
+ (require . mm-util)
+ url-version url-current-object url-current-mime-headers url-honor-refresh-requests url-automatic-caching url-cache-expired url-bug-address url-personal-mail-address url-directory-index-file url-privacy-level url-inhibit-uncompression url-uncompressor-alist url-mail-command url-proxy-services url-standalone-mode url-mime-separator-chars url-bad-port-list url-mime-content-type-charset-regexp url-request-data url-request-extra-headers url-request-method url-mime-encoding-string
+ (defun . url-mime-charset-string)
+ url-mime-charset-string
+ (defun . url-set-mime-charset-string)
+ url-mime-language-string url-mime-accept-string url-package-version url-package-name url-system-type url-os-type url-max-password-attempts url-temporary-directory url-show-status url-using-proxy url-news-server url-nonrelative-link url-max-redirections url-confirmation-func url-gateway-method url-setup-done url-weekday-alist url-weekday-alist url-monthabbrev-alist url-monthabbrev-alist url-lazy-message-time url-extensions-header url-parse-syntax-table url-load-hook url-working-buffer url-working-buffer url-gateway-unplugged
+ (provide . url-vars))
+ ("/usr/share/emacs/23.0.93/lisp/gnus/mm-util.elc"
+ (require . mail-prsvr)
+ (require . timer)
+ (defun . mm-coding-system-list)
+ (defun . mm-char-int)
+ (defun . mm-coding-system-equal)
+ (defun . mm-annotationp)
+ (defun . mm-set-buffer-file-coding-system)
+ (defun . mm-read-charset)
+ (defun . mm-subst-char-in-string)
+ (defun . mm-replace-in-string)
+ (defun . mm-string-as-unibyte)
+ (defun . mm-string-make-unibyte)
+ (defun . mm-string-as-multibyte)
+ (defun . mm-multibyte-string-p)
+ (defun . mm-insert-byte)
+ (defun . mm-multibyte-char-to-unibyte)
+ (defun . mm-set-buffer-multibyte)
+ (defun . mm-special-display-p)
+ (defun . mm-substring-no-properties)
+ (defun . mm-line-number-at-pos)
+ (defun . mm-decode-coding-string)
+ (defun . mm-encode-coding-string)
+ (defun . mm-decode-coding-region)
+ (defun . mm-encode-coding-region)
+ (defun . mm-string-to-multibyte)
+ (defun . mm-char-or-char-int-p)
+ (defun . mm-ucs-to-char)
+ (defun . mm-read-coding-system)
+ mm-coding-system-list
+ (defun . mm-get-coding-system-list)
+ (defun . mm-coding-system-p)
+ (defun . mm-codepage-setup)
+ mm-charset-synonym-alist mm-codepage-iso-8859-list mm-codepage-ibm-list
+ (defun . mm-setup-codepage-iso-8859)
+ (defun . mm-setup-codepage-ibm)
+ mm-charset-eval-alist
+ (defun . mm-charset-to-coding-system)
+ mm-charset-override-alist mm-binary-coding-system mm-text-coding-system mm-text-coding-system-for-write mm-auto-save-coding-system mm-universal-coding-system mm-mime-mule-charset-alist
+ (defun . mm-enrich-utf-8-by-mule-ucs)
+ mm-hack-charsets mm-iso-8859-15-compatible mm-iso-8859-x-to-15-table mm-coding-system-priorities mm-use-find-coding-systems-region
+ (defun . mm-mule-charset-to-mime-charset)
+ mm-emacs-mule
+ (defun . mm-enable-multibyte)
+ (defun . mm-disable-multibyte)
+ (defun . mm-preferred-coding-system)
+ (defun . mm-guess-charset)
+ (defun . mm-charset-after)
+ (defun . mm-mime-charset)
+ (defun . mm-delete-duplicates)
+ (defun . mm-multibyte-p)
+ (defun . mm-default-multibyte-p)
+ (defun . mm-iso-8859-x-to-15-region)
+ (defun . mm-sort-coding-systems-predicate)
+ (defun . mm-xemacs-find-mime-charset-1)
+ (defun . mm-xemacs-find-mime-charset)
+ (defun . mm-find-mime-charset-region)
+ (defun . mm-with-unibyte-buffer)
+ (defun . mm-with-multibyte-buffer)
+ (defun . mm-with-unibyte-current-buffer)
+ (defun . mm-find-charset-region)
+ (defun . mm-auto-mode-alist)
+ mm-inhibit-file-name-handlers
+ (defun . mm-insert-file-contents)
+ (defun . mm-append-to-file)
+ (defun . mm-write-region)
+ (autoload . gmm-write-region)
+ (defun . mm-make-temp-file)
+ (defun . mm-image-load-path)
+ (defun . mm-detect-coding-region)
+ (defun . mm-detect-mime-charset-region)
+ (defun . mm-coding-system-to-mime-charset)
+ (defun . mm-decompress-buffer)
+ (defun . mm-find-buffer-file-coding-system)
+ (provide . mm-util))
+ ("/usr/share/emacs/23.0.93/lisp/gnus/mail-prsvr.elc" mail-parse-charset mail-parse-mule-charset mail-parse-ignored-charsets
+ (provide . mail-prsvr))
+ ("/home/hobbes/nxhtml/util/ffip.el"
+ (require . cl)
+ ffip-project-name ffip-project-roots ffip-project-type ffip-project-file-types ffip-project-file-matcher ffip-project-files-table
+ (defun . ffip-reset-project)
+ (defun . ffip-is-current)
+ (defun . ffip-set-current-project)
+ (defun . ffip-cache-project-files)
+ (defun . ffip-file-matcher)
+ (defun . ffip-project-files)
+ (defun . ffip-project-root)
+ (defun . ffip-populate-files-table)
+ (defun . ffip-get-unique-directory-names)
+ (defun . ffip-file-is-in-project)
+ (defun . ffip-add-file-if-in-project)
+ (defun . ffip-after-save)
+ (defun . ffip-find-file-in-dirtree)
+ (defun . ffip-find-file-in-project)
+ (provide . ffip))
+ ("/home/hobbes/nxhtml/util/ourcomments-util.el" ourcomments-util:version
+ (require . apropos)
+ (require . cl)
+ (require . grep)
+ (require . ido)
+ (require . recentf)
+ (defun . point-to-coord)
+ (t . popup-menu-at-point)
+ (defun . popup-menu-at-point)
+ (t . define-toggle)
+ (defun . define-toggle)
+ (t . unfill-paragraph)
+ (defun . unfill-paragraph)
+ (t . unfill-region)
+ (defun . unfill-region)
+ (t . unfill-individual-paragraphs)
+ (defun . unfill-individual-paragraphs)
+ (defun . with-unfilling)
+ (t . major-or-multi-majorp)
+ (defun . major-or-multi-majorp)
+ (t . multi-major-modep)
+ (defun . multi-major-modep)
+ (t . major-modep)
+ (defun . major-modep)
+ (t . ourcomments-move-beginning-of-line)
+ (defun . ourcomments-move-beginning-of-line)
+ (t . ourcomments-move-end-of-line)
+ (defun . ourcomments-move-end-of-line)
+ (defun . ourcomments-find-keymap-variables)
+ (defun . key-bindings)
+ (defun . describe-keymap-placement)
+ (t . describe-key-and-map-briefly)
+ (defun . describe-key-and-map-briefly)
+ wrap-to-fill-left-marg wrap-to-fill-left-marg-use wrap-to-fill-left-marg-modes
+ (defun . wrap-to-fill-set-prefix)
+ (defun . wrap-to-fill-after-change)
+ (defun . wrap-to-fill-scroll-fun)
+ (defun . wrap-to-fill-wider)
+ (defun . wrap-to-fill-narrower)
+ wrap-to-fill-column-mode-map wrap-to-fill-column-mode
+ (t . wrap-to-fill-column-mode)
+ (defun . wrap-to-fill-column-mode)
+ (defun . wrap-to-fill-set-values)
+ (defun . wrap-to-fill-set-values-1)
+ better-bottom-angles-defaults
+ (defun . better-fringes-bottom-angles)
+ (defun . better-fringes-faces)
+ (defface . better-fringes-bitmap)
+ (defface . better-fringes-important-bitmap)
+ better-fringes-mode
+ (t . better-fringes-mode)
+ (defun . better-fringes-mode)
+ (t . find-emacs-other-file)
+ (defun . find-emacs-other-file)
+ (t . ourcomments-ediff-files)
+ (defun . ourcomments-ediff-files)
+ (defun . ourcomments-latest-changelog)
+ (defun . ourcomments-read-symbol)
+ (defun . ourcomments-command-at-point)
+ (t . describe-command)
+ (defun . describe-command)
+ (defun . buffer-narrowed-p)
+ describe-symbol-alist
+ (defun . describe-symbol-add-known)
+ (defun . property-list-keys)
+ (defun . ourcomments-symbol-type)
+ (defun . ourcomments-defstruct-p)
+ (defun . ourcomments-defstruct-slots)
+ (defun . ourcomments-defstruct-file)
+ (defun . ourcomments-member-defstruct)
+ (defun . ourcomments-custom-group-p)
+ (t . describe-custom-group)
+ (defun . describe-custom-group)
+ (t . describe-defstruct)
+ (defun . describe-defstruct)
+ (t . describe-symbol)
+ (defun . describe-symbol)
+ (defun . ourcomments-format-plist)
+ ourcomments-ido-visit-method
+ (t . ourcomments-ido-buffer-other-window)
+ (defun . ourcomments-ido-buffer-other-window)
+ (t . ourcomments-ido-buffer-other-frame)
+ (defun . ourcomments-ido-buffer-other-frame)
+ (t . ourcomments-ido-buffer-raise-frame)
+ (defun . ourcomments-ido-buffer-raise-frame)
+ (defun . ourcomments-ido-mode-advice)
+ ourcomments-ido-adviced ourcomments-ido-old-state
+ (defun . ourcomments-ido-ctrl-tab-activate)
+ ourcomments-ido-ctrl-tab
+ (defun . ourcomments-find-emacs)
+ (t . emacs)
+ (defun . emacs)
+ (t . emacs-buffer-file)
+ (defun . emacs-buffer-file)
+ (t . emacs--debug-init)
+ (defun . emacs--debug-init)
+ (t . emacs-Q)
+ (defun . emacs-Q)
+ (t . emacs-Q-nxhtml)
+ (defun . emacs-Q-nxhtml)
+ (defun . grep-get-buffer-files)
+ grep-query-replace-defaults
+ (t . grep-query-replace)
+ (defun . grep-query-replace)
+ (defun . ldir-query-replace)
+ (defun . rdir-query-replace)
+ (defun . rdir-get-files)
+ (defun . dir-replace-read-parameters)
+ replace-read-files-history
+ (defun . replace-read-files)
+ (t . info-open-file)
+ (defun . info-open-file)
+ (provide . ourcomments-util))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/advice.elc"
+ (provide . advice-preload)
+ (require . advice-preload)
+ ad-version ad-version ad-redefinition-action ad-default-compilation-action
+ (defun . ad-substitute-tree)
+ (defun . ad-copy-tree)
+ (defun . ad-dolist)
+ (defun . ad-do-return)
+ (defun . ad-save-real-definition)
+ (defun . ad-save-real-definitions)
+ ad-advised-functions
+ (defun . ad-pushnew-advised-function)
+ (defun . ad-pop-advised-function)
+ (defun . ad-do-advised-functions)
+ (defun . ad-get-advice-info)
+ (defun . ad-get-advice-info-macro)
+ (defun . ad-set-advice-info)
+ (defun . ad-copy-advice-info)
+ (defun . ad-is-advised)
+ (defun . ad-initialize-advice-info)
+ (defun . ad-get-advice-info-field)
+ (defun . ad-set-advice-info-field)
+ (defun . ad-is-active)
+ (defun . ad-make-advice)
+ (defun . ad-advice-name)
+ (defun . ad-advice-protected)
+ (defun . ad-advice-enabled)
+ (defun . ad-advice-definition)
+ (defun . ad-advice-set-enabled)
+ (defun . ad-class-p)
+ (defun . ad-name-p)
+ (defun . ad-position-p)
+ ad-advice-classes
+ (defun . ad-has-enabled-advice)
+ (defun . ad-has-redefining-advice)
+ (defun . ad-has-any-advice)
+ (defun . ad-get-enabled-advices)
+ (defun . ad-activate-internal)
+ (defun . ad-activate-internal-off)
+ ad-activate-on-top-level
+ (defun . ad-with-auto-activation-disabled)
+ (defun . ad-safe-fset)
+ (defun . ad-make-origname)
+ (defun . ad-get-orig-definition)
+ (defun . ad-set-orig-definition)
+ (defun . ad-clear-orig-definition)
+ (defun . ad-read-advised-function)
+ ad-advice-class-completion-table
+ (defun . ad-read-advice-class)
+ (defun . ad-read-advice-name)
+ (defun . ad-read-advice-specification)
+ ad-last-regexp
+ (defun . ad-read-regexp)
+ (defun . ad-find-advice)
+ (defun . ad-advice-position)
+ (defun . ad-find-some-advice)
+ (defun . ad-enable-advice-internal)
+ (t . ad-enable-advice)
+ (defun . ad-enable-advice)
+ (t . ad-disable-advice)
+ (defun . ad-disable-advice)
+ (defun . ad-enable-regexp-internal)
+ (defun . ad-enable-regexp)
+ (defun . ad-disable-regexp)
+ (defun . ad-remove-advice)
+ (t . ad-add-advice)
+ (defun . ad-add-advice)
+ (defun . ad-macrofy)
+ (defun . ad-lambdafy)
+ (defun . ad-special-form-p)
+ (defun . ad-subr-p)
+ (defun . ad-macro-p)
+ (defun . ad-lambda-p)
+ (defun . ad-advice-p)
+ (defun . ad-compiled-p)
+ (defun . ad-compiled-code)
+ (defun . ad-lambda-expression)
+ (defun . ad-arglist)
+ (defun . ad-define-subr-args)
+ (defun . ad-undefine-subr-args)
+ (defun . ad-subr-args-defined-p)
+ (defun . ad-get-subr-args)
+ (defun . ad-subr-arglist)
+ (defun . ad-docstring)
+ (defun . ad-interactive-form)
+ (defun . ad-body-forms)
+ (defun . ad-make-advised-definition-docstring)
+ (defun . ad-advised-definition-p)
+ (defun . ad-definition-type)
+ (defun . ad-has-proper-definition)
+ (defun . ad-real-definition)
+ (defun . ad-real-orig-definition)
+ (defun . ad-is-compilable)
+ (defun . ad-compile-function)
+ (defun . ad-prognify)
+ (defun . ad-parse-arglist)
+ (defun . ad-retrieve-args-form)
+ (defun . ad-arg-binding-field)
+ (defun . ad-list-access)
+ (defun . ad-element-access)
+ (defun . ad-access-argument)
+ (defun . ad-get-argument)
+ (defun . ad-set-argument)
+ (defun . ad-get-arguments)
+ (defun . ad-set-arguments)
+ (defun . ad-insert-argument-access-forms)
+ (defun . ad-map-arglists)
+ (defun . ad-make-mapped-call)
+ (defun . ad-make-single-advice-docstring)
+ (require . help-fns)
+ (defun . ad-make-advised-docstring)
+ (defun . ad-make-plain-docstring)
+ (defun . ad-make-freeze-docstring)
+ (defun . ad-advised-arglist)
+ (defun . ad-advised-interactive-form)
+ (defun . ad-make-advised-definition)
+ (defun . ad-assemble-advised-definition)
+ (defun . ad-make-hook-form)
+ (defun . ad-get-cache-definition)
+ (defun . ad-get-cache-id)
+ (defun . ad-set-cache)
+ (defun . ad-clear-cache)
+ (defun . ad-make-cache-id)
+ (defun . ad-get-cache-class-id)
+ (defun . ad-verify-cache-class-id)
+ (defun . ad-cache-id-verification-code)
+ (defun . ad-verify-cache-id)
+ (defun . ad-preactivate-advice)
+ (defun . ad-make-freeze-definition)
+ (defun . ad-should-compile)
+ (defun . ad-activate-advised-definition)
+ (defun . ad-handle-definition)
+ (t . ad-activate)
+ (defun . ad-activate)
+ (defun . ad-activate-on)
+ (defun . ad-deactivate)
+ (defun . ad-update)
+ (defun . ad-unadvise)
+ (defun . ad-recover)
+ (defun . ad-activate-regexp)
+ (defun . ad-deactivate-regexp)
+ (defun . ad-update-regexp)
+ (defun . ad-activate-all)
+ (defun . ad-deactivate-all)
+ (defun . ad-update-all)
+ (defun . ad-unadvise-all)
+ (defun . ad-recover-all)
+ ad-defadvice-flags
+ (t . defadvice)
+ (defun . defadvice)
+ (defun . ad-with-originals)
+ (defun . ad-start-advice)
+ (defun . ad-stop-advice)
+ (defun . ad-recover-normality)
+ (provide . advice))
+ ("/usr/share/emacs/23.0.93/lisp/help-fns.elc"
+ (require . help-mode)
+ (t . describe-function)
+ (defun . describe-function)
+ (defun . help-split-fundoc)
+ (defun . help-add-fundoc-usage)
+ (defun . help-function-arglist)
+ (defun . help-make-usage)
+ (t . help-C-file-name)
+ (defun . help-C-file-name)
+ (defface . help-argument-name)
+ (defun . help-default-arg-highlight)
+ (defun . help-do-arg-highlight)
+ (defun . help-highlight-arguments)
+ (t . find-lisp-object-file-name)
+ (defun . find-lisp-object-file-name)
+ (t . describe-function-1)
+ (defun . describe-function-1)
+ (t . variable-at-point)
+ (defun . variable-at-point)
+ (defun . describe-variable-custom-version-info)
+ (t . describe-variable)
+ (defun . describe-variable)
+ (t . describe-syntax)
+ (defun . describe-syntax)
+ (defun . help-describe-category-set)
+ (t . describe-categories)
+ (defun . describe-categories)
+ (provide . help-fns))
+ ("/usr/share/emacs/23.0.93/lisp/help-mode.elc"
+ (require . button)
+ (require . view)
+ help-mode-map help-mode-menu
+ (defun . help-mode-menu)
+ help-xref-stack help-xref-forward-stack help-xref-stack-item help-xref-stack-forward-item help-mode-hook
+ (defun . help-button-action)
+ (t . help-mode)
+ (defun . help-mode)
+ (t . help-mode-setup)
+ (defun . help-mode-setup)
+ (t . help-mode-finish)
+ (defun . help-mode-finish)
+ help-back-label help-forward-label help-xref-symbol-regexp help-xref-mule-regexp help-xref-info-regexp help-xref-url-regexp
+ (t . help-setup-xref)
+ (defun . help-setup-xref)
+ help-xref-following
+ (t . help-buffer)
+ (defun . help-buffer)
+ help-xref-override-view-map
+ (t . help-make-xrefs)
+ (defun . help-make-xrefs)
+ (t . help-xref-button)
+ (defun . help-xref-button)
+ (t . help-insert-xref-button)
+ (defun . help-insert-xref-button)
+ (t . help-xref-on-pp)
+ (defun . help-xref-on-pp)
+ (defun . help-xref-interned)
+ (defun . help-xref-go-back)
+ (defun . help-xref-go-forward)
+ (defun . help-go-back)
+ (defun . help-go-forward)
+ (defun . help-do-xref)
+ (defun . help-follow-mouse)
+ (defun . help-follow)
+ (defun . help-follow-symbol)
+ (defun . help-insert-string)
+ (provide . help-mode))
+ ("/usr/share/emacs/23.0.93/lisp/view.elc" view-highlight-face view-scroll-auto-exit view-try-extend-at-buffer-end view-remove-frame-by-deleting view-exits-all-viewing-windows view-inhibit-help-message view-mode view-mode-hook view-old-buffer-read-only view-page-size view-half-page-size view-last-regexp view-return-to-alist view-exit-action view-no-disable-on-exit view-overlay view-mode-map
+ (t . kill-buffer-if-not-modified)
+ (defun . kill-buffer-if-not-modified)
+ (t . view-file)
+ (defun . view-file)
+ (t . view-file-other-window)
+ (defun . view-file-other-window)
+ (t . view-file-other-frame)
+ (defun . view-file-other-frame)
+ (t . view-buffer)
+ (defun . view-buffer)
+ (t . view-buffer-other-window)
+ (defun . view-buffer-other-window)
+ (t . view-buffer-other-frame)
+ (defun . view-buffer-other-frame)
+ (t . view-mode)
+ (defun . view-mode)
+ (defun . view-mode-enable)
+ (defun . view-mode-disable)
+ (t . view-return-to-alist-update)
+ (defun . view-return-to-alist-update)
+ (t . view-mode-enter)
+ (defun . view-mode-enter)
+ (defun . view-mode-exit)
+ (defun . View-exit)
+ (t . View-exit-and-edit)
+ (defun . View-exit-and-edit)
+ (defun . View-leave)
+ (defun . View-quit)
+ (defun . View-quit-all)
+ (defun . View-kill-and-leave)
+ (defun . view-window-size)
+ (defun . view-recenter)
+ (defun . view-page-size-default)
+ (defun . view-set-half-page-size-default)
+ (defun . View-goto-percent)
+ (defun . View-goto-line)
+ (defun . View-back-to-mark)
+ (defun . view-scroll-lines)
+ (defun . view-really-at-end)
+ (defun . view-end-message)
+ (defun . View-scroll-to-buffer-end)
+ (defun . View-scroll-page-forward)
+ (defun . View-scroll-page-backward)
+ (defun . View-scroll-page-forward-set-page-size)
+ (defun . View-scroll-page-backward-set-page-size)
+ (defun . View-scroll-line-forward)
+ (defun . View-scroll-line-backward)
+ (defun . View-scroll-half-page-forward)
+ (defun . View-scroll-half-page-backward)
+ (defun . View-revert-buffer-scroll-page-forward)
+ (defun . View-search-regexp-forward)
+ (defun . View-search-regexp-backward)
+ (defun . View-search-last-regexp-forward)
+ (defun . View-search-last-regexp-backward)
+ (defun . view-search)
+ (defun . view-search-no-match-lines)
+ (provide . view))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/easy-mmode.elc"
+ (defun . easy-mmode-pretty-mode-name)
+ (defun . easy-mmode-define-minor-mode)
+ (t . define-minor-mode)
+ (defun . define-minor-mode)
+ (defun . easy-mmode-define-global-mode)
+ (defun . define-global-minor-mode)
+ (t . define-globalized-minor-mode)
+ (defun . define-globalized-minor-mode)
+ (defun . easy-mmode-set-keymap-parents)
+ (t . easy-mmode-define-keymap)
+ (defun . easy-mmode-define-keymap)
+ (t . easy-mmode-defmap)
+ (defun . easy-mmode-defmap)
+ (defun . easy-mmode-define-syntax)
+ (t . easy-mmode-defsyntax)
+ (defun . easy-mmode-defsyntax)
+ (defun . easy-mmode-define-navigation)
+ (provide . easy-mmode))
+ ("/usr/share/emacs/23.0.93/lisp/recentf.elc"
+ (require . easymenu)
+ (require . tree-widget)
+ (require . timer)
+ recentf-list
+ (defun . recentf-enabled-p)
+ recentf-max-saved-items recentf-save-file recentf-save-file-modes recentf-exclude
+ (defun . recentf-keep-default-predicate)
+ recentf-keep
+ (defun . recentf-menu-customization-changed)
+ recentf-menu-title recentf-menu-path recentf-menu-before recentf-menu-action recentf-max-menu-items recentf-menu-filter recentf-menu-open-all-flag recentf-menu-append-commands-p recentf-menu-append-commands-flag recentf-auto-cleanup recentf-initialize-file-name-history recentf-load-hook recentf-filename-handlers recentf-show-file-shortcuts-flag recentf-case-fold-search
+ (defun . recentf-string-equal)
+ (defun . recentf-string-lessp)
+ (defun . recentf-string-member)
+ (defun . recentf-trunc-list)
+ (defun . recentf-dump-variable)
+ recentf-auto-cleanup-timer
+ (defun . recentf-auto-cleanup)
+ (defun . recentf-push)
+ (defun . recentf-apply-filename-handlers)
+ (defun . recentf-expand-file-name)
+ (defun . recentf-include-p)
+ (defun . recentf-keep-p)
+ (defun . recentf-add-file)
+ (defun . recentf-remove-if-non-kept)
+ (defun . recentf-directory-compare)
+ (defun . recentf-digit-shortcut-command-name)
+ (defun . recentf-open-most-recent-file-0)
+ (defun . recentf-open-most-recent-file-9)
+ (defun . recentf-open-most-recent-file-8)
+ (defun . recentf-open-most-recent-file-7)
+ (defun . recentf-open-most-recent-file-6)
+ (defun . recentf-open-most-recent-file-5)
+ (defun . recentf-open-most-recent-file-4)
+ (defun . recentf-open-most-recent-file-3)
+ (defun . recentf-open-most-recent-file-2)
+ (defun . recentf-open-most-recent-file-1)
+ recentf--shortcuts-keymap recentf-menu-items-for-commands recentf-menu-filter-commands
+ (defun . recentf-elements)
+ (defun . recentf-make-menu-element)
+ (defun . recentf-menu-element-item)
+ (defun . recentf-menu-element-value)
+ (defun . recentf-set-menu-element-item)
+ (defun . recentf-set-menu-element-value)
+ (defun . recentf-sub-menu-element-p)
+ (defun . recentf-make-default-menu-element)
+ (defun . recentf-menu-elements)
+ (defun . recentf-apply-menu-filter)
+ (defun . recentf-make-menu-items)
+ (defun . recentf-menu-value-shortcut)
+ (defun . recentf-make-menu-item)
+ (defun . recentf-menu-bar)
+ (defun . recentf-show-menu)
+ (defun . recentf-hide-menu)
+ (defun . recentf-sort-ascending)
+ (defun . recentf-sort-descending)
+ (defun . recentf-sort-basenames-ascending)
+ (defun . recentf-sort-basenames-descending)
+ (defun . recentf-sort-directories-ascending)
+ (defun . recentf-sort-directories-descending)
+ (defun . recentf-show-basenames)
+ (defun . recentf-show-basenames-ascending)
+ (defun . recentf-show-basenames-descending)
+ (defun . recentf-relative-filter)
+ recentf-arrange-rules recentf-arrange-by-rule-others recentf-arrange-by-rules-min-items recentf-arrange-by-rule-subfilter
+ (defun . recentf-match-rule)
+ (defun . recentf-arrange-by-rule)
+ (defun . recentf-indirect-mode-rule)
+ (defun . recentf-build-mode-rules)
+ (defun . recentf-arrange-by-mode)
+ (defun . recentf-file-name-nondir)
+ (defun . recentf-dir-rule)
+ (defun . recentf-arrange-by-dir)
+ recentf-filter-changer-current recentf-filter-changer-alist
+ (defun . recentf-filter-changer-select)
+ (defun . recentf-filter-changer)
+ (defun . recentf-track-opened-file)
+ (defun . recentf-track-closed-file)
+ recentf-used-hooks
+ (defun . recentf-cancel-dialog)
+ (defun . recentf-dialog-goto-first)
+ recentf-dialog-mode-map recentf-dialog-mode-map
+ (defun . recentf-dialog-mode)
+ (defun . recentf-dialog)
+ recentf-edit-list
+ (defun . recentf-edit-list-select)
+ (defun . recentf-edit-list-validate)
+ (defun . recentf-edit-list)
+ (defun . recentf-open-files-action)
+ recentf--files-with-key
+ (defun . recentf-show-digit-shortcut-filter)
+ (defun . recentf-open-files-item)
+ (defun . recentf-open-files-items)
+ (defun . recentf-open-files)
+ (defun . recentf-open-more-files)
+ (defun . recentf-open-most-recent-file)
+ recentf-save-file-header recentf-save-file-coding-system
+ (defun . recentf-save-list)
+ (defun . recentf-load-list)
+ (defun . recentf-cleanup)
+ recentf-mode-map recentf-mode
+ (t . recentf-mode)
+ (defun . recentf-mode)
+ (provide . recentf))
+ ("/usr/share/emacs/23.0.93/lisp/tree-widget.elc"
+ (require . wid-edit)
+ tree-widget-image-enable tree-widget-themes-load-path tree-widget-themes-directory tree-widget-theme tree-widget-image-properties-emacs tree-widget-image-properties-xemacs tree-widget-space-width
+ (defun . tree-widget-use-image-p)
+ (defun . tree-widget-create-image)
+ (defun . tree-widget-image-formats)
+ tree-widget--theme
+ (defun . tree-widget-theme-name)
+ (defun . tree-widget-set-parent-theme)
+ (defun . tree-widget-set-theme)
+ (defun . tree-widget--locate-sub-directory)
+ (defun . tree-widget-themes-path)
+ tree-widget--cursors tree-widget--cursors
+ (defun . tree-widget-set-image-properties)
+ (defun . tree-widget-image-properties)
+ (defun . tree-widget-lookup-image)
+ (defun . tree-widget-find-image)
+ (defun . tree-widget-button-click)
+ tree-widget-button-keymap
+ (defun . tree-widget-p)
+ (defun . tree-widget-node)
+ (defun . tree-widget-keep)
+ (defun . tree-widget-children-value-save)
+ tree-widget-before-create-icon-functions
+ (defun . tree-widget-icon-create)
+ (defun . tree-widget-convert-widget)
+ (defun . tree-widget-value-create)
+ (defun . tree-widget-leaf-node-icon-p)
+ (defun . tree-widget-icon-action)
+ (defun . tree-widget-icon-help-echo)
+ tree-widget-after-toggle-functions
+ (defun . tree-widget-action)
+ (defun . tree-widget-help-echo)
+ (defun . tree-widget-expander-p)
+ (provide . tree-widget))
+ ("/usr/share/emacs/23.0.93/lisp/ido.elc"
+ (defun . ido-fractionp)
+ ido-mode ido-everywhere ido-case-fold ido-ignore-buffers ido-ignore-files ido-ignore-extensions ido-show-dot-for-dired ido-file-extensions-order ido-ignore-directories ido-ignore-directories-merge ido-default-file-method ido-default-buffer-method ido-enable-flex-matching ido-enable-regexp ido-enable-prefix ido-enable-dot-prefix ido-confirm-unique-completion ido-cannot-complete-command ido-record-commands ido-max-prospects ido-max-file-prompt-width ido-max-window-height ido-enable-last-directory-history ido-max-work-directory-list ido-work-directory-list-ignore-regexps ido-use-filename-at-point ido-use-url-at-point ido-enable-tramp-completion ido-record-ftp-work-directories ido-merge-ftp-work-directories ido-cache-ftp-work-directory-time ido-slow-ftp-hosts ido-slow-ftp-host-regexps ido-unc-hosts-cache ido-unc-hosts ido-downcase-unc-hosts ido-ignore-unc-host-regexps ido-cache-unc-host-shares-time ido-max-work-file-list ido-work-directory-match-only ido-auto-merge-work-directories-length ido-auto-merge-delay-time ido-auto-merge-inhibit-characters-regexp ido-merged-indicator ido-max-dir-file-cache ido-max-directory-size ido-rotate-file-list-default ido-enter-matching-directory ido-create-new-buffer ido-setup-hook ido-separator ido-decorations ido-use-faces
+ (defface . ido-first-match)
+ (defface . ido-only-match)
+ (defface . ido-subdir)
+ (defface . ido-indicator)
+ (defface . ido-incomplete-regexp)
+ ido-make-file-list-hook ido-make-dir-list-hook ido-make-buffer-list-hook ido-rewrite-file-prompt-functions ido-rewrite-file-prompt-rules ido-completion-buffer ido-completion-buffer-all-completions ido-all-frames ido-minibuffer-setup-hook ido-save-directory-list-file ido-read-file-name-as-directory-commands ido-read-file-name-non-ido ido-before-fallback-functions ido-completion-map ido-common-completion-map ido-file-completion-map ido-file-dir-completion-map ido-buffer-completion-map ido-file-history ido-buffer-history ido-last-directory-list ido-work-directory-list ido-work-file-list ido-dir-file-cache ido-ignore-item-temp-list ido-eoinput ido-common-match-string ido-rescan ido-rotate ido-text ido-text-init ido-input-stack ido-matches ido-report-no-match ido-exit ido-current-directory ido-auto-merge-timer ido-use-mycompletion-depth ido-incomplete-regexp ido-initial-position
+ (defun . ido-active)
+ ido-trace-enable
+ (defun . ido-trace)
+ (defun . ido-toggle-trace)
+ (defun . ido-local-file-exists-p)
+ (defun . ido-unc-hosts)
+ (defun . ido-unc-hosts-net-view)
+ (defun . ido-is-tramp-root)
+ (defun . ido-is-unc-root)
+ (defun . ido-is-unc-host)
+ (defun . ido-is-root-directory)
+ (defun . ido-is-ftp-directory)
+ (defun . ido-is-slow-ftp-host)
+ (defun . ido-time-stamp)
+ (defun . ido-cache-ftp-valid)
+ (defun . ido-cache-unc-valid)
+ (defun . ido-may-cache-directory)
+ (defun . ido-pp)
+ (defun . ido-save-history)
+ (defun . ido-load-history)
+ (defun . ido-wash-history)
+ (defun . ido-kill-emacs-hook)
+ ido-minor-mode-map-entry
+ (t . ido-mode)
+ (defun . ido-mode)
+ (defun . ido-everywhere)
+ (defun . ido-init-completion-maps)
+ (defun . ido-setup-completion-map)
+ (defun . ido-final-slash)
+ (defun . ido-no-final-slash)
+ (defun . ido-nonreadable-directory-p)
+ (defun . ido-directory-too-big-p)
+ (defun . ido-set-current-directory)
+ (defun . ido-set-current-home)
+ (defun . ido-record-command)
+ (defun . ido-make-prompt)
+ (defun . ido-read-internal)
+ (defun . ido-edit-input)
+ (defun . ido-buffer-internal)
+ (defun . ido-record-work-directory)
+ (defun . ido-forget-work-directory)
+ (defun . ido-record-work-file)
+ (defun . ido-expand-directory)
+ (defun . ido-file-internal)
+ (defun . ido-existing-item-p)
+ (defun . ido-set-common-completion)
+ (defun . ido-complete)
+ (defun . ido-complete-space)
+ (defun . ido-undo-merge-work-directory)
+ (defun . ido-magic-forward-char)
+ (defun . ido-magic-backward-char)
+ (defun . ido-magic-delete-char)
+ (defun . ido-toggle-case)
+ (defun . ido-toggle-regexp)
+ (defun . ido-toggle-prefix)
+ (defun . ido-toggle-ignore)
+ (defun . ido-toggle-vc)
+ (defun . ido-toggle-literal)
+ (defun . ido-reread-directory)
+ (defun . ido-exit-minibuffer)
+ (defun . ido-select-text)
+ (defun . ido-fallback-command)
+ (defun . ido-enter-find-file)
+ (defun . ido-enter-switch-buffer)
+ (defun . ido-enter-dired)
+ (defun . ido-enter-insert-buffer)
+ (defun . ido-enter-insert-file)
+ (defun . ido-up-directory)
+ (defun . ido-delete-backward-updir)
+ (defun . ido-delete-backward-word-updir)
+ (defun . ido-get-work-directory)
+ (defun . ido-prev-work-directory)
+ (defun . ido-next-work-directory)
+ (defun . ido-merge-work-directories)
+ (defun . ido-wide-find-file)
+ (defun . ido-wide-find-dir)
+ (defun . ido-wide-find-dir-or-delete-dir)
+ (defun . ido-take-first-match)
+ (defun . ido-push-dir)
+ (defun . ido-push-dir-first)
+ (defun . ido-pop-dir)
+ (defun . ido-wide-find-file-or-pop-dir)
+ (defun . ido-make-directory)
+ (defun . ido-get-work-file)
+ (defun . ido-prev-work-file)
+ (defun . ido-next-work-file)
+ (defun . ido-copy-current-file-name)
+ (defun . ido-copy-current-word)
+ (defun . ido-next-match)
+ (defun . ido-prev-match)
+ (defun . ido-next-match-dir)
+ (defun . ido-prev-match-dir)
+ (defun . ido-restrict-to-matches)
+ (defun . ido-chop)
+ (defun . ido-name)
+ (defun . ido-all-completions)
+ (defun . ido-file-lessp)
+ (defun . ido-file-extension-lessp)
+ (defun . ido-file-extension-aux)
+ (defun . ido-file-extension-order)
+ (defun . ido-sort-merged-list)
+ (defun . ido-wide-find-dirs-or-files)
+ (defun . ido-flatten-merged-list)
+ (defun . ido-make-merged-file-list-1)
+ (defun . ido-make-merged-file-list)
+ (defun . ido-make-buffer-list-1)
+ (defun . ido-make-buffer-list)
+ (defun . ido-make-choice-list)
+ (defun . ido-to-end)
+ (defun . ido-file-name-all-completions-1)
+ (defun . ido-file-name-all-completions)
+ (defun . ido-remove-cached-dir)
+ (defun . ido-make-file-list-1)
+ (defun . ido-make-file-list)
+ (defun . ido-make-dir-list-1)
+ (defun . ido-make-dir-list)
+ (defun . ido-get-buffers-in-frames)
+ (defun . ido-get-bufname)
+ (defun . ido-set-matches-1)
+ (defun . ido-set-matches)
+ (defun . ido-ignore-item-p)
+ (defun . ido-find-common-substring)
+ (defun . ido-word-matching-substring)
+ (defun . ido-makealist)
+ (defun . ido-choose-completion-string)
+ (defun . ido-completion-help)
+ (defun . ido-kill-buffer-at-head)
+ (defun . ido-delete-file-at-head)
+ (defun . ido-visit-buffer)
+ (defun . ido-buffer-window-other-frame)
+ (t . ido-switch-buffer)
+ (defun . ido-switch-buffer)
+ (t . ido-switch-buffer-other-window)
+ (defun . ido-switch-buffer-other-window)
+ (t . ido-display-buffer)
+ (defun . ido-display-buffer)
+ (t . ido-kill-buffer)
+ (defun . ido-kill-buffer)
+ (t . ido-insert-buffer)
+ (defun . ido-insert-buffer)
+ (t . ido-switch-buffer-other-frame)
+ (defun . ido-switch-buffer-other-frame)
+ (t . ido-find-file-in-dir)
+ (defun . ido-find-file-in-dir)
+ (t . ido-find-file)
+ (defun . ido-find-file)
+ (t . ido-find-file-other-window)
+ (defun . ido-find-file-other-window)
+ (t . ido-find-alternate-file)
+ (defun . ido-find-alternate-file)
+ (t . ido-find-file-read-only)
+ (defun . ido-find-file-read-only)
+ (t . ido-find-file-read-only-other-window)
+ (defun . ido-find-file-read-only-other-window)
+ (t . ido-find-file-read-only-other-frame)
+ (defun . ido-find-file-read-only-other-frame)
+ (t . ido-display-file)
+ (defun . ido-display-file)
+ (t . ido-find-file-other-frame)
+ (defun . ido-find-file-other-frame)
+ (t . ido-write-file)
+ (defun . ido-write-file)
+ (t . ido-insert-file)
+ (defun . ido-insert-file)
+ (t . ido-dired)
+ (defun . ido-dired)
+ (defun . ido-list-directory)
+ (defun . ido-initiate-auto-merge)
+ (defun . ido-exhibit)
+ (defun . ido-completions)
+ (defun . ido-minibuffer-setup)
+ (defun . ido-tidy)
+ (defun . ido-summary-buffers-to-end)
+ (t . ido-read-buffer)
+ (defun . ido-read-buffer)
+ (t . ido-read-file-name)
+ (defun . ido-read-file-name)
+ (t . ido-read-directory-name)
+ (defun . ido-read-directory-name)
+ (t . ido-completing-read)
+ (defun . ido-completing-read)
+ (defun . ido-unload-function)
+ (provide . ido))
+ ("/usr/share/emacs/23.0.93/lisp/progmodes/grep.elc"
+ (require . compile)
+ grep-window-height grep-highlight-matches grep-scroll-output grep-command grep-template grep-use-null-device grep-find-command grep-find-template grep-files-aliases grep-find-ignored-directories grep-error-screen-columns grep-setup-hook grep-mode-map grep-mode-tool-bar-map
+ (defun . kill-grep)
+ grep-last-buffer grep-regexp-alist grep-error grep-hit-face grep-error-face grep-match-face grep-context-face grep-mode-font-lock-keywords grep-program find-program xargs-program grep-find-use-xargs grep-history grep-find-history grep-regexp-history grep-files-history grep-host-defaults-alist
+ (t . grep-process-setup)
+ (defun . grep-process-setup)
+ (defun . grep-probe)
+ (t . grep-compute-defaults)
+ (defun . grep-compute-defaults)
+ (defun . grep-tag-default)
+ (defun . grep-default-command)
+ grep-mode-map grep-mode-syntax-table grep-mode-abbrev-table grep-mode-abbrev-table
+ (t . grep-mode)
+ (defun . grep-mode)
+ (t . grep)
+ (defun . grep)
+ (t . grep-find)
+ (defun . grep-find)
+ (defun . find-grep)
+ grep-expand-keywords
+ (defun . grep-expand-template)
+ (defun . grep-read-regexp)
+ (defun . grep-read-files)
+ (t . lgrep)
+ (defun . lgrep)
+ (t . rgrep)
+ (defun . rgrep)
+ (provide . grep))
+ ("/usr/share/emacs/23.0.93/lisp/progmodes/compile.elc"
+ (require . tool-bar)
+ (require . comint)
+ compilation-mode-hook compilation-start-hook compilation-window-height compilation-first-column compilation-parse-errors-filename-function compilation-process-setup-function compilation-buffer-name-function compilation-finish-function compilation-finish-functions compilation-in-progress compilation-error compilation-arguments compilation-error-regexp-alist-alist compilation-error-regexp-alist compilation-directory compilation-directory-matcher compilation-page-delimiter compilation-mode-font-lock-keywords compilation-highlight-regexp compilation-highlight-overlay compilation-error-screen-columns compilation-read-command compilation-ask-about-save compilation-search-path compile-command compilation-disable-input compilation-locs compilation-debug compilation-exit-message-function compilation-environment compile-history
+ (defface . compilation-error)
+ (defface . compilation-warning)
+ (defface . compilation-info)
+ (defface . compilation-line-number)
+ (defface . compilation-column-number)
+ compilation-message-face compilation-error-face compilation-warning-face compilation-info-face compilation-line-face compilation-column-face compilation-enter-directory-face compilation-leave-directory-face compilation-last-buffer compilation-parsing-end compilation-parse-errors-function compilation-error-list compilation-old-error-list compilation-auto-jump-to-first-error compilation-auto-jump-to-next compilation-skip-to-next-location compilation-skip-threshold compilation-skip-visited
+ (defun . compilation-face)
+ (defun . compilation-directory-properties)
+ (defun . compilation-auto-jump)
+ (defun . compilation-error-properties)
+ (defun . compilation-move-to-column)
+ (defun . compilation-internal-error-properties)
+ (defun . compilation-mode-font-lock-keywords)
+ (defun . compilation-read-command)
+ (t . compile)
+ (defun . compile)
+ (defun . recompile)
+ compilation-scroll-output
+ (defun . compilation-buffer-name)
+ (defun . compile-internal)
+ (t . compilation-start)
+ (defun . compilation-start)
+ (defun . compilation-set-window-height)
+ compilation-menu-map compilation-minor-mode-map compilation-shell-minor-mode-map compilation-button-map compilation-mode-map compilation-mode-tool-bar-map
+ (t . compilation-mode)
+ (defun . compilation-mode)
+ (defun . define-compilation-mode)
+ (defun . compilation-revert-buffer)
+ compilation-current-error compilation-messages-start compilation-turn-on-font-lock compilation-turn-on-font-lock
+ (defun . compilation-setup)
+ compilation-shell-minor-mode
+ (t . compilation-shell-minor-mode)
+ (defun . compilation-shell-minor-mode)
+ compilation-minor-mode
+ (t . compilation-minor-mode)
+ (defun . compilation-minor-mode)
+ (defun . compilation-handle-exit)
+ (defun . compilation-sentinel)
+ (defun . compilation-filter)
+ (defun . compilation-buffer-internal-p)
+ (defun . compilation-buffer-p)
+ (defun . compilation-loop)
+ (defun . compilation-next-error)
+ (defun . compilation-previous-error)
+ (defun . compilation-next-file)
+ (defun . compilation-previous-file)
+ (defun . kill-compilation)
+ (defun . compile-mouse-goto-error)
+ (defun . compile-goto-error)
+ (defun . compilation-find-buffer)
+ (t . compilation-next-error-function)
+ (defun . compilation-next-error-function)
+ compilation-gcpro
+ (defun . compilation-fake-loc)
+ compilation-context-lines
+ (defun . compilation-set-window)
+ (defun . compilation-goto-locus)
+ (defun . compilation-goto-locus-delete-o)
+ (defun . compilation-find-file)
+ (defun . compilation-get-file-structure)
+ (defun . compile-buffer-substring)
+ (defun . compilation-compat-error-properties)
+ (defun . compilation-compat-parse-errors)
+ (defun . compilation-forget-errors)
+ (provide . compile))
+ ("/usr/share/emacs/23.0.93/lisp/comint.elc"
+ (require . ring)
+ comint-prompt-regexp comint-prompt-read-only comint-delimiter-argument-list comint-input-autoexpand
+ (defface . comint-highlight-input)
+ (defface . comint-highlight-prompt)
+ comint-input-ignoredups comint-input-ring-file-name comint-scroll-to-bottom-on-input comint-move-point-for-output comint-scroll-to-bottom-on-output comint-scroll-show-maximum-output comint-buffer-maximum-size comint-input-ring-size comint-input-ring-separator comint-input-history-ignore comint-process-echoes comint-password-prompt-regexp comint-get-old-input comint-dynamic-complete-functions comint-input-filter comint-input-filter-functions comint-output-filter-functions comint-input-sender-no-newline comint-input-sender comint-eol-on-send comint-use-prompt-regexp comint-use-prompt-regexp-instead-of-fields comint-mode-hook comint-exec-hook comint-mode-map comint-ptyp comint-input-ring comint-last-input-start comint-last-input-end comint-last-output-start comint-input-ring-index comint-matching-input-from-input-string comint-save-input-ring-index comint-accum-marker comint-stored-incomplete-input comint-mode-map comint-mode-syntax-table comint-mode-abbrev-table comint-mode-abbrev-table
+ (defun . comint-mode)
+ (defun . comint-check-proc)
+ (t . make-comint-in-buffer)
+ (defun . make-comint-in-buffer)
+ (t . make-comint)
+ (defun . make-comint)
+ (t . comint-run)
+ (defun . comint-run)
+ (defun . comint-exec)
+ (defun . comint-exec-1)
+ (defun . comint-insert-input)
+ (defun . comint-read-input-ring)
+ (defun . comint-write-input-ring)
+ (defun . comint-dynamic-list-input-ring-select)
+ (defun . comint-dynamic-list-input-ring)
+ (defun . comint-regexp-arg)
+ (defun . comint-search-arg)
+ (defun . comint-restore-input)
+ (defun . comint-search-start)
+ (defun . comint-previous-input-string)
+ (defun . comint-previous-input)
+ (defun . comint-next-input)
+ (defun . comint-previous-matching-input-string)
+ (defun . comint-previous-matching-input-string-position)
+ (defun . comint-delete-input)
+ (defun . comint-previous-matching-input)
+ (defun . comint-next-matching-input)
+ (defun . comint-previous-matching-input-from-input)
+ (defun . comint-next-matching-input-from-input)
+ (defun . comint-replace-by-expanded-history)
+ (defun . comint-replace-by-expanded-history-before-point)
+ (defun . comint-magic-space)
+ (defun . comint-within-quotes)
+ (defun . comint-how-many-region)
+ (defun . comint-args)
+ (defun . comint-delim-arg)
+ (defun . comint-arguments)
+ (defun . comint-add-to-input-history)
+ (defun . comint-send-input)
+ comint-preoutput-filter-functions comint-inhibit-carriage-motion comint-last-prompt-overlay
+ (defun . comint-snapshot-last-prompt)
+ (defun . comint-carriage-motion)
+ (defun . comint-output-filter)
+ (defun . comint-preinput-scroll-to-bottom)
+ (defun . comint-postoutput-scroll-to-bottom)
+ (defun . comint-truncate-buffer)
+ (defun . comint-strip-ctrl-m)
+ (defun . shell-strip-ctrl-m)
+ (defun . comint-show-maximum-output)
+ (defun . comint-get-old-input-default)
+ (defun . comint-copy-old-input)
+ (defun . comint-skip-prompt)
+ (defun . comint-after-pmark-p)
+ (defun . comint-simple-send)
+ (defun . comint-line-beginning-position)
+ (defun . comint-bol)
+ (defun . comint-read-noecho)
+ (defun . send-invisible)
+ (defun . comint-watch-for-password-prompt)
+ (defun . comint-send-string)
+ (defun . comint-send-region)
+ (defun . comint-delete-output)
+ (defun . comint-kill-output)
+ (defun . comint-write-output)
+ (defun . comint-append-output-to-file)
+ (defun . comint-show-output)
+ (defun . comint-interrupt-subjob)
+ (defun . comint-kill-subjob)
+ (defun . comint-quit-subjob)
+ (defun . comint-stop-subjob)
+ (defun . comint-continue-subjob)
+ (defun . comint-skip-input)
+ (defun . comint-kill-input)
+ (defun . comint-delchar-or-maybe-eof)
+ (defun . comint-send-eof)
+ (defun . comint-backward-matching-input)
+ (defun . comint-forward-matching-input)
+ (defun . comint-next-prompt)
+ (defun . comint-previous-prompt)
+ comint-insert-previous-argument-last-start-pos comint-insert-previous-argument-last-index
+ (defun . comint-insert-previous-argument)
+ (defun . comint-update-fence)
+ (defun . comint-kill-whole-line)
+ (defun . comint-kill-region)
+ (defun . comint-source-default)
+ (defun . comint-check-source)
+ (defun . comint-extract-string)
+ (defun . comint-get-source)
+ (defun . comint-proc-query)
+ comint-completion-autolist comint-completion-addsuffix comint-completion-recexact comint-completion-fignore comint-file-name-prefix comint-file-name-chars comint-file-name-quote-list
+ (defun . comint-directory)
+ (defun . comint-word)
+ (defun . comint-substitute-in-file-name)
+ (defun . comint-match-partial-filename)
+ (defun . comint-quote-filename)
+ (defun . comint-unquote-filename)
+ (defun . comint-dynamic-complete)
+ (defun . comint-dynamic-complete-filename)
+ (defun . comint-dynamic-complete-as-filename)
+ (defun . comint-replace-by-expanded-filename)
+ (defun . comint-dynamic-simple-complete)
+ (defun . comint-dynamic-list-filename-completions)
+ comint-displayed-dynamic-completions comint-dynamic-list-completions-config
+ (defun . comint-dynamic-list-completions)
+ (defun . comint-get-next-from-history)
+ (defun . comint-accumulate)
+ (defun . comint-goto-process-mark)
+ (defun . comint-bol-or-process-mark)
+ (defun . comint-set-process-mark)
+ comint-redirect-verbose comint-redirect-filter-functions comint-redirect-output-buffer comint-redirect-finished-regexp comint-redirect-insert-matching-regexp comint-redirect-echo-input comint-redirect-completed comint-redirect-original-mode-line-process comint-redirect-perform-sanity-check comint-redirect-original-filter-function comint-redirect-subvert-readonly
+ (defun . comint-redirect-setup)
+ (defun . comint-redirect-cleanup)
+ (defun . comint-redirect-remove-redirection)
+ (defun . comint-redirect-filter)
+ (defun . comint-redirect-preoutput-filter)
+ (t . comint-redirect-send-command)
+ (defun . comint-redirect-send-command)
+ (t . comint-redirect-send-command-to-process)
+ (defun . comint-redirect-send-command-to-process)
+ (t . comint-redirect-results-list)
+ (defun . comint-redirect-results-list)
+ (t . comint-redirect-results-list-from-process)
+ (defun . comint-redirect-results-list-from-process)
+ (provide . comint))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/ring.elc"
+ (t . ring-p)
+ (defun . ring-p)
+ (t . make-ring)
+ (defun . make-ring)
+ (defun . ring-insert-at-beginning)
+ (defun . ring-plus1)
+ (defun . ring-minus1)
+ (defun . ring-length)
+ (defun . ring-index)
+ (defun . ring-empty-p)
+ (defun . ring-size)
+ (defun . ring-copy)
+ (defun . ring-insert)
+ (defun . ring-remove)
+ (defun . ring-ref)
+ (defun . ring-elements)
+ (defun . ring-member)
+ (defun . ring-next)
+ (defun . ring-previous)
+ (defun . ring-insert+extend)
+ (defun . ring-remove+insert+extend)
+ (defun . ring-convert-sequence-to-ring)
+ (provide . ring))
+ ("/usr/share/emacs/23.0.93/lisp/apropos.elc"
+ (require . button)
+ apropos-do-all apropos-symbol-face apropos-keybinding-face apropos-label-face apropos-property-face apropos-match-face apropos-sort-by-scores apropos-documentation-sort-by-scores apropos-mode-map apropos-mode-hook apropos-pattern apropos-pattern-quoted apropos-words apropos-all-words apropos-regexp apropos-all-words-regexp apropos-files-scanned apropos-accumulator apropos-item apropos-synonyms
+ (defun . apropos-symbol-button-display-help)
+ (defun . apropos-next-label-button)
+ (defun . apropos-words-to-regexp)
+ (t . apropos-read-pattern)
+ (defun . apropos-read-pattern)
+ (defun . apropos-parse-pattern)
+ (defun . apropos-calc-scores)
+ (defun . apropos-score-str)
+ (defun . apropos-score-doc)
+ (defun . apropos-score-symbol)
+ (defun . apropos-true-hit)
+ (defun . apropos-false-hit-symbol)
+ (defun . apropos-false-hit-str)
+ (defun . apropos-true-hit-doc)
+ apropos-mode-map apropos-mode-syntax-table apropos-mode-abbrev-table apropos-mode-abbrev-table
+ (defun . apropos-mode)
+ apropos-multi-type
+ (t . apropos-variable)
+ (defun . apropos-variable)
+ (defun . command-apropos)
+ (t . apropos-command)
+ (defun . apropos-command)
+ (t . apropos-documentation-property)
+ (defun . apropos-documentation-property)
+ (t . apropos)
+ (defun . apropos)
+ (defun . apropos-library-button)
+ (t . apropos-library)
+ (defun . apropos-library)
+ (defun . apropos-symbols-internal)
+ (t . apropos-value)
+ (defun . apropos-value)
+ (t . apropos-documentation)
+ (defun . apropos-documentation)
+ (defun . apropos-value-internal)
+ (defun . apropos-documentation-internal)
+ (defun . apropos-format-plist)
+ (defun . apropos-documentation-check-doc-file)
+ (defun . apropos-documentation-check-elc-file)
+ (defun . apropos-safe-documentation)
+ apropos-compact-layout
+ (defun . apropos-print)
+ (defun . apropos-macrop)
+ (defun . apropos-print-doc)
+ (defun . apropos-follow)
+ (defun . apropos-describe-plist)
+ (provide . apropos))
+ ("/home/hobbes/nxhtml/util/gimp.el" gimp:version
+ (require . w32-regdat)
+ (defun . gimp-get-remote-command)
+ gimp-remote-command
+ (defun . gimp-get-gimp-exe)
+ gimp-exe gimp-remote-command-list
+ (t . gimp-edit-file)
+ (defun . gimp-edit-file)
+ (t . gimp-edit-buffer)
+ (defun . gimp-edit-buffer)
+ (t . gimp-can-edit)
+ (defun . gimp-can-edit)
+ gimp-point-key-bindings
+ (defun . gimp-add-point-bindings)
+ (provide . gimp))
+ ("/usr/share/emacs/23.0.93/lisp/dired.elc" dired-listing-switches dired-subdir-switches dired-chown-program dired-use-ls-dired dired-chmod-program dired-touch-program dired-ls-F-marks-symlinks dired-trivial-filenames dired-keep-marker-rename dired-keep-marker-copy dired-keep-marker-hardlink dired-keep-marker-symlink dired-dwim-target dired-copy-preserve-time dired-free-space-program dired-free-space-args dired-load-hook dired-mode-hook dired-before-readin-hook dired-after-readin-hook dired-dnd-protocol-alist dired-marker-char dired-del-marker dired-shrink-to-fit dired-flagging-regexp dired-directory dired-actual-switches dired-re-inode-size dired-re-mark dired-re-maybe-mark dired-re-dir dired-re-sym dired-re-exe dired-re-perms dired-re-dot dired-subdir-alist dired-switches-alist dired-move-to-filename-regexp dired-subdir-regexp
+ (defface . dired-header)
+ dired-header-face
+ (defface . dired-mark)
+ dired-mark-face
+ (defface . dired-marked)
+ dired-marked-face
+ (defface . dired-flagged)
+ dired-flagged-face
+ (defface . dired-warning)
+ dired-warning-face
+ (defface . dired-perm-write)
+ dired-perm-write-face
+ (defface . dired-directory)
+ dired-directory-face
+ (defface . dired-symlink)
+ dired-symlink-face
+ (defface . dired-ignored)
+ dired-ignored-face dired-font-lock-keywords
+ (defun . dired-mark-if)
+ (defun . dired-map-over-marks)
+ (defun . dired-get-marked-files)
+ (defun . dired-read-dir-and-switches)
+ (t . dired)
+ (defun . dired)
+ (t . dired-other-window)
+ (defun . dired-other-window)
+ (t . dired-other-frame)
+ (defun . dired-other-frame)
+ (t . dired-noselect)
+ (defun . dired-noselect)
+ (defun . dired-directory-changed-p)
+ (defun . dired-buffer-stale-p)
+ (defun . dired-internal-noselect)
+ dired-buffers
+ (defun . dired-find-buffer-nocreate)
+ (defun . dired-readin)
+ (defun . dired-readin-insert)
+ (defun . dired-align-file)
+ (defun . dired-insert-directory)
+ (defun . dired-insert-set-properties)
+ (defun . dired-revert)
+ (defun . dired-remember-marks)
+ (defun . dired-mark-remembered)
+ (defun . dired-remember-hidden)
+ (defun . dired-insert-old-subdirs)
+ (defun . dired-uncache)
+ dired-mode-map
+ (t . dired-mode)
+ (defun . dired-mode)
+ (defun . dired-summary)
+ (defun . dired-undo)
+ (defun . dired-toggle-read-only)
+ (defun . dired-next-line)
+ (defun . dired-previous-line)
+ (defun . dired-next-dirline)
+ (defun . dired-prev-dirline)
+ (defun . dired-up-directory)
+ (defun . dired-get-file-for-visit)
+ (defun . dired-advertised-find-file)
+ (defun . dired-find-file)
+ (defun . dired-find-alternate-file)
+ (defun . dired-mouse-find-file-other-window)
+ (defun . dired-view-file)
+ (defun . dired-find-file-other-window)
+ (defun . dired-display-file)
+ (defun . dired-get-filename)
+ (defun . dired-string-replace-match)
+ (defun . dired-make-absolute)
+ (defun . dired-make-relative)
+ dired-permission-flags-regexp
+ (defun . dired-move-to-filename)
+ (defun . dired-move-to-end-of-filename)
+ (defun . dired-copy-filename-as-kill)
+ (defun . dired-buffers-for-dir)
+ (defun . dired-glob-regexp)
+ (defun . dired-advertise)
+ (defun . dired-unadvertise)
+ (defun . dired-in-this-tree)
+ (defun . dired-normalize-subdir)
+ (defun . dired-get-subdir)
+ (defun . dired-get-subdir-min)
+ (defun . dired-get-subdir-max)
+ (defun . dired-clear-alist)
+ (defun . dired-subdir-index)
+ (defun . dired-next-subdir)
+ (defun . dired-build-subdir-alist)
+ (defun . dired-alist-add-1)
+ (defun . dired-goto-next-nontrivial-file)
+ (defun . dired-goto-next-file)
+ (defun . dired-goto-file)
+ (defun . dired-initial-position)
+ (defun . dired-current-directory)
+ (defun . dired-subdir-max)
+ dired-recursive-deletes dired-re-no-dot
+ (defun . dired-delete-file)
+ (defun . dired-do-flagged-delete)
+ (defun . dired-do-delete)
+ dired-deletion-confirmer
+ (defun . dired-internal-do-deletions)
+ (defun . dired-fun-in-all-buffers)
+ (defun . dired-delete-entry)
+ (defun . dired-clean-up-after-deletion)
+ (defun . dired-marker-regexp)
+ (defun . dired-plural-s)
+ (defun . dired-mark-prompt)
+ (defun . dired-pop-to-buffer)
+ dired-no-confirm
+ (defun . dired-mark-pop-up)
+ (defun . dired-format-columns-of-files)
+ (defun . dired-repeat-over-lines)
+ (defun . dired-between-files)
+ (defun . dired-next-marked-file)
+ (defun . dired-prev-marked-file)
+ (defun . dired-file-marker)
+ (defun . dired-mark-files-in-region)
+ (defun . dired-mark)
+ (defun . dired-unmark)
+ (defun . dired-flag-file-deletion)
+ (defun . dired-unmark-backward)
+ (defun . dired-toggle-marks)
+ dired-regexp-history
+ (defun . dired-read-regexp)
+ (defun . dired-mark-files-regexp)
+ (defun . dired-mark-files-containing-regexp)
+ (defun . dired-flag-files-regexp)
+ (defun . dired-mark-symlinks)
+ (defun . dired-mark-directories)
+ (defun . dired-mark-executables)
+ (defun . dired-flag-auto-save-files)
+ dired-garbage-files-regexp
+ (defun . dired-flag-garbage-files)
+ (defun . dired-flag-backup-files)
+ (defun . dired-change-marks)
+ (defun . dired-unmark-all-marks)
+ (defun . dired-unmark-all-files)
+ dired-log-buffer
+ (defun . dired-why)
+ (defun . dired-log)
+ (defun . dired-log-summary)
+ dired-ls-sorting-switches dired-sort-by-date-regexp dired-sort-by-name-regexp dired-sort-inhibit
+ (defun . dired-sort-set-modeline)
+ (defun . dired-sort-toggle-or-edit)
+ (defun . dired-sort-toggle)
+ (defun . dired-replace-in-string)
+ (defun . dired-sort-other)
+ dired-subdir-alist-pre-R
+ (defun . dired-sort-R-check)
+ dired-recursive-copies
+ (defun . dired-dnd-popup-notice)
+ (defun . dired-dnd-do-ask-action)
+ (defun . dired-dnd-handle-local-file)
+ (defun . dired-dnd-handle-file)
+ (defun . dired-desktop-buffer-misc-data)
+ (defun . dired-restore-desktop-buffer)
+ (provide . dired))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/regexp-opt.elc"
+ (t . regexp-opt)
+ (defun . regexp-opt)
+ (t . regexp-opt-depth)
+ (defun . regexp-opt-depth)
+ (defun . regexp-opt-group)
+ (defun . regexp-opt-charset)
+ (provide . regexp-opt))
+ ("/usr/share/emacs/23.0.93/lisp/cus-edit.elc"
+ (require . cus-face)
+ (require . wid-edit)
+ (require . cus-load)
+ (require . cus-start)
+ custom-mode-map custom-mode-link-map custom-field-keymap
+ (defun . custom-split-regexp-maybe)
+ (defun . custom-variable-prompt)
+ (defun . custom-menu-filter)
+ custom-prefix-list custom-unlispify-menu-entries custom-unlispify-remove-prefixes
+ (defun . custom-unlispify-menu-entry)
+ custom-unlispify-tag-names
+ (defun . custom-unlispify-tag-name)
+ (defun . custom-prefix-add)
+ custom-guess-name-alist custom-guess-doc-alist
+ (defun . custom-guess-type)
+ custom-browse-sort-alphabetically custom-browse-order-groups custom-browse-only-groups custom-buffer-sort-alphabetically custom-buffer-order-groups custom-menu-sort-alphabetically custom-menu-order-groups
+ (defun . custom-sort-items)
+ custom-commands
+ (defun . Custom-help)
+ custom-reset-menu custom-options
+ (defun . custom-command-apply)
+ (defun . Custom-set)
+ (defun . Custom-save)
+ (defun . custom-reset)
+ (defun . Custom-reset-current)
+ (defun . Custom-reset-saved)
+ custom-reset-standard-variables-list custom-reset-standard-faces-list
+ (defun . custom-reset-standard-save-and-update)
+ (defun . Custom-reset-standard)
+ (defun . custom-prompt-variable)
+ (t . customize-set-value)
+ (defun . customize-set-value)
+ (t . customize-set-variable)
+ (defun . customize-set-variable)
+ (t . customize-save-variable)
+ (defun . customize-save-variable)
+ (t . customize)
+ (defun . customize)
+ (t . customize-mode)
+ (defun . customize-mode)
+ (defun . customize-read-group)
+ (t . customize-group)
+ (defun . customize-group)
+ (t . customize-group-other-window)
+ (defun . customize-group-other-window)
+ (defun . customize-variable)
+ (t . customize-option)
+ (defun . customize-option)
+ (defun . customize-variable-other-window)
+ (t . customize-option-other-window)
+ (defun . customize-option-other-window)
+ customize-changed-options-previous-release customize-package-emacs-version-alist
+ (defun . customize-changed)
+ (t . customize-changed-options)
+ (defun . customize-changed-options)
+ (defun . customize-package-emacs-version)
+ (defun . customize-version-lessp)
+ (t . customize-face)
+ (defun . customize-face)
+ (t . customize-face-other-window)
+ (defun . customize-face-other-window)
+ (defun . customize-customized)
+ (t . customize-unsaved)
+ (defun . customize-unsaved)
+ (t . customize-rogue)
+ (defun . customize-rogue)
+ (t . customize-saved)
+ (defun . customize-saved)
+ (t . customize-apropos)
+ (defun . customize-apropos)
+ (t . customize-apropos-options)
+ (defun . customize-apropos-options)
+ (t . customize-apropos-faces)
+ (defun . customize-apropos-faces)
+ (t . customize-apropos-groups)
+ (defun . customize-apropos-groups)
+ custom-buffer-style custom-buffer-done-kill custom-buffer-indent
+ (defun . custom-get-fresh-buffer)
+ (t . custom-buffer-create)
+ (defun . custom-buffer-create)
+ (t . custom-buffer-create-other-window)
+ (defun . custom-buffer-create-other-window)
+ custom-reset-button-menu custom-buffer-verbose-help
+ (defun . Custom-buffer-done)
+ custom-button custom-button-mouse custom-button-pressed custom-raised-buttons
+ (defun . custom-buffer-create-internal)
+ (t . customize-browse)
+ (defun . customize-browse)
+ (defun . custom-browse-visibility-action)
+ (defun . custom-browse-group-tag-action)
+ (defun . custom-browse-variable-tag-action)
+ (defun . custom-browse-face-tag-action)
+ custom-browse-alist custom-browse-alist
+ (defun . custom-browse-insert-prefix)
+ (defface . custom-invalid)
+ (defface . custom-rogue)
+ (defface . custom-modified)
+ (defface . custom-set)
+ (defface . custom-changed)
+ (defface . custom-themed)
+ (defface . custom-saved)
+ custom-magic-alist custom-magic-show custom-magic-show-hidden custom-magic-show-button
+ (defun . widget-magic-mouse-down-action)
+ (defun . custom-magic-value-create)
+ (defun . custom-magic-reset)
+ (defface . custom-button)
+ (defface . custom-button-mouse)
+ (defface . custom-button-unraised)
+ (defface . custom-button-pressed)
+ (defface . custom-button-pressed-unraised)
+ (defface . custom-documentation)
+ (defface . custom-state)
+ (defface . custom-link)
+ (defun . custom-convert-widget)
+ (defun . custom-notify)
+ (defun . custom-redraw)
+ (defun . custom-redraw-magic)
+ (defun . custom-show)
+ (defun . custom-load-widget)
+ (defun . custom-unloaded-symbol-p)
+ (defun . custom-unloaded-widget-p)
+ (defun . custom-toggle-hide)
+ (defun . custom-toggle-parent)
+ (defun . custom-add-see-also)
+ (defun . custom-add-parent-links)
+ (defface . custom-comment)
+ (defface . custom-comment-tag)
+ (defun . custom-comment-create)
+ (defun . custom-comment-hide)
+ (defun . custom-comment-show)
+ (defun . custom-comment-invisible-p)
+ (defface . custom-variable-tag)
+ (defface . custom-variable-button)
+ custom-variable-default-form
+ (defun . custom-variable-documentation)
+ (defun . custom-variable-type)
+ (defun . custom-variable-value-create)
+ (defun . custom-tag-action)
+ (defun . custom-tag-mouse-down-action)
+ (defun . custom-variable-state-set)
+ (defun . custom-variable-standard-value)
+ custom-variable-menu
+ (defun . custom-variable-action)
+ (defun . custom-variable-edit)
+ (defun . custom-variable-edit-lisp)
+ (defun . custom-variable-set)
+ (defun . custom-variable-mark-to-save)
+ (defun . custom-variable-state-set-and-redraw)
+ (defun . custom-variable-save)
+ (defun . custom-variable-reset-saved)
+ (defun . custom-variable-mark-to-reset-standard)
+ (defun . custom-variable-reset-standard)
+ (defun . custom-variable-backup-value)
+ (defun . custom-variable-reset-backup)
+ (defface . custom-visibility)
+ (defun . custom-face-edit-fix-value)
+ (defun . custom-face-edit-convert-widget)
+ (defun . custom-face-edit-deactivate)
+ (defun . custom-face-edit-activate)
+ (defun . custom-face-edit-delete)
+ (defun . custom-face-edit-attribute-tag)
+ (defface . custom-face-tag)
+ custom-face-default-form custom-face-all
+ (defun . custom-display-unselected-match)
+ custom-face-selected
+ (defun . custom-filter-face-spec)
+ (defun . custom-pre-filter-face-spec)
+ (defun . custom-post-filter-face-spec)
+ (defun . custom-face-value-create)
+ custom-face-menu
+ (defun . custom-face-edit-selected)
+ (defun . custom-face-edit-all)
+ (defun . custom-face-edit-lisp)
+ (defun . custom-face-state-set)
+ (defun . custom-face-action)
+ (defun . custom-face-set)
+ (defun . custom-face-mark-to-save)
+ (defun . custom-face-state-set-and-redraw)
+ (defun . custom-face-save)
+ (defun . custom-face-save-command)
+ (defun . custom-face-reset-saved)
+ (defun . custom-face-standard-value)
+ (defun . custom-face-mark-to-reset-standard)
+ (defun . custom-face-reset-standard)
+ widget-face-prompt-value-history
+ (defun . widget-face-sample-face-get)
+ (defun . widget-face-notify)
+ (defun . custom-hook-convert-widget)
+ (defun . custom-group-link-action)
+ custom-group-tag-faces
+ (defface . custom-group-tag-1)
+ (defface . custom-group-tag)
+ (defun . custom-group-sample-face-get)
+ (defun . custom-group-visibility-create)
+ (defun . custom-group-members)
+ (defun . custom-group-value-create)
+ custom-group-menu
+ (defun . custom-group-action)
+ (defun . custom-group-set)
+ (defun . custom-group-mark-to-save)
+ (defun . custom-group-state-set-and-redraw)
+ (defun . custom-group-save)
+ (defun . custom-group-reset-current)
+ (defun . custom-group-reset-saved)
+ (defun . custom-group-reset-standard)
+ (defun . custom-group-mark-to-reset-standard)
+ (defun . custom-group-state-update)
+ custom-file
+ (defun . custom-file)
+ (t . custom-save-all)
+ (defun . custom-save-all)
+ (t . customize-save-customized)
+ (defun . customize-save-customized)
+ (defun . custom-save-delete)
+ (defun . custom-save-variables)
+ (defun . custom-save-faces)
+ custom-menu-nesting
+ (defun . custom-face-menu-create)
+ (defun . custom-variable-menu-create)
+ (defun . custom-group-menu-create)
+ (t . custom-menu-create)
+ (defun . custom-menu-create)
+ (t . customize-menu-create)
+ (defun . customize-menu-create)
+ Custom-mode-menu
+ (defun . Custom-mode-menu)
+ custom-tool-bar-map
+ (defun . Custom-no-edit)
+ (defun . Custom-newline)
+ (defun . Custom-goto-parent)
+ Custom-mode-hook
+ (defun . custom-state-buffer-message)
+ Custom-mode-map Custom-mode-syntax-table Custom-mode-abbrev-table Custom-mode-abbrev-table
+ (defun . Custom-mode)
+ (defun . custom-mode)
+ custom-mode-hook
+ (provide . cus-edit))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/easymenu.elc" easy-menu-precalculate-equivalent-keybindings
+ (defun . easy-menu-intern)
+ (t . easy-menu-define)
+ (defun . easy-menu-define)
+ (defun . easy-menu-binding)
+ (t . easy-menu-do-define)
+ (defun . easy-menu-do-define)
+ (defun . easy-menu-filter-return)
+ easy-menu-avoid-duplicate-keys
+ (t . easy-menu-create-menu)
+ (defun . easy-menu-create-menu)
+ easy-menu-button-prefix easy-menu-converted-items-table
+ (defun . easy-menu-convert-item)
+ (defun . easy-menu-convert-item-1)
+ (defun . easy-menu-define-key)
+ (defun . easy-menu-name-match)
+ (defun . easy-menu-always-true-p)
+ easy-menu-item-count
+ (defun . easy-menu-make-symbol)
+ (t . easy-menu-change)
+ (defun . easy-menu-change)
+ (defun . easy-menu-remove)
+ (defun . easy-menu-add)
+ (defun . add-submenu)
+ (defun . easy-menu-add-item)
+ (defun . easy-menu-item-present-p)
+ (defun . easy-menu-remove-item)
+ (defun . easy-menu-return-item)
+ (defun . easy-menu-lookup-name)
+ (defun . easy-menu-get-map)
+ (provide . easymenu))
+ ("/usr/share/emacs/23.0.93/lisp/cus-start.elc"
+ (provide . cus-start))
+ ("/usr/share/emacs/23.0.93/lisp/cus-load.el"
+ (defun . custom-put-if-not)
+ custom-versions-load-alist
+ (provide . cus-load))
+ ("/usr/share/emacs/23.0.93/lisp/wid-edit.elc"
+ (defun . widget-event-point)
+ (defun . widget-button-release-event-p)
+ widget-documentation-face
+ (defface . widget-documentation)
+ widget-button-face
+ (defface . widget-button)
+ widget-mouse-face
+ (defface . widget-field)
+ (defface . widget-single-line-field)
+ (defun . widget-princ-to-string)
+ (defun . widget-clear-undo)
+ widget-menu-max-size widget-menu-max-shortcuts widget-menu-minibuffer-flag
+ (defun . widget-choose)
+ (defun . widget-remove-if)
+ widget-field-add-space widget-field-use-before-change
+ (defun . widget-specify-field)
+ (defun . widget-specify-secret)
+ (defun . widget-specify-button)
+ (defun . widget-mouse-help)
+ (defun . widget-specify-sample)
+ (defun . widget-specify-doc)
+ (defun . widget-specify-insert)
+ (defface . widget-inactive)
+ (defun . widget-specify-inactive)
+ (defun . widget-overlay-inactive)
+ (defun . widget-specify-active)
+ (defun . widget-type)
+ (t . widgetp)
+ (defun . widgetp)
+ (defun . widget-get-indirect)
+ (defun . widget-member)
+ (t . widget-value)
+ (defun . widget-value)
+ (defun . widget-value-set)
+ (defun . widget-default-get)
+ (defun . widget-match-inline)
+ (defun . widget-apply-action)
+ (t . widget-prompt-value)
+ (defun . widget-prompt-value)
+ (defun . widget-get-sibling)
+ (defun . widget-map-buttons)
+ widget-image-directory widget-image-enable widget-image-conversion
+ (defun . widget-image-find)
+ widget-button-pressed-face
+ (defun . widget-image-insert)
+ (defun . widget-move-and-invoke)
+ widget-button-prefix widget-button-suffix
+ (t . widget-create)
+ (defun . widget-create)
+ (defun . widget-create-child-and-convert)
+ (defun . widget-create-child)
+ (defun . widget-create-child-value)
+ (t . widget-delete)
+ (defun . widget-delete)
+ (defun . widget-copy)
+ (defun . widget-convert)
+ (t . widget-insert)
+ (defun . widget-insert)
+ (defun . widget-convert-text)
+ (defun . widget-convert-button)
+ (defun . widget-leave-text)
+ (defun . advertised-widget-backward)
+ widget-keymap widget-global-map widget-field-keymap widget-text-keymap
+ (defun . widget-field-activate)
+ (defface . widget-button-pressed)
+ widget-button-click-moves-point
+ (defun . widget-button-click)
+ (defun . widget-button-press)
+ (defun . widget-tabable-at)
+ widget-use-overlay-change
+ (defun . widget-move)
+ (defun . widget-forward)
+ (defun . widget-backward)
+ (defun . widget-beginning-of-line)
+ (defun . widget-end-of-line)
+ (defun . widget-kill-line)
+ widget-complete-field
+ (defun . widget-narrow-to-field)
+ (defun . widget-complete)
+ widget-field-new widget-field-list
+ (defun . widget-at)
+ (t . widget-setup)
+ (defun . widget-setup)
+ widget-field-last widget-field-was
+ (defun . widget-field-at)
+ (defun . widget-field-buffer)
+ (defun . widget-field-start)
+ (defun . widget-field-end)
+ (defun . widget-field-find)
+ (defun . widget-before-change)
+ (defun . widget-add-change)
+ (defun . widget-after-change)
+ (defun . widget-parent-action)
+ (defun . widget-children-value-delete)
+ (defun . widget-children-validate)
+ (defun . widget-child-value-get)
+ (defun . widget-child-value-inline)
+ (defun . widget-child-validate)
+ (defun . widget-type-value-create)
+ (defun . widget-type-default-get)
+ (defun . widget-type-match)
+ (defun . widget-types-copy)
+ (defun . widget-types-convert-widget)
+ (defun . widget-value-convert-widget)
+ (defun . widget-value-value-get)
+ (defun . widget-default-complete)
+ (defun . widget-default-create)
+ (defun . widget-default-format-handler)
+ (defun . widget-default-button-face-get)
+ (defun . widget-default-mouse-face-get)
+ (defun . widget-default-sample-face-get)
+ (defun . widget-default-delete)
+ (defun . widget-default-value-set)
+ (defun . widget-default-value-inline)
+ (defun . widget-default-default-get)
+ (defun . widget-default-menu-tag-get)
+ (defun . widget-default-active)
+ (defun . widget-default-deactivate)
+ (defun . widget-default-action)
+ (defun . widget-default-notify)
+ (defun . widget-default-prompt-value)
+ (defun . widget-docstring)
+ (defun . widget-item-value-create)
+ (defun . widget-item-match)
+ (defun . widget-item-match-inline)
+ (defun . widget-sublist)
+ (defun . widget-item-action)
+ widget-push-button-prefix widget-push-button-suffix
+ (defun . widget-push-button-value-create)
+ widget-link-prefix widget-link-suffix
+ (defun . widget-info-link-action)
+ (defun . widget-url-link-action)
+ (defun . widget-function-link-action)
+ (defun . widget-variable-link-action)
+ (defun . widget-file-link-action)
+ (defun . widget-emacs-library-link-action)
+ (defun . widget-emacs-commentary-link-action)
+ widget-field-history
+ (defun . widget-field-prompt-internal)
+ (defun . widget-field-prompt-value)
+ widget-edit-functions
+ (defun . widget-field-action)
+ (defun . widget-field-validate)
+ (defun . widget-field-value-create)
+ (defun . widget-field-value-delete)
+ (defun . widget-field-value-get)
+ (defun . widget-field-match)
+ (defun . widget-choice-value-create)
+ (defun . widget-choice-default-get)
+ widget-choice-toggle
+ (defun . widget-choice-mouse-down-action)
+ (defun . widget-choice-action)
+ (defun . widget-choice-validate)
+ (defun . widget-choice-match)
+ (defun . widget-choice-match-inline)
+ (defun . widget-toggle-value-create)
+ (defun . widget-toggle-action)
+ (defun . widget-checkbox-action)
+ (defun . widget-checklist-value-create)
+ (defun . widget-checklist-add-item)
+ (defun . widget-checklist-match)
+ (defun . widget-checklist-match-inline)
+ (defun . widget-checklist-match-find)
+ (defun . widget-checklist-match-up)
+ (defun . widget-checklist-value-get)
+ (defun . widget-checklist-validate)
+ (defun . widget-radio-button-notify)
+ (defun . widget-radio-value-create)
+ (defun . widget-radio-add-item)
+ (defun . widget-radio-value-get)
+ (defun . widget-radio-chosen)
+ (defun . widget-radio-value-inline)
+ (defun . widget-radio-value-set)
+ (defun . widget-radio-validate)
+ (defun . widget-radio-action)
+ (defun . widget-insert-button-action)
+ (defun . widget-delete-button-action)
+ (defun . widget-editable-list-format-handler)
+ (defun . widget-editable-list-value-create)
+ (defun . widget-editable-list-value-get)
+ (defun . widget-editable-list-match)
+ (defun . widget-editable-list-match-inline)
+ (defun . widget-editable-list-insert-before)
+ (defun . widget-editable-list-delete-at)
+ (defun . widget-editable-list-entry-create)
+ (defun . widget-group-value-create)
+ (defun . widget-group-default-get)
+ (defun . widget-group-match)
+ (defun . widget-group-match-inline)
+ (defun . widget-visibility-value-create)
+ (defun . widget-documentation-link-action)
+ widget-documentation-links widget-documentation-link-regexp widget-documentation-link-p widget-documentation-link-type
+ (defun . widget-documentation-link-add)
+ (defun . widget-documentation-string-value-create)
+ (defun . widget-documentation-string-action)
+ (defun . widget-add-documentation-string-button)
+ (defun . widget-const-prompt-value)
+ widget-string-prompt-value-history
+ (defun . widget-string-complete)
+ (defun . widget-regexp-match)
+ (defun . widget-regexp-validate)
+ (defun . widget-file-complete)
+ (defun . widget-file-prompt-value)
+ widget-symbol-prompt-value-history
+ (defun . widget-symbol-prompt-internal)
+ widget-function-prompt-value-history widget-variable-prompt-value-history
+ (defun . widget-coding-system-prompt-value)
+ (defun . widget-coding-system-action)
+ widget-key-sequence-prompt-value-history widget-key-sequence-default-value widget-key-sequence-map
+ (defun . widget-key-sequence-read-event)
+ (defun . widget-key-sequence-validate)
+ (defun . widget-key-sequence-value-to-internal)
+ (defun . widget-key-sequence-value-to-external)
+ (defun . widget-sexp-value-to-internal)
+ (defun . widget-sexp-validate)
+ widget-sexp-prompt-value-history
+ (defun . widget-sexp-prompt-value)
+ (defun . widget-restricted-sexp-match)
+ (defun . widget-vector-match)
+ (defun . widget-cons-match)
+ (defun . widget-plist-convert-widget)
+ (defun . widget-plist-convert-option)
+ (defun . widget-alist-convert-widget)
+ (defun . widget-alist-convert-option)
+ (defun . widget-choice-prompt-value)
+ (defun . widget-boolean-prompt-value)
+ (defun . widget-color-complete)
+ (defun . widget-color-sample-face-get)
+ (defun . widget-color-action)
+ (defun . widget-color-notify)
+ (defun . widget-echo-help)
+ (provide . wid-edit))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/cl.elc" cl-optimize-speed cl-optimize-safety custom-print-functions
+ (defun . cl-unload-function)
+ (defun . incf)
+ (defun . decf)
+ (defun . pop)
+ (defun . push)
+ (defun . pushnew)
+ (defun . cl-set-elt)
+ (defun . cl-set-nthcdr)
+ (defun . cl-set-buffer-substring)
+ (defun . cl-set-substring)
+ (defun . cl-map-extents)
+ (defun . cl-block-wrapper)
+ (defun . cl-block-throw)
+ (defun . values)
+ (defun . values-list)
+ (defun . multiple-value-list)
+ (defun . multiple-value-apply)
+ (defun . multiple-value-call)
+ (defun . nth-value)
+ cl-macro-environment cl-old-macroexpand
+ (defun . macroexpand)
+ (defun . cl-macroexpand)
+ cl-compiling-file
+ (defun . cl-compiling-file)
+ cl-proclaims-deferred
+ (defun . proclaim)
+ (defun . declaim)
+ (defun . cl-random-time)
+ *gensym-counter*
+ (defun . floatp-safe)
+ (defun . plusp)
+ (defun . minusp)
+ (defun . oddp)
+ (defun . evenp)
+ *random-state* most-positive-float most-positive-float most-negative-float most-negative-float least-positive-float least-positive-float least-negative-float least-negative-float least-positive-normalized-float least-positive-normalized-float least-negative-normalized-float least-negative-normalized-float float-epsilon float-epsilon float-negative-epsilon float-negative-epsilon
+ (defun . copy-seq)
+ (defun . mapcar*)
+ (defun . svref)
+ (defun . first)
+ (defun . second)
+ (defun . rest)
+ (defun . endp)
+ (defun . third)
+ (defun . fourth)
+ (defun . fifth)
+ (defun . sixth)
+ (defun . seventh)
+ (defun . eighth)
+ (defun . ninth)
+ (defun . tenth)
+ (defun . caaar)
+ (defun . caadr)
+ (defun . cadar)
+ (defun . caddr)
+ (defun . cdaar)
+ (defun . cdadr)
+ (defun . cddar)
+ (defun . cdddr)
+ (defun . caaaar)
+ (defun . caaadr)
+ (defun . caadar)
+ (defun . caaddr)
+ (defun . cadaar)
+ (defun . cadadr)
+ (defun . caddar)
+ (defun . cadddr)
+ (defun . cdaaar)
+ (defun . cdaadr)
+ (defun . cdadar)
+ (defun . cdaddr)
+ (defun . cddaar)
+ (defun . cddadr)
+ (defun . cdddar)
+ (defun . cddddr)
+ (defun . list*)
+ (defun . ldiff)
+ (defun . copy-list)
+ (defun . cl-maclisp-member)
+ (defun . cl-member)
+ (defun . cl-floor)
+ (defun . cl-ceiling)
+ (defun . cl-truncate)
+ (defun . cl-round)
+ (defun . cl-mod)
+ (defun . adjoin)
+ (defun . subst)
+ (defun . cl-do-subst)
+ (defun . acons)
+ (defun . pairlis)
+ (provide . cl-19)
+ (provide . cl)
+ cl-hacked-flag
+ (defun . cl-hack-byte-compiler)
+ (provide . cl))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/cl-loaddefs.el"
+ (autoload . coerce)
+ (autoload . equalp)
+ (autoload . cl-mapcar-many)
+ (autoload . map)
+ (autoload . maplist)
+ (autoload . mapl)
+ (autoload . mapcan)
+ (autoload . mapcon)
+ (autoload . some)
+ (autoload . every)
+ (autoload . notany)
+ (autoload . notevery)
+ (defun . cl-map-keymap)
+ (autoload . cl-map-keymap-recursively)
+ (autoload . cl-map-intervals)
+ (autoload . cl-map-overlays)
+ (autoload . cl-set-frame-visible-p)
+ (autoload . cl-progv-before)
+ (autoload . gcd)
+ (autoload . lcm)
+ (autoload . isqrt)
+ (autoload . floor*)
+ (autoload . ceiling*)
+ (autoload . truncate*)
+ (autoload . round*)
+ (autoload . mod*)
+ (autoload . rem*)
+ (autoload . signum)
+ (autoload . random*)
+ (autoload . make-random-state)
+ (autoload . random-state-p)
+ (autoload . cl-float-limits)
+ (autoload . subseq)
+ (autoload . concatenate)
+ (autoload . revappend)
+ (autoload . nreconc)
+ (autoload . list-length)
+ (autoload . tailp)
+ (autoload . get*)
+ (autoload . getf)
+ (autoload . cl-set-getf)
+ (autoload . cl-do-remf)
+ (autoload . cl-remprop)
+ (defun . remprop)
+ (defun . cl-gethash)
+ (defun . cl-puthash)
+ (defun . cl-remhash)
+ (defun . cl-clrhash)
+ (defun . cl-maphash)
+ (defun . cl-make-hash-table)
+ (defun . cl-hash-table-p)
+ (defun . cl-hash-table-count)
+ (autoload . cl-macroexpand-all)
+ (autoload . cl-prettyexpand)
+ (autoload . gensym)
+ (autoload . gentemp)
+ (autoload . defun*)
+ (autoload . defmacro*)
+ (autoload . function*)
+ (autoload . destructuring-bind)
+ (autoload . eval-when)
+ (autoload . load-time-value)
+ (autoload . case)
+ (autoload . ecase)
+ (autoload . typecase)
+ (autoload . etypecase)
+ (autoload . block)
+ (autoload . return)
+ (autoload . return-from)
+ (autoload . loop)
+ (autoload . do)
+ (autoload . do*)
+ (autoload . dolist)
+ (autoload . dotimes)
+ (autoload . do-symbols)
+ (autoload . do-all-symbols)
+ (autoload . psetq)
+ (autoload . progv)
+ (autoload . flet)
+ (autoload . labels)
+ (autoload . macrolet)
+ (autoload . symbol-macrolet)
+ (autoload . lexical-let)
+ (autoload . lexical-let*)
+ (autoload . multiple-value-bind)
+ (autoload . multiple-value-setq)
+ (autoload . locally)
+ (autoload . the)
+ (autoload . declare)
+ (autoload . define-setf-method)
+ (autoload . defsetf)
+ (autoload . get-setf-method)
+ (autoload . setf)
+ (autoload . psetf)
+ (autoload . cl-do-pop)
+ (autoload . remf)
+ (autoload . shiftf)
+ (autoload . rotatef)
+ (autoload . letf)
+ (autoload . letf*)
+ (autoload . callf)
+ (autoload . callf2)
+ (autoload . define-modify-macro)
+ (autoload . defstruct)
+ (autoload . cl-struct-setf-expander)
+ (autoload . typep)
+ (autoload . check-type)
+ (autoload . assert)
+ (autoload . define-compiler-macro)
+ (autoload . compiler-macroexpand)
+ (autoload . reduce)
+ (autoload . fill)
+ (autoload . replace)
+ (autoload . remove*)
+ (autoload . remove-if)
+ (autoload . remove-if-not)
+ (autoload . delete*)
+ (autoload . delete-if)
+ (autoload . delete-if-not)
+ (autoload . remove-duplicates)
+ (autoload . delete-duplicates)
+ (autoload . substitute)
+ (autoload . substitute-if)
+ (autoload . substitute-if-not)
+ (autoload . nsubstitute)
+ (autoload . nsubstitute-if)
+ (autoload . nsubstitute-if-not)
+ (autoload . find)
+ (autoload . find-if)
+ (autoload . find-if-not)
+ (autoload . position)
+ (autoload . position-if)
+ (autoload . position-if-not)
+ (autoload . count)
+ (autoload . count-if)
+ (autoload . count-if-not)
+ (autoload . mismatch)
+ (autoload . search)
+ (autoload . sort*)
+ (autoload . stable-sort)
+ (autoload . merge)
+ (autoload . member*)
+ (autoload . member-if)
+ (autoload . member-if-not)
+ (autoload . cl-adjoin)
+ (autoload . assoc*)
+ (autoload . assoc-if)
+ (autoload . assoc-if-not)
+ (autoload . rassoc*)
+ (autoload . rassoc-if)
+ (autoload . rassoc-if-not)
+ (autoload . union)
+ (autoload . nunion)
+ (autoload . intersection)
+ (autoload . nintersection)
+ (autoload . set-difference)
+ (autoload . nset-difference)
+ (autoload . set-exclusive-or)
+ (autoload . nset-exclusive-or)
+ (autoload . subsetp)
+ (autoload . subst-if)
+ (autoload . subst-if-not)
+ (autoload . nsubst)
+ (autoload . nsubst-if)
+ (autoload . nsubst-if-not)
+ (autoload . sublis)
+ (autoload . nsublis)
+ (autoload . tree-equal))
+ ("/home/hobbes/nxhtml/nxhtml-loaddefs.el"
+ (autoload . html-site-buffer-or-dired-file-name)
+ (autoload . html-site-set-site)
+ (autoload . html-site-dired-current)
+ (autoload . html-site-find-file)
+ (autoload . html-site-rgrep)
+ (autoload . html-site-query-replace)
+ (autoload . inlimg-mode)
+ (autoload . inlimg-toggle-img-display)
+ (autoload . nxhtml-report-bug)
+ (autoload . nxhtml-edit-with-gimp)
+ (autoload . nxhtml-browse-file)
+ (autoload . nxhtml-browse-region)
+ nxhtml-global-minor-mode
+ (autoload . nxhtml-global-minor-mode)
+ (autoload . nxhtml-mode)
+ (autoload . nxhtml-short-tag-help)
+ (autoload . nxhtml-validation-header-mode)
+ (autoload . nxhtml-mumamo-mode)
+ (autoload . embperl-nxhtml-mumamo-mode)
+ (autoload . django-nxhtml-mumamo-mode)
+ (autoload . genshi-nxhtml-mumamo-mode)
+ (autoload . mjt-nxhtml-mumamo-mode)
+ (autoload . smarty-nxhtml-mumamo-mode)
+ (autoload . jsp-nxhtml-mumamo-mode)
+ (autoload . eruby-nxhtml-mumamo-mode)
+ (autoload . asp-nxhtml-mumamo-mode)
+ (autoload . mako-nxhtml-mumamo-mode)
+ nxml-where-global-mode
+ (autoload . nxml-where-global-mode)
+ (autoload . rngalt-set-validation-header)
+ (autoload . tidy-build-menu)
+ (autoload . xhtml-help-show-css-ref)
+ (autoload . xhtml-help-show-tag-ref)
+ (autoload . csharp-mode)
+ (autoload . django-mode)
+ (autoload . javascript-mode)
+ (autoload . moz-minor-mode)
+ (autoload . inferior-moz-mode)
+ php-file-patterns
+ (autoload . php-mode)
+ (autoload . smarty-mode)
+ (autoload . tt-mode)
+ (autoload . wikipedia-mode)
+ (autoload . wikipedia-draft)
+ (autoload . wikipedia-draft-page)
+ (autoload . wikipedia-draft-buffer)
+ wikipedia-draft-send-archive
+ (autoload . ert-deftest)
+ (autoload . ert-run-tests-interactively)
+ (autoload . nxhtmltest-run-Q)
+ (autoload . nxhtmltest-run-indent)
+ (autoload . nxhtmltest-run)
+ (autoload . appmenu-add)
+ (autoload . as-external-for-xhtml)
+ (autoload . as-external-for-mail)
+ (autoload . as-external-for-wiki)
+ as-external-mode
+ (autoload . as-external-mode)
+ (autoload . chart-complete)
+ (autoload . chart-make-chart)
+ css-color-global-mode
+ (autoload . css-color-global-mode)
+ (autoload . css-color-mode)
+ (autoload . css-palette-mode)
+ css-palette-global-mode
+ (autoload . css-palette-global-mode)
+ (autoload . freemind-show)
+ (autoload . freemind-from-org-mode-node)
+ (autoload . freemind-from-org-mode)
+ (autoload . freemind-from-org-sparse-tree)
+ (autoload . freemind-to-org-mode)
+ (autoload . gimp-edit-file)
+ (autoload . gimp-edit-buffer)
+ (autoload . gimp-can-edit)
+ (autoload . gpl-mode)
+ (autoload . html-write-mode)
+ (autoload . htmlfontify-buffer)
+ (autoload . majmodpri-sort-lists)
+ (autoload . majmodpri-apply)
+ (autoload . majmodpri-apply-priorities)
+ (autoload . mlinks-mode)
+ (autoload . mumamo-mark-for-refontification)
+ (autoload . html-mumamo-mode)
+ (autoload . nxml-mumamo-mode)
+ (autoload . embperl-html-mumamo-mode)
+ (autoload . django-html-mumamo-mode)
+ (autoload . genshi-html-mumamo-mode)
+ (autoload . mjt-html-mumamo-mode)
+ (autoload . smarty-html-mumamo-mode)
+ (autoload . jsp-html-mumamo-mode)
+ (autoload . eruby-mumamo-mode)
+ (autoload . eruby-html-mumamo-mode)
+ (autoload . perl-mumamo-mode)
+ (autoload . cperl-mumamo-mode)
+ (autoload . metapost-mumamo-mode)
+ (autoload . laszlo-nxml-mumamo-mode)
+ (autoload . csound-sgml-mumamo-mode)
+ (autoload . noweb2-mumamo-mode)
+ (autoload . asp-html-mumamo-mode)
+ (autoload . org-mumamo-mode)
+ (autoload . mako-html-mumamo-mode)
+ (autoload . popup-menu-at-point)
+ (autoload . define-toggle)
+ (autoload . unfill-paragraph)
+ (autoload . unfill-region)
+ (autoload . unfill-individual-paragraphs)
+ (autoload . major-or-multi-majorp)
+ (autoload . multi-major-modep)
+ (autoload . major-modep)
+ (autoload . ourcomments-move-beginning-of-line)
+ (autoload . ourcomments-move-end-of-line)
+ (autoload . describe-key-and-map-briefly)
+ wrap-to-fill-left-marg wrap-to-fill-left-marg-modes
+ (autoload . wrap-to-fill-column-mode)
+ better-fringes-mode
+ (autoload . better-fringes-mode)
+ (autoload . find-emacs-other-file)
+ (autoload . ourcomments-ediff-files)
+ (autoload . describe-command)
+ (autoload . describe-custom-group)
+ (autoload . describe-defstruct)
+ (autoload . describe-symbol)
+ (autoload . ourcomments-ido-buffer-other-window)
+ (autoload . ourcomments-ido-buffer-other-frame)
+ (autoload . ourcomments-ido-buffer-raise-frame)
+ ourcomments-ido-ctrl-tab
+ (autoload . emacs)
+ (autoload . emacs-buffer-file)
+ (autoload . emacs--debug-init)
+ (autoload . emacs-Q)
+ (autoload . emacs-Q-nxhtml)
+ (autoload . grep-query-replace)
+ (autoload . info-open-file)
+ (autoload . rnc-mode)
+ (autoload . search-form)
+ sex-mode
+ (autoload . sex-mode)
+ tabkey2-mode
+ (autoload . tabkey2-mode)
+ (autoload . tyda-lookup-word)
+ (autoload . udev-cedet-update)
+ (autoload . udev-ecb-update)
+ (autoload . udev-rinari-update)
+ (autoload . viper-tutorial)
+ (autoload . winsav-put-window-tree)
+ winsav-save-mode
+ (autoload . winsav-save-mode)
+ (autoload . winsav-save-named-config)
+ (autoload . winsav-switch-config)
+ (autoload . resize-windows)
+ (autoload . winsize-balance-siblings)
+ (autoload . winsize-save-window-configuration)
+ (autoload . nxhtmlmaint-start-byte-compilation)
+ (autoload . nxhtmlmaint-byte-uncompile-all))
+ ("/usr/share/emacs/23.0.93/lisp/international/encoded-kb.elc" encoded-kbd-mode-map encoded-kbd-iso2022-esc-map encoded-kbd-iso2022-esc-dollar-map encoded-kbd-iso2022-designation-map encoded-kbd-iso2022-designations encoded-kbd-iso2022-invocations
+ (defun . encoded-kbd-last-key)
+ (defun . encoded-kbd-iso2022-designation)
+ (defun . encoded-kbd-iso2022-single-shift)
+ (defun . encoded-kbd-self-insert-iso2022-7bit)
+ (defun . encoded-kbd-self-insert-iso2022-8bit)
+ (defun . encoded-kbd-self-insert-sjis)
+ (defun . encoded-kbd-self-insert-big5)
+ (defun . encoded-kbd-self-insert-ccl)
+ (defun . encoded-kbd-decode-code-list)
+ (defun . encoded-kbd-self-insert-charset)
+ (defun . encoded-kbd-self-insert-utf-8)
+ (defun . encoded-kbd-setup-keymap)
+ (t . encoded-kbd-setup-display)
+ (defun . encoded-kbd-setup-display)
+ (provide . encoded-kb))
+ ("/usr/share/emacs/23.0.93/leim/leim-list.el"
+ (autoload . ucs-input-activate)
+ (autoload . hangul-input-method-activate))
+ ("/usr/share/emacs/23.0.93/lisp/subdirs.el")
+ ("/usr/share/emacs-snapshot/site-lisp/subdirs.el")
+ ("/usr/share/emacs/23.0.93/lisp/site-init.elc")
+ ("/usr/share/emacs/23.0.93/lisp/tooltip.elc" tooltip-mode
+ (defun . tooltip-mode)
+ tooltip-delay tooltip-short-delay tooltip-recent-seconds tooltip-hide-delay tooltip-x-offset tooltip-y-offset tooltip-frame-parameters
+ (defface . tooltip)
+ tooltip-use-echo-area tooltip-functions tooltip-hook tooltip-timeout-id tooltip-last-mouse-motion-event tooltip-hide-time
+ (defun . tooltip-event-buffer)
+ (defun . tooltip-delay)
+ (defun . tooltip-cancel-delayed-tip)
+ (defun . tooltip-start-delayed-tip)
+ (defun . tooltip-timeout)
+ (defun . tooltip-set-param)
+ (defun . tooltip-show)
+ (defun . tooltip-hide)
+ (defun . tooltip-identifier-from-point)
+ (defun . tooltip-region-active-p)
+ (defun . tooltip-expr-to-print)
+ (defun . tooltip-process-prompt-regexp)
+ (defun . tooltip-strip-prompt)
+ tooltip-help-message tooltip-previous-message
+ (defun . tooltip-show-help-non-mode)
+ (defun . tooltip-show-help)
+ (defun . tooltip-help-tips)
+ (provide . tooltip))
+ ("/usr/share/emacs/23.0.93/lisp/ediff-hook.elc" menu-bar-ediff-misc-menu menu-bar-epatch-menu menu-bar-ediff-merge-menu menu-bar-ediff-menu
+ (provide . ediff-hook))
+ ("/usr/share/emacs/23.0.93/lisp/vc-hooks.elc" vc-ignore-vc-files vc-master-templates vc-header-alist vc-ignore-dir-regexp vc-handled-backends vc-directory-exclusion-list vc-path vc-make-backup-files vc-follow-symlinks vc-display-status vc-consult-headers vc-keep-workfiles vc-mistrust-permissions
+ (defun . vc-mistrust-permissions)
+ vc-stay-local
+ (defun . vc-stay-local-p)
+ (defun . vc-mode)
+ (defun . vc-error-occurred)
+ vc-file-prop-obarray vc-touched-properties
+ (defun . vc-file-setprop)
+ (defun . vc-file-getprop)
+ (defun . vc-file-clearprops)
+ (defun . vc-make-backend-sym)
+ (defun . vc-find-backend-function)
+ (defun . vc-call-backend)
+ (defun . vc-call)
+ (defun . vc-parse-buffer)
+ (defun . vc-insert-file)
+ (defun . vc-find-root)
+ (defun . vc-registered)
+ (defun . vc-backend)
+ (defun . vc-backend-subdirectory-name)
+ (defun . vc-name)
+ (defun . vc-checkout-model)
+ (defun . vc-user-login-name)
+ (defun . vc-state)
+ (defun . vc-up-to-date-p)
+ (defun . vc-default-state-heuristic)
+ (defun . vc-workfile-unchanged-p)
+ (defun . vc-default-workfile-unchanged-p)
+ (defun . vc-working-revision)
+ (defun . vc-workfile-version)
+ (defun . vc-default-working-revision)
+ (defun . vc-default-registered)
+ (defun . vc-possible-master)
+ (defun . vc-check-master-templates)
+ (defun . vc-toggle-read-only)
+ (defun . vc-default-make-version-backups-p)
+ (defun . vc-version-backup-file-name)
+ (defun . vc-delete-automatic-version-backups)
+ (defun . vc-make-version-backup)
+ (defun . vc-before-save)
+ (defun . vc-after-save)
+ vc-menu-entry vc-mode-line-map vc-mode-line-map
+ (defun . vc-mode-line)
+ (defun . vc-default-mode-line-string)
+ (defun . vc-follow-link)
+ (defun . vc-default-find-file-hook)
+ (defun . vc-find-file-hook)
+ (defun . vc-file-not-found-hook)
+ (defun . vc-default-find-file-not-found-hook)
+ (defun . vc-kill-buffer-hook)
+ vc-prefix-map vc-menu-map
+ (defun . vc-menu-map)
+ (defun . vc-menu-map-filter)
+ (defun . vc-default-extra-menu)
+ (provide . vc-hooks))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/float-sup.elc" pi e degrees-to-radians radians-to-degrees
+ (defun . degrees-to-radians)
+ (defun . radians-to-degrees)
+ (provide . lisp-float-type))
+ ("/usr/share/emacs/23.0.93/lisp/term/x-win.elc"
+ (require . frame)
+ (require . mouse)
+ (require . scroll-bar)
+ (require . faces)
+ (require . select)
+ (require . menu-bar)
+ (require . fontset)
+ (require . x-dnd)
+ (defun . x-handle-no-bitmap-icon)
+ (defun . x-handle-parent-id)
+ (defun . x-handle-smid)
+ emacs-save-session-functions
+ (defun . emacs-session-filename)
+ (defun . emacs-session-save)
+ (defun . emacs-session-restore)
+ x-pointer-X-cursor x-pointer-X-cursor x-pointer-arrow x-pointer-arrow x-pointer-based-arrow-down x-pointer-based-arrow-down x-pointer-based-arrow-up x-pointer-based-arrow-up x-pointer-boat x-pointer-boat x-pointer-bogosity x-pointer-bogosity x-pointer-bottom-left-corner x-pointer-bottom-left-corner x-pointer-bottom-right-corner x-pointer-bottom-right-corner x-pointer-bottom-side x-pointer-bottom-side x-pointer-bottom-tee x-pointer-bottom-tee x-pointer-box-spiral x-pointer-box-spiral x-pointer-center-ptr x-pointer-center-ptr x-pointer-circle x-pointer-circle x-pointer-clock x-pointer-clock x-pointer-coffee-mug x-pointer-coffee-mug x-pointer-cross x-pointer-cross x-pointer-cross-reverse x-pointer-cross-reverse x-pointer-crosshair x-pointer-crosshair x-pointer-diamond-cross x-pointer-diamond-cross x-pointer-dot x-pointer-dot x-pointer-dotbox x-pointer-dotbox x-pointer-double-arrow x-pointer-double-arrow x-pointer-draft-large x-pointer-draft-large x-pointer-draft-small x-pointer-draft-small x-pointer-draped-box x-pointer-draped-box x-pointer-exchange x-pointer-exchange x-pointer-fleur x-pointer-fleur x-pointer-gobbler x-pointer-gobbler x-pointer-gumby x-pointer-gumby x-pointer-hand1 x-pointer-hand1 x-pointer-hand2 x-pointer-hand2 x-pointer-heart x-pointer-heart x-pointer-icon x-pointer-icon x-pointer-iron-cross x-pointer-iron-cross x-pointer-left-ptr x-pointer-left-ptr x-pointer-left-side x-pointer-left-side x-pointer-left-tee x-pointer-left-tee x-pointer-leftbutton x-pointer-leftbutton x-pointer-ll-angle x-pointer-ll-angle x-pointer-lr-angle x-pointer-lr-angle x-pointer-man x-pointer-man x-pointer-middlebutton x-pointer-middlebutton x-pointer-mouse x-pointer-mouse x-pointer-pencil x-pointer-pencil x-pointer-pirate x-pointer-pirate x-pointer-plus x-pointer-plus x-pointer-question-arrow x-pointer-question-arrow x-pointer-right-ptr x-pointer-right-ptr x-pointer-right-side x-pointer-right-side x-pointer-right-tee x-pointer-right-tee x-pointer-rightbutton x-pointer-rightbutton x-pointer-rtl-logo x-pointer-rtl-logo x-pointer-sailboat x-pointer-sailboat x-pointer-sb-down-arrow x-pointer-sb-down-arrow x-pointer-sb-h-double-arrow x-pointer-sb-h-double-arrow x-pointer-sb-left-arrow x-pointer-sb-left-arrow x-pointer-sb-right-arrow x-pointer-sb-right-arrow x-pointer-sb-up-arrow x-pointer-sb-up-arrow x-pointer-sb-v-double-arrow x-pointer-sb-v-double-arrow x-pointer-shuttle x-pointer-shuttle x-pointer-sizing x-pointer-sizing x-pointer-spider x-pointer-spider x-pointer-spraycan x-pointer-spraycan x-pointer-star x-pointer-star x-pointer-target x-pointer-target x-pointer-tcross x-pointer-tcross x-pointer-top-left-arrow x-pointer-top-left-arrow x-pointer-top-left-corner x-pointer-top-left-corner x-pointer-top-right-corner x-pointer-top-right-corner x-pointer-top-side x-pointer-top-side x-pointer-top-tee x-pointer-top-tee x-pointer-trek x-pointer-trek x-pointer-ul-angle x-pointer-ul-angle x-pointer-umbrella x-pointer-umbrella x-pointer-ur-angle x-pointer-ur-angle x-pointer-watch x-pointer-watch x-pointer-xterm x-pointer-xterm x-pointer-invisible x-pointer-invisible
+ (defun . xw-defined-colors)
+ x-alternatives-map
+ (defun . x-setup-function-keys)
+ (defun . vendor-specific-keysyms)
+ x-last-selected-text-clipboard x-last-selected-text-primary x-last-selected-text-cut x-last-selected-text-cut-encoded x-last-cut-buffer-coding x-cut-buffer-max x-select-enable-clipboard x-select-enable-primary
+ (defun . x-select-text)
+ x-select-request-type
+ (defun . x-selection-value)
+ (defun . x-cut-buffer-or-selection-value)
+ (defun . x-clipboard-yank)
+ (defun . x-menu-bar-open)
+ (defun . x-win-suspend-error)
+ x-initialized
+ (defun . x-initialize-window-system)
+ x-gtk-stock-map icon-map-list x-gtk-stock-cache x-gtk-stock-cache
+ (defun . x-gtk-map-stock)
+ (provide . x-win))
+ ("/usr/share/emacs/23.0.93/lisp/term/common-win.elc" x-command-line-resources
+ (defun . x-handle-switch)
+ (defun . x-handle-numeric-switch)
+ (defun . x-handle-initial-switch)
+ (defun . x-handle-iconic)
+ (defun . x-handle-xrm-switch)
+ (defun . x-handle-geometry)
+ (defun . x-handle-name-switch)
+ x-display-name
+ (defun . x-handle-display)
+ (defun . x-handle-args)
+ x-colors)
+ ("/usr/share/emacs/23.0.93/lisp/x-dnd.elc"
+ (require . dnd)
+ x-dnd-test-function x-dnd-types-alist x-dnd-known-types x-dnd-current-state x-dnd-empty-state
+ (defun . x-dnd-init-frame)
+ (defun . x-dnd-get-state-cons-for-frame)
+ (defun . x-dnd-get-state-for-frame)
+ (defun . x-dnd-default-test-function)
+ (defun . x-dnd-current-type)
+ (defun . x-dnd-forget-drop)
+ (defun . x-dnd-maybe-call-test-function)
+ (defun . x-dnd-save-state)
+ (defun . x-dnd-handle-moz-url)
+ (defun . x-dnd-insert-utf8-text)
+ (defun . x-dnd-insert-utf16-text)
+ (defun . x-dnd-insert-ctext)
+ (defun . x-dnd-handle-uri-list)
+ (defun . x-dnd-handle-file-name)
+ (defun . x-dnd-choose-type)
+ (defun . x-dnd-drop-data)
+ (defun . x-dnd-handle-drag-n-drop-event)
+ (defun . x-dnd-handle-old-kde)
+ x-dnd-xdnd-to-action
+ (defun . x-dnd-init-xdnd-for-frame)
+ (defun . x-dnd-get-drop-width-height)
+ (defun . x-dnd-get-drop-x-y)
+ (defun . x-dnd-handle-xdnd)
+ (defun . x-dnd-init-motif-for-frame)
+ (defun . x-dnd-get-motif-value)
+ (defun . x-dnd-motif-value-to-list)
+ x-dnd-motif-message-types x-dnd-motif-to-action
+ (defun . x-dnd-handle-motif)
+ (provide . x-dnd))
+ ("/usr/share/emacs/23.0.93/lisp/tool-bar.elc" tool-bar-mode
+ (defun . tool-bar-mode)
+ (t . toggle-tool-bar-mode-from-frame)
+ (defun . toggle-tool-bar-mode-from-frame)
+ tool-bar-map tool-bar-keymap-cache tool-bar-keymap-cache
+ (defun . tool-bar-make-keymap)
+ (defun . tool-bar-make-keymap-1)
+ (t . tool-bar-add-item)
+ (defun . tool-bar-add-item)
+ (t . tool-bar-local-item)
+ (defun . tool-bar-local-item)
+ (t . tool-bar-add-item-from-menu)
+ (defun . tool-bar-add-item-from-menu)
+ (t . tool-bar-local-item-from-menu)
+ (defun . tool-bar-local-item-from-menu)
+ (defun . tool-bar-setup)
+ (provide . tool-bar))
+ ("/usr/share/emacs/23.0.93/lisp/mwheel.elc"
+ (require . custom)
+ (require . timer)
+ (defun . mouse-wheel-change-button)
+ mouse-wheel-down-button mouse-wheel-down-event mouse-wheel-up-button mouse-wheel-up-event mouse-wheel-click-button mouse-wheel-click-event mouse-wheel-inhibit-click-time mouse-wheel-scroll-amount mouse-wheel-progressive-speed mouse-wheel-follow-mouse
+ (defun . mwheel-event-button)
+ (defun . mwheel-event-window)
+ mwheel-inhibit-click-event-timer
+ (defun . mwheel-inhibit-click-timeout)
+ (defun . mwheel-filter-click-events)
+ (defun . mwheel-scroll)
+ mouse-wheel-mode
+ (t . mouse-wheel-mode)
+ (defun . mouse-wheel-mode)
+ (t . mwheel-install)
+ (defun . mwheel-install)
+ (provide . mwheel))
+ ("/usr/share/emacs/23.0.93/lisp/dnd.elc" dnd-protocol-alist dnd-open-remote-file-function dnd-open-file-other-window
+ (defun . dnd-handle-one-url)
+ (defun . dnd-get-local-file-uri)
+ (defun . dnd-get-local-file-name)
+ (defun . dnd-open-local-file)
+ (defun . dnd-open-remote-url)
+ (defun . dnd-open-file)
+ (defun . dnd-insert-text)
+ (provide . dnd))
+ ("/usr/share/emacs/23.0.93/lisp/international/fontset.elc"
+ (defun . setup-default-fontset)
+ (defun . create-default-fontset)
+ (defun . set-font-encoding)
+ x-font-name-charset-alist xlfd-regexp-family-subnum xlfd-regexp-family-subnum xlfd-regexp-weight-subnum xlfd-regexp-weight-subnum xlfd-regexp-slant-subnum xlfd-regexp-slant-subnum xlfd-regexp-swidth-subnum xlfd-regexp-swidth-subnum xlfd-regexp-adstyle-subnum xlfd-regexp-adstyle-subnum xlfd-regexp-pixelsize-subnum xlfd-regexp-pixelsize-subnum xlfd-regexp-pointsize-subnum xlfd-regexp-pointsize-subnum xlfd-regexp-resx-subnum xlfd-regexp-resx-subnum xlfd-regexp-resy-subnum xlfd-regexp-resy-subnum xlfd-regexp-spacing-subnum xlfd-regexp-spacing-subnum xlfd-regexp-avgwidth-subnum xlfd-regexp-avgwidth-subnum xlfd-regexp-registry-subnum xlfd-regexp-registry-subnum xlfd-tight-regexp xlfd-tight-regexp xlfd-style-regexp xlfd-style-regexp xlfd-regexp-numeric-subnums xlfd-regexp-numeric-subnums
+ (defun . x-decompose-font-name)
+ (defun . x-compose-font-name)
+ (defun . x-must-resolve-font-name)
+ (defun . x-complement-fontset-spec)
+ (defun . fontset-name-p)
+ (defun . generate-fontset-menu)
+ (defun . fontset-plain-name)
+ charset-script-alist
+ (defun . create-fontset-from-fontset-spec)
+ (defun . create-fontset-from-ascii-font)
+ standard-fontset-spec
+ (defun . create-fontset-from-x-resource)
+ (provide . fontset))
+ ("/usr/share/emacs/23.0.93/lisp/image.elc" image-type-header-regexps image-type-file-name-regexps image-type-auto-detectable image-load-path
+ (defun . image-load-path-for-library)
+ (defun . image-jpeg-p)
+ (t . image-type-from-data)
+ (defun . image-type-from-data)
+ (t . image-type-from-buffer)
+ (defun . image-type-from-buffer)
+ (t . image-type-from-file-header)
+ (defun . image-type-from-file-header)
+ (t . image-type-from-file-name)
+ (defun . image-type-from-file-name)
+ (t . image-type)
+ (defun . image-type)
+ (t . image-type-available-p)
+ (defun . image-type-available-p)
+ (t . image-type-auto-detected-p)
+ (defun . image-type-auto-detected-p)
+ (t . create-image)
+ (defun . create-image)
+ (t . put-image)
+ (defun . put-image)
+ (t . insert-image)
+ (defun . insert-image)
+ (t . insert-sliced-image)
+ (defun . insert-sliced-image)
+ (t . remove-images)
+ (defun . remove-images)
+ (defun . image-search-load-path)
+ (t . find-image)
+ (defun . find-image)
+ (t . defimage)
+ (defun . defimage)
+ (provide . image))
+ ("/usr/share/emacs/23.0.93/lisp/fringe.elc"
+ (defun . fringe-bitmap-p)
+ fringe-mode-explicit
+ (defun . set-fringe-mode-1)
+ (defun . set-fringe-mode)
+ (defun . fringe-mode-initialize)
+ fringe-mode
+ (defun . fringe-query-style)
+ (defun . fringe-mode)
+ (defun . set-fringe-style)
+ (defun . fringe-columns)
+ (provide . fringe))
+ ("/usr/share/emacs/23.0.93/lisp/buff-menu.elc" Buffer-menu-use-header-line
+ (defface . buffer-menu-buffer)
+ Buffer-menu-buffer+size-width Buffer-menu-mode-width Buffer-menu-use-frame-buffer-list Buffer-menu-sort-column Buffer-menu-buffer-column Buffer-menu-buffer-column Buffer-menu-files-only Buffer-menu-mode-map Buffer-menu-mode-map Buffer-menu-mode-syntax-table Buffer-menu-mode-abbrev-table Buffer-menu-mode-abbrev-table
+ (defun . Buffer-menu-mode)
+ buffer-menu-mode-hook
+ (defun . Buffer-menu-revert-function)
+ (defun . Buffer-menu-toggle-files-only)
+ (defun . Buffer-menu-buffer)
+ (defun . buffer-menu)
+ (defun . buffer-menu-other-window)
+ (defun . Buffer-menu-no-header)
+ (defun . Buffer-menu-mark)
+ (defun . Buffer-menu-unmark)
+ (defun . Buffer-menu-backup-unmark)
+ (defun . Buffer-menu-delete)
+ (defun . Buffer-menu-delete-backwards)
+ (defun . Buffer-menu-save)
+ (defun . Buffer-menu-not-modified)
+ (defun . Buffer-menu-beginning)
+ (defun . Buffer-menu-execute)
+ (defun . Buffer-menu-select)
+ (defun . Buffer-menu-marked-buffers)
+ (defun . Buffer-menu-isearch-buffers)
+ (defun . Buffer-menu-isearch-buffers-regexp)
+ (defun . Buffer-menu-visit-tags-table)
+ (defun . Buffer-menu-1-window)
+ (defun . Buffer-menu-mouse-select)
+ (defun . Buffer-menu-this-window)
+ (defun . Buffer-menu-other-window)
+ (defun . Buffer-menu-switch-other-window)
+ (defun . Buffer-menu-2-window)
+ (defun . Buffer-menu-toggle-read-only)
+ (defun . Buffer-menu-bury)
+ (defun . Buffer-menu-view)
+ (defun . Buffer-menu-view-other-window)
+ (defun . list-buffers)
+ Buffer-menu-short-ellipsis Buffer-menu-short-ellipsis
+ (defun . Buffer-menu-buffer+size)
+ (defun . Buffer-menu-sort)
+ (defun . Buffer-menu-sort-by-column)
+ Buffer-menu-sort-button-map
+ (defun . Buffer-menu-make-sort-button)
+ (defun . list-buffers-noselect))
+ ("/usr/share/emacs/23.0.93/lisp/replace.elc" case-replace query-replace-history query-replace-defaults query-replace-interactive query-replace-from-history-variable query-replace-to-history-variable query-replace-skip-read-only query-replace-show-replacement query-replace-highlight query-replace-lazy-highlight
+ (defface . query-replace)
+ (defun . query-replace-descr)
+ (defun . query-replace-read-from)
+ (defun . query-replace-compile-replacement)
+ (defun . query-replace-read-to)
+ (defun . query-replace-read-args)
+ (defun . query-replace)
+ (defun . query-replace-regexp)
+ (defun . query-replace-regexp-eval)
+ (defun . map-query-replace-regexp)
+ (defun . replace-string)
+ (defun . replace-regexp)
+ regexp-history
+ (defun . read-regexp)
+ (defun . delete-non-matching-lines)
+ (defun . delete-matching-lines)
+ (defun . count-matches)
+ (defun . keep-lines-read-args)
+ (defun . keep-lines)
+ (defun . flush-lines)
+ (defun . how-many)
+ occur-mode-map occur-revert-arguments occur-mode-hook occur-hook occur-mode-find-occurrence-hook
+ (defun . occur-mode)
+ (defun . occur-revert-function)
+ (defun . occur-mode-find-occurrence)
+ (defun . occur-mode-mouse-goto)
+ (defun . occur-mode-goto-occurrence)
+ (defun . occur-mode-goto-occurrence-other-window)
+ (defun . occur-mode-display-occurrence)
+ (defun . occur-find-match)
+ (defun . occur-next)
+ (defun . occur-prev)
+ (defun . occur-next-error)
+ (defface . match)
+ list-matching-lines-default-context-lines
+ (defun . list-matching-lines)
+ list-matching-lines-face list-matching-lines-buffer-name-face occur-excluded-properties
+ (defun . occur-accumulate-lines)
+ (defun . occur-read-primary-args)
+ (defun . occur-rename-buffer)
+ (defun . occur)
+ (defun . multi-occur)
+ (defun . multi-occur-in-matching-buffers)
+ (defun . occur-1)
+ (defun . occur-engine-add-prefix)
+ (defun . occur-engine)
+ (defun . occur-context-lines)
+ query-replace-help query-replace-map multi-query-replace-map
+ (defun . replace-match-string-symbols)
+ (defun . replace-eval-replacement)
+ (defun . replace-quote)
+ (defun . replace-loop-through-replacements)
+ (defun . replace-match-data)
+ (defun . replace-match-maybe-edit)
+ replace-search-function replace-re-search-function
+ (defun . perform-replace)
+ replace-overlay
+ (defun . replace-highlight)
+ (defun . replace-dehighlight))
+ ("/usr/share/emacs/23.0.93/lisp/textmodes/fill.elc" fill-individual-varying-indent colon-double-space fill-paragraph-function fill-paragraph-handle-comment enable-kinsoku
+ (defun . set-fill-prefix)
+ adaptive-fill-mode adaptive-fill-regexp adaptive-fill-first-line-regexp adaptive-fill-function fill-indent-according-to-mode
+ (defun . current-fill-column)
+ (defun . canonically-space-region)
+ (defun . fill-common-string-prefix)
+ (defun . fill-match-adaptive-prefix)
+ (defun . fill-context-prefix)
+ (defun . fill-single-word-nobreak-p)
+ (defun . fill-french-nobreak-p)
+ fill-nobreak-predicate fill-nobreak-invisible
+ (defun . fill-nobreak-p)
+ fill-find-break-point-function-table fill-nospace-between-words-table
+ (defun . fill-find-break-point)
+ (defun . fill-delete-prefix)
+ (defun . fill-delete-newlines)
+ (defun . fill-move-to-break-point)
+ (defun . fill-text-properties-at)
+ (defun . fill-newline)
+ (defun . fill-indent-to-left-margin)
+ (defun . fill-region-as-paragraph)
+ (defun . skip-line-prefix)
+ (defun . fill-minibuffer-function)
+ fill-forward-paragraph-function
+ (defun . fill-forward-paragraph)
+ (defun . fill-paragraph)
+ (defun . fill-comment-paragraph)
+ (defun . fill-region)
+ default-justification
+ (defun . current-justification)
+ (defun . set-justification)
+ (defun . set-justification-none)
+ (defun . set-justification-left)
+ (defun . set-justification-right)
+ (defun . set-justification-full)
+ (defun . set-justification-center)
+ (defun . justify-current-line)
+ (defun . unjustify-current-line)
+ (defun . unjustify-region)
+ (defun . fill-nonuniform-paragraphs)
+ (defun . fill-individual-paragraphs)
+ (defun . fill-individual-paragraphs-prefix)
+ (defun . fill-individual-paragraphs-citation))
+ ("/usr/share/emacs/23.0.93/lisp/textmodes/text-mode.elc" text-mode-hook text-mode-variant text-mode-syntax-table text-mode-map text-mode-map text-mode-syntax-table text-mode-abbrev-table text-mode-abbrev-table
+ (defun . text-mode)
+ paragraph-indent-text-mode-map
+ (defun . paragraph-indent-text-mode)
+ (defun . paragraph-indent-minor-mode)
+ (defun . indented-text-mode)
+ (defun . text-mode-hook-identify)
+ (defun . toggle-text-mode-auto-fill)
+ (defun . center-paragraph)
+ (defun . center-region)
+ (defun . center-line))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/lisp-mode.elc" lisp-mode-abbrev-table lisp-mode-abbrev-table emacs-lisp-mode-syntax-table lisp-mode-syntax-table lisp-imenu-generic-expression lisp-doc-string-elt-property
+ (defun . lisp-font-lock-syntactic-face-function)
+ (defun . lisp-mode-variables)
+ (defun . lisp-outline-level)
+ lisp-mode-shared-map emacs-lisp-mode-map
+ (defun . emacs-lisp-byte-compile)
+ (defun . emacs-lisp-byte-compile-and-load)
+ emacs-lisp-mode-hook lisp-mode-hook lisp-interaction-mode-hook
+ (defun . emacs-lisp-mode)
+ lisp-mode-map
+ (defun . lisp-mode)
+ (defun . lisp-find-tag-default)
+ (defun . common-lisp-mode)
+ (defun . lisp-eval-defun)
+ lisp-interaction-mode-map lisp-interaction-mode-abbrev-table lisp-interaction-mode-map lisp-interaction-mode-syntax-table lisp-interaction-mode-abbrev-table
+ (defun . lisp-interaction-mode)
+ (defun . eval-print-last-sexp)
+ (defun . last-sexp-setup-props)
+ (defun . last-sexp-toggle-display)
+ (defun . prin1-char)
+ (defun . preceding-sexp)
+ (defun . eval-last-sexp-1)
+ (defun . eval-last-sexp-print-value)
+ eval-last-sexp-fake-value
+ (defun . eval-last-sexp)
+ (defun . eval-defun-1)
+ (defun . eval-defun-2)
+ (defun . eval-defun)
+ (defun . lisp-comment-indent)
+ (defun . lisp-mode-auto-fill)
+ lisp-indent-offset lisp-indent-function
+ (defun . lisp-indent-line)
+ (defun . calculate-lisp-indent)
+ (defun . lisp-indent-function)
+ lisp-body-indent
+ (defun . lisp-indent-specform)
+ (defun . lisp-indent-defform)
+ (defun . indent-sexp)
+ (defun . lisp-indent-region)
+ (defun . indent-pp-sexp)
+ emacs-lisp-docstring-fill-column
+ (defun . lisp-fill-paragraph)
+ (defun . indent-code-rigidly)
+ (provide . lisp-mode))
+ ("/usr/share/emacs/23.0.93/lisp/textmodes/paragraphs.elc" use-hard-newlines
+ (defun . use-hard-newlines)
+ paragraph-start paragraph-separate sentence-end-double-space sentence-end-without-period sentence-end-without-space sentence-end sentence-end-base
+ (defun . sentence-end)
+ page-delimiter paragraph-ignore-fill-prefix
+ (defun . forward-paragraph)
+ (defun . backward-paragraph)
+ (defun . mark-paragraph)
+ (defun . kill-paragraph)
+ (defun . backward-kill-paragraph)
+ (defun . transpose-paragraphs)
+ (defun . start-of-paragraph-text)
+ (defun . end-of-paragraph-text)
+ (defun . forward-sentence)
+ (defun . repunctuate-sentences)
+ (defun . backward-sentence)
+ (defun . kill-sentence)
+ (defun . backward-kill-sentence)
+ (defun . mark-end-of-sentence)
+ (defun . transpose-sentences))
+ ("/usr/share/emacs/23.0.93/lisp/register.elc" register-alist
+ (defun . get-register)
+ (defun . set-register)
+ (defun . point-to-register)
+ (defun . window-configuration-to-register)
+ (defun . frame-configuration-to-register)
+ (defun . register-to-point)
+ (defun . jump-to-register)
+ (defun . register-swap-out)
+ (defun . number-to-register)
+ (defun . increment-register)
+ (defun . view-register)
+ (defun . list-registers)
+ (defun . describe-register-1)
+ (defun . insert-register)
+ (defun . copy-to-register)
+ (defun . append-to-register)
+ (defun . prepend-to-register)
+ (defun . copy-rectangle-to-register)
+ (provide . register))
+ ("/usr/share/emacs/23.0.93/lisp/textmodes/page.elc"
+ (defun . forward-page)
+ (defun . backward-page)
+ (defun . mark-page)
+ (defun . narrow-to-page)
+ (defun . count-lines-page)
+ (defun . what-page)
+ (provide . page))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/lisp.elc" defun-prompt-regexp parens-require-spaces forward-sexp-function
+ (defun . forward-sexp)
+ (defun . backward-sexp)
+ (defun . mark-sexp)
+ (defun . forward-list)
+ (defun . backward-list)
+ (defun . down-list)
+ (defun . backward-up-list)
+ (defun . up-list)
+ (defun . kill-sexp)
+ (defun . backward-kill-sexp)
+ (defun . kill-backward-up-list)
+ beginning-of-defun-function
+ (defun . beginning-of-defun)
+ (defun . beginning-of-defun-raw)
+ end-of-defun-function
+ (defun . buffer-end)
+ (defun . end-of-defun)
+ (defun . mark-defun)
+ (defun . narrow-to-defun)
+ insert-pair-alist
+ (defun . insert-pair)
+ (defun . insert-parentheses)
+ (defun . delete-pair)
+ (defun . raise-sexp)
+ (defun . move-past-close-and-reindent)
+ (defun . check-parens)
+ (defun . field-complete)
+ (defun . lisp-complete-symbol))
+ ("/usr/share/emacs/23.0.93/lisp/paths.el"
+ (defun . prune-directory-list)
+ Info-default-directory-list news-directory news-path news-inews-program gnus-default-nntp-server gnus-nntp-service gnus-local-organization rmail-file-name rmail-spool-directory remote-shell-program term-file-prefix abbrev-file-name)
+ ("/usr/share/emacs/23.0.93/lisp/menu-bar.elc" menu-bar-help-menu menu-bar-tools-menu global-buffers-menu-map menu-bar-options-menu menu-bar-edit-menu menu-bar-file-menu menu-bar-files-menu
+ (defun . menu-find-file-existing)
+ menu-bar-last-search-type
+ (defun . nonincremental-repeat-search-forward)
+ (defun . nonincremental-repeat-search-backward)
+ (defun . nonincremental-search-forward)
+ (defun . nonincremental-search-backward)
+ (defun . nonincremental-re-search-forward)
+ (defun . nonincremental-re-search-backward)
+ menu-bar-search-menu menu-bar-i-search-menu menu-bar-replace-menu menu-bar-goto-menu
+ (defun . menu-bar-next-tag-other-window)
+ (defun . menu-bar-next-tag)
+ yank-menu
+ (defun . menu-bar-kill-ring-save)
+ (defun . clipboard-yank)
+ (defun . clipboard-kill-ring-save)
+ (defun . clipboard-kill-region)
+ (defun . menu-bar-enable-clipboard)
+ menu-bar-custom-menu
+ (defun . menu-bar-make-mm-toggle)
+ (defun . menu-bar-make-toggle)
+ (defun . menu-set-font)
+ (defun . menu-bar-options-save)
+ menu-bar-showhide-menu menu-bar-showhide-fringe-menu menu-bar-showhide-fringe-ind-menu
+ (defun . menu-bar-showhide-fringe-ind-customize)
+ (defun . menu-bar-showhide-fringe-ind-mixed)
+ (defun . menu-bar-showhide-fringe-ind-box)
+ (defun . menu-bar-showhide-fringe-ind-right)
+ (defun . menu-bar-showhide-fringe-ind-left)
+ (defun . menu-bar-showhide-fringe-ind-none)
+ (defun . toggle-indicate-empty-lines)
+ (defun . menu-bar-showhide-fringe-menu-customize)
+ (defun . menu-bar-showhide-fringe-menu-customize-reset)
+ (defun . menu-bar-showhide-fringe-menu-customize-right)
+ (defun . menu-bar-showhide-fringe-menu-customize-left)
+ (defun . menu-bar-showhide-fringe-menu-customize-disable)
+ menu-bar-showhide-scroll-bar-menu
+ (defun . menu-bar-right-scroll-bar)
+ (defun . menu-bar-left-scroll-bar)
+ (defun . menu-bar-no-scroll-bar)
+ (defun . toggle-debug-on-quit)
+ (defun . toggle-debug-on-error)
+ (defun . toggle-save-place-globally)
+ (defun . toggle-uniquify-buffer-names)
+ (defun . toggle-case-fold-search)
+ (defun . menu-bar-text-mode-auto-fill)
+ menu-bar-line-wrapping-menu
+ (defun . send-mail-item-name)
+ (defun . read-mail-item-name)
+ menu-bar-games-menu menu-bar-encryption-decryption-menu
+ (defun . menu-bar-read-mail)
+ menu-bar-describe-menu menu-bar-search-documentation-menu
+ (defun . menu-bar-read-lispref)
+ (defun . menu-bar-read-lispintro)
+ (defun . search-emacs-glossary)
+ (defun . emacs-index-search)
+ (defun . elisp-index-search)
+ (defun . debian-emacs-changelog)
+ (defun . debian-emacs-news)
+ (defun . debian-emacs-readme)
+ menu-bar-manuals-menu
+ (defun . menu-bar-help-extra-packages)
+ (defun . help-with-tutorial-spec-language)
+ (defun . menu-bar-menu-frame-live-and-visible-p)
+ (defun . menu-bar-non-minibuffer-window-p)
+ (defun . kill-this-buffer)
+ (defun . kill-this-buffer-enabled-p)
+ (defun . delete-frame-enabled-p)
+ yank-menu-length
+ (defun . menu-bar-update-yank-menu)
+ (defun . menu-bar-select-yank)
+ buffers-menu-max-size buffers-menu-buffer-name-length buffers-menu-show-directories buffers-menu-show-status list-buffers-directory
+ (defun . menu-bar-select-buffer)
+ (defun . menu-bar-select-frame)
+ (defun . menu-bar-update-buffers-1)
+ menu-bar-buffers-menu-command-entries
+ (defun . menu-bar-update-buffers)
+ menu-bar-mode
+ (defun . menu-bar-mode)
+ (defun . toggle-menu-bar-mode-from-frame)
+ (defun . menu-bar-open)
+ (provide . menu-bar))
+ ("/usr/share/emacs/23.0.93/lisp/rfn-eshadow.elc" file-name-shadow-properties-custom-type file-name-shadow-properties-custom-type file-name-shadow-properties file-name-shadow-tty-properties
+ (defface . file-name-shadow)
+ rfn-eshadow-setup-minibuffer-hook rfn-eshadow-update-overlay-hook rfn-eshadow-frobbed-minibufs
+ (defun . rfn-eshadow-setup-minibuffer)
+ (defun . rfn-eshadow-sifn-equal)
+ (defun . rfn-eshadow-update-overlay)
+ file-name-shadow-mode
+ (defun . file-name-shadow-mode)
+ (provide . rfn-eshadow))
+ ("/usr/share/emacs/23.0.93/lisp/isearch.elc" search-exit-option search-slow-window-lines search-slow-speed search-upper-case search-nonincremental-instead search-whitespace-regexp search-invisible isearch-hide-immediately isearch-resume-in-command-history isearch-mode-hook isearch-mode-end-hook isearch-mode-end-hook-quit isearch-message-function isearch-wrap-function isearch-push-state-function isearch-filter-predicate search-ring regexp-search-ring search-ring-max regexp-search-ring-max search-ring-yank-pointer regexp-search-ring-yank-pointer search-ring-update search-highlight
+ (defface . isearch)
+ isearch
+ (defface . isearch-fail)
+ isearch-lazy-highlight lazy-highlight-cleanup isearch-lazy-highlight-cleanup lazy-highlight-initial-delay isearch-lazy-highlight-initial-delay lazy-highlight-interval isearch-lazy-highlight-interval lazy-highlight-max-at-a-time isearch-lazy-highlight-max-at-a-time
+ (defface . lazy-highlight)
+ lazy-highlight-face isearch-lazy-highlight-face isearch-help-map
+ (defun . isearch-help-for-help-internal-doc)
+ (defun . isearch-help-for-help-internal)
+ (defun . isearch-help-for-help)
+ (defun . isearch-describe-bindings)
+ (defun . isearch-describe-key)
+ (defun . isearch-describe-mode)
+ (defun . isearch-mode-help)
+ isearch-mode-map minibuffer-local-isearch-map isearch-forward isearch-regexp isearch-word isearch-hidden isearch-cmds isearch-string isearch-message isearch-message-prefix-add isearch-message-suffix-add isearch-success isearch-error isearch-other-end isearch-wrapped isearch-barrier isearch-just-started isearch-start-hscroll isearch-case-fold-search isearch-last-case-fold-search isearch-original-minibuffer-message-timeout isearch-adjusted isearch-slow-terminal-mode isearch-small-window isearch-opoint isearch-window-configuration isearch-yank-flag isearch-op-fun isearch-recursive-edit isearch-nonincremental isearch-new-forward isearch-opened-overlays isearch-input-method-function isearch-input-method-local-p isearch-mode
+ (defun . isearch-forward)
+ (defun . isearch-forward-regexp)
+ (defun . isearch-forward-word)
+ (defun . isearch-backward)
+ (defun . isearch-backward-regexp)
+ (defun . isearch-mode)
+ (defun . isearch-update)
+ (defun . isearch-done)
+ (defun . isearch-update-ring)
+ (defun . isearch-string-state)
+ (defun . isearch-message-state)
+ (defun . isearch-point-state)
+ (defun . isearch-success-state)
+ (defun . isearch-forward-state)
+ (defun . isearch-other-end-state)
+ (defun . isearch-word-state)
+ (defun . isearch-error-state)
+ (defun . isearch-wrapped-state)
+ (defun . isearch-barrier-state)
+ (defun . isearch-case-fold-search-state)
+ (defun . isearch-pop-fun-state)
+ (defun . isearch-top-state)
+ (defun . isearch-pop-state)
+ (defun . isearch-push-state)
+ (defun . isearch-exit)
+ (defun . isearch-edit-string)
+ (defun . isearch-nonincremental-exit-minibuffer)
+ (defun . isearch-forward-exit-minibuffer)
+ (defun . isearch-reverse-exit-minibuffer)
+ (defun . isearch-cancel)
+ (defun . isearch-abort)
+ (defun . isearch-repeat)
+ (defun . isearch-repeat-forward)
+ (defun . isearch-repeat-backward)
+ (defun . isearch-toggle-regexp)
+ (defun . isearch-toggle-word)
+ (defun . isearch-toggle-case-fold)
+ (defun . isearch-query-replace)
+ (defun . isearch-query-replace-regexp)
+ (defun . isearch-occur)
+ (defun . isearch-highlight-regexp)
+ (defun . isearch-delete-char)
+ (defun . isearch-del-char)
+ (defun . isearch-yank-string)
+ (defun . isearch-yank-kill)
+ (defun . isearch-yank-x-selection)
+ (defun . isearch-mouse-2)
+ (defun . isearch-yank-internal)
+ (defun . isearch-yank-char-in-minibuffer)
+ (defun . isearch-yank-char)
+ (defun . isearch-yank-word-or-char)
+ (defun . isearch-yank-word)
+ (defun . isearch-yank-line)
+ (defun . isearch-search-and-update)
+ (defun . isearch-backslash)
+ (defun . isearch-fallback)
+ (defun . isearch-unread-key-sequence)
+ isearch-allow-scroll
+ (defun . isearch-string-out-of-window)
+ (defun . isearch-back-into-window)
+ (defun . isearch-reread-key-sequence-naturally)
+ (defun . isearch-lookup-scroll-key)
+ (defun . isearch-other-control-char)
+ (defun . isearch-other-meta-char)
+ (defun . isearch-quote-char)
+ (defun . isearch-return-char)
+ (defun . isearch-printing-char)
+ (defun . isearch-process-search-char)
+ (defun . isearch-process-search-string)
+ (defun . isearch-ring-adjust1)
+ (defun . isearch-ring-adjust)
+ (defun . isearch-ring-advance)
+ (defun . isearch-ring-retreat)
+ (defun . isearch-complete1)
+ (defun . isearch-complete)
+ (defun . isearch-complete-edit)
+ (defun . isearch-message)
+ (defun . isearch-message-prefix)
+ (defun . isearch-message-suffix)
+ isearch-search-fun-function
+ (defun . isearch-search-fun)
+ (defun . isearch-search-string)
+ (defun . isearch-search)
+ (defun . isearch-open-overlay-temporary)
+ (defun . isearch-open-necessary-overlays)
+ (defun . isearch-clean-overlays)
+ (defun . isearch-intersects-p)
+ (defun . isearch-close-unnecessary-overlays)
+ (defun . isearch-range-invisible)
+ (defun . isearch-filter-visible)
+ (defun . isearch-no-upper-case-p)
+ (defun . isearch-text-char-description)
+ (defun . isearch-unread)
+ isearch-overlay
+ (defun . isearch-highlight)
+ (defun . isearch-dehighlight)
+ isearch-lazy-highlight-overlays isearch-lazy-highlight-wrapped isearch-lazy-highlight-start-limit isearch-lazy-highlight-end-limit isearch-lazy-highlight-start isearch-lazy-highlight-end isearch-lazy-highlight-timer isearch-lazy-highlight-last-string isearch-lazy-highlight-window isearch-lazy-highlight-window-start isearch-lazy-highlight-window-end isearch-lazy-highlight-case-fold-search isearch-lazy-highlight-regexp isearch-lazy-highlight-space-regexp
+ (defun . lazy-highlight-cleanup)
+ (defun . isearch-lazy-highlight-cleanup)
+ (defun . isearch-lazy-highlight-new-loop)
+ (defun . isearch-lazy-highlight-search)
+ (defun . isearch-lazy-highlight-update)
+ (defun . isearch-resume))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/timer.elc"
+ (defun . timer--triggered)
+ (defun . timer--high-seconds)
+ (defun . timer--low-seconds)
+ (defun . timer--usecs)
+ (defun . timer--repeat-delay)
+ (defun . timer--function)
+ (defun . timer--args)
+ (defun . timer--idle-delay)
+ (defun . timer-create)
+ (defun . timerp)
+ (defun . timer--time)
+ (defun . timer-set-time)
+ (defun . timer-set-idle-time)
+ (defun . timer-next-integral-multiple-of-time)
+ (defun . timer-relative-time)
+ (defun . timer--time-less-p)
+ (defun . timer-inc-time)
+ (defun . timer-set-time-with-usecs)
+ (defun . timer-set-function)
+ (defun . timer--activate)
+ (defun . timer-activate)
+ (defun . timer-activate-when-idle)
+ (defun . disable-timeout)
+ (defun . cancel-timer)
+ (defun . cancel-timer-internal)
+ (defun . cancel-function-timers)
+ timer-event-last timer-event-last-1 timer-event-last-2 timer-max-repeats
+ (defun . timer-until)
+ (defun . timer-event-handler)
+ (defun . timeout-event-p)
+ (defun . run-at-time)
+ (defun . run-with-timer)
+ (defun . add-timeout)
+ (defun . run-with-idle-timer)
+ (defun . with-timeout-handler)
+ with-timeout-timers
+ (defun . with-timeout)
+ (defun . with-timeout-suspend)
+ (defun . with-timeout-unsuspend)
+ (defun . y-or-n-p-with-timeout)
+ timer-duration-words
+ (defun . timer-duration)
+ (provide . timer))
+ ("/usr/share/emacs/23.0.93/lisp/select.elc" selection-coding-system next-selection-coding-system
+ (defun . x-selection)
+ (defun . x-get-selection)
+ (defun . x-get-clipboard)
+ (defun . x-set-selection)
+ (defun . x-valid-simple-selection-p)
+ (defun . x-get-cut-buffer)
+ (defun . x-set-cut-buffer)
+ (defun . xselect-convert-to-string)
+ (defun . xselect-convert-to-length)
+ (defun . xselect-convert-to-targets)
+ (defun . xselect-convert-to-delete)
+ (defun . xselect-convert-to-filename)
+ (defun . xselect-convert-to-charpos)
+ (defun . xselect-convert-to-lineno)
+ (defun . xselect-convert-to-colno)
+ (defun . xselect-convert-to-os)
+ (defun . xselect-convert-to-host)
+ (defun . xselect-convert-to-user)
+ (defun . xselect-convert-to-class)
+ (defun . xselect-convert-to-name)
+ (defun . xselect-convert-to-integer)
+ (defun . xselect-convert-to-atom)
+ (defun . xselect-convert-to-identity)
+ (provide . select))
+ ("/usr/share/emacs/23.0.93/lisp/scroll-bar.elc"
+ (require . mouse)
+ (defun . scroll-bar-event-ratio)
+ (defun . scroll-bar-scale)
+ (defun . scroll-bar-columns)
+ previous-scroll-bar-mode scroll-bar-mode-explicit
+ (defun . set-scroll-bar-mode-1)
+ (defun . set-scroll-bar-mode)
+ scroll-bar-mode
+ (defun . scroll-bar-mode)
+ (defun . toggle-scroll-bar)
+ (defun . toggle-horizontal-scroll-bar)
+ (defun . scroll-bar-set-window-start)
+ (defun . scroll-bar-drag-position)
+ (defun . scroll-bar-maybe-set-window-start)
+ (defun . scroll-bar-drag-1)
+ (defun . scroll-bar-drag)
+ (defun . scroll-bar-scroll-down)
+ (defun . scroll-bar-scroll-up)
+ (defun . scroll-bar-toolkit-scroll)
+ (provide . scroll-bar))
+ ("/usr/share/emacs/23.0.93/lisp/mouse.elc" mouse-yank-at-point mouse-drag-copy-region mouse-1-click-follows-link mouse-1-click-in-non-selected-windows
+ (defun . popup-menu)
+ (defun . minor-mode-menu-from-indicator)
+ (defun . mouse-minor-mode-menu)
+ (defun . mouse-menu-major-mode-map)
+ (defun . mouse-menu-non-singleton)
+ (defun . mouse-menu-bar-map)
+ (defun . mouse-major-mode-menu)
+ (defun . mouse-popup-menubar)
+ (defun . mouse-popup-menubar-stuff)
+ (defun . mouse-minibuffer-check)
+ (defun . mouse-delete-window)
+ (defun . mouse-select-window)
+ (defun . mouse-tear-off-window)
+ (defun . mouse-delete-other-windows)
+ (defun . mouse-split-window-vertically)
+ (defun . mouse-split-window-horizontally)
+ (defun . mouse-drag-window-above)
+ (defun . mouse-drag-move-window-bottom)
+ (defun . mouse-drag-move-window-top)
+ (defun . mouse-drag-mode-line-1)
+ (defun . mouse-drag-mode-line)
+ (defun . mouse-drag-header-line)
+ (defun . mouse-drag-vertical-line-rightward-window)
+ (defun . mouse-drag-vertical-line)
+ (defun . mouse-set-point)
+ mouse-last-region-beg mouse-last-region-end mouse-last-region-tick
+ (defun . mouse-region-match)
+ (defun . mouse-set-region)
+ (defun . mouse-set-region-1)
+ mouse-scroll-delay mouse-scroll-min-lines
+ (defun . mouse-scroll-subr)
+ mouse-drag-overlay mouse-drag-overlay mouse-selection-click-count mouse-selection-click-count-buffer
+ (defun . mouse-drag-region)
+ (defun . mouse-posn-property)
+ (defun . mouse-on-link-p)
+ (defun . mouse-fixup-help-message)
+ (defun . mouse-move-drag-overlay)
+ (defun . mouse-drag-track)
+ (defun . mouse-skip-word)
+ (defun . mouse-start-end)
+ (defun . mouse-set-mark-fast)
+ (defun . mouse-undouble-last-event)
+ mouse-region-delete-keys
+ (defun . mouse-show-mark)
+ (defun . mouse-set-mark)
+ (defun . mouse-kill)
+ (defun . mouse-yank-at-click)
+ (defun . mouse-yank-primary)
+ (defun . mouse-kill-ring-save)
+ mouse-save-then-kill-posn
+ (defun . mouse-save-then-kill-delete-region)
+ (defun . mouse-save-then-kill)
+ mouse-secondary-overlay mouse-secondary-click-count mouse-secondary-start
+ (defun . mouse-start-secondary)
+ (defun . mouse-set-secondary)
+ (defun . mouse-drag-secondary)
+ (defun . mouse-yank-secondary)
+ (defun . mouse-kill-secondary)
+ (defun . mouse-secondary-save-then-kill)
+ mouse-buffer-menu-maxlen mouse-buffer-menu-mode-mult mouse-buffer-menu-mode-groups
+ (defun . mouse-buffer-menu)
+ (defun . mouse-buffer-menu-alist)
+ (defun . mouse-buffer-menu-split)
+ (defun . mouse-choose-completion)
+ (defun . font-menu-add-default)
+ x-fixed-font-alist
+ (defun . mouse-select-font)
+ (defun . mouse-set-font)
+ mouse-appearance-menu-map
+ (defun . mouse-appearance-menu)
+ (provide . mouse)
+ (defun . mldrag-drag-mode-line)
+ (defun . mldrag-drag-vertical-line)
+ (provide . mldrag))
+ ("/usr/share/emacs/23.0.93/lisp/jit-lock.elc" jit-lock-chunk-size jit-lock-stealth-time jit-lock-stealth-nice jit-lock-stealth-load jit-lock-stealth-verbose jit-lock-defer-contextually jit-lock-contextually jit-lock-context-time jit-lock-defer-time jit-lock-mode jit-lock-functions jit-lock-context-unfontify-pos jit-lock-stealth-timer jit-lock-stealth-repeat-timer jit-lock-context-timer jit-lock-defer-timer jit-lock-defer-buffers jit-lock-stealth-buffers
+ (defun . jit-lock-mode)
+ (defun . jit-lock-register)
+ (defun . jit-lock-unregister)
+ (defun . jit-lock-refontify)
+ (defun . jit-lock-function)
+ (defun . jit-lock-fontify-now)
+ (defun . jit-lock-force-redisplay)
+ (defun . jit-lock-stealth-chunk-start)
+ (defun . jit-lock-stealth-fontify)
+ (defun . jit-lock-deferred-fontify)
+ (defun . jit-lock-context-fontify)
+ jit-lock-after-change-extend-region-functions
+ (defun . jit-lock-after-change)
+ (provide . jit-lock))
+ ("/usr/share/emacs/23.0.93/lisp/font-lock.elc"
+ (require . syntax)
+ font-lock-maximum-size font-lock-maximum-decoration font-lock-verbose font-lock-comment-face font-lock-comment-delimiter-face font-lock-string-face font-lock-doc-face font-lock-keyword-face font-lock-builtin-face font-lock-function-name-face font-lock-variable-name-face font-lock-type-face font-lock-constant-face font-lock-warning-face font-lock-negation-char-face font-lock-preprocessor-face font-lock-reference-face font-lock-keywords font-lock-keywords-alist font-lock-removed-keywords-alist font-lock-keywords-only font-lock-keywords-case-fold-search font-lock-syntactically-fontified font-lock-syntactic-face-function font-lock-syntactic-keywords font-lock-syntax-table font-lock-beginning-of-syntax-function font-lock-mark-block-function font-lock-fontify-buffer-function font-lock-unfontify-buffer-function font-lock-fontify-region-function font-lock-unfontify-region-function font-lock-inhibit-thing-lock font-lock-multiline font-lock-fontified
+ (defun . font-lock-mode-internal)
+ (defun . font-lock-add-keywords)
+ (defun . font-lock-update-removed-keyword-alist)
+ (defun . font-lock-remove-keywords)
+ font-lock-support-mode
+ (defun . font-lock-turn-on-thing-lock)
+ (defun . font-lock-turn-off-thing-lock)
+ (defun . font-lock-after-fontify-buffer)
+ (defun . font-lock-after-unfontify-buffer)
+ font-lock-extend-after-change-region-function
+ (defun . font-lock-fontify-buffer)
+ (defun . font-lock-unfontify-buffer)
+ (defun . font-lock-fontify-region)
+ (defun . font-lock-unfontify-region)
+ (defun . font-lock-default-fontify-buffer)
+ (defun . font-lock-default-unfontify-buffer)
+ font-lock-dont-widen font-lock-extend-region-functions
+ (defun . font-lock-extend-region-multiline)
+ (defun . font-lock-extend-region-wholelines)
+ (defun . font-lock-default-fontify-region)
+ font-lock-extra-managed-props
+ (defun . font-lock-default-unfontify-region)
+ (defun . font-lock-after-change-function)
+ (defun . font-lock-extend-jit-lock-region-after-change)
+ (defun . font-lock-fontify-block)
+ (defun . font-lock-prepend-text-property)
+ (defun . font-lock-append-text-property)
+ (defun . font-lock-fillin-text-property)
+ (defun . font-lock-apply-syntactic-highlight)
+ (defun . font-lock-fontify-syntactic-anchored-keywords)
+ (defun . font-lock-fontify-syntactic-keywords-region)
+ font-lock-comment-start-skip font-lock-comment-end-skip
+ (defun . font-lock-fontify-syntactically-region)
+ (defun . font-lock-apply-highlight)
+ (defun . font-lock-fontify-anchored-keywords)
+ (defun . font-lock-fontify-keywords-region)
+ (defun . font-lock-compile-keywords)
+ (defun . font-lock-compile-keyword)
+ (defun . font-lock-eval-keywords)
+ (defun . font-lock-value-in-major-mode)
+ (defun . font-lock-choose-keywords)
+ font-lock-set-defaults
+ (defun . font-lock-set-defaults)
+ (defface . font-lock-comment-face)
+ (defface . font-lock-comment-delimiter-face)
+ (defface . font-lock-string-face)
+ (defface . font-lock-doc-face)
+ (defface . font-lock-keyword-face)
+ (defface . font-lock-builtin-face)
+ (defface . font-lock-function-name-face)
+ (defface . font-lock-variable-name-face)
+ (defface . font-lock-type-face)
+ (defface . font-lock-constant-face)
+ (defface . font-lock-warning-face)
+ (defface . font-lock-negation-char-face)
+ (defface . font-lock-preprocessor-face)
+ (defface . font-lock-regexp-grouping-backslash)
+ (defface . font-lock-regexp-grouping-construct)
+ (defun . font-lock-match-c-style-declaration-item-and-skip-to-next)
+ cpp-font-lock-keywords-source-directives cpp-font-lock-keywords-source-depth cpp-font-lock-keywords lisp-font-lock-keywords-1 lisp-font-lock-keywords-2 lisp-font-lock-keywords
+ (provide . font-lock))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/syntax.elc"
+ (defun . syntax-ppss-depth)
+ (defun . syntax-ppss-toplevel-pos)
+ (defun . syntax-ppss-context)
+ syntax-ppss-max-span syntax-begin-function syntax-ppss-cache syntax-ppss-last
+ (defun . syntax-ppss-after-change-function)
+ (defun . syntax-ppss-flush-cache)
+ syntax-ppss-stats
+ (defun . syntax-ppss-stats)
+ (defun . syntax-ppss)
+ (defun . syntax-ppss-debug)
+ (provide . syntax))
+ ("/usr/share/emacs/23.0.93/lisp/facemenu.elc" facemenu-keybindings facemenu-new-faces-at-end facemenu-unlisted-faces facemenu-listed-faces facemenu-face-menu
+ (defun . facemenu-face-menu)
+ facemenu-foreground-menu
+ (defun . facemenu-foreground-menu)
+ facemenu-background-menu
+ (defun . facemenu-background-menu)
+ (defun . facemenu-enable-faces-p)
+ facemenu-special-menu
+ (defun . facemenu-special-menu)
+ facemenu-justification-menu
+ (defun . facemenu-justification-menu)
+ facemenu-indentation-menu
+ (defun . facemenu-indentation-menu)
+ facemenu-menu
+ (defun . facemenu-menu)
+ facemenu-keymap
+ (defun . facemenu-keymap)
+ facemenu-add-face-function facemenu-end-add-face facemenu-remove-face-function facemenu-color-alist
+ (defun . facemenu-update)
+ (defun . facemenu-set-face)
+ (defun . facemenu-set-foreground)
+ (defun . facemenu-set-background)
+ (defun . facemenu-set-face-from-menu)
+ (defun . facemenu-set-invisible)
+ (defun . facemenu-set-intangible)
+ (defun . facemenu-set-read-only)
+ (defun . facemenu-remove-face-props)
+ (defun . facemenu-remove-all)
+ (defun . facemenu-remove-special)
+ (defun . facemenu-read-color)
+ (defun . list-colors-display)
+ (defun . list-colors-print)
+ (defun . list-colors-duplicates)
+ (defun . facemenu-color-equal)
+ (defun . facemenu-add-face)
+ (defun . facemenu-active-faces)
+ (defun . facemenu-add-new-face)
+ (defun . facemenu-add-new-color)
+ (defun . facemenu-complete-face-list)
+ (defun . facemenu-iterate)
+ (provide . facemenu))
+ ("/usr/share/emacs/23.0.93/lisp/font-core.elc" font-lock-defaults font-lock-defaults-alist font-lock-function font-lock-mode
+ (defun . font-lock-mode)
+ (defun . font-lock-change-mode)
+ (defun . font-lock-defontify)
+ (defun . font-lock-default-function)
+ (defun . turn-on-font-lock)
+ font-lock-global-modes
+ (defun . turn-on-font-lock-if-desired)
+ font-lock-mode-major-mode global-font-lock-mode
+ (defun . global-font-lock-mode)
+ global-font-lock-mode-buffers
+ (defun . global-font-lock-mode-enable-in-buffers)
+ (defun . global-font-lock-mode-check-buffers)
+ (defun . global-font-lock-mode-cmhh)
+ (provide . font-core))
+ ("/usr/share/emacs/23.0.93/lisp/term/tty-colors.elc" color-name-rgb-alist tty-standard-colors tty-color-mode-alist tty-defined-color-alist
+ (defun . tty-color-alist)
+ (defun . tty-modify-color-alist)
+ (defun . tty-register-default-colors)
+ (defun . tty-color-canonicalize)
+ (defun . tty-color-define)
+ (defun . tty-color-clear)
+ (defun . tty-color-off-gray-diag)
+ (defun . tty-color-approximate)
+ (defun . tty-color-standard-values)
+ (defun . tty-color-translate)
+ (defun . tty-color-by-index)
+ (defun . tty-color-values)
+ (defun . tty-color-desc)
+ (defun . tty-color-gray-shades))
+ ("/usr/share/emacs/23.0.93/lisp/frame.elc" frame-creation-function-alist window-system-default-frame-alist initial-frame-alist minibuffer-frame-alist pop-up-frame-alist pop-up-frame-function special-display-frame-alist
+ (defun . special-display-popup-frame)
+ (defun . handle-delete-frame)
+ frame-initial-frame frame-initial-geometry-arguments
+ (defun . frame-initialize)
+ frame-notice-user-settings
+ (defun . frame-notice-user-settings)
+ (defun . make-initial-minibuffer-frame)
+ (defun . modify-all-frames-parameters)
+ (defun . get-other-frame)
+ (defun . next-multiframe-window)
+ (defun . previous-multiframe-window)
+ (defun . make-frame-on-display)
+ (defun . close-display-connection)
+ (defun . make-frame-command)
+ before-make-frame-hook after-make-frame-functions after-setting-font-hook
+ (defun . new-frame)
+ frame-inherited-parameters
+ (defun . make-frame)
+ (defun . filtered-frame-list)
+ (defun . minibuffer-frame-list)
+ (defun . get-device-terminal)
+ (defun . frames-on-display-list)
+ (defun . framep-on-display)
+ (defun . frame-remove-geometry-params)
+ (defun . select-frame-set-input-focus)
+ (defun . other-frame)
+ (defun . iconify-or-deiconify-frame)
+ (defun . suspend-frame)
+ (defun . make-frame-names-alist)
+ frame-name-history
+ (defun . select-frame-by-name)
+ (defun . current-frame-configuration)
+ (defun . set-frame-configuration)
+ (defun . frame-height)
+ (defun . frame-width)
+ (defun . set-default-font)
+ (defun . set-frame-font)
+ (defun . set-frame-parameter)
+ (defun . set-background-color)
+ (defun . set-foreground-color)
+ (defun . set-cursor-color)
+ (defun . set-mouse-color)
+ (defun . set-border-color)
+ (defun . auto-raise-mode)
+ (defun . auto-lower-mode)
+ (defun . set-frame-name)
+ (defun . frame-current-scroll-bars)
+ (defun . selected-terminal)
+ (defun . display-mouse-p)
+ (defun . display-popup-menus-p)
+ (defun . display-graphic-p)
+ (defun . display-images-p)
+ (defun . display-multi-frame-p)
+ (defun . display-multi-font-p)
+ (defun . display-selections-p)
+ (defun . display-screens)
+ (defun . display-pixel-height)
+ (defun . display-pixel-width)
+ display-mm-dimensions-alist
+ (defun . display-mm-height)
+ (defun . display-mm-width)
+ (defun . display-backing-store)
+ (defun . display-save-under)
+ (defun . display-planes)
+ (defun . display-color-cells)
+ (defun . display-visual-class)
+ (defun . frame-geom-value-cons)
+ (defun . frame-geom-spec-cons)
+ (defun . screen-height)
+ (defun . screen-width)
+ (defun . set-screen-width)
+ (defun . set-screen-height)
+ (defun . delete-other-frames)
+ delete-frame-hook show-trailing-whitespace auto-hscroll-mode automatic-hscrolling blink-cursor-delay blink-cursor-interval blink-cursor-idle-timer blink-cursor-timer
+ (defun . blink-cursor-start)
+ (defun . blink-cursor-timer-function)
+ (defun . blink-cursor-end)
+ blink-cursor-mode
+ (defun . blink-cursor-mode)
+ blink-cursor display-hourglass hourglass-delay cursor-in-non-selected-windows
+ (provide . frame))
+ ("/usr/share/emacs/23.0.93/lisp/window.elc" window-size-fixed
+ (defun . save-selected-window)
+ (defun . window-body-height)
+ (defun . one-window-p)
+ (defun . window-current-scroll-bars)
+ (defun . walk-windows)
+ (defun . get-window-with-predicate)
+ (defun . some-window)
+ (defun . get-buffer-window-list)
+ (defun . minibuffer-window-active-p)
+ (defun . count-windows)
+ (defun . bw-get-tree)
+ (defun . bw-get-tree-1)
+ (defun . bw-find-tree-sub)
+ (defun . bw-find-tree-sub-1)
+ (defun . bw-l)
+ (defun . bw-t)
+ (defun . bw-r)
+ (defun . bw-b)
+ (defun . bw-dir)
+ (defun . bw-eqdir)
+ (defun . bw-refresh-edges)
+ (defun . balance-windows)
+ (defun . bw-adjust-window)
+ (defun . bw-balance-sub)
+ (defun . window-fixed-size-p)
+ window-area-factor
+ (defun . balance-windows-area)
+ display-buffer-function special-display-buffer-names special-display-regexps
+ (defun . special-display-p)
+ special-display-function same-window-buffer-names same-window-regexps
+ (defun . same-window-p)
+ pop-up-frames display-buffer-reuse-frames pop-up-windows split-height-threshold split-width-threshold split-window-preferred-function
+ (defun . window--splittable-p)
+ (defun . window--try-to-split-window)
+ (defun . window--frame-usable-p)
+ even-window-heights
+ (defun . window--even-window-heights)
+ (defun . window--display-buffer-1)
+ (defun . window--display-buffer-2)
+ (defun . display-buffer)
+ (defun . pop-to-buffer)
+ split-window-keep-point
+ (defun . split-window-vertically)
+ (defun . split-window-save-restore-data)
+ (defun . split-window-horizontally)
+ (defun . set-window-text-height)
+ (defun . enlarge-window-horizontally)
+ (defun . shrink-window-horizontally)
+ (defun . window-buffer-height)
+ (defun . count-screen-lines)
+ (defun . fit-window-to-buffer)
+ (defun . window-safely-shrinkable-p)
+ (defun . shrink-window-if-larger-than-buffer)
+ (defun . kill-buffer-and-window)
+ (defun . quit-window)
+ recenter-last-op
+ (defun . recenter-top-bottom)
+ mouse-autoselect-window-timer mouse-autoselect-window-position mouse-autoselect-window-window mouse-autoselect-window-state
+ (defun . mouse-autoselect-window-cancel)
+ (defun . mouse-autoselect-window-start)
+ (defun . mouse-autoselect-window-select)
+ (defun . handle-select-window)
+ (defun . delete-other-windows-vertically)
+ (defun . truncated-partial-width-window-p))
+ ("/usr/share/emacs/23.0.93/lisp/indent.elc" standard-indent indent-line-function tab-always-indent
+ (defun . indent-according-to-mode)
+ (defun . indent-for-tab-command)
+ (defun . insert-tab)
+ (defun . indent-rigidly)
+ (defun . indent-line-to)
+ (defun . current-left-margin)
+ (defun . move-to-left-margin)
+ (defun . indent-to-left-margin)
+ (defun . delete-to-left-margin)
+ (defun . set-left-margin)
+ (defun . set-right-margin)
+ (defun . alter-text-property)
+ (defun . increase-left-margin)
+ (defun . decrease-left-margin)
+ (defun . increase-right-margin)
+ (defun . decrease-right-margin)
+ (defun . beginning-of-line-text)
+ indent-region-function
+ (defun . indent-region)
+ (defun . indent-relative-maybe)
+ (defun . indent-relative)
+ tab-stop-list edit-tab-stops-map edit-tab-stops-buffer
+ (defun . edit-tab-stops)
+ (defun . edit-tab-stops-note-changes)
+ (defun . tab-to-tab-stop)
+ (defun . move-to-tab-stop))
+ ("/usr/share/emacs/23.0.93/lisp/language/cham.el"
+ (provide . cham))
+ ("/usr/share/emacs/23.0.93/lisp/language/burmese.el")
+ ("/usr/share/emacs/23.0.93/lisp/language/khmer.el")
+ ("/usr/share/emacs/23.0.93/lisp/language/georgian.el"
+ (provide . georgian))
+ ("/usr/share/emacs/23.0.93/lisp/language/utf-8-lang.el"
+ (provide . utf-8-lang))
+ ("/usr/share/emacs/23.0.93/lisp/language/misc-lang.el"
+ (provide . misc-lang))
+ ("/usr/share/emacs/23.0.93/lisp/language/vietnamese.elc"
+ (provide . vietnamese))
+ ("/usr/share/emacs/23.0.93/lisp/language/tibetan.elc" tibetan-composable-pattern tibetan-consonant-transcription-alist tibetan-consonant-transcription-alist tibetan-vowel-transcription-alist tibetan-vowel-transcription-alist tibetan-modifier-transcription-alist tibetan-modifier-transcription-alist tibetan-precomposed-transcription-alist tibetan-precomposed-transcription-alist tibetan-subjoined-transcription-alist tibetan-subjoined-transcription-alist tibetan-base-to-subjoined-alist tibetan-base-to-subjoined-alist tibetan-composite-vowel-alist tibetan-composite-vowel-alist tibetan-precomposition-rule-alist tibetan-precomposition-rule-alist tibetan-regexp tibetan-precomposed-regexp tibetan-precomposition-rule-regexp tibetan-decomposed tibetan-decomposed-temp
+ (provide . tibetan))
+ ("/usr/share/emacs/23.0.93/lisp/language/thai.el"
+ (provide . thai))
+ ("/usr/share/emacs/23.0.93/lisp/language/tai-viet.el"
+ (provide . tai-viet))
+ ("/usr/share/emacs/23.0.93/lisp/language/lao.el"
+ (provide . lao))
+ ("/usr/share/emacs/23.0.93/lisp/language/korean.el"
+ (provide . korean))
+ ("/usr/share/emacs/23.0.93/lisp/language/japanese.el"
+ (defun . compose-gstring-for-variation-glyph)
+ (provide . japanese))
+ ("/usr/share/emacs/23.0.93/lisp/international/eucjp-ms.el")
+ ("/usr/share/emacs/23.0.93/lisp/international/cp51932.el")
+ ("/usr/share/emacs/23.0.93/lisp/language/hebrew.el"
+ (provide . hebrew))
+ ("/usr/share/emacs/23.0.93/lisp/language/greek.el"
+ (provide . greek))
+ ("/usr/share/emacs/23.0.93/lisp/language/romanian.el"
+ (provide . romanian))
+ ("/usr/share/emacs/23.0.93/lisp/language/slovak.el"
+ (provide . slovak))
+ ("/usr/share/emacs/23.0.93/lisp/language/czech.el"
+ (provide . czech))
+ ("/usr/share/emacs/23.0.93/lisp/language/european.elc"
+ (defun . turkish-case-conversion-enable)
+ (defun . turkish-case-conversion-disable)
+ (provide . european))
+ ("/usr/share/emacs/23.0.93/lisp/language/ethiopic.elc" ccl-encode-ethio-font ccl-encode-ethio-font
+ (provide . ethiopic))
+ ("/usr/share/emacs/23.0.93/lisp/language/english.el")
+ ("/usr/share/emacs/23.0.93/lisp/language/sinhala.el")
+ ("/usr/share/emacs/23.0.93/lisp/language/indian.elc" devanagari-composable-pattern tamil-composable-pattern kannada-composable-pattern malayalam-composable-pattern
+ (provide . indian))
+ ("/usr/share/emacs/23.0.93/lisp/language/cyrillic.elc"
+ (provide . cyrillic))
+ ("/usr/share/emacs/23.0.93/lisp/language/chinese.elc"
+ (provide . chinese))
+ ("/usr/share/emacs/23.0.93/lisp/international/charprop.el")
+ ("/usr/share/emacs/23.0.93/lisp/composite.elc" reference-point-alist
+ (t . encode-composition-rule)
+ (defun . encode-composition-rule)
+ (defun . decode-composition-rule)
+ (defun . encode-composition-components)
+ (defun . decode-composition-components)
+ (defun . compose-region)
+ (defun . decompose-region)
+ (defun . compose-string)
+ (defun . decompose-string)
+ (defun . compose-chars)
+ (defun . find-composition)
+ (defun . compose-chars-after)
+ (defun . compose-last-chars)
+ (defun . lgstring-header)
+ (defun . lgstring-set-header)
+ (defun . lgstring-font)
+ (defun . lgstring-char)
+ (defun . lgstring-char-len)
+ (defun . lgstring-shaped-p)
+ (defun . lgstring-set-id)
+ (defun . lgstring-glyph)
+ (defun . lgstring-glyph-len)
+ (defun . lgstring-set-glyph)
+ (defun . lglyph-from)
+ (defun . lglyph-to)
+ (defun . lglyph-char)
+ (defun . lglyph-code)
+ (defun . lglyph-width)
+ (defun . lglyph-lbearing)
+ (defun . lglyph-rbearing)
+ (defun . lglyph-ascent)
+ (defun . lglyph-descent)
+ (defun . lglyph-adjustment)
+ (defun . lglyph-set-from-to)
+ (defun . lglyph-set-char)
+ (defun . lglyph-set-code)
+ (defun . lglyph-set-width)
+ (defun . lglyph-set-adjustment)
+ (defun . lglyph-copy)
+ (defun . lgstring-insert-glyph)
+ (defun . compose-glyph-string)
+ (defun . compose-glyph-string-relative)
+ (defun . compose-gstring-for-graphic)
+ (defun . compose-gstring-for-terminal)
+ (defun . auto-compose-chars)
+ auto-composition-mode
+ (t . auto-composition-mode)
+ (defun . auto-composition-mode)
+ (defun . turn-on-auto-composition-if-enabled)
+ auto-composition-mode-major-mode global-auto-composition-mode
+ (t . global-auto-composition-mode)
+ (defun . global-auto-composition-mode)
+ global-auto-composition-mode-buffers
+ (defun . global-auto-composition-mode-enable-in-buffers)
+ (defun . global-auto-composition-mode-check-buffers)
+ (defun . global-auto-composition-mode-cmhh)
+ (defun . toggle-auto-composition)
+ (defun . decompose-composite-char))
+ ("/usr/share/emacs/23.0.93/lisp/international/characters.elc" cjk-char-width-table
+ (defun . use-cjk-char-width-table)
+ (defun . use-default-char-width-table)
+ (defun . build-unicode-category-table))
+ ("/usr/share/emacs/23.0.93/lisp/case-table.elc"
+ (defun . describe-buffer-case-table)
+ (defun . get-upcase-table)
+ (defun . copy-case-table)
+ (defun . set-case-syntax-delims)
+ (defun . set-case-syntax-pair)
+ (defun . set-upcase-syntax)
+ (defun . set-downcase-syntax)
+ (defun . set-case-syntax)
+ (provide . case-table))
+ ("/usr/share/emacs/23.0.93/lisp/international/mule-cmds.elc" mule-keymap mule-menu-keymap describe-language-environment-map setup-language-environment-map set-coding-system-map help-xref-mule-regexp-template help-xref-mule-regexp-template
+ (defun . coding-system-change-eol-conversion)
+ (defun . coding-system-change-text-conversion)
+ (defun . canonicalize-coding-system-name)
+ (defun . coding-system-from-name)
+ (defun . toggle-enable-multibyte-characters)
+ (defun . view-hello-file)
+ (defun . universal-coding-system-argument)
+ (defun . set-default-coding-systems)
+ (defun . prefer-coding-system)
+ sort-coding-systems-predicate
+ (defun . sort-coding-systems)
+ (defun . find-coding-systems-region)
+ (defun . find-coding-systems-string)
+ (defun . find-coding-systems-for-charsets)
+ (defun . find-multibyte-characters)
+ (defun . search-unencodable-char)
+ last-coding-system-specified select-safe-coding-system-accept-default-p
+ (defun . select-safe-coding-system-interactively)
+ (defun . select-safe-coding-system)
+ (defun . select-message-coding-system)
+ language-info-alist
+ (defun . get-language-info)
+ (defun . set-language-info)
+ (defun . set-language-info-internal)
+ (defun . set-language-info-alist)
+ (defun . read-language-name)
+ leim-list-file-name leim-list-header leim-list-entry-regexp update-leim-list-functions
+ (defun . update-leim-list-file)
+ current-input-method current-input-method-title default-input-method input-method-history inactivate-current-input-method-function describe-current-input-method-function input-method-alist
+ (defun . register-input-method)
+ (defun . read-input-method-name)
+ (defun . activate-input-method)
+ (defun . inactivate-input-method)
+ (defun . set-input-method)
+ toggle-input-method-active
+ (defun . toggle-input-method)
+ (defun . describe-input-method)
+ (defun . describe-current-input-method)
+ (defun . read-multilingual-string)
+ input-method-verbose-flag input-method-highlight-flag input-method-activate-hook input-method-inactivate-hook input-method-after-insert-chunk-hook input-method-exit-on-first-char input-method-use-echo-area input-method-exit-on-invalid-key set-language-environment-hook exit-language-environment-hook
+ (defun . setup-specified-language-environment)
+ current-language-environment
+ (defun . reset-language-environment)
+ (defun . set-display-table-and-terminal-coding-system)
+ (defun . set-language-environment)
+ language-info-custom-alist
+ (defun . standard-display-european-internal)
+ (defun . set-language-environment-coding-systems)
+ (defun . set-language-environment-input-method)
+ (defun . set-language-environment-nonascii-translation)
+ (defun . set-language-environment-charset)
+ (defun . set-language-environment-unibyte)
+ (defun . princ-list)
+ (defun . describe-specified-language-support)
+ (defun . describe-language-environment)
+ locale-translation-file-name locale-language-names locale-charset-language-names locale-preferred-coding-systems
+ (defun . locale-name-match)
+ (defun . locale-charset-match-p)
+ locale-charset-alist
+ (defun . locale-charset-to-coding-system)
+ (defun . locale-translate)
+ (defun . set-locale-environment)
+ char-code-property-alist
+ (defun . define-char-code-property)
+ char-code-property-table
+ (defun . get-char-code-property)
+ (defun . put-char-code-property)
+ (defun . char-code-property-description)
+ iso-2022-control-alist
+ (defun . encoded-string-description)
+ (defun . encode-coding-char)
+ unify-8859-on-encoding-mode
+ (defun . unify-8859-on-encoding-mode)
+ unify-8859-on-decoding-mode
+ (defun . unify-8859-on-decoding-mode)
+ nonascii-insert-offset nonascii-translation-table ucs-names
+ (defun . ucs-names)
+ ucs-completions
+ (defun . read-char-by-name)
+ (defun . ucs-insert))
+ ("/usr/share/emacs/23.0.93/lisp/epa-hook.elc"
+ (defun . epa-file--file-name-regexp-set)
+ epa-file-name-regexp epa-file-inhibit-auto-save epa-file-encrypt-to epa-file-handler epa-file-auto-mode-alist-entry
+ (defun . epa-file-name-regexp-update)
+ (defun . epa-file-find-file-hook)
+ auto-encryption-mode
+ (defun . auto-encryption-mode)
+ (provide . epa-hook))
+ ("/usr/share/emacs/23.0.93/lisp/jka-cmpr-hook.elc" jka-compr-added-to-file-coding-system-alist jka-compr-file-name-handler-entry jka-compr-compression-info-list--internal jka-compr-mode-alist-additions--internal jka-compr-load-suffixes--internal
+ (defun . jka-compr-build-file-regexp)
+ (defun . jka-compr-info-regexp)
+ (defun . jka-compr-info-compress-message)
+ (defun . jka-compr-info-compress-program)
+ (defun . jka-compr-info-compress-args)
+ (defun . jka-compr-info-uncompress-message)
+ (defun . jka-compr-info-uncompress-program)
+ (defun . jka-compr-info-uncompress-args)
+ (defun . jka-compr-info-can-append)
+ (defun . jka-compr-info-strip-extension)
+ (defun . jka-compr-info-file-magic-bytes)
+ (defun . jka-compr-get-compression-info)
+ (defun . jka-compr-install)
+ (defun . jka-compr-installed-p)
+ (defun . jka-compr-update)
+ (defun . jka-compr-set)
+ jka-compr-compression-info-list jka-compr-mode-alist-additions jka-compr-load-suffixes auto-compression-mode
+ (defun . auto-compression-mode)
+ (defun . with-auto-compression-mode)
+ (provide . jka-cmpr-hook))
+ ("/usr/share/emacs/23.0.93/lisp/help.elc" help-window help-window-point-marker help-map help-button-cache
+ (defun . help-quit)
+ help-return-method
+ (defun . print-help-return-message)
+ (defun . help)
+ (defun . help-for-help)
+ (defun . help-for-help-internal-doc)
+ (defun . help-for-help-internal)
+ (defun . function-called-at-point)
+ (defun . view-help-file)
+ (defun . describe-distribution)
+ (defun . describe-copying)
+ (defun . describe-gnu-project)
+ (defun . describe-project)
+ (defun . describe-no-warranty)
+ (defun . describe-prefix-bindings)
+ (defun . view-emacs-news)
+ (defun . view-emacs-todo)
+ (defun . view-todo)
+ (defun . view-echo-area-messages)
+ (defun . view-order-manuals)
+ (defun . view-emacs-FAQ)
+ (defun . view-emacs-problems)
+ (defun . view-emacs-debugging)
+ (defun . view-external-packages)
+ (defun . view-lossage)
+ (defun . describe-bindings)
+ (defun . describe-bindings-internal)
+ (defun . where-is)
+ (defun . help-key-description)
+ (defun . describe-key-briefly)
+ (defun . describe-key)
+ (defun . describe-mode)
+ (defun . describe-minor-mode)
+ (defun . describe-minor-mode-completion-table-for-symbol)
+ (defun . describe-minor-mode-from-symbol)
+ (defun . describe-minor-mode-completion-table-for-indicator)
+ (defun . describe-minor-mode-from-indicator)
+ (defun . lookup-minor-mode-from-indicator)
+ temp-buffer-max-height temp-buffer-resize-mode
+ (defun . temp-buffer-resize-mode)
+ (defun . resize-temp-buffer-window)
+ help-window-select
+ (defun . help-window-display-message)
+ (defun . help-window-setup-finish)
+ (defun . help-window-setup)
+ (defun . with-help-window)
+ (provide . help))
+ ("/usr/share/emacs/23.0.93/lisp/simple.elc" idle-update-delay
+ (defun . get-next-valid-buffer)
+ (defun . last-buffer)
+ (defun . next-buffer)
+ (defun . previous-buffer)
+ (defface . next-error)
+ next-error-highlight next-error-highlight-no-select next-error-recenter next-error-hook next-error-highlight-timer next-error-overlay-arrow-position next-error-last-buffer next-error-function
+ (defun . next-error-buffer-p)
+ (defun . next-error-find-buffer)
+ (defun . next-error)
+ (defun . next-error-internal)
+ (defun . goto-next-locus)
+ (defun . next-match)
+ (defun . previous-error)
+ (defun . first-error)
+ (defun . next-error-no-select)
+ (defun . previous-error-no-select)
+ next-error-follow-last-line next-error-follow-minor-mode
+ (defun . next-error-follow-minor-mode)
+ (defun . next-error-follow-mode-post-command-hook)
+ (defun . fundamental-mode)
+ special-mode-map special-mode-map special-mode-syntax-table special-mode-abbrev-table special-mode-abbrev-table
+ (defun . special-mode)
+ hard-newline
+ (defun . newline)
+ (defun . set-hard-newline-properties)
+ (defun . open-line)
+ (defun . split-line)
+ (defun . delete-indentation)
+ (defun . join-line)
+ (defun . delete-blank-lines)
+ (defun . delete-trailing-whitespace)
+ (defun . newline-and-indent)
+ (defun . reindent-then-newline-and-indent)
+ (defun . quoted-insert)
+ (defun . forward-to-indentation)
+ (defun . backward-to-indentation)
+ (defun . back-to-indentation)
+ (defun . fixup-whitespace)
+ (defun . delete-horizontal-space)
+ (defun . just-one-space)
+ (defun . beginning-of-buffer)
+ (defun . end-of-buffer)
+ (defun . mark-whole-buffer)
+ (defun . goto-line)
+ (defun . count-lines-region)
+ (defun . what-line)
+ (defun . count-lines)
+ (defun . line-number-at-pos)
+ (defun . what-cursor-position)
+ read-expression-history minibuffer-completing-symbol minibuffer-default eval-expression-print-level eval-expression-print-length eval-expression-debug-on-error
+ (defun . eval-expression-print-format)
+ (defun . eval-expression)
+ (defun . edit-and-eval-command)
+ (defun . repeat-complex-command)
+ minibuffer-history minibuffer-history-sexp-flag minibuffer-history-search-history minibuffer-text-before-history
+ (defun . minibuffer-history-initialize)
+ (defun . minibuffer-avoid-prompt)
+ minibuffer-history-case-insensitive-variables
+ (defun . previous-matching-history-element)
+ (defun . next-matching-history-element)
+ minibuffer-temporary-goal-position minibuffer-default-add-function minibuffer-default-add-done
+ (defun . minibuffer-default-add-completions)
+ (defun . goto-history-element)
+ (defun . next-history-element)
+ (defun . previous-history-element)
+ (defun . next-complete-history-element)
+ (defun . previous-complete-history-element)
+ (defun . minibuffer-prompt-width)
+ (defun . minibuffer-history-isearch-setup)
+ (defun . minibuffer-history-isearch-end)
+ (defun . minibuffer-history-isearch-search)
+ (defun . minibuffer-history-isearch-message)
+ (defun . minibuffer-history-isearch-wrap)
+ (defun . minibuffer-history-isearch-push-state)
+ (defun . minibuffer-history-isearch-pop-state)
+ (defun . advertised-undo)
+ undo-equiv-table undo-in-region undo-no-redo pending-undo-list
+ (defun . undo)
+ (defun . buffer-disable-undo)
+ (defun . undo-only)
+ undo-in-progress
+ (defun . undo-more)
+ (defun . undo-copy-list)
+ (defun . undo-copy-list-1)
+ (defun . undo-start)
+ (defun . undo-make-selective-list)
+ (defun . undo-elt-in-region)
+ (defun . undo-elt-crosses-region)
+ (defun . undo-delta)
+ undo-ask-before-discard undo-extra-outer-limit
+ (defun . undo-outer-limit-truncate)
+ shell-command-history shell-command-switch shell-command-default-error-buffer
+ (defun . minibuffer-default-add-shell-commands)
+ (defun . minibuffer-complete-shell-command)
+ minibuffer-local-shell-command-map
+ (defun . read-shell-command)
+ (defun . shell-command)
+ (defun . display-message-or-buffer)
+ (defun . shell-command-sentinel)
+ (defun . shell-command-on-region)
+ (defun . shell-command-to-string)
+ (defun . process-file)
+ (defun . start-file-process)
+ universal-argument-map universal-argument-num-events overriding-map-is-bound saved-overriding-map
+ (defun . ensure-overriding-map-is-bound)
+ (defun . restore-overriding-map)
+ (defun . universal-argument)
+ (defun . universal-argument-more)
+ (defun . negative-argument)
+ (defun . digit-argument)
+ (defun . universal-argument-minus)
+ (defun . universal-argument-other-key)
+ buffer-substring-filters
+ (defun . filter-buffer-substring)
+ interprogram-cut-function interprogram-paste-function kill-ring kill-ring-max kill-ring-yank-pointer
+ (defun . kill-new)
+ (defun . kill-append)
+ yank-pop-change-selection
+ (defun . current-kill)
+ kill-read-only-ok
+ (defun . kill-region)
+ (defun . copy-region-as-kill)
+ (defun . kill-ring-save)
+ (defun . append-next-kill)
+ yank-excluded-properties yank-window-start yank-undo-function
+ (defun . yank-pop)
+ (defun . yank)
+ (defun . rotate-yank-pointer)
+ (defun . kill-forward-chars)
+ (defun . kill-backward-chars)
+ backward-delete-char-untabify-method
+ (defun . backward-delete-char-untabify)
+ (defun . zap-to-char)
+ kill-whole-line
+ (defun . kill-line)
+ (defun . kill-whole-line)
+ (defun . forward-visible-line)
+ (defun . end-of-visible-line)
+ (defun . insert-buffer)
+ (defun . append-to-buffer)
+ (defun . prepend-to-buffer)
+ (defun . copy-to-buffer)
+ activate-mark-hook deactivate-mark-hook
+ (defun . mark)
+ (defun . deactivate-mark)
+ (defun . activate-mark)
+ select-active-regions
+ (defun . set-mark)
+ use-empty-active-region
+ (defun . use-region-p)
+ (defun . region-active-p)
+ mark-ring mark-ring-max global-mark-ring global-mark-ring-max
+ (defun . pop-to-mark-command)
+ (defun . push-mark-command)
+ set-mark-command-repeat-pop set-mark-default-inactive
+ (defun . set-mark-command)
+ (defun . push-mark)
+ (defun . pop-mark)
+ (defun . exchange-dot-and-mark)
+ (defun . exchange-point-and-mark)
+ shift-select-mode
+ (defun . handle-shift-selection)
+ transient-mark-mode
+ (defun . transient-mark-mode)
+ transient-mark-mode widen-automatically
+ (defun . pop-global-mark)
+ next-line-add-newlines
+ (defun . next-line)
+ (defun . previous-line)
+ track-eol goal-column temporary-goal-column line-move-ignore-invisible line-move-visual
+ (defun . line-move-partial)
+ (defun . line-move)
+ (defun . line-move-visual)
+ (defun . line-move-1)
+ (defun . line-move-finish)
+ (defun . line-move-to-column)
+ (defun . move-end-of-line)
+ (defun . move-beginning-of-line)
+ (defun . set-goal-column)
+ (defun . end-of-visual-line)
+ (defun . beginning-of-visual-line)
+ (defun . kill-visual-line)
+ (defun . next-logical-line)
+ (defun . previous-logical-line)
+ visual-line-mode-map visual-line-fringe-indicators visual-line--saved-state visual-line-mode
+ (defun . visual-line-mode)
+ (defun . turn-on-visual-line-mode)
+ visual-line-mode-major-mode global-visual-line-mode
+ (defun . global-visual-line-mode)
+ global-visual-line-mode-buffers
+ (defun . global-visual-line-mode-enable-in-buffers)
+ (defun . global-visual-line-mode-check-buffers)
+ (defun . global-visual-line-mode-cmhh)
+ (defun . scroll-other-window-down)
+ (defun . beginning-of-buffer-other-window)
+ (defun . end-of-buffer-other-window)
+ (defun . transpose-chars)
+ (defun . transpose-words)
+ (defun . transpose-sexps)
+ (defun . transpose-lines)
+ (defun . transpose-subr)
+ (defun . transpose-subr-1)
+ (defun . backward-word)
+ (defun . mark-word)
+ (defun . kill-word)
+ (defun . backward-kill-word)
+ (defun . current-word)
+ fill-prefix auto-fill-inhibit-regexp
+ (defun . do-auto-fill)
+ comment-line-break-function
+ (defun . default-indent-new-line)
+ normal-auto-fill-function
+ (defun . auto-fill-mode)
+ (defun . auto-fill-function)
+ (defun . turn-on-auto-fill)
+ (defun . turn-off-auto-fill)
+ (defun . set-fill-column)
+ (defun . set-selective-display)
+ indicate-unused-lines
+ (defun . toggle-truncate-lines)
+ (defun . toggle-word-wrap)
+ overwrite-mode-textual overwrite-mode-binary
+ (defun . overwrite-mode)
+ (defun . binary-overwrite-mode)
+ line-number-mode
+ (defun . line-number-mode)
+ column-number-mode
+ (defun . column-number-mode)
+ size-indication-mode
+ (defun . size-indication-mode)
+ blink-matching-paren blink-matching-paren-on-screen blink-matching-paren-distance blink-matching-delay blink-matching-paren-dont-ignore-comments
+ (defun . blink-matching-open)
+ (defun . keyboard-quit)
+ buffer-quit-function
+ (defun . keyboard-escape-quit)
+ (defun . play-sound-file)
+ read-mail-command mail-user-agent
+ (defun . rfc822-goto-eoh)
+ (defun . sendmail-user-agent-compose)
+ (defun . compose-mail)
+ (defun . compose-mail-other-window)
+ (defun . compose-mail-other-frame)
+ set-variable-value-history
+ (defun . set-variable)
+ completion-list-mode-map completion-reference-buffer completion-no-auto-exit completion-base-size
+ (defun . delete-completion-window)
+ (defun . previous-completion)
+ (defun . next-completion)
+ (defun . choose-completion)
+ (defun . choose-completion-delete-max-match)
+ choose-completion-string-functions
+ (defun . choose-completion-string)
+ completion-list-mode-map completion-list-mode-syntax-table completion-list-mode-abbrev-table completion-list-mode-abbrev-table
+ (defun . completion-list-mode)
+ (defun . completion-list-mode-finish)
+ completion-show-help completion-root-regexp
+ (defun . completion-setup-function)
+ (defun . switch-to-completions)
+ (defun . event-apply-alt-modifier)
+ (defun . event-apply-super-modifier)
+ (defun . event-apply-hyper-modifier)
+ (defun . event-apply-shift-modifier)
+ (defun . event-apply-control-modifier)
+ (defun . event-apply-meta-modifier)
+ (defun . event-apply-modifier)
+ clone-buffer-hook clone-indirect-buffer-hook
+ (defun . clone-process)
+ (defun . clone-buffer)
+ (defun . clone-indirect-buffer)
+ (defun . clone-indirect-buffer-other-window)
+ normal-erase-is-backspace
+ (defun . normal-erase-is-backspace-setup-frame)
+ (defun . normal-erase-is-backspace-mode)
+ vis-mode-saved-buffer-invisibility-spec visible-mode
+ (defun . visible-mode)
+ (defun . apply-partially)
+ bad-packages-alist
+ (defun . bad-package-check)
+ (provide . simple))
+ ("/usr/share/emacs/23.0.93/lisp/abbrev.elc" only-global-abbrevs abbrev-mode
+ (defun . abbrev-mode)
+ abbrev-mode edit-abbrevs-map
+ (defun . kill-all-abbrevs)
+ (defun . copy-abbrev-table)
+ (defun . insert-abbrevs)
+ (defun . list-abbrevs)
+ (defun . abbrev-table-name)
+ (defun . prepare-abbrev-list-buffer)
+ (defun . edit-abbrevs-mode)
+ (defun . edit-abbrevs)
+ (defun . edit-abbrevs-redefine)
+ (defun . define-abbrevs)
+ (defun . read-abbrev-file)
+ (defun . quietly-read-abbrev-file)
+ (defun . write-abbrev-file)
+ (defun . add-mode-abbrev)
+ (defun . add-global-abbrev)
+ (defun . add-abbrev)
+ (defun . inverse-add-mode-abbrev)
+ (defun . inverse-add-global-abbrev)
+ (defun . inverse-add-abbrev)
+ (defun . abbrev-prefix-mark)
+ (defun . expand-region-abbrevs)
+ (defun . abbrev-table-get)
+ (defun . abbrev-table-put)
+ (defun . abbrev-get)
+ (defun . abbrev-put)
+ (defun . abbrev-with-wrapper-hook)
+ abbrev-table-name-list
+ (defun . make-abbrev-table)
+ (defun . abbrev-table-p)
+ global-abbrev-table abbrev-minor-mode-table-alist fundamental-mode-abbrev-table abbrevs-changed abbrev-all-caps abbrev-start-location abbrev-start-location-buffer last-abbrev last-abbrev-text last-abbrev-location pre-abbrev-expand-hook
+ (defun . clear-abbrev-table)
+ (defun . define-abbrev)
+ (defun . abbrev--check-chars)
+ (defun . define-global-abbrev)
+ (defun . define-mode-abbrev)
+ (defun . abbrev--active-tables)
+ (defun . abbrev-symbol)
+ (defun . abbrev-expansion)
+ (defun . abbrev--before-point)
+ (defun . abbrev-insert)
+ abbrev-expand-functions
+ (defun . expand-abbrev)
+ (defun . unexpand-abbrev)
+ (defun . abbrev--write)
+ (defun . abbrev--describe)
+ (defun . insert-abbrev-table-description)
+ (defun . define-abbrev-table)
+ (defun . abbrev-table-menu)
+ (provide . abbrev))
+ ("/usr/share/emacs/23.0.93/lisp/loaddefs.el" add-log-current-defun-function add-log-full-name add-log-mailing-address add-log-lisp-like-modes add-log-c-like-modes add-log-tex-like-modes ad-redefinition-action ad-default-compilation-action
+ (defun . outlinify-sticky)
+ (defun . ange-ftp-re-read-dir)
+ (defun . command-apropos)
+ autoarg-mode autoarg-kp-mode auto-insert-mode global-auto-revert-mode mouse-avoidance-mode display-battery-mode binhex-begin-line bookmark-map
+ (defun . bookmark-locate)
+ (defun . list-bookmarks)
+ (defun . edit-bookmarks)
+ menu-bar-bookmark-map
+ (defun . menu-bar-bookmark-map)
+ browse-url-browser-function browse-url-firefox-program browse-url-galeon-program
+ (defun . list-yahrzeit-dates)
+ calc-settings-file c-mode-syntax-table c++-mode-syntax-table objc-mode-syntax-table java-mode-syntax-table idl-mode-syntax-table pike-mode-syntax-table custom-print-functions comint-output-filter-functions comint-use-prompt-regexp-instead-of-fields comint-file-name-prefix compilation-mode-hook compilation-start-hook compilation-window-height compilation-process-setup-function compilation-buffer-name-function compilation-finish-function compilation-finish-functions compilation-ask-about-save compilation-search-path compile-command compilation-disable-input partial-completion-mode dynamic-completion-mode global-auto-composition-mode crisp-mode
+ (defun . brief-mode)
+ cua-mode custom-browse-sort-alphabetically custom-buffer-sort-alphabetically custom-menu-sort-alphabetically
+ (defun . customize-variable)
+ (defun . customize-variable-other-window)
+ customize-package-emacs-version-alist
+ (defun . customize-changed)
+ custom-file global-cwarn-mode
+ (defun . pending-delete-mode)
+ delete-selection-mode desktop-save-mode desktop-locals-to-save desktop-save-buffer desktop-buffer-mode-handlers desktop-minor-mode-handlers diff-switches diff-command dired-listing-switches dired-chown-program dired-ls-F-marks-symlinks dired-trivial-filenames dired-keep-marker-rename dired-keep-marker-copy dired-keep-marker-hardlink dired-keep-marker-symlink dired-dwim-target dired-copy-preserve-time dired-directory dnd-protocol-alist
+ (defun . zone-mode)
+ (defun . easy-mmode-define-minor-mode)
+ (defun . easy-mmode-define-global-mode)
+ (defun . define-global-minor-mode)
+ (defun . ebnf-despool)
+ edebug-all-defs edebug-all-forms
+ (defun . edebug-defun)
+ (defun . ediff3)
+ (defun . ediff)
+ (defun . ebuffers)
+ (defun . ebuffers3)
+ (defun . edirs)
+ (defun . edir-revisions)
+ (defun . edirs3)
+ (defun . edirs-merge)
+ (defun . edir-merge-revisions)
+ (defun . edir-merge-revisions-with-ancestor)
+ (defun . edirs-merge-with-ancestor)
+ (defun . ediff-merge)
+ (defun . ediff-merge-with-ancestor)
+ (defun . epatch)
+ (defun . epatch-buffer)
+ (defun . erevision)
+ menu-bar-ediff-misc-menu menu-bar-epatch-menu menu-bar-ediff-merge-menu menu-bar-ediff-menu
+ (defun . eregistry)
+ edmacro-eight-bits eldoc-minor-mode-string eldoc-documentation-function menu-bar-emerge-menu epa-global-mail-mode
+ (defun . epg-import-keys-from-server)
+ (defun . erc-select)
+ erc-ctcp-query-DCC-hook erc-track-minor-mode
+ (defun . eshell-report-bug)
+ tags-file-name tags-case-fold-search tags-table-list tags-compression-info-list tags-add-tables find-tag-hook find-tag-default-function eudc-tools-menu
+ (defun . ffap)
+ find-ls-option find-ls-subdir-switches find-grep-options find-name-arg ff-special-constructs
+ (defun . ff-find-related-file)
+ flyspell-mode
+ (defun . gdba)
+ gdb-enable-debug generic-mode-list
+ (defun . gnus-batch-kill)
+ (defun . gnus-set-sorted-intersection)
+ (defun . goto-address-at-mouse)
+ grep-window-height grep-command grep-find-command grep-setup-hook grep-regexp-alist grep-program find-program xargs-program grep-find-use-xargs grep-history grep-find-history
+ (defun . find-grep)
+ help-at-pt-display-when-idle three-step-help global-hi-lock-mode
+ (defun . highlight-lines-matching-regexp)
+ (defun . highlight-regexp)
+ (defun . highlight-phrase)
+ (defun . unhighlight-regexp)
+ hs-special-modes-alist global-highlight-changes-mode hippie-expand-try-functions-list hippie-expand-verbose hippie-expand-dabbrev-skip-space hippie-expand-dabbrev-as-symbol hippie-expand-no-restriction hippie-expand-max-buffers hippie-expand-ignore-buffers hippie-expand-only-buffers global-hl-line-mode holiday-general-holidays general-holidays holiday-oriental-holidays oriental-holidays holiday-local-holidays local-holidays holiday-other-holidays other-holidays hebrew-holidays-1 hebrew-holidays-2 hebrew-holidays-3 hebrew-holidays-4 holiday-hebrew-holidays hebrew-holidays holiday-christian-holidays christian-holidays holiday-islamic-holidays islamic-holidays holiday-bahai-holidays bahai-holidays holiday-solar-holidays solar-holidays
+ (defun . holiday-list)
+ icomplete-mode ido-mode
+ (defun . image-dired)
+ (defun . tumme)
+ image-file-name-extensions image-file-name-regexps auto-image-file-mode imenu-sort-function imenu-generic-expression imenu-create-index-function imenu-prev-index-position-function imenu-extract-index-name-function imenu-name-lookup-function imenu-default-goto-function inferior-lisp-filter-regexp inferior-lisp-program inferior-lisp-load-command inferior-lisp-prompt inferior-lisp-mode-hook
+ (defun . run-lisp)
+ Info-split-threshold ispell-personal-dictionary ispell-menu-map ispell-menu-xemacs ispell-menu-map-needed ispell-skip-region-alist ispell-tex-skip-alists ispell-html-skip-alists iswitchb-mode jka-compr-inhibit keypad-setup keypad-numlock-setup keypad-shifted-setup keypad-numlock-shifted-setup kkc-after-update-conversion-functions default-korean-keyboard
+ (defun . landmark-repeat)
+ (defun . landmark)
+ latex-inputenc-coding-alist latin1-display latin1-display-ucs-per-lynx ledit-save-files ledit-go-to-lisp-string ledit-go-to-liszt-string linum-format global-linum-mode locate-ls-subdir-switches lpr-windows-system lpr-lp-system printer-name lpr-switches lpr-command ls-lisp-support-shell-wildcards
+ (defun . phases-of-moon)
+ mail-hist-keep-history mail-use-rfc822 mail-abbrevs-mode mail-complete-style
+ (defun . manual-entry)
+ minibuffer-depth-indicate-mode minibuffer-electric-default-mode multi-isearch-next-buffer-function multi-isearch-next-buffer-current-function multi-isearch-current-buffer mouse-sel-mode msb-mode
+ (defun . string-to-list)
+ (defun . string-to-vector)
+ (defun . nested-alist-p)
+ mouse-wheel-mode
+ (defun . ipconfig)
+ (defun . indent-for-comment)
+ (defun . set-comment-column)
+ (defun . kill-comment)
+ (defun . indent-new-comment-line)
+ comment-use-syntax comment-column comment-start comment-start-skip comment-end-skip comment-end comment-indent-function comment-insert-comment-function comment-style comment-padding comment-multi-line comment-auto-fill-only-comments disabled-command-function disabled-command-hook
+ (defun . run-octave)
+ (defun . org-publish-project)
+ show-paren-mode pc-selection-mode
+ (defun . pcomplete/gdb)
+ (defun . pcomplete/pushd)
+ (defun . pcomplete/time)
+ cvs-dired-action cvs-dired-use-hook
+ (defun . cvs-dired-noselect)
+ cvs-global-menu
+ (defun . edit-picture)
+ (defun . run-prolog)
+ bdf-directory-list ps-page-dimensions-database ps-paper-type ps-print-color-p quickurl-reread-hook-postfix
+ (defun . irc)
+ rcirc-track-minor-mode
+ (defun . regexp-builder)
+ recentf-mode
+ (defun . close-rectangle)
+ (defun . replace-rectangle)
+ global-reveal-mode rmail-dont-reply-to-names rmail-default-dont-reply-to-names rmail-ignored-headers rmail-displayed-headers rmail-retry-ignored-headers rmail-highlighted-headers rmail-primary-inbox-list rmail-secondary-file-directory rmail-secondary-file-regexp rmail-mode-hook rmail-show-message-hook rmail-file-coding-system rmail-insert-mime-forwarded-message-function rmail-user-mail-address-regexp savehist-mode scroll-all-mode mail-from-style mail-specify-envelope-from mail-self-blind mail-interactive send-mail-function mail-header-separator mail-archive-file-name mail-default-reply-to mail-alias-file mail-personal-alias-file mail-setup-hook mail-aliases mail-yank-prefix mail-indentation-spaces mail-citation-hook mail-citation-prefix-regexp mail-signature mail-signature-file mail-default-directory mail-default-headers mail-bury-selects-summary mail-send-nonascii mail-mailing-lists sendmail-coding-system default-sendmail-coding-system server-mode
+ (defun . xml-mode)
+ (defun . shell-script-mode)
+ shell-dumb-shell-regexp skeleton-filter-function
+ (defun . speedbar)
+ strokes-mode
+ (defun . t-mouse-mode)
+ gpm-mouse-mode table-cell-map-hook table-load-hook table-point-entered-cell-hook table-point-left-cell-hook tex-shell-file-name tex-directory tex-first-line-header-regexp tex-main-file tex-offer-save tex-run-command latex-run-command slitex-run-command tex-start-options tex-start-commands latex-block-names tex-bibtex-command tex-dvi-print-command tex-alt-dvi-print-command tex-dvi-view-command tex-show-queue-command tex-default-mode tex-open-quote tex-close-quote
+ (defun . TeX-mode)
+ (defun . plain-TeX-mode)
+ (defun . LaTeX-mode)
+ texinfo-open-quote texinfo-close-quote
+ (defun . thumbs)
+ display-time-day-and-date display-time-mode
+ (defun . subtract-time)
+ tpu-edt-mode
+ (defun . tpu-edt)
+ trace-buffer tramp-mode tramp-syntax tramp-file-name-regexp-unified tramp-file-name-regexp-separate tramp-file-name-regexp-url tramp-file-name-regexp tramp-root-regexp tramp-completion-file-name-regexp-unified tramp-completion-file-name-regexp-separate tramp-completion-file-name-regexp-url tramp-completion-file-name-regexp tramp-completion-file-name-handler-alist
+ (defun . tramp-run-real-handler)
+ (defun . tramp-completion-run-real-handler)
+ (defun . tramp-completion-file-name-handler)
+ (defun . tramp-register-file-name-handler)
+ (defun . tramp-register-completion-file-name-handler)
+ type-break-mode type-break-interval type-break-good-rest-interval type-break-good-break-interval type-break-keystroke-threshold url-handler-mode
+ (defun . url-http-file-readable-p)
+ url-https-default-port url-https-asynchronous-p
+ (defun . url-https-expand-file-name)
+ (defun . url-rlogin)
+ (defun . url-telnet)
+ (defun . url-tn3270)
+ url-debug
+ (defun . url-basepath)
+ vc-checkout-hook vc-checkin-hook vc-before-checkin-hook
+ (defun . vc-resolve-conflicts)
+ (defun . vc-revert-buffer)
+ (defun . vc-arch-registered)
+ vc-bzr-admin-dirname vc-bzr-admin-checkout-format-file
+ (defun . vc-bzr-registered)
+ (defun . vc-cvs-registered)
+ (defun . vc-git-registered)
+ (defun . vc-hg-registered)
+ vc-mtn-admin-dir vc-mtn-admin-format
+ (defun . vc-mtn-registered)
+ vc-rcs-master-templates
+ (defun . vc-rcs-registered)
+ vc-sccs-master-templates
+ (defun . vc-sccs-registered)
+ (defun . vc-sccs-search-project-dir)
+ (defun . vc-svn-registered)
+ view-remove-frame-by-deleting view-mode warning-prefix-function warning-series warning-fill-prefix warning-type-format
+ (defun . which-func-mode)
+ which-function-mode global-whitespace-mode global-whitespace-newline-mode widget-keymap winner-mode woman-locale xterm-mouse-mode
+ (provide . loaddefs))
+ ("/usr/share/emacs/23.0.93/lisp/startup.elc" command-line-processed initial-buffer-choice inhibit-startup-screen inhibit-splash-screen inhibit-startup-message startup-screen-inhibit-startup-screen inhibit-startup-echo-area-message inhibit-default-init inhibit-startup-buffer-menu command-switch-alist command-line-args-left argv command-line-functions command-line-default-directory command-line-x-option-alist command-line-ns-option-alist before-init-hook after-init-hook emacs-startup-hook term-setup-hook inhibit-startup-hooks keyboard-type window-setup-hook initial-major-mode init-file-user site-run-file mail-host-address user-mail-address auto-save-list-file-prefix emacs-quick-startup emacs-basic-display init-file-debug init-file-had-error normal-top-level-add-subdirs-inode-list debian-emacs-flavor no-blinking-cursor pure-space-overflow pure-space-overflow-message tutorial-directory
+ (defun . normal-top-level-add-subdirs-to-load-path)
+ (defun . normal-top-level-add-to-load-path)
+ (defun . normal-top-level)
+ (defun . precompute-menubar-bindings)
+ tty-long-option-alist tty-long-option-alist tool-bar-images-pixel-height tool-bar-originally-present handle-args-function-alist window-system-initialization-alist
+ (defun . tty-handle-args)
+ (defun . command-line)
+ initial-scratch-message fancy-startup-text fancy-about-text fancy-splash-image splash-screen-keymap
+ (defun . fancy-splash-insert)
+ (defun . fancy-splash-head)
+ (defun . fancy-startup-tail)
+ (defun . exit-splash-screen)
+ (defun . fancy-startup-screen)
+ (defun . fancy-about-screen)
+ (defun . fancy-splash-frame)
+ (defun . use-fancy-splash-screens-p)
+ (defun . normal-splash-screen)
+ (defun . normal-mouse-startup-screen)
+ (defun . normal-no-mouse-startup-screen)
+ (defun . normal-about-screen)
+ (defun . startup-echo-area-message)
+ (defun . display-startup-echo-area-message)
+ (defun . display-startup-screen)
+ (defun . display-about-screen)
+ (defun . about-emacs)
+ (defun . display-splash-screen)
+ (defun . command-line-1)
+ (defun . command-line-normalize-file-name))
+ ("/usr/share/emacs/23.0.93/lisp/button.elc"
+ (defface . button)
+ button-map button-buffer-map
+ (defun . button-category-symbol)
+ (defun . define-button-type)
+ (defun . button-type-put)
+ (defun . button-type-get)
+ (defun . button-type-subtype-p)
+ (defun . button-start)
+ (defun . button-end)
+ (defun . button-get)
+ (defun . button-put)
+ (defun . button-activate)
+ (defun . button-label)
+ (defun . button-type)
+ (defun . button-has-type-p)
+ (defun . make-button)
+ (defun . insert-button)
+ (defun . make-text-button)
+ (defun . insert-text-button)
+ (defun . button-at)
+ (defun . next-button)
+ (defun . previous-button)
+ (defun . push-button)
+ (defun . forward-button)
+ (defun . backward-button)
+ (provide . button))
+ ("/usr/share/emacs/23.0.93/lisp/minibuffer.elc"
+ (defun . completion-boundaries)
+ (defun . completion--some)
+ (defun . complete-with-action)
+ (defun . completion-table-dynamic)
+ (defun . lazy-completion-table)
+ (defun . completion-table-with-context)
+ (defun . completion-table-with-terminator)
+ (defun . completion-table-with-predicate)
+ (defun . completion-table-in-turn)
+ (defun . complete-in-turn)
+ (defun . dynamic-completion-table)
+ (defun . minibuffer-message)
+ (defun . minibuffer-completion-contents)
+ (defun . delete-minibuffer-contents)
+ completion-auto-help completion-styles-alist completion-styles
+ (defun . completion-try-completion)
+ (defun . completion-all-completions)
+ (defun . minibuffer--bitset)
+ (defun . completion--do-completion)
+ (defun . minibuffer-complete)
+ completion-all-sorted-completions
+ (defun . completion--flush-all-sorted-completions)
+ (defun . completion-all-sorted-completions)
+ (defun . minibuffer-force-complete)
+ minibuffer-confirm-exit-commands
+ (defun . minibuffer-complete-and-exit)
+ (defun . completion--try-word-completion)
+ (defun . minibuffer-complete-word)
+ (defun . completion--insert-strings)
+ completion-common-substring completion-setup-hook
+ (defface . completions-first-difference)
+ (defface . completions-common-part)
+ (defun . completion-hilit-commonality)
+ (defun . display-completion-list)
+ (defun . minibuffer-completion-help)
+ (defun . exit-minibuffer)
+ (defun . self-insert-and-exit)
+ minibuffer-local-must-match-filename-map
+ (defun . minibuffer--double-dollars)
+ (defun . completion--make-envvar-table)
+ completion--embedded-envvar-re completion--embedded-envvar-re
+ (defun . completion--embedded-envvar-table)
+ (defun . completion--file-name-table)
+ (defun . read-file-name-internal)
+ read-file-name-function read-file-name-predicate read-file-name-completion-ignore-case insert-default-directory
+ (defun . read-file-name)
+ (defun . internal-complete-buffer-except)
+ (defun . completion-emacs21-try-completion)
+ (defun . completion-emacs21-all-completions)
+ (defun . completion-emacs22-try-completion)
+ (defun . completion-emacs22-all-completions)
+ (defun . completion--merge-suffix)
+ (defun . completion-basic-try-completion)
+ (defun . completion-basic-all-completions)
+ completion-pcm--delim-wild-regex
+ (defun . completion-pcm--prepare-delim-re)
+ completion-pcm-word-delimiters
+ (defun . completion-pcm--pattern-trivial-p)
+ (defun . completion-pcm--string->pattern)
+ (defun . completion-pcm--pattern->regex)
+ (defun . completion-pcm--all-completions)
+ (defun . completion-pcm--hilit-commonality)
+ (defun . completion-pcm--find-all-completions)
+ (defun . completion-pcm-all-completions)
+ (defun . completion-pcm--merge-completions)
+ (defun . completion-pcm--pattern->string)
+ (defun . completion-pcm--filename-try-filter)
+ (defun . completion-pcm--merge-try)
+ (defun . completion-pcm-try-completion)
+ (provide . minibuffer))
+ ("/usr/share/emacs/23.0.93/lisp/faces.elc" face-name-history face-font-selection-order face-font-family-alternatives face-font-registry-alternatives
+ (defun . face-list)
+ (defun . make-face)
+ (defun . make-empty-face)
+ (defun . copy-face)
+ (defun . internal-find-face)
+ (defun . internal-get-face)
+ (defun . facep)
+ (defun . check-face)
+ (defun . face-id)
+ (defun . face-equal)
+ (defun . face-differs-from-default-p)
+ (defun . face-nontrivial-p)
+ face-x-resources
+ (defun . set-face-attribute-from-resource)
+ (defun . set-face-attributes-from-resources)
+ (defun . make-face-x-resource-internal)
+ (defun . face-name)
+ (defun . face-all-attributes)
+ (defun . face-attribute)
+ (defun . face-attribute-merged-with)
+ (defun . face-attribute-specified-or)
+ (defun . face-foreground)
+ (defun . face-background)
+ (defun . face-stipple)
+ (defun . face-background-pixmap)
+ (defun . face-underline-p)
+ (defun . face-inverse-video-p)
+ (defun . face-bold-p)
+ (defun . face-italic-p)
+ (defun . face-documentation)
+ (defun . set-face-documentation)
+ (defun . face-doc-string)
+ (defun . set-face-doc-string)
+ (defun . set-face-attribute)
+ (defun . make-face-bold)
+ (defun . make-face-unbold)
+ (defun . make-face-italic)
+ (defun . make-face-unitalic)
+ (defun . make-face-bold-italic)
+ (defun . set-face-font)
+ (defun . set-face-background)
+ (defun . set-face-foreground)
+ (defun . set-face-stipple)
+ (defun . set-face-underline-p)
+ (defun . set-face-underline)
+ (defun . set-face-inverse-video-p)
+ (defun . set-face-bold-p)
+ (defun . set-face-italic-p)
+ (defun . set-face-background-pixmap)
+ (defun . invert-face)
+ (defun . read-face-name)
+ (defun . face-valid-attribute-values)
+ face-attribute-name-alist
+ (defun . face-descriptive-attribute-name)
+ (defun . face-read-string)
+ (defun . face-read-integer)
+ (defun . read-face-attribute)
+ (defun . read-face-font)
+ (defun . read-all-face-attributes)
+ (defun . modify-face)
+ (defun . read-face-and-attribute)
+ list-faces-sample-text
+ (defun . list-faces-display)
+ (defun . describe-face)
+ (defun . face-attr-construct)
+ (defun . face-spec-set-match-display)
+ (defun . face-spec-choose)
+ (defun . face-spec-reset-face)
+ (defun . face-spec-set)
+ (defun . face-spec-recalc)
+ (defun . face-spec-set-2)
+ (defun . face-attr-match-p)
+ (defun . face-spec-match-p)
+ (defun . face-default-spec)
+ (defun . face-user-default-spec)
+ (defun . defined-colors)
+ (defun . x-defined-colors)
+ (defun . color-defined-p)
+ (defun . x-color-defined-p)
+ (defun . color-values)
+ (defun . x-color-values)
+ (defun . display-color-p)
+ (defun . x-display-color-p)
+ (defun . display-grayscale-p)
+ (defun . read-color)
+ (defun . face-at-point)
+ (defun . foreground-color-at-point)
+ (defun . background-color-at-point)
+ frame-background-mode inhibit-frame-set-background-mode
+ (defun . frame-set-background-mode)
+ (defun . x-handle-named-frame-geometry)
+ (defun . x-handle-reverse-video)
+ (defun . x-create-frame-with-faces)
+ (defun . face-set-after-frame-default)
+ (defun . tty-handle-reverse-video)
+ (defun . tty-create-frame-with-faces)
+ (defun . tty-find-type)
+ (defun . tty-run-terminal-initialization)
+ (defun . tty-set-up-initial-frame-faces)
+ (defun . frame-update-faces)
+ (defun . frame-update-face-colors)
+ (defface . default)
+ (defface . bold)
+ (defface . italic)
+ (defface . bold-italic)
+ (defface . underline)
+ (defface . fixed-pitch)
+ (defface . variable-pitch)
+ (defface . shadow)
+ (defface . link)
+ (defface . link-visited)
+ (defface . highlight)
+ (defface . region)
+ (defface . secondary-selection)
+ (defface . trailing-whitespace)
+ (defface . escape-glyph)
+ (defface . nobreak-space)
+ (defface . mode-line)
+ (defface . mode-line-inactive)
+ (defface . mode-line-highlight)
+ (defface . mode-line-emphasis)
+ (defface . mode-line-buffer-id)
+ (defface . header-line)
+ (defface . vertical-border)
+ (defface . minibuffer-prompt)
+ (defface . fringe)
+ (defface . scroll-bar)
+ (defface . border)
+ (defface . cursor)
+ (defface . mouse)
+ (defface . tool-bar)
+ (defface . menu)
+ x-font-regexp x-font-regexp-head x-font-regexp-weight x-font-regexp-slant x-font-regexp-weight-subnum x-font-regexp-weight-subnum x-font-regexp-slant-subnum x-font-regexp-slant-subnum x-font-regexp-swidth-subnum x-font-regexp-swidth-subnum x-font-regexp-adstyle-subnum x-font-regexp-adstyle-subnum
+ (defun . x-resolve-font-name)
+ (defun . x-frob-font-weight)
+ (defun . x-frob-font-slant)
+ (defun . internal-frob-font-weight)
+ (defun . internal-frob-font-slant)
+ (defun . x-make-font-bold)
+ (defun . x-make-font-demibold)
+ (defun . x-make-font-unbold)
+ (defun . x-make-font-italic)
+ (defun . x-make-font-oblique)
+ (defun . x-make-font-unitalic)
+ (defun . x-make-font-bold-italic)
+ (provide . faces))
+ ("/usr/share/emacs/23.0.93/lisp/cus-face.elc"
+ (defun . custom-facep)
+ (defun . custom-declare-face)
+ custom-face-attributes
+ (defun . custom-face-attributes-get)
+ (defun . custom-set-faces)
+ (defun . custom-theme-set-faces)
+ (defun . custom-theme-reset-faces)
+ (defun . custom-reset-faces)
+ (provide . cus-face))
+ ("/usr/share/emacs/23.0.93/lisp/files.elc" delete-auto-save-files directory-abbrev-alist make-backup-files backup-inhibited backup-by-copying backup-by-copying-when-linked backup-by-copying-when-mismatch backup-by-copying-when-privileged-mismatch backup-enable-predicate buffer-offer-save find-file-existing-other-name find-file-visit-truename revert-without-query buffer-file-number buffer-file-numbers-unique buffer-file-read-only temporary-file-directory small-temporary-file-directory null-device file-name-invalid-regexp file-precious-flag break-hardlink-on-save version-control dired-kept-versions delete-old-versions kept-old-versions kept-new-versions require-final-newline mode-require-final-newline auto-save-default auto-save-file-name-transforms save-abbrevs find-file-run-dired find-directory-functions find-file-not-found-functions find-file-not-found-hooks find-file-hooks find-file-hook write-file-functions write-file-hooks local-write-file-hooks write-contents-functions write-contents-hooks enable-local-variables local-enable-local-variables enable-local-eval view-read-only file-name-history
+ (defun . ange-ftp-completion-hook-function)
+ (defun . convert-standard-filename)
+ (defun . read-directory-name)
+ (defun . pwd)
+ cd-path
+ (defun . parse-colon-path)
+ (defun . cd-absolute)
+ (defun . cd)
+ (defun . load-file)
+ (defun . locate-file)
+ (defun . locate-file-completion-table)
+ (defun . locate-file-completion)
+ locate-dominating-stop-dir-regexp
+ (defun . locate-dominating-file)
+ (defun . executable-find)
+ (defun . load-library)
+ (defun . file-remote-p)
+ (defun . file-local-copy)
+ (defun . file-truename)
+ (defun . file-chase-links)
+ (defun . make-temp-file)
+ (defun . recode-file-name)
+ confirm-nonexistent-file-or-buffer
+ (defun . confirm-nonexistent-file-or-buffer)
+ (defun . read-buffer-to-switch)
+ (defun . switch-to-buffer-other-window)
+ (defun . switch-to-buffer-other-frame)
+ (defun . display-buffer-other-frame)
+ find-file-default
+ (defun . minibuffer-with-setup-hook)
+ (defun . find-file-read-args)
+ (defun . find-file)
+ (defun . find-file-other-window)
+ (defun . find-file-other-frame)
+ (defun . find-file-existing)
+ (defun . find-file-read-only)
+ (defun . find-file-read-only-other-window)
+ (defun . find-file-read-only-other-frame)
+ (defun . find-alternate-file-other-window)
+ (defun . find-alternate-file)
+ (defun . create-file-buffer)
+ (defun . generate-new-buffer)
+ automount-dir-prefix abbreviated-home-dir
+ (defun . abbreviate-file-name)
+ find-file-not-true-dirname-list
+ (defun . find-buffer-visiting)
+ find-file-wildcards find-file-suppress-same-file-warnings large-file-warning-threshold
+ (defun . abort-if-file-too-large)
+ (defun . find-file-noselect)
+ (defun . find-file-noselect-1)
+ (defun . insert-file-contents-literally)
+ (defun . insert-file-1)
+ (defun . insert-file-literally)
+ find-file-literally
+ (defun . find-file-literally)
+ after-find-file-from-revert-buffer
+ (defun . after-find-file)
+ (defun . report-errors)
+ (defun . normal-mode)
+ auto-mode-case-fold auto-mode-alist
+ (defun . conf-mode-maybe)
+ interpreter-mode-alist inhibit-first-line-modes-regexps inhibit-first-line-modes-suffixes auto-mode-interpreter-regexp magic-mode-alist magic-fallback-mode-alist magic-mode-regexp-match-limit
+ (defun . set-auto-mode)
+ (defun . set-auto-mode-0)
+ (defun . set-auto-mode-1)
+ ignored-local-variables hack-local-variables-hook safe-local-variable-values safe-local-eval-forms file-local-variables-alist before-hack-local-variables-hook
+ (defun . hack-local-variables-confirm)
+ (defun . hack-local-variables-prop-line)
+ (defun . hack-local-variables-filter)
+ (defun . hack-local-variables)
+ (defun . safe-local-variable-p)
+ (defun . risky-local-variable-p)
+ (defun . hack-one-local-variable-quotep)
+ (defun . hack-one-local-variable-constantp)
+ (defun . hack-one-local-variable-eval-safep)
+ (defun . hack-one-local-variable)
+ dir-locals-class-alist dir-locals-directory-cache
+ (defun . dir-locals-get-class-variables)
+ (defun . dir-locals-collect-mode-variables)
+ (defun . dir-locals-collect-variables)
+ (defun . dir-locals-set-directory-class)
+ (defun . dir-locals-set-class-variables)
+ dir-locals-file
+ (defun . dir-locals-find-file)
+ (defun . dir-locals-read-from-file)
+ (defun . hack-dir-local-variables)
+ change-major-mode-with-file-name
+ (defun . set-visited-file-name)
+ (defun . write-file)
+ (defun . backup-buffer)
+ (defun . backup-buffer-copy)
+ (defun . file-name-sans-versions)
+ (defun . file-ownership-preserved-p)
+ (defun . file-name-sans-extension)
+ (defun . file-name-extension)
+ make-backup-file-name-function backup-directory-alist
+ (defun . normal-backup-enable-predicate)
+ (defun . make-backup-file-name)
+ (defun . make-backup-file-name-1)
+ (defun . backup-file-name-p)
+ (defun . backup-extract-version)
+ (defun . find-backup-file-name)
+ (defun . file-nlinks)
+ (defun . file-relative-name)
+ (defun . save-buffer)
+ (defun . delete-auto-save-file-if-necessary)
+ auto-save-hook before-save-hook after-save-hook save-buffer-coding-system
+ (defun . basic-save-buffer)
+ (defun . basic-save-buffer-1)
+ (defun . basic-save-buffer-2)
+ (defun . diff-buffer-with-file)
+ save-some-buffers-action-alist buffer-save-without-query
+ (defun . save-some-buffers)
+ (defun . not-modified)
+ (defun . toggle-read-only)
+ (defun . insert-file)
+ (defun . append-to-file)
+ (defun . file-newest-backup)
+ (defun . rename-uniquely)
+ (defun . make-directory)
+ revert-buffer-function revert-buffer-insert-file-contents-function buffer-stale-function before-revert-hook after-revert-hook
+ (defun . revert-buffer)
+ (defun . recover-this-file)
+ (defun . recover-file)
+ (defun . recover-session)
+ (defun . recover-session-finish)
+ (defun . kill-buffer-ask)
+ (defun . kill-some-buffers)
+ (defun . kill-matching-buffers)
+ (defun . auto-save-mode)
+ (defun . rename-auto-save-file)
+ (defun . make-auto-save-file-name)
+ (defun . auto-save-file-name-p)
+ (defun . wildcard-to-regexp)
+ list-directory-brief-switches list-directory-verbose-switches
+ (defun . file-expand-wildcards)
+ (defun . list-directory)
+ (defun . shell-quote-wildcard-pattern)
+ insert-directory-program directory-free-space-program directory-free-space-args
+ (defun . get-free-disk-space)
+ directory-listing-before-filename-regexp insert-directory-ls-version
+ (defun . insert-directory)
+ (defun . insert-directory-adj-pos)
+ (defun . insert-directory-safely)
+ kill-emacs-query-functions confirm-kill-emacs
+ (defun . save-buffers-kill-emacs)
+ (defun . save-buffers-kill-terminal)
+ (defun . file-name-non-special)
+ (defun . file-modes-char-to-who)
+ (defun . file-modes-char-to-right)
+ (defun . file-modes-rights-to-number)
+ (defun . file-modes-symbolic-to-number)
+ (defun . read-file-modes)
+ trash-directory
+ (defun . move-file-to-trash))
+ ("/usr/share/emacs/23.0.93/lisp/bindings.elc"
+ (defun . make-mode-line-mouse-map)
+ (defun . mode-line-toggle-read-only)
+ (defun . mode-line-toggle-modified)
+ (defun . mode-line-widen)
+ (defun . mode-line-abbrev-mode)
+ (defun . mode-line-auto-fill-mode)
+ mode-line-input-method-map mode-line-coding-system-map
+ (defun . mode-line-change-eol)
+ mode-line-eol-desc-cache
+ (defun . mode-line-eol-desc)
+ mode-line-client mode-line-mule-info
+ (defun . mode-line-frame-control)
+ mode-line-frame-identification mode-line-process mode-line-modified mode-line-remote mode-line-position mode-line-modes mode-line-mode-menu mode-line-major-mode-keymap mode-line-minor-mode-keymap mode-line-column-line-number-mode-map mode-line-buffer-identification-keymap
+ (defun . propertized-buffer-identification)
+ mode-line-buffer-identification
+ (defun . unbury-buffer)
+ (defun . mode-line-unbury-buffer)
+ (defun . mode-line-bury-buffer)
+ (defun . mode-line-other-buffer)
+ (defun . mode-line-next-buffer)
+ (defun . mode-line-previous-buffer)
+ (defun . bound-and-true-p)
+ (defun . mode-line-minor-mode-help)
+ minor-mode-alist
+ (provide . base64)
+ (provide . md5)
+ (provide . overlay)
+ (provide . text-properties)
+ (defun . complete-symbol)
+ narrow-map goto-map search-map
+ (defun . mode-specific-command-prefix)
+ mode-specific-map ctl-x-r-map abbrev-map)
+ ("/usr/share/emacs/23.0.93/lisp/format.elc" format-alist
+ (defun . format-encode-run-method)
+ (defun . format-decode-run-method)
+ (defun . format-annotate-function)
+ (defun . format-decode)
+ (defun . format-decode-buffer)
+ (defun . format-decode-region)
+ (defun . format-encode-buffer)
+ (defun . format-encode-region)
+ (defun . format-write-file)
+ (defun . format-find-file)
+ (defun . format-insert-file)
+ (defun . format-read)
+ (defun . format-replace-strings)
+ (defun . format-delq-cons)
+ (defun . format-make-relatively-unique)
+ (defun . format-common-tail)
+ (defun . format-proper-list-p)
+ (defun . format-reorder)
+ (defun . format-deannotate-region)
+ (defun . format-subtract-regions)
+ (defun . format-property-increment-region)
+ (defun . format-insert-annotations)
+ (defun . format-annotate-value)
+ (defun . format-annotate-region)
+ (defun . format-annotate-location)
+ (defun . format-annotate-single-property-change)
+ (defun . format-annotate-atomic-property-change)
+ (provide . format))
+ ("/usr/share/emacs/23.0.93/lisp/env.elc" read-envvar-name-history
+ (defun . read-envvar-name)
+ setenv-history
+ (defun . substitute-env-vars)
+ (defun . setenv-internal)
+ (defun . setenv)
+ (defun . getenv)
+ (provide . env))
+ ("/usr/share/emacs/23.0.93/lisp/international/mule-conf.el"
+ (defun . define-iso-single-byte-charset)
+ (provide . code-pages))
+ ("/usr/share/emacs/23.0.93/lisp/international/mule.elc" mule-version mule-version-date private-char-area-1-min private-char-area-1-max private-char-area-2-min private-char-area-2-max emacs-mule-charset-table
+ (defun . convert-define-charset-argument)
+ (defun . define-charset)
+ (defun . load-with-code-conversion)
+ (defun . charset-info)
+ (defun . charset-id)
+ (defun . charset-bytes)
+ (defun . get-charset-property)
+ (defun . put-charset-property)
+ (defun . charset-description)
+ (defun . charset-dimension)
+ (defun . charset-chars)
+ (defun . charset-iso-final-char)
+ (defun . charset-short-name)
+ (defun . charset-long-name)
+ (defun . charset-list)
+ (defun . char-valid-p)
+ (defun . generic-char-p)
+ (defun . make-char-internal)
+ ascii-case-table coding-system-iso-2022-flags
+ (defun . define-coding-system)
+ (defun . coding-system-doc-string)
+ (defun . coding-system-mnemonic)
+ (defun . coding-system-type)
+ (defun . coding-system-charset-list)
+ (defun . coding-system-category)
+ (defun . coding-system-get)
+ (defun . coding-system-eol-type-mnemonic)
+ (defun . coding-system-lessp)
+ (defun . coding-system-equal)
+ (defun . add-to-coding-system-list)
+ (defun . coding-system-list)
+ char-coding-system-table
+ (defun . transform-make-coding-system-args)
+ (defun . make-coding-system)
+ (defun . merge-coding-systems)
+ (defun . autoload-coding-system)
+ buffer-file-coding-system-explicit
+ (defun . set-buffer-file-coding-system)
+ (defun . revert-buffer-with-coding-system)
+ (defun . set-file-name-coding-system)
+ default-terminal-coding-system
+ (defun . set-terminal-coding-system)
+ default-keyboard-coding-system
+ (defun . set-keyboard-coding-system)
+ keyboard-coding-system
+ (defun . set-buffer-process-coding-system)
+ (defun . set-clipboard-coding-system)
+ (defun . set-selection-coding-system)
+ last-next-selection-coding-system
+ (defun . set-next-selection-coding-system)
+ (defun . set-coding-priority)
+ ctext-non-standard-encodings-alist ctext-non-standard-encodings ctext-non-standard-encodings-regexp
+ (defun . ctext-post-read-conversion)
+ (defun . ctext-non-standard-encodings-table)
+ (defun . ctext-pre-write-conversion)
+ auto-coding-alist auto-coding-regexp-alist
+ (defun . auto-coding-regexp-alist-lookup)
+ auto-coding-functions set-auto-coding-for-load
+ (defun . auto-coding-alist-lookup)
+ (defun . find-auto-coding)
+ (defun . set-auto-coding)
+ (defun . after-insert-file-set-coding)
+ (defun . find-new-buffer-file-coding-system)
+ (defun . modify-coding-system-alist)
+ (defun . decode-coding-inserted-region)
+ (defun . recode-region)
+ (defun . make-translation-table)
+ (defun . make-translation-table-from-vector)
+ (defun . make-translation-table-from-alist)
+ (defun . define-translation-table)
+ (defun . translate-region)
+ (defun . with-category-table)
+ (defun . define-translation-hash-table)
+ (defun . sgml-xml-auto-coding-function)
+ (defun . sgml-html-meta-auto-coding-function)
+ (defun . xml-find-file-coding-system)
+ (provide . mule))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/map-ynp.elc"
+ (defun . map-y-or-n-p))
+ ("/usr/share/emacs/23.0.93/lisp/custom.elc"
+ (require . widget)
+ custom-define-hook custom-dont-initialize custom-current-group-alist
+ (defun . custom-initialize-default)
+ (defun . custom-initialize-set)
+ (defun . custom-initialize-safe-set)
+ (defun . custom-initialize-safe-default)
+ (defun . custom-initialize-reset)
+ (defun . custom-initialize-changed)
+ (defun . custom-declare-variable)
+ (defun . defcustom)
+ (defun . defface)
+ (defun . custom-current-group)
+ (defun . custom-declare-group)
+ (defun . defgroup)
+ (defun . custom-add-to-group)
+ (defun . custom-group-of-mode)
+ (defun . custom-handle-all-keywords)
+ (defun . custom-handle-keyword)
+ (defun . custom-add-dependencies)
+ (defun . custom-add-option)
+ (defun . custom-add-frequent-value)
+ (defun . custom-add-link)
+ (defun . custom-add-version)
+ (defun . custom-add-package-version)
+ (defun . custom-add-load)
+ (defun . custom-autoload)
+ (defun . custom-variable-p)
+ (defun . custom-note-var-changed)
+ custom-load-recursion
+ (defun . custom-load-symbol)
+ custom-local-buffer
+ (defun . custom-set-default)
+ (defun . custom-set-minor-mode)
+ (defun . custom-quote)
+ (defun . customize-mark-to-save)
+ (defun . customize-mark-as-set)
+ (defun . custom-reevaluate-setting)
+ custom-known-themes
+ (defun . custom-theme-p)
+ (defun . custom-check-theme)
+ (defun . custom-push-theme)
+ (defun . custom-set-variables)
+ (defun . custom-theme-set-variables)
+ (defun . deftheme)
+ (defun . custom-declare-theme)
+ (defun . custom-make-theme-feature)
+ custom-theme-directory
+ (defun . provide-theme)
+ (defun . load-theme)
+ custom-enabling-themes
+ (defun . enable-theme)
+ custom-enabled-themes
+ (defun . custom-theme-enabled-p)
+ (defun . disable-theme)
+ (defun . custom-variable-theme-value)
+ (defun . custom-theme-recalc-variable)
+ (defun . custom-theme-recalc-face)
+ (defun . custom-theme-reset-variables)
+ (defun . custom-reset-variables)
+ read-quoted-char-radix
+ (provide . custom))
+ ("/usr/share/emacs/23.0.93/lisp/widget.elc"
+ (defun . define-widget-keywords)
+ (defun . define-widget)
+ (defun . widget-plist-member)
+ (provide . widget))
+ ("/usr/share/emacs/23.0.93/lisp/version.el" emacs-copyright emacs-version emacs-major-version emacs-minor-version emacs-build-time emacs-build-system
+ (defun . emacs-version)
+ (defun . version))
+ ("/usr/share/emacs/23.0.93/lisp/subr.elc" custom-declare-variable-list
+ (defun . custom-declare-variable-early)
+ (defun . declare-function)
+ (defun . not)
+ (defun . noreturn)
+ (defun . 1value)
+ (defun . def-edebug-spec)
+ (defun . lambda)
+ (defun . push)
+ (defun . pop)
+ (defun . when)
+ (defun . unless)
+ --dolist-tail--
+ (defun . dolist)
+ --dotimes-limit--
+ (defun . dotimes)
+ (defun . declare)
+ (defun . ignore-errors)
+ (defun . ignore)
+ (defun . error)
+ (defun . frame-configuration-p)
+ (defun . functionp)
+ (defun . caar)
+ (defun . cadr)
+ (defun . cdar)
+ (defun . cddr)
+ (defun . last)
+ (defun . butlast)
+ (defun . nbutlast)
+ (defun . delete-dups)
+ (defun . number-sequence)
+ (defun . copy-tree)
+ (defun . assoc-default)
+ (defun . assoc-ignore-case)
+ (defun . assoc-ignore-representation)
+ (defun . member-ignore-case)
+ (defun . assq-delete-all)
+ (defun . rassq-delete-all)
+ (defun . remove)
+ (defun . remq)
+ (defun . kbd)
+ (defun . undefined)
+ (defun . suppress-keymap)
+ (defun . define-key-after)
+ (defun . map-keymap-sorted)
+ (defun . keymap-canonicalize)
+ (defun . keyboard-translate)
+ (defun . global-set-key)
+ (defun . local-set-key)
+ (defun . global-unset-key)
+ (defun . local-unset-key)
+ key-substitution-in-progress
+ (defun . substitute-key-definition)
+ (defun . substitute-key-definition-key)
+ global-map esc-map ctl-x-map ctl-x-4-map
+ (defun . ctl-x-4-prefix)
+ ctl-x-5-map
+ (defun . ctl-x-5-prefix)
+ listify-key-sequence-1 listify-key-sequence-1
+ (defun . listify-key-sequence)
+ (defun . eventp)
+ (defun . event-modifiers)
+ (defun . event-basic-type)
+ (defun . mouse-movement-p)
+ (defun . mouse-event-p)
+ (defun . event-start)
+ (defun . event-end)
+ (defun . event-click-count)
+ (defun . posn-window)
+ (defun . posn-area)
+ (defun . posn-point)
+ (defun . posn-set-point)
+ (defun . posn-x-y)
+ (defun . posn-col-row)
+ (defun . posn-actual-col-row)
+ (defun . posn-timestamp)
+ (defun . posn-string)
+ (defun . posn-image)
+ (defun . posn-object)
+ (defun . posn-object-x-y)
+ (defun . posn-object-width-height)
+ (defun . window-dot)
+ (defun . set-window-dot)
+ (defun . read-input)
+ (defun . show-buffer)
+ (defun . eval-current-buffer)
+ (defun . string-to-int)
+ (defun . insert-string)
+ (defun . makehash)
+ (defun . baud-rate)
+ (defun . focus-frame)
+ (defun . unfocus-frame)
+ executing-macro x-lost-selection-hooks x-sent-selection-hooks messages-buffer-max-lines last-input-char last-command-char
+ (defun . send-string)
+ (defun . send-region)
+ (defun . string=)
+ (defun . string<)
+ (defun . move-marker)
+ (defun . rplaca)
+ (defun . rplacd)
+ (defun . beep)
+ (defun . indent-to-column)
+ (defun . backward-delete-char)
+ (defun . search-forward-regexp)
+ (defun . search-backward-regexp)
+ (defun . int-to-string)
+ (defun . store-match-data)
+ (defun . chmod)
+ (defun . mkdir)
+ (defun . point-at-eol)
+ (defun . point-at-bol)
+ (defun . user-original-login-name)
+ (defun . make-local-hook)
+ (defun . add-hook)
+ (defun . remove-hook)
+ (defun . add-to-list)
+ (defun . add-to-ordered-list)
+ (defun . add-to-history)
+ delay-mode-hooks delayed-mode-hooks after-change-major-mode-hook
+ (defun . run-mode-hooks)
+ (defun . delay-mode-hooks)
+ (defun . derived-mode-p)
+ minor-mode-list
+ (defun . add-minor-mode)
+ (defun . symbol-file)
+ (defun . locate-library)
+ (defun . eval-at-startup)
+ (defun . load-history-regexp)
+ (defun . load-history-filename-element)
+ (defun . eval-after-load)
+ (defun . do-after-load-evaluation)
+ (defun . eval-next-after-load)
+ (defun . process-lines)
+ (defun . open-network-stream)
+ (defun . process-kill-without-query)
+ (defun . process-get)
+ (defun . process-put)
+ read-quoted-char-radix
+ (defun . read-quoted-char)
+ (defun . read-passwd)
+ (defun . read-number)
+ (defun . sit-for)
+ (defun . atomic-change-group)
+ (defun . prepare-change-group)
+ (defun . activate-change-group)
+ (defun . accept-change-group)
+ (defun . cancel-change-group)
+ (defun . redraw-modeline)
+ (defun . force-mode-line-update)
+ (defun . momentary-string-display)
+ (defun . copy-overlay)
+ (defun . remove-overlays)
+ suspend-hook suspend-resume-hook temp-buffer-show-hook temp-buffer-setup-hook buffer-file-type user-emacs-directory
+ (defun . locate-user-emacs-file)
+ (defun . find-tag-default)
+ (defun . play-sound)
+ (defun . shell-quote-argument)
+ (defun . string-or-null-p)
+ (defun . booleanp)
+ (defun . field-at-pos)
+ (defun . remove-yank-excluded-properties)
+ (defun . insert-for-yank)
+ (defun . insert-for-yank-1)
+ (defun . insert-buffer-substring-no-properties)
+ (defun . insert-buffer-substring-as-yank)
+ (defun . start-process-shell-command)
+ (defun . start-file-process-shell-command)
+ (defun . call-process-shell-command)
+ (defun . process-file-shell-command)
+ (defun . with-current-buffer)
+ (defun . with-selected-window)
+ (defun . with-selected-frame)
+ (defun . with-temp-file)
+ (defun . with-temp-message)
+ (defun . with-temp-buffer)
+ (defun . with-output-to-string)
+ (defun . with-local-quit)
+ (defun . while-no-input)
+ (defun . condition-case-no-debug)
+ (defun . with-demoted-errors)
+ (defun . combine-after-change-calls)
+ (defun . with-case-table)
+ (defun . save-match-data)
+ (defun . match-string)
+ (defun . match-string-no-properties)
+ (defun . match-substitute-replacement)
+ (defun . looking-back)
+ (defun . looking-at-p)
+ (defun . string-match-p)
+ (defun . subregexp-context-p)
+ split-string-default-separators
+ (defun . split-string)
+ (defun . combine-and-quote-strings)
+ (defun . split-string-and-unquote)
+ (defun . subst-char-in-string)
+ (defun . replace-regexp-in-string)
+ (defun . add-to-invisibility-spec)
+ (defun . remove-from-invisibility-spec)
+ (defun . with-syntax-table)
+ (defun . make-syntax-table)
+ (defun . syntax-after)
+ (defun . syntax-class)
+ (defun . text-clone-maintain)
+ (defun . text-clone-create)
+ (defun . define-mail-user-agent)
+ (defun . progress-reporter-update)
+ (defun . make-progress-reporter)
+ (defun . progress-reporter-force-update)
+ (defun . progress-reporter-do-update)
+ (defun . progress-reporter-done)
+ (defun . dotimes-with-progress-reporter)
+ version-separator version-regexp-alist
+ (defun . version-to-list)
+ (defun . version-list-<)
+ (defun . version-list-=)
+ (defun . version-list-<=)
+ (defun . version-list-not-zero)
+ (defun . version<)
+ (defun . version<=)
+ (defun . version=))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/backquote.elc"
+ (provide . backquote)
+ (defun . backquote-list*-function)
+ (defun . backquote-list*-macro)
+ (defun . backquote-list*)
+ backquote-backquote-symbol backquote-unquote-symbol backquote-splice-symbol
+ (defun . backquote)
+ (defun . \`)
+ (defun . backquote-delay-process)
+ (defun . backquote-process)
+ (defun . backquote-listify))
+ ("/usr/share/emacs/23.0.93/lisp/emacs-lisp/byte-run.elc"
+ (defun . macro-declaration-function)
+ (defun . defsubst)
+ (defun . make-obsolete)
+ (defun . define-obsolete-function-alias)
+ (defun . make-obsolete-variable)
+ (defun . define-obsolete-variable-alias)
+ (defun . dont-compile)
+ (defun . eval-when-compile)
+ (defun . eval-and-compile)
+ (defun . with-no-warnings)))
--- /dev/null
+<html>\r
+ <body>\r
+ <p>\r
+ <?php\r
+ echo "foo";\r
+echo "bar";\r
+ ?>\r
+ </p>\r
+ </body>\r
+</html>\r
--- /dev/null
+Debugger entered--Lisp error: (wrong-type-argument number-or-marker-p nil)\r
+ <(1 nil)\r
+ (and mumamo-last-new-chunk first-check-from (< first-check-from (overlay-end mumamo-last-new-chunk)))\r
+ (if (and mumamo-last-new-chunk first-check-from (< first-check-from ...)) (progn (setq mumamo-last-new-chunk ...)))\r
+ (when (and mumamo-last-new-chunk first-check-from (< first-check-from ...)) (setq mumamo-last-new-chunk (overlay-get mumamo-last-new-chunk ...)))\r
+ (progn (setq mumamo-last-new-chunk (overlay-get new-chunk-at-change-min ...)) (when (and mumamo-last-new-chunk first-check-from ...) (setq mumamo-last-new-chunk ...)))\r
+ (if new-chunk-at-change-min (progn (setq mumamo-last-new-chunk ...) (when ... ...)))\r
+ (when new-chunk-at-change-min (setq mumamo-last-new-chunk (overlay-get new-chunk-at-change-min ...)) (when (and mumamo-last-new-chunk first-check-from ...) (setq mumamo-last-new-chunk ...)))\r
+ (progn (when new-chunk-at-change-min (setq mumamo-last-new-chunk ...) (when ... ...)))\r
+ (if (mumamo-make-new-chunks) (progn (when new-chunk-at-change-min ... ...)))\r
+ (when (mumamo-make-new-chunks) (when new-chunk-at-change-min (setq mumamo-last-new-chunk ...) (when ... ...)))\r
+ (progn (when (mumamo-make-new-chunks) (when new-chunk-at-change-min ... ...)) (setq mumamo-last-chunk-change-pos nil))\r
+ (if mumamo-last-chunk-change-pos (progn (when ... ...) (setq mumamo-last-chunk-change-pos nil)))\r
+ (when mumamo-last-chunk-change-pos (when (mumamo-make-new-chunks) (when new-chunk-at-change-min ... ...)) (setq mumamo-last-chunk-change-pos nil))\r
+ (let* ((change-min ...) (change-max ...) (new-chunk-at-change-min ...) (new-chunk-at-change-min-start ...) (this-new-syntax-min-max ...) (this-new-syntax-min ...) (in-new-min-border ...) (here ...) (first-check-from ...)) (when mumamo-last-chunk-change-pos (when ... ...) (setq mumamo-last-chunk-change-pos nil)) (let* (... ... ... ... narpos this-new-values this-new-chunk prev-new-chunk first-change-pos interrupted ... ... ... ... ...) (when ... ...) (unless this-new-chunk ...) (setq mumamo-find-chunks-level ...) (when this-new-chunk ... ...) (when end-param ...)))\r
+ (save-restriction (widen) (let* (... ... ... ... ... ... ... ... ...) (when mumamo-last-chunk-change-pos ... ...) (let* ... ... ... ... ... ...)))\r
+ mumamo-find-chunks(1 "mumamo-set-major-post-command")\r
+ (let* ((ovl ...) (major ...) (in-pre-hook ...)) (if (not major) (lwarn ... :error "major=%s" major) (unless ... ...)))\r
+ mumamo-set-major-post-command()\r
+ (if font-lock-mode (mumamo-set-major-post-command))\r
+ mumamo-post-command-1()\r
+ eval((mumamo-post-command-1))\r
+ eval-expression((mumamo-post-command-1) nil)\r
+ call-interactively(eval-expression nil nil)\r
--- /dev/null
+<?php\r
+$a = array(\r
+ 'foo' => 'bar',\r
+ 'gaz' => 'gazonk',\r
+);\r
+?>
\ No newline at end of file
--- /dev/null
+<?php
+// $Id$
+/**
+ * @file
+ * A few generic functions for interfacing with Subversion via command line.
+ * The API of these functions has been inspired by the SVN PECL extension
+ * (http://www.php.net/manual/en/ref.svn.php), but works differently in places.
+ * On the one hand, this is due to the incompleteness of the functions in here,
+ * and on the other hand there are a few artificial restrictions and
+ * complications in the PECL extension's API that we can really do without.
+ *
+ * @note
+ * These functions can be run *without* Drupal.
+ *
+ * Copyright 2008 by Jakob Petsovits ("jpetso", http://drupal.org/user/56020)
+ * Copyright 2006-2008 by Gavin Mogan ("halkeye", http://drupal.org/user/56779)
+ */
+
+// file_directory_temp() is normally provided by Drupal, but as this file is
+// supposed to be independent from Drupal code, here's a fallback definition.
+if (!function_exists('file_directory_temp')) {
+ /**
+ * Determine the default temporary directory.
+ *
+ * @return A string containing a temp directory.
+ */
+ function file_directory_temp() {
+ return sys_get_temp_dir();
+ }
+}
+
+/**
+ * If subsequent function calls from this file act on a private repository
+ * that requires authentication, this function will store username and password
+ * for the duration of the current process (in a static variable, that is).
+ * Other functions in this file make use of this login information.
+ */
+function svnlib_set_authentication_info($username, $password) {
+ _svnlib_authentication_info(
+ array('username' => $username, 'password' => $password)
+ );
+}
+
+/**
+ * Unset any username and password that was previously passed
+ * to subversion_set_authentication_info(), so that subsequent repository
+ * access will happen anonymously again.
+ */
+function svnlib_unset_authentication_info() {
+ _svnlib_authentication_info(FALSE);
+}
+
+/**
+ * Append the option for our custom config dir to a $cmd array,
+ * and also username and password if those have been set before.
+ */
+function _svnlib_add_common_options(&$cmd) {
+ $auth_info = _svnlib_authentication_info();
+ if (isset($auth_info)) {
+ $cmd = array_merge($cmd, array(
+ '--username', escapeshellarg($auth_info['username']),
+ '--password', escapeshellarg($auth_info['password']),
+ ));
+ }
+ $cmd[] = '--config-dir '. escapeshellarg(dirname(__FILE__) .'/configdir');
+}
+
+/**
+ * Write or retrieve the authentication info state, stored in a static variable.
+ *
+ * @param $info
+ * NULL to retrieve the info, FALSE to unset it, or an array with array keys
+ * 'username' and 'password' to remember it for later retrieval.
+ */
+function _svnlib_authentication_info($info = NULL) {
+ static $auth_info = NULL;
+
+ if (!isset($info)) {
+ return $auth_info;
+ }
+ else {
+ $auth_info = ($info === FALSE) ? NULL : $info;
+ return $auth_info;
+ }
+}
+
+/**
+ * By default, Subversion will be invoked with the 'svn' binary which is
+ * alright as long as the binary is in the PATH. If it's not, you can call
+ * this function to set a different path to the binary (which will be used
+ * until this process finishes, or until a new path is set).
+ */
+function svnlib_set_svn_binary($svn_binary) {
+ _svnlib_svn_binary($svn_binary);
+}
+
+/**
+ * Write or retrieve the path of the svn binary, stored in a static variable.
+ *
+ * @param $svn_binary
+ * NULL to retrieve the info, or the path to the binary to remember it
+ * for later retrieval.
+ */
+function _svnlib_svn_binary($svn_binary = NULL) {
+ static $binary = 'svn';
+
+ if (!isset($svn_binary)) {
+ return $binary;
+ }
+ $binary = $svn_binary;
+ return $binary;
+}
+
+/**
+ * Retrieve the version of the svn binary, and return an array with the keys
+ * 'major', 'minor' and 'patch', each containing the integer for the respective
+ * part of the version number. If invoking the SVN executable fails, an empty
+ * array is returned.
+ */
+function svnlib_version() {
+ static $version;
+
+ if (isset($version)) {
+ return $version;
+ }
+ $return_code = 0;
+ exec(_svnlib_svn_binary() .' --version', $output, $return_code);
+
+ if ($return_code != 0) {
+ $version = array();
+ return $version;
+ }
+ $line = reset($output); // The first line contains the version number.
+
+ if (!preg_match('/\b([\d]+)\.([\d]+)(?:\.([\d]+))?/', $line, $matches)) {
+ $version = array();
+ return $version;
+ }
+ $version = array(
+ 'major' => (int) $matches[1],
+ 'minor' => (int) $matches[2],
+ 'patch' => empty($matches[3]) ? 0 : (int) $matches[3],
+ );
+ return $version;
+}
+
+/**
+ * Append an appropriate output pipe to a $cmd array, which causes STDERR
+ * to be written to a random file.
+ *
+ * @return
+ * An array with the temporary files that will be created when $cmd
+ * is executed. In its current form, the return array only contains
+ * the filename for STDERR output as 'stderr' array element.
+ */
+function _svnlib_add_output_pipes(&$cmd) {
+ $tempdir = file_directory_temp();
+ $tempfiles = array(
+ 'stderr' => $tempdir .'/drupal_versioncontrol_svn.stderr.'. mt_rand() .'.txt',
+ );
+ $cmd[] = '2> '. $tempfiles['stderr'];
+ return $tempfiles;
+}
+
+/**
+ * Delete temporary files that have been created by a command which included
+ * output pipes from _svnlib_add_output_pipes().
+ */
+function _svnlib_delete_temporary_files($tempfiles) {
+ @unlink($tempfiles['stderr']);
+}
+
+/**
+ * Read the STDERR output for a command that was executed.
+ * The output must have been written to a temporary file which was given
+ * by _svnlib_add_output_pipes(). The temporary file is deleted after it
+ * has been read. After calling the function, the error message can be
+ * retrieved by calling svnlib_last_error_message() or discarded by calling
+ * svnlib_unset_error_message().
+ */
+function _svnlib_set_error_message($tempfiles) {
+ _svnlib_error_message(file_get_contents($tempfiles['stderr']));
+ @unlink($tempfiles['stderr']);
+}
+
+/**
+ * Retrieve the STDERR output from the last invocation of 'svn' that exited
+ * with a non-zero status code. After fetching the error message, it will be
+ * unset again until a subsequent 'svn' invocation fails as well. If no message
+ * is set, this function returns NULL.
+ *
+ * For better security, it is advisable to run the returned error message
+ * through check_plain() or similar string checker functions.
+ */
+function svnlib_last_error_message() {
+ $message = _svnlib_error_message();
+ _svnlib_error_message(FALSE);
+ return $message;
+}
+
+/**
+ * Write or retrieve an error message, stored in a static variable.
+ *
+ * @param $info
+ * NULL to retrieve the message, FALSE to unset it, or a string containing
+ * the new message to remember it for later retrieval.
+ */
+function _svnlib_error_message($message = NULL) {
+ static $error_message = NULL;
+
+ if (!isset($message)) {
+ return $error_message;
+ }
+ else {
+ $error_message = ($message === FALSE) ? NULL : $message;
+ return $error_message;
+ }
+}
+
+/**
+ * Return commit log messages of a repository URL. This function is equivalent
+ * to 'svn log -v -r $revision_range $repository_url'.
+ *
+ * @param $repository_url
+ * The URL of the repository (e.g. 'file:///svnroot/my-repo') or an item
+ * inside that repository (e.g. 'file:///svnroot/my-repo/subdir/hello.php').
+ * @param $revision_range
+ * The revision specification that will be passed to 'svn log' as the
+ * '-r' parameter. Examples: '35' for a specific revision, 'HEAD:35' for all
+ * revisions since (and including) r35, or the default parameter 'HEAD:1'
+ * for all revisions of the given URL. If you specify the more recent
+ * revision first (e.g. 'HEAD:1') then it will also be first in the
+ * result array, whereas if you specify the older revision first ('1:HEAD')
+ * then you'll get a result array with an ascending sort, the most
+ * recent revision being the last array element.
+ * @param $url_revision
+ * The revision of the URL that should be listed.
+ * This needs to be a single revision, e.g. '35' or 'HEAD'.
+ * For example, if a file was deleted in revision 36, you need to pass '35'
+ * as parameter to get its log, otherwise Subversion won't find the file.
+ *
+ * @return
+ * An array of detailed information about the revisions that exist
+ * in the given URL at the specified revision or revision range.
+ * Each revision detail array has the revision number as array key.
+ * If the 'svn log' invocation exited with an error, this function
+ * returns NULL and the error message can be retrieved by calling
+ * svnlib_last_error_message().
+ */
+function svnlib_log($repository_url, $revision_range = 'HEAD:1', $url_revision = 'HEAD') {
+ $cmd = array(
+ escapeshellarg(escapeshellcmd(_svnlib_svn_binary())),
+ 'log',
+ '-r', $revision_range,
+ '--non-interactive',
+ '--xml',
+ '-v',
+ );
+ _svnlib_add_common_options($cmd);
+ $cmd[] = escapeshellarg($repository_url .'@'. $url_revision);
+ $tempfiles = _svnlib_add_output_pipes($cmd);
+
+ $return_code = 0;
+ exec(implode(' ', $cmd), $output, $return_code);
+ if ($return_code != 0) {
+ _svnlib_set_error_message($tempfiles);
+ return NULL; // no such revision(s) found
+ }
+ $log = implode("\n", $output);
+ _svnlib_delete_temporary_files($tempfiles);
+
+ return _svnlib_parse_log($log);
+}
+
+/*
+ * Parse the output of 'svn log' into an array of log entries.
+ * The output looks something like this (0 to N possible "logentry" elements):
+<?xml version="1.0"?>
+<log>
+ <logentry revision="272">
+ <author>jpetso</author>
+ <date>2007-04-12T15:01:00.247137Z</date>
+ <paths>
+ <path action="M">/trunk/lila/kde/scalable/apps/ktorrent.svg</path>
+ <path action="A">/trunk/lila/kde/scalable/devices/laptop.svg</path>
+ <path copyfrom-path="/trunk/lila/kde/scalable/devices/pda_black.svg"
+ copyfrom-rev="270"
+ action="A">/trunk/lila/kde/scalable/devices/pda_blue.svg</path>
+ <path action="R">/trunk/lila/kde/scalable/devices/ipod_unmount.svg</path>
+ <path action="D">/trunk/lila/kde/ChangeLog</path>
+ </paths>
+ <msg>New laptop icon from the GNOME set, more moderate
+ colors in ktorrent.svg, and bits of devices stuff.
+ </msg>
+ </logentry>
+</log>
+*/
+function _svnlib_parse_log($log) {
+ $revisions = array();
+ $xml = new SimpleXMLElement($log);
+
+ foreach ($xml->logentry as $logentry) {
+ $revision = array();
+ $revision['rev'] = intval((string) $logentry['revision']);
+ $revision['author'] = (string) $logentry->author;
+ $revision['msg'] = rtrim((string) $logentry->msg); // no trailing linebreaks
+ $revision['time_t'] = strtotime((string) $logentry->date);
+ $paths = array();
+
+ foreach ($logentry->paths->path as $logpath) {
+ $path = array(
+ 'path' => (string) $logpath,
+ 'action' => (string) $logpath['action'],
+ );
+ if (!empty($logpath['copyfrom-path'])) {
+ $path['copyfrom'] = array(
+ 'path' => (string) $logpath['copyfrom-path'],
+ 'rev' => (string) $logpath['copyfrom-rev'],
+ );
+ }
+ $paths[$path['path']] = $path;
+ }
+ $revision['paths'] = $paths;
+ $revisions[$revision['rev']] = $revision;
+ }
+ return $revisions;
+}
+
+/**
+ * Return the contents of a directory (specified as repository URL,
+ * optionally at a certain revision) as an array of items. This function
+ * is equivalent to 'svn ls $repository_url@$revision'.
+ *
+ * @param $repository_url
+ * The URL of the repository (e.g. 'file:///svnroot/my-repo') or an item
+ * inside that repository (e.g. 'file:///svnroot/my-repo/subdir').
+ * @param $url_revision
+ * The revision of the URL that should be listed.
+ * This needs to be a single revision, e.g. '35' or 'HEAD'.
+ * For example, if a file was deleted in revision 36, you need to pass '35'
+ * as parameter to get its listing, otherwise Subversion won't find the file.
+ * @param $recursive
+ * FALSE to retrieve just the direct child items of the current directory,
+ * or TRUE to descend into each subdirectory and retrieve all descendant
+ * items recursively. If $recursive is true then each directory item
+ * in the result array will have an additional array element 'children'
+ * which contains the list entries below this directory, as array keys
+ * in the result array.
+ *
+ * If @p $repository_url refers to a file then the @p $recursive parameter
+ * has no effect on the 'svn ls' output and, by consequence, on the
+ * return value.
+ *
+ * @return
+ * A array of items. If @p $repository_url refers to a file then the array
+ * contains a single entry with this file, whereas if @p $repository_url
+ * refers to a directory then the array contains all items inside this
+ * directory (but not the directory itself).
+ * If the 'svn ls' invocation exited with an error, this function
+ * returns NULL and the error message can be retrieved by calling
+ * svnlib_last_error_message().
+ */
+function svnlib_ls($repository_url, $url_revision = 'HEAD', $recursive = FALSE) {
+ $cmd = array(
+ escapeshellarg(escapeshellcmd(_svnlib_svn_binary())),
+ 'ls',
+ '--non-interactive',
+ '--xml',
+ );
+ if ($recursive) {
+ $cmd[] = '-R';
+ }
+ _svnlib_add_common_options($cmd);
+ $cmd[] = escapeshellarg($repository_url .'@'. $url_revision);
+ $tempfiles = _svnlib_add_output_pipes($cmd);
+
+ $return_code = 0;
+ exec(implode(' ', $cmd), $output, $return_code);
+ if ($return_code != 0) {
+ _svnlib_set_error_message($tempfiles);
+ return NULL; // no such item or revision found
+ }
+ $lists = implode("\n", $output);
+ _svnlib_delete_temporary_files($tempfiles);
+
+ return _svnlib_parse_ls($lists, $recursive);
+}
+
+/*
+ * Parse the output of 'svn ls' into an array of item entries.
+ * The output looks something like this (0 to N possible "entry" elements):
+<?xml version="1.0"?>
+<lists>
+ <list path="file:///home/jakob/repos/svn/lila-theme/tags/svg-utils-0-1/utils/svg-utils/svgcolor-xml">
+ <entry kind="dir">
+ <name>lila</name>
+ <commit revision="257">
+ <author>jpetso</author>
+ <date>2006-11-29T01:27:47.192716Z</date>
+ </commit>
+ </entry>
+ <entry kind="file">
+ <name>lila/lila-blue.xml</name>
+ <size>918</size>
+ <commit revision="9">
+ <author>dgt84</author>
+ <date>2004-05-04T21:32:13.000000Z</date>
+ </commit>
+ </entry>
+ </list>
+</lists>
+*/
+function _svnlib_parse_ls($lists, $recursive) {
+ $items = array();
+ $current_item_stack = array(); // will help us determine hierarchical structures
+ $xml = new SimpleXMLElement($lists);
+
+ foreach ($xml->list->entry as $entry) {
+ $item = array();
+ $item['created_rev'] = intval((string) $entry->commit['revision']);
+ $item['last_author'] = (string) $entry->commit->author;
+ $item['time_t'] = strtotime((string) $entry->commit->date);
+ $relative_path = (string) $entry->name;
+ $item['name'] = basename($relative_path);
+ $item['type'] = (string) $entry['kind'];
+
+ if ($item['type'] == 'file') {
+ $item['size'] = intval((string) $entry->size);
+ }
+
+ // When listing recursively, we want to capture the item hierarchy.
+ if ($recursive) {
+ if ($item['type'] == 'dir') {
+ $item['children'] = array();
+ }
+ if (strpos($relative_path, '/') !== FALSE) { // don't regard top-level items
+ $parent_path = dirname($relative_path);
+ if (isset($items[$parent_path]) && !in_array($relative_path, $items[$parent_path]['children'])) {
+ $items[$parent_path]['children'][] = $relative_path;
+ }
+ }
+ }
+ $items[$relative_path] = $item;
+ }
+ return $items;
+}
+
+/**
+ * Returns detail information about a directory or file item in the repository.
+ * In most cases, svnlib_info() is the better svnlib_ls(), as it retrieves not
+ * only item names but also repository root and the path of each item
+ * inside the repository.
+ *
+ * You can also use svnlib_info() to retrieve a former item path if the item
+ * has been moved or copied: just pass the current URL and revision together
+ * with a past or future revision number as @p $target_revision, and you get
+ * the path of the item at that time.
+ *
+ * This function is equivalent to
+ * 'svn info -r $target_revision $repository_url@$url_revision'.
+ *
+ * @param $repository_urls
+ * The URL of the item (e.g. 'file:///svnroot/my-repo/subdir/hello.php')
+ * or the repository itself (e.g. 'file:///svnroot/my-repo'), as string.
+ * Alternatively, you can also pass an array of multiple URLs.
+ * @param $url_revision
+ * The revision of the URL that should be listed.
+ * This needs to be a single revision, e.g. '35' or 'HEAD'.
+ * For example, if a file was deleted in revision 36, you need to pass '35'
+ * as parameter to get its info, otherwise Subversion won't find the file.
+ * In case multiple URLs are passed, this revision applies to each of them.
+ * @param $depth
+ * Specifies if info for descendant items should be retrieved as well, and
+ * if so, which of those. The default 'empty' will not retrieve any children,
+ * 'files' will retrieve all immediate file children, 'immediates' will
+ * retrieve file and directory children, and 'infinity' will retrieve all
+ * descendant items there are, recursively. If $depth is 'infinity' then each
+ * directory item in the result array will have an additional array element
+ * named 'children' which contains the paths below this directory, the paths
+ * corresponding to array keys in the result array.
+ *
+ * If @p $repository_url refers to a file then the @p $depth parameter
+ * has no effect on the 'svn info' output and, by consequence, on the
+ * return value.
+ *
+ * @param $target_revision
+ * The revision specification that will be passed to 'svn info' as the
+ * '-r' parameter. This needs to be a single revision, e.g. '35' or 'HEAD'.
+ * This is handy to track item copies and renames, see the general function
+ * description on how to do that. If you leave this at NULL, the info will be
+ * retrieved at the state of the $url_revision.
+ *
+ * @return
+ * A array of items that contain information about the items that correspond
+ * the specified URL(s). If @p $repository_url refers to a directory and
+ * @p $depth is 'infinity', the array also includes information about all
+ * descendants of the items that correspond to the specified URL(s).
+ * If the 'svn info' invocation exited with an error, this function
+ * returns NULL and the error message can be retrieved by calling
+ * svnlib_last_error_message().
+ */
+function svnlib_info($repository_urls, $url_revision = 'HEAD', $depth = 'empty', $target_revision = NULL) {
+ if (!is_array($repository_urls)) { // it's a single URL as a string!
+ $repository_urls = array($repository_urls);
+ }
+
+ $cmd = array(
+ escapeshellarg(escapeshellcmd(_svnlib_svn_binary())),
+ 'info',
+ '--non-interactive',
+ '--xml',
+ );
+
+ if ($depth == 'infinity') {
+ $cmd[] = '-R'; // "--depth infinity" is not in 1.4, but '-R' (recursive) is
+ }
+ elseif ($depth != 'empty') {
+ $version = svnlib_version();
+ if ($version['major'] >= 1 && $version['minor'] >= 5) {
+ $cmd[] = '--depth '. $depth;
+ }
+ else { // 1.4 and earlier compatibility workaround
+ foreach ($repository_urls as $repository_url) {
+ // Make sure the item is a directory, otherwise it has no children
+ // anyways (and the relative path fetched by ls will lead to incorrect
+ // results as it duplicates the basename that is already in the URL).
+ $repository_url_items = svnlib_info($repository_url, $url_revision, 'empty', $target_revision);
+ $repository_url_item = reset($repository_url_items);
+ if ($repository_url_item['type'] != 'dir') {
+ continue;
+ }
+ // Fetch child items with svn ls, that's what 1.4 can actually do.
+ $items = svnlib_ls($repository_url, $url_revision);
+ foreach ($items as $relative_path => $item) {
+ if ($depth == 'files' && $item['type'] = 'dir') {
+ continue; // 'immediates' fetches all children, 'files' only files
+ }
+ $repository_urls[] = $repository_url .'/'. $relative_path;
+ }
+ }
+ }
+ }
+ // else {
+ // "--depth empty" is the default, leave it out for svn <= 1.4 compatibility
+ // }
+
+ if (isset($target_revision)) {
+ $cmd[] = '-r';
+ $cmd[] = $target_revision;
+ }
+ _svnlib_add_common_options($cmd);
+ foreach ($repository_urls as $repository_url) {
+ $cmd[] = escapeshellarg($repository_url .'@'. $url_revision);
+ }
+ $tempfiles = _svnlib_add_output_pipes($cmd);
+
+ $return_code = 0;
+ exec(implode(' ', $cmd), $output, $return_code);
+ if ($return_code != 0) {
+ _svnlib_set_error_message($tempfiles);
+ return NULL; // no such item or revision found
+ }
+ $info = implode("\n", $output);
+ _svnlib_delete_temporary_files($tempfiles);
+
+ $recursive = ($depth == 'infinity');
+ return _svnlib_parse_info($info, $recursive);
+}
+
+/*
+ * Parse the output of 'svn info' into an array of item entries.
+ * The output looks something like this (same URL as in the 'svn ls' example,
+ * also 0 to N possible "entry" elements):
+<?xml version="1.0"?>
+<info>
+ <entry kind="dir" path="svgcolor-xml" revision="275">
+ <url>file:///home/jakob/repos/svn/lila-theme/tags/svg-utils-0-1/utils/svg-utils/svgcolor-xml</url>
+ <repository>
+ <root>file:///home/jakob/repos/svn/lila-theme</root>
+ <uuid>fd53868f-e4f1-0310-84ca-8663aff3ef64</uuid>
+ </repository>
+ <commit revision="257">
+ <author>jpetso</author>
+ <date>2006-11-29T01:27:47.192716Z</date>
+ </commit>
+ </entry>
+ <entry kind="dir" path="lila" revision="275">
+ <url>file:///home/jakob/repos/svn/lila-theme/tags/svg-utils-0-1/utils/svg-utils/svgcolor-xml/lila</url>
+ <repository>
+ <root>file:///home/jakob/repos/svn/lila-theme</root>
+ <uuid>fd53868f-e4f1-0310-84ca-8663aff3ef64</uuid>
+ </repository>
+ <commit revision="257">
+ <author>jpetso</author>
+ <date>2006-11-29T01:27:47.192716Z</date>
+ </commit>
+ </entry>
+ <entry kind="file" path="lila/lila-blue.xml" revision="275">
+ <url>file:///home/jakob/repos/svn/lila-theme/tags/svg-utils-0-1/utils/svg-utils/svgcolor-xml/lila/lila-blue.xml</url>
+ <repository>
+ <root>file:///home/jakob/repos/svn/lila-theme</root>
+ <uuid>fd53868f-e4f1-0310-84ca-8663aff3ef64</uuid>
+ </repository>
+ <commit revision="9">
+ <author>dgt84</author>
+ <date>2004-05-04T21:32:13.000000Z</date>
+ </commit>
+ </entry>
+</info>
+*/
+function _svnlib_parse_info($info, $recursive) {
+ $items = array();
+ $xml = new SimpleXMLElement($info);
+
+ foreach ($xml->entry as $entry) {
+ $item = array();
+ $item['url'] = (string) $entry->url;
+ $item['repository_root'] = (string) $entry->repository->root;
+ $item['repository_uuid'] = (string) $entry->repository->uuid;
+
+ if ($item['url'] == $item['repository_root']) {
+ $item['path'] = '/';
+ }
+ else {
+ $item['path'] = substr($item['url'], strlen($item['repository_root']));
+ }
+
+ if (isset($items[$item['path']])) {
+ // Duplicate item, we had this one before already. Nevertheless, we can
+ // perhaps make use of it in order to enhance the hierarchical structure.
+ $item = $items[$item['path']];
+ }
+ else {
+ $item['type'] = (string) $entry['kind'];
+ $relative_path = (string) $entry['path'];
+ $item['rev'] = intval((string) $entry['revision']); // current state of the item
+ $item['created_rev'] = intval((string) $entry->commit['revision']); // last edit
+ $item['last_author'] = (string) $entry->commit->author;
+ $item['time_t'] = strtotime((string) $entry->commit->date);
+
+ if ($recursive && $item['type'] == 'dir') {
+ $item['children'] = array();
+ }
+ }
+
+ // For "--depth infinity", provide the caller with further hierarchy info.
+ if ($recursive && $item['path'] != '/') {
+ $parent_path = dirname($item['path']);
+ if (isset($items[$parent_path]) && !in_array($item['path'], $items[$parent_path]['children'])) {
+ $items[$parent_path]['children'][] = $item['path'];
+ }
+ }
+ $items[$item['path']] = $item;
+ }
+ return $items;
+}
+
+
+/**
+ * Copy the contents of a file in a repository to a given destination.
+ * This function is equivalent to
+ * 'svn cat $repository_url@$url_revision > $destination'.
+ *
+ * @param $destination
+ * The path of the file that should afterwards contain the file contents.
+ * @param $repository_url
+ * The URL of the file, e.g. 'file:///svnroot/my-repo/subdir/hello.php'.
+ * @param $url_revision
+ * The revision of the URL that should be queried for the property.
+ * This needs to be a single revision, e.g. '35' or 'HEAD'.
+ *
+ * @return
+ * TRUE if the file was created successfully. If the 'svn cat' invocation
+ * exited with an error, this function returns FALSE and the error message
+ * can be retrieved by calling svnlib_last_error_message().
+ */
+function svnlib_cat($destination, $repository_url, $url_revision = 'HEAD') {
+ $cmd = array(
+ escapeshellarg(escapeshellcmd(_svnlib_svn_binary())),
+ 'cat',
+ '--non-interactive',
+ );
+ _svnlib_add_common_options($cmd);
+ $cmd[] = escapeshellarg($repository_url .'@'. $url_revision);
+ $cmd[] = '> '. $destination;
+ $tempfiles = _svnlib_add_output_pipes($cmd);
+
+ $return_code = 0;
+ exec(implode(' ', $cmd), $output, $return_code);
+ if ($return_code != 0) {
+ @unlink($destination);
+ _svnlib_set_error_message($tempfiles);
+ return FALSE; // no such item or revision found
+ }
+ _svnlib_delete_temporary_files($tempfiles);
+ return TRUE;
+}
+
+/**
+ * Return a specific SVN property of the given file or directory in the
+ * repository. This function is equivalent to
+ * 'svn propget $property_name $repository_url@$url_revision'.
+ *
+ * @param $property_name
+ * The name of the property, e.g. 'svn:mime-type' or 'svn:executable'.
+ * @param $repository_url
+ * The URL of the item (e.g. 'file:///svnroot/my-repo/subdir/hello.php')
+ * or the repository itself (e.g. 'file:///svnroot/my-repo'), as string.
+ * @param $url_revision
+ * The revision of the URL that should be queried for the property.
+ * This needs to be a single revision, e.g. '35' or 'HEAD'.
+ *
+ * @return
+ * A string containing the specified property for the item in the given
+ * revision, an empty string if this property is not set. If the
+ * 'svn propget' invocation exited with an error, this function
+ * returns NULL and the error message can be retrieved by calling
+ * svnlib_last_error_message().
+ */
+function svnlib_propget($property_name, $repository_url, $url_revision = 'HEAD') {
+ $cmd = array(
+ escapeshellarg(escapeshellcmd(_svnlib_svn_binary())),
+ 'propget',
+ $property_name,
+ '--non-interactive',
+ );
+ _svnlib_add_common_options($cmd);
+ $cmd[] = escapeshellarg($repository_url .'@'. $url_revision);
+ $tempfiles = _svnlib_add_output_pipes($cmd);
+
+ $return_code = 0;
+ exec(implode(' ', $cmd), $output, $return_code);
+ if ($return_code != 0) {
+ _svnlib_set_error_message($tempfiles);
+ return NULL; // no such item or revision found
+ }
+ $property = trim(implode('', $output));
+ _svnlib_delete_temporary_files($tempfiles);
+
+ if (empty($property)) {
+ return '';
+ }
+ return $property;
+}
--- /dev/null
+Debugger entered--Lisp error: (file-error "Cannot open load file" "../../../../../../elisp/package.d/nxhtml/nxhtml/nxhtml-menu")
+ (nxhtml-global-minor-mode 1)
+ (let* ((util-dir ...) (related-dir ...) (nxhtml-dir ...)) (add-to-list (quote load-path) nxhtml-dir) (add-to-list (quote load-path) related-dir) (add-to-list (quote load-path) util-dir) (add-to-list (quote load-path) nxhtml-install-dir) (message "... nXhtml loading %.1f seconds elapsed ..." (- ... nxhtml-load-time-start)) (load (expand-file-name "nxhtml-loaddefs" nxhtml-install-dir)) (message "... nXhtml loading %.1f seconds elapsed ..." (- ... nxhtml-load-time-start)) (nxhtml-global-minor-mode 1) (message "... nXhtml loading %.1f seconds elapsed ..." (- ... nxhtml-load-time-start)) (when (fboundp ...) (load ...) (rncpp-patch-xhtml-loader)) (message "... nXhtml loading %.1f seconds elapsed ..." (- ... nxhtml-load-time-start)) (load (expand-file-name "nxhtml/nxhtml-autoload" nxhtml-install-dir)))
+ (if (featurep (quote nxhtml-autostart)) nil (provide (quote nxhtml-autostart)) (if (< emacs-major-version 23) (load ...) (let ... ...)) (let* (... ... ...) (add-to-list ... nxhtml-dir) (add-to-list ... related-dir) (add-to-list ... util-dir) (add-to-list ... nxhtml-install-dir) (message "... nXhtml loading %.1f seconds elapsed ..." ...) (load ...) (message "... nXhtml loading %.1f seconds elapsed ..." ...) (nxhtml-global-minor-mode 1) (message "... nXhtml loading %.1f seconds elapsed ..." ...) (when ... ... ...) (message "... nXhtml loading %.1f seconds elapsed ..." ...) (load ...)) (message "... nXhtml loading %.1f seconds elapsed ..." (- ... nxhtml-load-time-start)) (nxhtml-list-loaded-features) (message "Nxml/Nxhtml Autostart.el loaded in %.1f seconds" (- ... nxhtml-load-time-start)))
+ (unless (featurep (quote nxhtml-autostart)) (provide (quote nxhtml-autostart)) (if (< emacs-major-version 23) (load ...) (let ... ...)) (let* (... ... ...) (add-to-list ... nxhtml-dir) (add-to-list ... related-dir) (add-to-list ... util-dir) (add-to-list ... nxhtml-install-dir) (message "... nXhtml loading %.1f seconds elapsed ..." ...) (load ...) (message "... nXhtml loading %.1f seconds elapsed ..." ...) (nxhtml-global-minor-mode 1) (message "... nXhtml loading %.1f seconds elapsed ..." ...) (when ... ... ...) (message "... nXhtml loading %.1f seconds elapsed ..." ...) (load ...)) (message "... nXhtml loading %.1f seconds elapsed ..." (- ... nxhtml-load-time-start)) (nxhtml-list-loaded-features) (message "Nxml/Nxhtml Autostart.el loaded in %.1f seconds" (- ... nxhtml-load-time-start)))
+ eval-buffer(#<buffer *load*> nil "/Users/dave/elisp/package.d/nxhtml/autostart.el" nil t) ; Reading at buffer position 7076
+ load-with-code-conversion("/Users/dave/elisp/package.d/nxhtml/autostart.el" "/Users/dave/elisp/package.d/nxhtml/autostart.el" nil t)
+ load("/Users/dave/elisp/package.d/nxhtml/autostart.el" nil t)
+ command-line-1(("-l" "/Users/dave/elisp/package.d/nxhtml/nxhtmlmaint.el" "-l" "/Users/dave/elisp/package.d/nxhtml/autostart.el" "-f" "nxhtmlmaint-byte-compile-all"))
+ command-line()
+ normal-top-level()
--- /dev/null
+("/Applications/Emacs.app/Contents/MacOS/Emacs" "-Q" "--debug-init" "--load" "/Users/isho/.emacs.d/nxhtml/autostart.el")
+For information about GNU Emacs and the GNU system, type C-h C-a.
+Nxml/Nxhtml Autostart.el loading ...
+Loading /Users/isho/.emacs.d/nxhtml/autostart22.el (source)...
+Loading /Applications/Emacs.app/Contents/Resources/site-lisp/nxml-mode/rng-auto.el (source)...done
+Loading /Users/isho/.emacs.d/nxhtml/autostart22.el (source)...done
+... nXhtml loading 0.1 seconds elapsed ...
+Loading /Users/isho/.emacs.d/nxhtml/nxhtml-loaddefs.el (source)...done
+... nXhtml loading 0.1 seconds elapsed ...
+Loading /Users/isho/.emacs.d/nxhtml/nxhtml/nxhtml-menu.el (source)...
+Loading regexp-opt...done
+Loading easy-mmode...done
+Loading advice...done
+after advising ido
+Loading cl-macs...done
+Loading url-methods...done
+html-site-current (information): No current site set
+Loading derived...done
+Loading byte-opt...done
+
+Finished loading /Users/isho/.emacs.d/nxhtml/util/mumamo.el
+
+Loading /Users/isho/.emacs.d/nxhtml/nxhtml/nxhtml-menu.el (source)...done
+... nXhtml loading 1.3 seconds elapsed ...
+Loading /Users/isho/.emacs.d/nxhtml/etc/schema/schema-path-patch.el (source)...done
+xhtml-loader.rnc was ok
+(No changes need to be saved)
+... nXhtml loading 1.4 seconds elapsed ...
+Loading /Users/isho/.emacs.d/nxhtml/nxhtml/nxhtml-autoload.el (source)...
+nxhtml-autoload starting ... (hm, should maybe be renamed ...)
+majmodpri-apply-priorities running...
+majmodpri-sort-lists running ... (done)
+majmodpri-apply-priorities: No file buffers to change modes in
+majmodpri-apply-priorities running ... (done)
+majmodpri-sort-lists running ... (done)
+nxhtml-autoload finished
+majmodpri-sort-lists running ... (done)
+Loading /Users/isho/.emacs.d/nxhtml/nxhtml/nxhtml-autoload.el (source)...done
+... nXhtml loading 1.7 seconds elapsed ...
+=== Loaded at nxhtml/autostart.el end:
+(feature 'html-imenu)=t
+(feature 'html-quote)=t
+(feature 'html-site)=t
+(feature 'html-upl)=t
+(feature 'mumamo)=t
+(feature 'nxhtml-menu)=t
+(feature 'nxhtml-mode)=t
+(feature 'rngalt)=t
+(feature 'tidy-xhtml)=t
+Nxml/Nxhtml Autostart.el loaded in 1.9 seconds
+nxhtml_test.php has auto save data; consider M-x recover-this-file
+Loading /Users/isho/.emacs.d/nxhtml/util/mumamo-fun.el (source)...done
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=1 from mumamo-get-chunk-save-buffer-state, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=nil
+MU:(find-next-chunk-values nil nil nil)
+MU:find-next-chunk-values:here a, curr-min=1, after-chunk=nil
+MU:find-next-chunk-values:(when (>= 45 1)
+MU:find-next-chunk-values:here d, curr-min=1, after-chunk=nil
+MU:find-next-chunk-values:curr-chunk-funs=(mumamo-chunk-xml-pi mumamo-chunk-inlined-style mumamo-chunk-inlined-script mumamo-chunk-style= mumamo-chunk-onjs=)
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-xml-pi pos=1, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-xml-pi, r=(5 nil php-mode (10 nil) nil mumamo-search-fw-exc-end-xml-pi mumamo-find-borders-xml-pi)
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-inlined-style pos=1, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-inlined-style, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-inlined-script pos=1, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-inlined-script, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-style= pos=1, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-style=, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-onjs= pos=1, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-onjs=, r=nil
+MU:find-next-chunk-values:here A, curr-min=1, after-chunk=nil
+MU:find-next-chunk-values:here B, curr-min=1, after-chunk=nil
+MU:find-next-chunk-values:here E
+MU:find-next-chunk-values:curr-is-closed=t
+MU:find-next-chunk-values=> current=(1 5 html-mode 10 nil nil (mumamo-chunk-xml-pi mumamo-chunk-inlined-style mumamo-chunk-inlined-script mumamo-chunk-style= mumamo-chunk-onjs=) nil t), next=(php-mode mumamo-search-fw-exc-end-xml-pi mumamo-find-borders-xml-pi none 1)
+MU:find-chunks:mumamo-old-tail=nil, major=nil, mumamo-last-chunk=nil
+MU:
+--------------------
+MU:
+--------------------
+MU:find-chunks:Exit.end-param=1, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>, point-max=45, last=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 5 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=1 from mumamo-turn-on-actions, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks:using old at end=1, ok-pos=4, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=1, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>, point-max=45, last=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 5 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=nil from mumamo-turn-on-actions, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:(find-next-chunk-values #<overlay from 1 to 5 in nxhtml_test.php> nil nil)
+MU:find-next-chunk-values:here a, curr-min=5, after-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-next-chunk-values:(when (>= 45 6)
+MU:find-next-chunk-values:Calling (curr-end-fun=mumamo-search-fw-exc-end-xml-pi 4 45)=>44
+MU:find-next-chunk-values:here c, curr-min=5, after-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-next-chunk-values:here c2, curr-min=5, after-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-next-chunk-values:before end-in-code: 5 mumamo-search-fw-exc-end-xml-pi php-mode
+Loading /Users/isho/.emacs.d/nxhtml/related/php-mode.el (source)...
+majmodpri-sort-lists running ... (done)
+Loading /Users/isho/.emacs.d/nxhtml/related/php-mode.el (source)...done
+MU:
+--------------------
+MU:find-next-chunk-values:curr-end-fun-end after end-in-code=44
+MU:find-next-chunk-values:here d, curr-min=5, after-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-next-chunk-values:curr-chunk-funs=nil
+MU:find-next-chunk-values:here A, curr-min=5, after-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-next-chunk-values:here B, curr-min=5, after-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-next-chunk-values:here C, curr-min=5, after-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-next-chunk-values:here D
+MU:find-next-chunk-values:here E
+MU:find-next-chunk-values:curr-is-closed=t
+MU:find-next-chunk-values=> current=(5 44 php-mode nil nil nil nil #<overlay from 1 to 5 in nxhtml_test.php> t), next=(nil nil nil nil -1)
+MU:find-chunks:mumamo-old-tail=nil, major=nil, mumamo-last-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:(find-next-chunk-values #<overlay from 5 to 44 in nxhtml_test.php> nil nil)
+MU:find-next-chunk-values:here a, curr-min=44, after-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:find-next-chunk-values:(when (>= 45 45)
+MU:find-next-chunk-values:here d, curr-min=44, after-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:find-next-chunk-values:curr-chunk-funs=(mumamo-chunk-xml-pi mumamo-chunk-inlined-style mumamo-chunk-inlined-script mumamo-chunk-style= mumamo-chunk-onjs=)
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-xml-pi pos=45, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-xml-pi, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-inlined-style pos=45, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-inlined-style, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-inlined-script pos=45, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-inlined-script, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-style= pos=45, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-style=, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-onjs= pos=45, max=45
+MU:find-next-chunk-values:fn=mumamo-chunk-onjs=, r=nil
+MU:find-next-chunk-values:here A, curr-min=44, after-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:find-next-chunk-values:here B, curr-min=44, after-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:find-next-chunk-values:here C, curr-min=44, after-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:find-next-chunk-values:here D
+MU:find-next-chunk-values:here E
+MU:find-next-chunk-values:curr-is-closed=nil
+MU:find-next-chunk-values=> current=(44 nil html-mode nil nil nil (mumamo-chunk-xml-pi mumamo-chunk-inlined-style mumamo-chunk-inlined-script mumamo-chunk-style= mumamo-chunk-onjs=) #<overlay from 5 to 44 in nxhtml_test.php> nil), next=(nil nil nil nil 1)
+MU:find-chunks:mumamo-old-tail=nil, major=nil, mumamo-last-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=1 from mumamo-set-major-post-command, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=1, ok-pos=45, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=1, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 5 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=1 from mumamo-fontify-region-1, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=1, ok-pos=45, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=1, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 5 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=1 from mumamo-fontify-region-1 2, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=1, ok-pos=45, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=1, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 5 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=1 from syntax-ppss, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=1, ok-pos=45, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=1, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 5 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=5 from mumamo-fontify-region-1 2, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=5, ok-pos=45, this-new-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=5, this-new-chunk=#<overlay from 5 to 44 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 5 to 44 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=10 from syntax-ppss, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=10, ok-pos=45, this-new-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=10, this-new-chunk=#<overlay from 5 to 44 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 5 to 44 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=44 from mumamo-fontify-region-1 2, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=44, ok-pos=45, this-new-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=44, this-new-chunk=#<overlay from 44 to 45 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 44 to 45 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=2 from mumamo-set-major-post-command, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=2, ok-pos=45, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=2, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 5 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=3 from mumamo-set-major-post-command, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=3, ok-pos=45, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=3, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 5 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=4 from mumamo-set-major-post-command, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=4, ok-pos=45, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=4, this-new-chunk=#<overlay from 1 to 5 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 5 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=5 from mumamo-set-major-post-command, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=5, ok-pos=45, this-new-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=5, this-new-chunk=#<overlay from 5 to 44 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 5 to 44 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=5 from mumamo-idle-set-major-mode, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=5, ok-pos=45, this-new-chunk=#<overlay from 5 to 44 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=5, this-new-chunk=#<overlay from 5 to 44 in nxhtml_test.php>, point-max=45, last=#<overlay from 44 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 5 to 44 in nxhtml_test.php>
+MU:c-after-change: major-mode=php-mode c-nonsymbol-token-regexp=!=\|##\|%\(?::%:\|[:=]\)\|&[&=]\|\*[/=]\|\+[+=]\|-[=>-]\|\.\.\.\|/[*/=]\|:[:>]\|<\(?:<=\|[:<=]\)\|==\|>\(?:>=\|[=>]\)\|\?\?\(?:!\?\?!\|=\?\?=\|[!()=-]\)\|\^=\||[=|]\|[]!#%&(-,./:-?[{-~^-]
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=5 from syntax-ppss-flush-cache, level=0
+MU:find-chunks:first-check-from=4, chunk-at-change-min=#<overlay from 5 to 5 in nxhtml_test.php>
+MU:find-chunks:at start mumamo-old-tail=#<overlay from 1 to 5 in nxhtml_test.php>, mumamo-last-chunk=nil
+MU:(find-next-chunk-values nil 4 nil)
+MU:find-next-chunk-values:here a, curr-min=1, after-chunk=nil
+MU:find-next-chunk-values:(when (>= 6 1)
+MU:find-next-chunk-values:here d, curr-min=1, after-chunk=nil
+MU:find-next-chunk-values:curr-chunk-funs=(mumamo-chunk-xml-pi mumamo-chunk-inlined-style mumamo-chunk-inlined-script mumamo-chunk-style= mumamo-chunk-onjs=)
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-xml-pi pos=1, max=6
+MU:find-next-chunk-values:fn=mumamo-chunk-xml-pi, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-inlined-style pos=1, max=6
+MU:find-next-chunk-values:fn=mumamo-chunk-inlined-style, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-inlined-script pos=1, max=6
+MU:find-next-chunk-values:fn=mumamo-chunk-inlined-script, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-style= pos=1, max=6
+MU:find-next-chunk-values:fn=mumamo-chunk-style=, r=nil
+MU:find-next-chunk-values:before (r (funcall fn pos pos max)), fn=mumamo-chunk-onjs= pos=1, max=6
+MU:find-next-chunk-values:fn=mumamo-chunk-onjs=, r=nil
+MU:find-next-chunk-values:here A, curr-min=1, after-chunk=nil
+MU:find-next-chunk-values:here B, curr-min=1, after-chunk=nil
+MU:find-next-chunk-values:here E
+MU:find-next-chunk-values:curr-is-closed=nil
+MU:find-next-chunk-values=> current=(1 nil html-mode nil nil nil (mumamo-chunk-xml-pi mumamo-chunk-inlined-style mumamo-chunk-inlined-script mumamo-chunk-style= mumamo-chunk-onjs=) nil nil), next=(nil nil nil nil 1)
+MU:find-chunks:mumamo-old-tail=#<overlay from 1 to 5 in nxhtml_test.php>, major=html-mode, mumamo-last-chunk=nil
+MU:find-chunks:Exit.end-param=5, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>, point-max=6, last=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 6 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=5 from mumamo-set-major-post-command, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:using old at end=5, ok-pos=6, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=5, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>, point-max=6, last=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 6 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=1 from mumamo-fontify-region-1, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:using old at end=1, ok-pos=6, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=1, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>, point-max=6, last=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 6 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=1 from mumamo-fontify-region-1 2, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:using old at end=1, ok-pos=6, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=1, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>, point-max=6, last=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 6 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=1 from syntax-ppss, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:using old at end=1, ok-pos=6, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=1, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>, point-max=6, last=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 6 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=5 from mumamo-idle-set-major-mode, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:using old at end=5, ok-pos=6, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=5, this-new-chunk=#<overlay from 1 to 6 in nxhtml_test.php>, point-max=6, last=#<overlay from 1 to 6 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 6 in nxhtml_test.php>
+Mark set
+MU:c-after-change: major-mode=html-mode c-nonsymbol-token-regexp=nil
+Loading debug...done
+Entering debugger...
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=5 from mumamo-fontify-region-1, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=5, ok-pos=45, this-new-chunk=#<overlay from 1 to 45 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=5, this-new-chunk=#<overlay from 1 to 45 in nxhtml_test.php>, point-max=45, last=#<overlay from 1 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 45 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=5 from mumamo-fontify-region-1 2, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=5, ok-pos=45, this-new-chunk=#<overlay from 1 to 45 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=5, this-new-chunk=#<overlay from 1 to 45 in nxhtml_test.php>, point-max=45, last=#<overlay from 1 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 45 in nxhtml_test.php>
+MU:!!!!!!!!!!!!!!!!!!!find-chunks end=5 from syntax-ppss, level=0
+MU:find-chunks:first-check-from=nil, chunk-at-change-min=nil
+MU:find-chunks:at start mumamo-old-tail=nil, mumamo-last-chunk=#<overlay from 1 to 45 in nxhtml_test.php>
+MU:find-chunks:using old at end=5, ok-pos=45, this-new-chunk=#<overlay from 1 to 45 in nxhtml_test.php>
+MU:find-chunks:Exit.end-param=5, this-new-chunk=#<overlay from 1 to 45 in nxhtml_test.php>, point-max=45, last=#<overlay from 1 to 45 in nxhtml_test.php>
+MU:find-chunks=>#<overlay from 1 to 45 in nxhtml_test.php>
+Quit
+File `/Users/isho/Desktop/backtrace.txt' exists; overwrite? (y or n)
+Wrote /Users/isho/Desktop/backtrace.txt
+File `~/Desktop/messages.txt' exists; overwrite? (y or n)
--- /dev/null
+
+<?php echo "this could be anything"; ?>
--- /dev/null
+ <h1>New post</h1>
+
+<% form_for(@post) do |f| %>
+ <%= f.error_messages %>
+<p>
+ <%= f.label :title %><br />
+<% a = f.text_field :title %>
+</p>
+<p>
+ <%= f.label :body %><br />
+<%#= f.text_area :body %>
+</p>
+<p>
+ <%= f.submit 'Create' %>
+</p>
+<% end %>
+
+<%= link_to 'Back', posts_path %>
--- /dev/null
+<?php\r
+\r
+class Foo {\r
+ public function foo() {\r
+ $foo = <<<EOT_SQL\r
+ I am a heredoc\r
+EOT_SQL\r
+ }\r
+}\r
--- /dev/null
+<?php
+
+class Foo {
+ public function foo() {
+ $foo = <<<EOT_SQL
+ I am a heredoc
+EOT_SQL;
+ }
+}
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+ xmlns:xi="http://www.w3.org/2001/XInclude"
+ xmlns:py="http://genshi.edgewall.org/"
+ py:strip="True">
+ <head>
+ <title></title>
+ </head>
+ <body>
+ <py:match path="head" once="True">Something</py:match>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>
+<mx:Canvas
+ xmlns:mx="http://www.adobe.com/2006/mxml"
+ xmlns:c="imo.utils.*"
+ xmlns:imocp="imo.components.*"
+ xmlns:fl="http://github.com/lancecarlson/flails"
+ xmlns:commons="imo.components.commons.*"
+ creationComplete="resetMenus()"
+ horizontalScrollPolicy="off" verticalScrollPolicy="off">
+
+ <mx:Script>
+ <![CDATA[
+ import imo.components.tooltips.MediaFileToolTip;
+
+ import mx.core.UIComponent;
+ import mx.events.DragEvent;
+ import mx.managers.DragManager;
+
+ public static const LEFT_STATES:Array = [];
+ public static const RIGHT_STATES:Array = [];
+
+ [Deprecated]
+ public function changeState(state:String):void {
+ containers.currentState = state;
+ }
+
+ private function tabMouseDown(e:MouseEvent):void{
+ resetMenus(e.target.parent);
+ containers.currentState = e.target.label;
+ }
+
+ private function resetMenus(which:Object = null):void {
+ if (which == null) {
+ leftMenu.selectedIndex = -1;
+ rightMenu.selectedIndex = -1;
+ } else {
+ which.selectedIndex = -1;
+ }
+ }
+
+ private function onDragEnter( event:DragEvent ):void{
+ containers.currentState = "queue";
+ DragManager.acceptDragDrop( UIComponent(event.target) );
+ }
+
+ private function updateMenu(page:Object):void{
+ if (page.hasOwnProperty("menu")) {
+ this[page.menu + "Menu"].selectedIndex = page.menuIndex;
+ } else {
+ resetMenus();
+ }
+ }
+ ]]>
+ </mx:Script>
+
+ <!--<commons:TransparentBorderCanvas styleName="sideCanvas" x="-10" width="30" height="210"
+ horizontalScrollPolicy="off" verticalScrollPolicy="off"
+ customBorderThickness="2" borderAlpha=".6" cornerRadius="10">-->
+ <mx:Canvas styleName="sideCanvas" horizontalScrollPolicy="off" verticalScrollPolicy="off" x="-8" width="30" height="174" >
+ <mx:TabBar id="leftMenu"
+ styleName="sideMenu"
+ dataProvider="{LEFT_STATES.reverse()}"
+ rotation="90"
+ x="24"
+ y="4"
+ width="163"
+ buttonMode="true"
+ mouseDown="tabMouseDown(event);"
+ toggleOnClick="true"/>
+ </mx:Canvas>
+ <!--</commons:TransparentBorderCanvas>-->
+
+ <imocp:MainContainer x="29" y="0" id="containers" width="376" height="473"/>
+ <mx:Canvas x="412" styleName="sideCanvas" horizontalScrollPolicy="off" verticalScrollPolicy="off" width="40" height="155">
+ <mx:TabBar x="22" y="5" id="rightMenu" mouseDown="tabMouseDown(event);"
+ styleName="rightSideMenu"
+ dataProvider="{RIGHT_STATES.reverse()}"
+ rotation="90"
+ width="142"
+ buttonMode="true"
+ dragEnter="onDragEnter(event)"
+ toggleOnClick="true"/>
+ </mx:Canvas>
+ <!--</commons:TransparentBorderCanvas>-->
+</mx:Canvas>
--- /dev/null
+;; NXHTML
+;;(load (concat vendor-path "/nxhtml/autostart.el"))
+
+(defconst mumamo-actionscript-tag-start-regex
+ (rx "<mx:Script>" (0+ space) "<![CDATA["))
+
+(defconst mumamo-actionscript-tag-end-regex
+ (rx "]]>" (0+ space) "</mx:Script>"))
+
+;; (defun mumamo-search-bw-exc-start-inlined-actionscript (pos min)
+;; (let ((exc-start (mumamo-chunk-start-bw-re pos min mumamo-actionscript-tag-start-regex)))
+;; (and exc-start
+;; (<= exc-start pos)
+;; (cons exc-start 'espresso-mode))))
+
+;; (defun mumamo-search-bw-exc-end-inlined-actionscript (pos min)
+;; (mumamo-chunk-end-bw-re pos min mumamo-actionscript-tag-end-regex))
+
+;; (defun mumamo-search-fw-exc-start-inlined-actionscript-old (pos max)
+;; (mumamo-chunk-start-fw-re pos max mumamo-actionscript-tag-start-regex))
+
+(defun mumamo-search-fw-exc-start-inlined-actionscript (pos max)
+ (let ((where (mumamo-chunk-start-fw-re pos max mumamo-actionscript-tag-start-regex)))
+ (when where
+ (list where 'js-mode))))
+
+(defun mumamo-search-fw-exc-end-inlined-actionscript (pos max)
+ (mumamo-chunk-end-fw-re pos max mumamo-actionscript-tag-end-regex))
+
+(defun mumamo-chunk-inlined-actionscript (pos min max)
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-exc-start-inlined-actionscript
+ ;; 'mumamo-search-bw-exc-end-inlined-actionscript
+ ;; 'mumamo-search-fw-exc-start-inlined-actionscript-old
+ ;; 'mumamo-search-fw-exc-end-inlined-actionscript)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-inlined-actionscript
+ 'mumamo-search-fw-exc-end-inlined-actionscript))
+
+(define-mumamo-multi-major-mode mxml-actionscript-mumamo-mode
+ "Turn on multiple major modes for MXML with main mode `nxml-mode'.
+This covers inlined style and script for mxml."
+ ("nXml Family" nxml-mode (mumamo-chunk-inlined-actionscript)))
+
+(add-to-list 'auto-mode-alist '("\\.mxml$" . mxml-actionscript-mumamo-mode))
--- /dev/null
+\r
+<?php\r
+\r
+class Foo {\r
+ public $foo = array(\r
+ 'long' => <<<'LONG'\r
+lorem ipsum\r
+LONG\r
+);\r
+\r
+ public $bar = 1;\r
+ CancelOk\r
--- /dev/null
+\r
+<body>\r
+ <?php\r
+echo "test";\r
+echo "test2";
\ No newline at end of file
--- /dev/null
+<?php
+function render()
+{
+ $html =<<<HTML
+ <head>
+ </head>
+ <body>
+ <div id="some_id" class="some_class"></div>
+ <div id="some_id" class="some_class"></div>
+ <form method="post" id="" action="">
+ </form>
+ <form method="get" id="id2" action="do.php">
+ </form>
+ </body>
+HTML;
+
+echo $html;
+}
+
+render();
+ ?>
--- /dev/null
+#!/usr/bin/perl
+# heredoc_demo.pl doom@kzsu.stanford.edu
+# December 10, 2009
+
+use warnings;
+use strict;
+$|=1;
+use Data::Dumper;
+
+use File::Path qw( mkpath );
+use File::Basename qw( fileparse basename dirname );
+use File::Copy qw( copy move );
+use Fatal qw( open close mkpath copy move );
+use Cwd qw( cwd abs_path );
+
+use Env qw(HOME);
+
+our $VERSION = 0.01;
+my $prog = basename($0);
+
+use Getopt::Std;
+my %opt = ();
+getopts('d', \%opt);
+my $DEBUG = $opt{d} || 1; # TODO set default to 0 when in production
+
+my ($title, $incantation, $god);
+
+my $skull=<<"END_SQL";
+ SELECT id, god, incantation
+ FROM spell, pantheon
+ WHERE pantheon.id = spell.pantheon AND
+ pantheon.name = 'lovecraft'
+END_SQL
+
+my $phfftp=<<"END_HTML";
+<HTML><HEAD><TITLE>$title</TITLE></HEAD>
+<BODY>
+<H2>$title</H2>
+<P>Speak not the dread words of $incantation
+lest ye invoke the $god.</P>
+</BODY></HTML>
+END_HTML
+
+print $skull, "\n";
+print $phfftp, "\n";
+
+__END__
+
+=head1 NAME
+
+heredoc_demo.pl - (( TODO insert brief description ))
+
+=head1 SYNOPSIS
+
+ heredoc_demo.pl -[options] [arguments]
+
+ Options:
+ -d debug
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-d>
+
+Turn on debug messages.
+
+=back
+
+=head1 DESCRIPTION
+
+B<heredoc_demo.pl> is a script which
+
+(( TODO insert explaination
+ This is stub documentation created by template.el. ))
+
+=head1 AUTHOR
+
+Joseph Brenner, E<lt>doom@kzsu.stanford.eduE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2009 by Joseph Brenner
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+=head1 BUGS
+
+None reported... yet.
+
+=cut
--- /dev/null
+Wrote /home/ranko/.emacs.d/nxhtml/web-vcs-temp.tmp
+Updated "/home/ranko/.emacs.d/nxhtml/autostart.el"
+Invalid face reference: hi-gold [4 times]
+Reading [application/octet-stream]... 2k of 2k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/web-vcs-temp.tmp
+Updated "/home/ranko/.emacs.d/nxhtml/autostart22.el"
+Invalid face reference: hi-gold
+Reading [application/octet-stream]... 77 bytes of 66 bytes (117%)
+Wrote /home/ranko/.emacs.d/nxhtml/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/emacs22.cmd" was ok
+Reading [application/octet-stream]... 158k of 158k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/web-vcs-temp.tmp
+Updated "/home/ranko/.emacs.d/nxhtml/nxhtml-loaddefs.el"
+Reading [application/octet-stream]... 16k of 16k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/web-vcs-temp.tmp
+Updated "/home/ranko/.emacs.d/nxhtml/nxhtmlmaint.el"
+Reading [text/plain]... 1k of 1k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/README.txt" was ok
+Reading [application/octet-stream]... 18k of 18k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/web-vcs-temp.tmp
+Downloaded "/home/ranko/.emacs.d/nxhtml/web-autoload.el"
+Reading [application/octet-stream]... 95k of 95k (100%) [2 times]
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/web-vcs-temp.tmp
+Downloaded "/home/ranko/.emacs.d/nxhtml/web-vcs.el"
+Contacting host: bazaar.launchpad.net:80
+Reading [application/octet-stream]... 5k of 5k (100%)
+Wrote /home/ranko/.emacs.d/nxhtml/alts/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/alts/find-recursive-orig.el" was ok
+Reading [application/octet-stream]... 23k of 23k (100%)
+Wrote /home/ranko/.emacs.d/nxhtml/alts/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/alts/javascript-mozlab.el" was ok
+Reading [application/octet-stream]... 97k of 97k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/alts/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/alts/smarty-mode-vdebout.el" was ok
+Contacting host: bazaar.launchpad.net:80 [2 times]
+Reading [image/jpeg]... 25k of 25k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/etc/img/pause/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/etc/img/pause/pause.jpg" was ok
+Reading [image/jpeg]... 26k of 26k (100%)
+Wrote /home/ranko/.emacs.d/nxhtml/etc/img/pause/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/etc/img/pause/pause2.jpg" was ok
+Contacting host: bazaar.launchpad.net:80
+Reading [application/octet-stream]... 1k of 1k (100%)
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/etc/schema/genshi-old.rnc" was ok
+Reading [text/xml]... 150 bytes of 139 bytes (108%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/etc/schema/genshi-schemas.xml" was ok
+Reading [application/octet-stream]... 2k of 2k (100%)
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+Updated "/home/ranko/.emacs.d/nxhtml/etc/schema/genshi.rnc"
+Reading [application/octet-stream]... 2k of 2k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/etc/schema/mjt.rnc" was ok
+Reading [text/x-diff]... 1k of 1k (100%)
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/etc/schema/nxml-erb.patch" was ok
+Reading [application/octet-stream]... 1k of 1k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+Downloaded "/home/ranko/.emacs.d/nxhtml/etc/schema/old-genshi.rnc"
+Reading [application/octet-stream]... 2k of 2k (100%)
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+Downloaded "/home/ranko/.emacs.d/nxhtml/etc/schema/old-qtmstr-xhtml.rnc"
+Reading [application/octet-stream]... 367 bytes of 356 bytes (103%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+Downloaded "/home/ranko/.emacs.d/nxhtml/etc/schema/old-xinclude.rnc"
+Reading [application/octet-stream]... 2k of 2k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/etc/schema/qtmstr-xhtml-old.rnc" was ok
+Reading [application/octet-stream]... 2k of 2k (100%)
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+Updated "/home/ranko/.emacs.d/nxhtml/etc/schema/qtmstr-xhtml.rnc"
+Reading [application/octet-stream]... 3k of 3k (100%)
+Reading... done.
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+File "/home/ranko/.emacs.d/nxhtml/etc/schema/schema-path-patch.el" was ok
+Reading [application/octet-stream]... 890 bytes of 879 bytes (101%)
+Wrote /home/ranko/.emacs.d/nxhtml/etc/schema/web-vcs-temp.tmp
+Updated "/home/ranko/.emacs.d/nxhtml/etc/schema/xinclude.rnc"
+let*: Args out of range: 5023, 5047
+Mark set [2 times]
+Saved text from "Contacting host: bazaar.launchpad.net:80"
+call-interactively: End of buffer
+(New file)
--- /dev/null
+<h1><%= t('views.common.login') %></h1>
+
+<% form_tag session_path do -%>
+<p><%= label_tag(t('views.common.username')) %><br />
+<%= text_field_tag 'login', @login %></p>
+
+<p><%= label_tag(t('views.common.password')) %><br/>
+<%= password_field_tag 'password', nil %></p>
+
+<p><%= submit_tag(t('views.common.login_verb')) %></p>
+<% end -%>
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en" dir="ltr">
+<head>
+</head>
+
+<body>
+ <script type="text/javascript">
+ </script>
+</body>
+</html>
--- /dev/null
+<!DOCTYPE html PUBLIC
+"-//W3C//DTD XHTML 1.0 Strict//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+ xmlns:py="http://genshi.edgewall.org/">
+ <head>
+ <title>Title</title>
+ </head>
+ <!-- To test this open this file in `genshi-nxhtml-mumamo-mode' and
+ add evaluate this: -->
+ <!-- (setq exec-path (cons "c:/python26/" exec-path)) -->
+ <!-- (add-hook 'python-mode-hook 'turn-on-eldoc-mode) -->
+ <body>
+ ${}
+ </body>
+</html>
--- /dev/null
+In JSP page, if we have a line like <% // some comments %>, then the "%>" is ignored by nxhtml.\r
+However if we write it like this:\r
+<% // some comments\r
+%>\r
+or\r
+<%\r
+// some comments\r
+%>\r
+then the page is parsed correctly\r
--- /dev/null
+\r
+ <?php /* ?>\r
+ This is a comment\r
+ */\r
+ ?>\r
+ This is html\r
--- /dev/null
+# $Id: statemachine.py 6188 2009-10-28 14:08:17Z milde $
+# Author: David Goodger <goodger@python.org>
+# Copyright: This module has been placed in the public domain.
+
+"""
+A finite state machine specialized for regular-expression-based text filters,
+this module defines the following classes:
+
+- `StateMachine`, a state machine
+- `State`, a state superclass
+- `StateMachineWS`, a whitespace-sensitive version of `StateMachine`
+- `StateWS`, a state superclass for use with `StateMachineWS`
+- `SearchStateMachine`, uses `re.search()` instead of `re.match()`
+- `SearchStateMachineWS`, uses `re.search()` instead of `re.match()`
+- `ViewList`, extends standard Python lists.
+- `StringList`, string-specific ViewList.
+
+Exception classes:
+
+- `StateMachineError`
+- `UnknownStateError`
+- `DuplicateStateError`
+- `UnknownTransitionError`
+- `DuplicateTransitionError`
+- `TransitionPatternNotFound`
+- `TransitionMethodNotFound`
+- `UnexpectedIndentationError`
+- `TransitionCorrection`: Raised to switch to another transition.
+- `StateCorrection`: Raised to switch to another state & transition.
+
+Functions:
+
+- `string2lines()`: split a multi-line string into a list of one-line strings
+
+
+How To Use This Module
+======================
+(See the individual classes, methods, and attributes for details.)
+
+1. Import it: ``import statemachine`` or ``from statemachine import ...``.
+ You will also need to ``import re``.
+
+2. Derive a subclass of `State` (or `StateWS`) for each state in your state
+ machine::
+
+ class MyState(statemachine.State):
+
+ Within the state's class definition:
+
+ a) Include a pattern for each transition, in `State.patterns`::
+
+ patterns = {'atransition': r'pattern', ...}
+
+ b) Include a list of initial transitions to be set up automatically, in
+ `State.initial_transitions`::
+
+ initial_transitions = ['atransition', ...]
+
+ c) Define a method for each transition, with the same name as the
+ transition pattern::
+
+ def atransition(self, match, context, next_state):
+ # do something
+ result = [...] # a list
+ return context, next_state, result
+ # context, next_state may be altered
+
+ Transition methods may raise an `EOFError` to cut processing short.
+
+ d) You may wish to override the `State.bof()` and/or `State.eof()` implicit
+ transition methods, which handle the beginning- and end-of-file.
+
+ e) In order to handle nested processing, you may wish to override the
+ attributes `State.nested_sm` and/or `State.nested_sm_kwargs`.
+
+ If you are using `StateWS` as a base class, in order to handle nested
+ indented blocks, you may wish to:
+
+ - override the attributes `StateWS.indent_sm`,
+ `StateWS.indent_sm_kwargs`, `StateWS.known_indent_sm`, and/or
+ `StateWS.known_indent_sm_kwargs`;
+ - override the `StateWS.blank()` method; and/or
+ - override or extend the `StateWS.indent()`, `StateWS.known_indent()`,
+ and/or `StateWS.firstknown_indent()` methods.
+
+3. Create a state machine object::
+
+ sm = StateMachine(state_classes=[MyState, ...],
+ initial_state='MyState')
+
+4. Obtain the input text, which needs to be converted into a tab-free list of
+ one-line strings. For example, to read text from a file called
+ 'inputfile'::
+
+ input_string = open('inputfile').read()
+ input_lines = statemachine.string2lines(input_string)
+
+5. Run the state machine on the input text and collect the results, a list::
+
+ results = sm.run(input_lines)
+
+6. Remove any lingering circular references::
+
+ sm.unlink()
+"""
+
+__docformat__ = 'restructuredtext'
+
+import sys
+import re
+import types
+import unicodedata
+
+
+class StateMachine:
+
+ """
+ A finite state machine for text filters using regular expressions.
+
+ The input is provided in the form of a list of one-line strings (no
+ newlines). States are subclasses of the `State` class. Transitions consist
+ of regular expression patterns and transition methods, and are defined in
+ each state.
+
+ The state machine is started with the `run()` method, which returns the
+ results of processing in a list.
+ """
+
+ def __init__(self, state_classes, initial_state, debug=0):
+ """
+ Initialize a `StateMachine` object; add state objects.
+
+ Parameters:
+
+ - `state_classes`: a list of `State` (sub)classes.
+ - `initial_state`: a string, the class name of the initial state.
+ - `debug`: a boolean; produce verbose output if true (nonzero).
+ """
+
+ self.input_lines = None
+ """`StringList` of input lines (without newlines).
+ Filled by `self.run()`."""
+
+ self.input_offset = 0
+ """Offset of `self.input_lines` from the beginning of the file."""
+
+ self.line = None
+ """Current input line."""
+
+ self.line_offset = -1
+ """Current input line offset from beginning of `self.input_lines`."""
+
+ self.debug = debug
+ """Debugging mode on/off."""
+
+ self.initial_state = initial_state
+ """The name of the initial state (key to `self.states`)."""
+
+ self.current_state = initial_state
+ """The name of the current state (key to `self.states`)."""
+
+ self.states = {}
+ """Mapping of {state_name: State_object}."""
+
+ self.add_states(state_classes)
+
+ self.observers = []
+ """List of bound methods or functions to call whenever the current
+ line changes. Observers are called with one argument, ``self``.
+ Cleared at the end of `run()`."""
+
+ def unlink(self):
+ """Remove circular references to objects no longer required."""
+ for state in self.states.values():
+ state.unlink()
+ self.states = None
+
+ def run(self, input_lines, input_offset=0, context=None,
+ input_source=None, initial_state=None):
+ """
+ Run the state machine on `input_lines`. Return results (a list).
+
+ Reset `self.line_offset` and `self.current_state`. Run the
+ beginning-of-file transition. Input one line at a time and check for a
+ matching transition. If a match is found, call the transition method
+ and possibly change the state. Store the context returned by the
+ transition method to be passed on to the next transition matched.
+ Accumulate the results returned by the transition methods in a list.
+ Run the end-of-file transition. Finally, return the accumulated
+ results.
+
+ Parameters:
+
+ - `input_lines`: a list of strings without newlines, or `StringList`.
+ - `input_offset`: the line offset of `input_lines` from the beginning
+ of the file.
+ - `context`: application-specific storage.
+ - `input_source`: name or path of source of `input_lines`.
+ - `initial_state`: name of initial state.
+ """
+ self.runtime_init()
+ if isinstance(input_lines, StringList):
+ self.input_lines = input_lines
+ else:
+ self.input_lines = StringList(input_lines, source=input_source)
+ self.input_offset = input_offset
+ self.line_offset = -1
+ self.current_state = initial_state or self.initial_state
+ if self.debug:
+ print >>sys.stderr, (
+ '\nStateMachine.run: input_lines (line_offset=%s):\n| %s'
+ % (self.line_offset, '\n| '.join(self.input_lines)))
+ transitions = None
+ results = []
+ state = self.get_state()
+ try:
+ if self.debug:
+ print >>sys.stderr, ('\nStateMachine.run: bof transition')
+ context, result = state.bof(context)
+ results.extend(result)
+ while 1:
+ try:
+ try:
+ self.next_line()
+ if self.debug:
+ source, offset = self.input_lines.info(
+ self.line_offset)
+ print >>sys.stderr, (
+ '\nStateMachine.run: line (source=%r, '
+ 'offset=%r):\n| %s'
+ % (source, offset, self.line))
+ context, next_state, result = self.check_line(
+ context, state, transitions)
+ except EOFError:
+ if self.debug:
+ print >>sys.stderr, (
+ '\nStateMachine.run: %s.eof transition'
+ % state.__class__.__name__)
+ result = state.eof(context)
+ results.extend(result)
+ break
+ else:
+ results.extend(result)
+ except TransitionCorrection, exception:
+ self.previous_line() # back up for another try
+ transitions = (exception.args[0],)
+ if self.debug:
+ print >>sys.stderr, (
+ '\nStateMachine.run: TransitionCorrection to '
+ 'state "%s", transition %s.'
+ % (state.__class__.__name__, transitions[0]))
+ continue
+ except StateCorrection, exception:
+ self.previous_line() # back up for another try
+ next_state = exception.args[0]
+ if len(exception.args) == 1:
+ transitions = None
+ else:
+ transitions = (exception.args[1],)
+ if self.debug:
+ print >>sys.stderr, (
+ '\nStateMachine.run: StateCorrection to state '
+ '"%s", transition %s.'
+ % (next_state, transitions[0]))
+ else:
+ transitions = None
+ state = self.get_state(next_state)
+ except:
+ if self.debug:
+ self.error()
+ raise
+ self.observers = []
+ return results
+
+ def get_state(self, next_state=None):
+ """
+ Return current state object; set it first if `next_state` given.
+
+ Parameter `next_state`: a string, the name of the next state.
+
+ Exception: `UnknownStateError` raised if `next_state` unknown.
+ """
+ if next_state:
+ if self.debug and next_state != self.current_state:
+ print >>sys.stderr, \
+ ('\nStateMachine.get_state: Changing state from '
+ '"%s" to "%s" (input line %s).'
+ % (self.current_state, next_state,
+ self.abs_line_number()))
+ self.current_state = next_state
+ try:
+ return self.states[self.current_state]
+ except KeyError:
+ raise UnknownStateError(self.current_state)
+
+ def next_line(self, n=1):
+ """Load `self.line` with the `n`'th next line and return it."""
+ try:
+ try:
+ self.line_offset += n
+ self.line = self.input_lines[self.line_offset]
+ except IndexError:
+ self.line = None
+ raise EOFError
+ return self.line
+ finally:
+ self.notify_observers()
+
+ def is_next_line_blank(self):
+ """Return 1 if the next line is blank or non-existant."""
+ try:
+ return not self.input_lines[self.line_offset + 1].strip()
+ except IndexError:
+ return 1
+
+ def at_eof(self):
+ """Return 1 if the input is at or past end-of-file."""
+ return self.line_offset >= len(self.input_lines) - 1
+
+ def at_bof(self):
+ """Return 1 if the input is at or before beginning-of-file."""
+ return self.line_offset <= 0
+
+ def previous_line(self, n=1):
+ """Load `self.line` with the `n`'th previous line and return it."""
+ self.line_offset -= n
+ if self.line_offset < 0:
+ self.line = None
+ else:
+ self.line = self.input_lines[self.line_offset]
+ self.notify_observers()
+ return self.line
+
+ def goto_line(self, line_offset):
+ """Jump to absolute line offset `line_offset`, load and return it."""
+ try:
+ try:
+ self.line_offset = line_offset - self.input_offset
+ self.line = self.input_lines[self.line_offset]
+ except IndexError:
+ self.line = None
+ raise EOFError
+ return self.line
+ finally:
+ self.notify_observers()
+
+ def get_source(self, line_offset):
+ """Return source of line at absolute line offset `line_offset`."""
+ return self.input_lines.source(line_offset - self.input_offset)
+
+ def get_source_spot(self, line_offset=None):
+ """Return dict with source position of current or given line"""
+ if line_offset is None:
+ line_offset = self.line_offset
+ else:
+ line_offset -= self.input_offset
+ (source, offset) = self.input_lines.info(line_offset)
+ return {'source': source, 'line': offset + 1}
+
+ def abs_line_offset(self):
+ """Return line offset of current line, from beginning of file."""
+ return self.line_offset + self.input_offset
+
+ def abs_line_number(self):
+ """Return line number of current line (counting from 1)."""
+ return self.line_offset + self.input_offset + 1
+
+ def insert_input(self, input_lines, source):
+ self.input_lines.insert(self.line_offset + 1, '',
+ source='internal padding after ' + source)
+ self.input_lines.insert(self.line_offset + 1, '',
+ source='internal padding before '+ source)
+ self.input_lines.insert(self.line_offset + 2,
+ StringList(input_lines, source))
+
+ def get_text_block(self, flush_left=0):
+ """
+ Return a contiguous block of text.
+
+ If `flush_left` is true, raise `UnexpectedIndentationError` if an
+ indented line is encountered before the text block ends (with a blank
+ line).
+ """
+ try:
+ block = self.input_lines.get_text_block(self.line_offset,
+ flush_left)
+ self.next_line(len(block) - 1)
+ return block
+ except UnexpectedIndentationError, error:
+ block, source, lineno = error.args
+ self.next_line(len(block) - 1) # advance to last line of block
+ raise
+
+ def check_line(self, context, state, transitions=None):
+ """
+ Examine one line of input for a transition match & execute its method.
+
+ Parameters:
+
+ - `context`: application-dependent storage.
+ - `state`: a `State` object, the current state.
+ - `transitions`: an optional ordered list of transition names to try,
+ instead of ``state.transition_order``.
+
+ Return the values returned by the transition method:
+
+ - context: possibly modified from the parameter `context`;
+ - next state name (`State` subclass name);
+ - the result output of the transition, a list.
+
+ When there is no match, ``state.no_match()`` is called and its return
+ value is returned.
+ """
+ if transitions is None:
+ transitions = state.transition_order
+ state_correction = None
+ if self.debug:
+ print >>sys.stderr, (
+ '\nStateMachine.check_line: state="%s", transitions=%r.'
+ % (state.__class__.__name__, transitions))
+ for name in transitions:
+ pattern, method, next_state = state.transitions[name]
+ match = pattern.match(self.line)
+ if match:
+ if self.debug:
+ print >>sys.stderr, (
+ '\nStateMachine.check_line: Matched transition '
+ '"%s" in state "%s".'
+ % (name, state.__class__.__name__))
+ return method(match, context, next_state)
+ else:
+ if self.debug:
+ print >>sys.stderr, (
+ '\nStateMachine.check_line: No match in state "%s".'
+ % state.__class__.__name__)
+ return state.no_match(context, transitions)
+
+ def add_state(self, state_class):
+ """
+ Initialize & add a `state_class` (`State` subclass) object.
+
+ Exception: `DuplicateStateError` raised if `state_class` was already
+ added.
+ """
+ statename = state_class.__name__
+ if statename in self.states:
+ raise DuplicateStateError(statename)
+ self.states[statename] = state_class(self, self.debug)
+
+ def add_states(self, state_classes):
+ """
+ Add `state_classes` (a list of `State` subclasses).
+ """
+ for state_class in state_classes:
+ self.add_state(state_class)
+
+ def runtime_init(self):
+ """
+ Initialize `self.states`.
+ """
+ for state in self.states.values():
+ state.runtime_init()
+
+ def error(self):
+ """Report error details."""
+ type, value, module, line, function = _exception_data()
+ print >>sys.stderr, '%s: %s' % (type, value)
+ print >>sys.stderr, 'input line %s' % (self.abs_line_number())
+ print >>sys.stderr, ('module %s, line %s, function %s'
+ % (module, line, function))
+
+ def attach_observer(self, observer):
+ """
+ The `observer` parameter is a function or bound method which takes two
+ arguments, the source and offset of the current line.
+ """
+ self.observers.append(observer)
+
+ def detach_observer(self, observer):
+ self.observers.remove(observer)
+
+ def notify_observers(self):
+ for observer in self.observers:
+ try:
+ info = self.input_lines.info(self.line_offset)
+ except IndexError:
+ info = (None, None)
+ observer(*info)
+
+
+class State:
+
+ """
+ State superclass. Contains a list of transitions, and transition methods.
+
+ Transition methods all have the same signature. They take 3 parameters:
+
+ - An `re` match object. ``match.string`` contains the matched input line,
+ ``match.start()`` gives the start index of the match, and
+ ``match.end()`` gives the end index.
+ - A context object, whose meaning is application-defined (initial value
+ ``None``). It can be used to store any information required by the state
+ machine, and the retured context is passed on to the next transition
+ method unchanged.
+ - The name of the next state, a string, taken from the transitions list;
+ normally it is returned unchanged, but it may be altered by the
+ transition method if necessary.
+
+ Transition methods all return a 3-tuple:
+
+ - A context object, as (potentially) modified by the transition method.
+ - The next state name (a return value of ``None`` means no state change).
+ - The processing result, a list, which is accumulated by the state
+ machine.
+
+ Transition methods may raise an `EOFError` to cut processing short.
+
+ There are two implicit transitions, and corresponding transition methods
+ are defined: `bof()` handles the beginning-of-file, and `eof()` handles
+ the end-of-file. These methods have non-standard signatures and return
+ values. `bof()` returns the initial context and results, and may be used
+ to return a header string, or do any other processing needed. `eof()`
+ should handle any remaining context and wrap things up; it returns the
+ final processing result.
+
+ Typical applications need only subclass `State` (or a subclass), set the
+ `patterns` and `initial_transitions` class attributes, and provide
+ corresponding transition methods. The default object initialization will
+ take care of constructing the list of transitions.
+ """
+
+ patterns = None
+ """
+ {Name: pattern} mapping, used by `make_transition()`. Each pattern may
+ be a string or a compiled `re` pattern. Override in subclasses.
+ """
+
+ initial_transitions = None
+ """
+ A list of transitions to initialize when a `State` is instantiated.
+ Each entry is either a transition name string, or a (transition name, next
+ state name) pair. See `make_transitions()`. Override in subclasses.
+ """
+
+ nested_sm = None
+ """
+ The `StateMachine` class for handling nested processing.
+
+ If left as ``None``, `nested_sm` defaults to the class of the state's
+ controlling state machine. Override it in subclasses to avoid the default.
+ """
+
+ nested_sm_kwargs = None
+ """
+ Keyword arguments dictionary, passed to the `nested_sm` constructor.
+
+ Two keys must have entries in the dictionary:
+
+ - Key 'state_classes' must be set to a list of `State` classes.
+ - Key 'initial_state' must be set to the name of the initial state class.
+
+ If `nested_sm_kwargs` is left as ``None``, 'state_classes' defaults to the
+ class of the current state, and 'initial_state' defaults to the name of
+ the class of the current state. Override in subclasses to avoid the
+ defaults.
+ """
+
+ def __init__(self, state_machine, debug=0):
+ """
+ Initialize a `State` object; make & add initial transitions.
+
+ Parameters:
+
+ - `statemachine`: the controlling `StateMachine` object.
+ - `debug`: a boolean; produce verbose output if true (nonzero).
+ """
+
+ self.transition_order = []
+ """A list of transition names in search order."""
+
+ self.transitions = {}
+ """
+ A mapping of transition names to 3-tuples containing
+ (compiled_pattern, transition_method, next_state_name). Initialized as
+ an instance attribute dynamically (instead of as a class attribute)
+ because it may make forward references to patterns and methods in this
+ or other classes.
+ """
+
+ self.add_initial_transitions()
+
+ self.state_machine = state_machine
+ """A reference to the controlling `StateMachine` object."""
+
+ self.debug = debug
+ """Debugging mode on/off."""
+
+ if self.nested_sm is None:
+ self.nested_sm = self.state_machine.__class__
+ if self.nested_sm_kwargs is None:
+ self.nested_sm_kwargs = {'state_classes': [self.__class__],
+ 'initial_state': self.__class__.__name__}
+
+ def runtime_init(self):
+ """
+ Initialize this `State` before running the state machine; called from
+ `self.state_machine.run()`.
+ """
+ pass
+
+ def unlink(self):
+ """Remove circular references to objects no longer required."""
+ self.state_machine = None
+
+ def add_initial_transitions(self):
+ """Make and add transitions listed in `self.initial_transitions`."""
+ if self.initial_transitions:
+ names, transitions = self.make_transitions(
+ self.initial_transitions)
+ self.add_transitions(names, transitions)
+
+ def add_transitions(self, names, transitions):
+ """
+ Add a list of transitions to the start of the transition list.
+
+ Parameters:
+
+ - `names`: a list of transition names.
+ - `transitions`: a mapping of names to transition tuples.
+
+ Exceptions: `DuplicateTransitionError`, `UnknownTransitionError`.
+ """
+ for name in names:
+ if name in self.transitions:
+ raise DuplicateTransitionError(name)
+ if name not in transitions:
+ raise UnknownTransitionError(name)
+ self.transition_order[:0] = names
+ self.transitions.update(transitions)
+
+ def add_transition(self, name, transition):
+ """
+ Add a transition to the start of the transition list.
+
+ Parameter `transition`: a ready-made transition 3-tuple.
+
+ Exception: `DuplicateTransitionError`.
+ """
+ if name in self.transitions:
+ raise DuplicateTransitionError(name)
+ self.transition_order[:0] = [name]
+ self.transitions[name] = transition
+
+ def remove_transition(self, name):
+ """
+ Remove a transition by `name`.
+
+ Exception: `UnknownTransitionError`.
+ """
+ try:
+ del self.transitions[name]
+ self.transition_order.remove(name)
+ except:
+ raise UnknownTransitionError(name)
+
+ def make_transition(self, name, next_state=None):
+ """
+ Make & return a transition tuple based on `name`.
+
+ This is a convenience function to simplify transition creation.
+
+ Parameters:
+
+ - `name`: a string, the name of the transition pattern & method. This
+ `State` object must have a method called '`name`', and a dictionary
+ `self.patterns` containing a key '`name`'.
+ - `next_state`: a string, the name of the next `State` object for this
+ transition. A value of ``None`` (or absent) implies no state change
+ (i.e., continue with the same state).
+
+ Exceptions: `TransitionPatternNotFound`, `TransitionMethodNotFound`.
+ """
+ if next_state is None:
+ next_state = self.__class__.__name__
+ try:
+ pattern = self.patterns[name]
+ if not hasattr(pattern, 'match'):
+ pattern = re.compile(pattern)
+ except KeyError:
+ raise TransitionPatternNotFound(
+ '%s.patterns[%r]' % (self.__class__.__name__, name))
+ try:
+ method = getattr(self, name)
+ except AttributeError:
+ raise TransitionMethodNotFound(
+ '%s.%s' % (self.__class__.__name__, name))
+ return (pattern, method, next_state)
+
+ def make_transitions(self, name_list):
+ """
+ Return a list of transition names and a transition mapping.
+
+ Parameter `name_list`: a list, where each entry is either a transition
+ name string, or a 1- or 2-tuple (transition name, optional next state
+ name).
+ """
+ stringtype = type('')
+ names = []
+ transitions = {}
+ for namestate in name_list:
+ if type(namestate) is stringtype:
+ transitions[namestate] = self.make_transition(namestate)
+ names.append(namestate)
+ else:
+ transitions[namestate[0]] = self.make_transition(*namestate)
+ names.append(namestate[0])
+ return names, transitions
+
+ def no_match(self, context, transitions):
+ """
+ Called when there is no match from `StateMachine.check_line()`.
+
+ Return the same values returned by transition methods:
+
+ - context: unchanged;
+ - next state name: ``None``;
+ - empty result list.
+
+ Override in subclasses to catch this event.
+ """
+ return context, None, []
+
+ def bof(self, context):
+ """
+ Handle beginning-of-file. Return unchanged `context`, empty result.
+
+ Override in subclasses.
+
+ Parameter `context`: application-defined storage.
+ """
+ return context, []
+
+ def eof(self, context):
+ """
+ Handle end-of-file. Return empty result.
+
+ Override in subclasses.
+
+ Parameter `context`: application-defined storage.
+ """
+ return []
+
+ def nop(self, match, context, next_state):
+ """
+ A "do nothing" transition method.
+
+ Return unchanged `context` & `next_state`, empty result. Useful for
+ simple state changes (actionless transitions).
+ """
+ return context, next_state, []
+
+
+class StateMachineWS(StateMachine):
+
+ """
+ `StateMachine` subclass specialized for whitespace recognition.
+
+ There are three methods provided for extracting indented text blocks:
+
+ - `get_indented()`: use when the indent is unknown.
+ - `get_known_indented()`: use when the indent is known for all lines.
+ - `get_first_known_indented()`: use when only the first line's indent is
+ known.
+ """
+
+ def get_indented(self, until_blank=0, strip_indent=1):
+ """
+ Return a block of indented lines of text, and info.
+
+ Extract an indented block where the indent is unknown for all lines.
+
+ :Parameters:
+ - `until_blank`: Stop collecting at the first blank line if true
+ (1).
+ - `strip_indent`: Strip common leading indent if true (1,
+ default).
+
+ :Return:
+ - the indented block (a list of lines of text),
+ - its indent,
+ - its first line offset from BOF, and
+ - whether or not it finished with a blank line.
+ """
+ offset = self.abs_line_offset()
+ indented, indent, blank_finish = self.input_lines.get_indented(
+ self.line_offset, until_blank, strip_indent)
+ if indented:
+ self.next_line(len(indented) - 1) # advance to last indented line
+ while indented and not indented[0].strip():
+ indented.trim_start()
+ offset += 1
+ return indented, indent, offset, blank_finish
+
+ def get_known_indented(self, indent, until_blank=0, strip_indent=1):
+ """
+ Return an indented block and info.
+
+ Extract an indented block where the indent is known for all lines.
+ Starting with the current line, extract the entire text block with at
+ least `indent` indentation (which must be whitespace, except for the
+ first line).
+
+ :Parameters:
+ - `indent`: The number of indent columns/characters.
+ - `until_blank`: Stop collecting at the first blank line if true
+ (1).
+ - `strip_indent`: Strip `indent` characters of indentation if true
+ (1, default).
+
+ :Return:
+ - the indented block,
+ - its first line offset from BOF, and
+ - whether or not it finished with a blank line.
+ """
+ offset = self.abs_line_offset()
+ indented, indent, blank_finish = self.input_lines.get_indented(
+ self.line_offset, until_blank, strip_indent,
+ block_indent=indent)
+ self.next_line(len(indented) - 1) # advance to last indented line
+ while indented and not indented[0].strip():
+ indented.trim_start()
+ offset += 1
+ return indented, offset, blank_finish
+
+ def get_first_known_indented(self, indent, until_blank=0, strip_indent=1,
+ strip_top=1):
+ """
+ Return an indented block and info.
+
+ Extract an indented block where the indent is known for the first line
+ and unknown for all other lines.
+
+ :Parameters:
+ - `indent`: The first line's indent (# of columns/characters).
+ - `until_blank`: Stop collecting at the first blank line if true
+ (1).
+ - `strip_indent`: Strip `indent` characters of indentation if true
+ (1, default).
+ - `strip_top`: Strip blank lines from the beginning of the block.
+
+ :Return:
+ - the indented block,
+ - its indent,
+ - its first line offset from BOF, and
+ - whether or not it finished with a blank line.
+ """
+ offset = self.abs_line_offset()
+ indented, indent, blank_finish = self.input_lines.get_indented(
+ self.line_offset, until_blank, strip_indent,
+ first_indent=indent)
+ self.next_line(len(indented) - 1) # advance to last indented line
+ if strip_top:
+ while indented and not indented[0].strip():
+ indented.trim_start()
+ offset += 1
+ return indented, indent, offset, blank_finish
+
+
+class StateWS(State):
+
+ """
+ State superclass specialized for whitespace (blank lines & indents).
+
+ Use this class with `StateMachineWS`. The transitions 'blank' (for blank
+ lines) and 'indent' (for indented text blocks) are added automatically,
+ before any other transitions. The transition method `blank()` handles
+ blank lines and `indent()` handles nested indented blocks. Indented
+ blocks trigger a new state machine to be created by `indent()` and run.
+ The class of the state machine to be created is in `indent_sm`, and the
+ constructor keyword arguments are in the dictionary `indent_sm_kwargs`.
+
+ The methods `known_indent()` and `firstknown_indent()` are provided for
+ indented blocks where the indent (all lines' and first line's only,
+ respectively) is known to the transition method, along with the attributes
+ `known_indent_sm` and `known_indent_sm_kwargs`. Neither transition method
+ is triggered automatically.
+ """
+
+ indent_sm = None
+ """
+ The `StateMachine` class handling indented text blocks.
+
+ If left as ``None``, `indent_sm` defaults to the value of
+ `State.nested_sm`. Override it in subclasses to avoid the default.
+ """
+
+ indent_sm_kwargs = None
+ """
+ Keyword arguments dictionary, passed to the `indent_sm` constructor.
+
+ If left as ``None``, `indent_sm_kwargs` defaults to the value of
+ `State.nested_sm_kwargs`. Override it in subclasses to avoid the default.
+ """
+
+ known_indent_sm = None
+ """
+ The `StateMachine` class handling known-indented text blocks.
+
+ If left as ``None``, `known_indent_sm` defaults to the value of
+ `indent_sm`. Override it in subclasses to avoid the default.
+ """
+
+ known_indent_sm_kwargs = None
+ """
+ Keyword arguments dictionary, passed to the `known_indent_sm` constructor.
+
+ If left as ``None``, `known_indent_sm_kwargs` defaults to the value of
+ `indent_sm_kwargs`. Override it in subclasses to avoid the default.
+ """
+
+ ws_patterns = {'blank': ' *$',
+ 'indent': ' +'}
+ """Patterns for default whitespace transitions. May be overridden in
+ subclasses."""
+
+ ws_initial_transitions = ('blank', 'indent')
+ """Default initial whitespace transitions, added before those listed in
+ `State.initial_transitions`. May be overridden in subclasses."""
+
+ def __init__(self, state_machine, debug=0):
+ """
+ Initialize a `StateSM` object; extends `State.__init__()`.
+
+ Check for indent state machine attributes, set defaults if not set.
+ """
+ State.__init__(self, state_machine, debug)
+ if self.indent_sm is None:
+ self.indent_sm = self.nested_sm
+ if self.indent_sm_kwargs is None:
+ self.indent_sm_kwargs = self.nested_sm_kwargs
+ if self.known_indent_sm is None:
+ self.known_indent_sm = self.indent_sm
+ if self.known_indent_sm_kwargs is None:
+ self.known_indent_sm_kwargs = self.indent_sm_kwargs
+
+ def add_initial_transitions(self):
+ """
+ Add whitespace-specific transitions before those defined in subclass.
+
+ Extends `State.add_initial_transitions()`.
+ """
+ State.add_initial_transitions(self)
+ if self.patterns is None:
+ self.patterns = {}
+ self.patterns.update(self.ws_patterns)
+ names, transitions = self.make_transitions(
+ self.ws_initial_transitions)
+ self.add_transitions(names, transitions)
+
+ def blank(self, match, context, next_state):
+ """Handle blank lines. Does nothing. Override in subclasses."""
+ return self.nop(match, context, next_state)
+
+ def indent(self, match, context, next_state):
+ """
+ Handle an indented text block. Extend or override in subclasses.
+
+ Recursively run the registered state machine for indented blocks
+ (`self.indent_sm`).
+ """
+ indented, indent, line_offset, blank_finish = \
+ self.state_machine.get_indented()
+ sm = self.indent_sm(debug=self.debug, **self.indent_sm_kwargs)
+ results = sm.run(indented, input_offset=line_offset)
+ return context, next_state, results
+
+ def known_indent(self, match, context, next_state):
+ """
+ Handle a known-indent text block. Extend or override in subclasses.
+
+ Recursively run the registered state machine for known-indent indented
+ blocks (`self.known_indent_sm`). The indent is the length of the
+ match, ``match.end()``.
+ """
+ indented, line_offset, blank_finish = \
+ self.state_machine.get_known_indented(match.end())
+ sm = self.known_indent_sm(debug=self.debug,
+ **self.known_indent_sm_kwargs)
+ results = sm.run(indented, input_offset=line_offset)
+ return context, next_state, results
+
+ def first_known_indent(self, match, context, next_state):
+ """
+ Handle an indented text block (first line's indent known).
+
+ Extend or override in subclasses.
+
+ Recursively run the registered state machine for known-indent indented
+ blocks (`self.known_indent_sm`). The indent is the length of the
+ match, ``match.end()``.
+ """
+ indented, line_offset, blank_finish = \
+ self.state_machine.get_first_known_indented(match.end())
+ sm = self.known_indent_sm(debug=self.debug,
+ **self.known_indent_sm_kwargs)
+ results = sm.run(indented, input_offset=line_offset)
+ return context, next_state, results
+
+
+class _SearchOverride:
+
+ """
+ Mix-in class to override `StateMachine` regular expression behavior.
+
+ Changes regular expression matching, from the default `re.match()`
+ (succeeds only if the pattern matches at the start of `self.line`) to
+ `re.search()` (succeeds if the pattern matches anywhere in `self.line`).
+ When subclassing a `StateMachine`, list this class **first** in the
+ inheritance list of the class definition.
+ """
+
+ def match(self, pattern):
+ """
+ Return the result of a regular expression search.
+
+ Overrides `StateMachine.match()`.
+
+ Parameter `pattern`: `re` compiled regular expression.
+ """
+ return pattern.search(self.line)
+
+
+class SearchStateMachine(_SearchOverride, StateMachine):
+ """`StateMachine` which uses `re.search()` instead of `re.match()`."""
+ pass
+
+
+class SearchStateMachineWS(_SearchOverride, StateMachineWS):
+ """`StateMachineWS` which uses `re.search()` instead of `re.match()`."""
+ pass
+
+
+class ViewList:
+
+ """
+ List with extended functionality: slices of ViewList objects are child
+ lists, linked to their parents. Changes made to a child list also affect
+ the parent list. A child list is effectively a "view" (in the SQL sense)
+ of the parent list. Changes to parent lists, however, do *not* affect
+ active child lists. If a parent list is changed, any active child lists
+ should be recreated.
+
+ The start and end of the slice can be trimmed using the `trim_start()` and
+ `trim_end()` methods, without affecting the parent list. The link between
+ child and parent lists can be broken by calling `disconnect()` on the
+ child list.
+
+ Also, ViewList objects keep track of the source & offset of each item.
+ This information is accessible via the `source()`, `offset()`, and
+ `info()` methods.
+ """
+
+ def __init__(self, initlist=None, source=None, items=None,
+ parent=None, parent_offset=None):
+ self.data = []
+ """The actual list of data, flattened from various sources."""
+
+ self.items = []
+ """A list of (source, offset) pairs, same length as `self.data`: the
+ source of each line and the offset of each line from the beginning of
+ its source."""
+
+ self.parent = parent
+ """The parent list."""
+
+ self.parent_offset = parent_offset
+ """Offset of this list from the beginning of the parent list."""
+
+ if isinstance(initlist, ViewList):
+ self.data = initlist.data[:]
+ self.items = initlist.items[:]
+ elif initlist is not None:
+ self.data = list(initlist)
+ if items:
+ self.items = items
+ else:
+ self.items = [(source, i) for i in range(len(initlist))]
+ assert len(self.data) == len(self.items), 'data mismatch'
+
+ def __str__(self):
+ return str(self.data)
+
+ def __repr__(self):
+ return '%s(%s, items=%s)' % (self.__class__.__name__,
+ self.data, self.items)
+
+ def __lt__(self, other): return self.data < self.__cast(other)
+ def __le__(self, other): return self.data <= self.__cast(other)
+ def __eq__(self, other): return self.data == self.__cast(other)
+ def __ne__(self, other): return self.data != self.__cast(other)
+ def __gt__(self, other): return self.data > self.__cast(other)
+ def __ge__(self, other): return self.data >= self.__cast(other)
+ def __cmp__(self, other): return cmp(self.data, self.__cast(other))
+
+ def __cast(self, other):
+ if isinstance(other, ViewList):
+ return other.data
+ else:
+ return other
+
+ def __contains__(self, item): return item in self.data
+ def __len__(self): return len(self.data)
+
+ # The __getitem__()/__setitem__() methods check whether the index
+ # is a slice first, since indexing a native list with a slice object
+ # just works.
+
+ def __getitem__(self, i):
+ if isinstance(i, types.SliceType):
+ assert i.step in (None, 1), 'cannot handle slice with stride'
+ return self.__class__(self.data[i.start:i.stop],
+ items=self.items[i.start:i.stop],
+ parent=self, parent_offset=i.start or 0)
+ else:
+ return self.data[i]
+
+ def __setitem__(self, i, item):
+ if isinstance(i, types.SliceType):
+ assert i.step in (None, 1), 'cannot handle slice with stride'
+ if not isinstance(item, ViewList):
+ raise TypeError('assigning non-ViewList to ViewList slice')
+ self.data[i.start:i.stop] = item.data
+ self.items[i.start:i.stop] = item.items
+ assert len(self.data) == len(self.items), 'data mismatch'
+ if self.parent:
+ self.parent[(i.start or 0) + self.parent_offset
+ : (i.stop or len(self)) + self.parent_offset] = item
+ else:
+ self.data[i] = item
+ if self.parent:
+ self.parent[i + self.parent_offset] = item
+
+ def __delitem__(self, i):
+ try:
+ del self.data[i]
+ del self.items[i]
+ if self.parent:
+ del self.parent[i + self.parent_offset]
+ except TypeError:
+ assert i.step is None, 'cannot handle slice with stride'
+ del self.data[i.start:i.stop]
+ del self.items[i.start:i.stop]
+ if self.parent:
+ del self.parent[(i.start or 0) + self.parent_offset
+ : (i.stop or len(self)) + self.parent_offset]
+
+ def __add__(self, other):
+ if isinstance(other, ViewList):
+ return self.__class__(self.data + other.data,
+ items=(self.items + other.items))
+ else:
+ raise TypeError('adding non-ViewList to a ViewList')
+
+ def __radd__(self, other):
+ if isinstance(other, ViewList):
+ return self.__class__(other.data + self.data,
+ items=(other.items + self.items))
+ else:
+ raise TypeError('adding ViewList to a non-ViewList')
+
+ def __iadd__(self, other):
+ if isinstance(other, ViewList):
+ self.data += other.data
+ else:
+ raise TypeError('argument to += must be a ViewList')
+ return self
+
+ def __mul__(self, n):
+ return self.__class__(self.data * n, items=(self.items * n))
+
+ __rmul__ = __mul__
+
+ def __imul__(self, n):
+ self.data *= n
+ self.items *= n
+ return self
+
+ def extend(self, other):
+ if not isinstance(other, ViewList):
+ raise TypeError('extending a ViewList with a non-ViewList')
+ if self.parent:
+ self.parent.insert(len(self.data) + self.parent_offset, other)
+ self.data.extend(other.data)
+ self.items.extend(other.items)
+
+ def append(self, item, source=None, offset=0):
+ if source is None:
+ self.extend(item)
+ else:
+ if self.parent:
+ self.parent.insert(len(self.data) + self.parent_offset, item,
+ source, offset)
+ self.data.append(item)
+ self.items.append((source, offset))
+
+ def insert(self, i, item, source=None, offset=0):
+ if source is None:
+ if not isinstance(item, ViewList):
+ raise TypeError('inserting non-ViewList with no source given')
+ self.data[i:i] = item.data
+ self.items[i:i] = item.items
+ if self.parent:
+ index = (len(self.data) + i) % len(self.data)
+ self.parent.insert(index + self.parent_offset, item)
+ else:
+ self.data.insert(i, item)
+ self.items.insert(i, (source, offset))
+ if self.parent:
+ index = (len(self.data) + i) % len(self.data)
+ self.parent.insert(index + self.parent_offset, item,
+ source, offset)
+
+ def pop(self, i=-1):
+ if self.parent:
+ index = (len(self.data) + i) % len(self.data)
+ self.parent.pop(index + self.parent_offset)
+ self.items.pop(i)
+ return self.data.pop(i)
+
+ def trim_start(self, n=1):
+ """
+ Remove items from the start of the list, without touching the parent.
+ """
+ if n > len(self.data):
+ raise IndexError("Size of trim too large; can't trim %s items "
+ "from a list of size %s." % (n, len(self.data)))
+ elif n < 0:
+ raise IndexError('Trim size must be >= 0.')
+ del self.data[:n]
+ del self.items[:n]
+ if self.parent:
+ self.parent_offset += n
+
+ def trim_end(self, n=1):
+ """
+ Remove items from the end of the list, without touching the parent.
+ """
+ if n > len(self.data):
+ raise IndexError("Size of trim too large; can't trim %s items "
+ "from a list of size %s." % (n, len(self.data)))
+ elif n < 0:
+ raise IndexError('Trim size must be >= 0.')
+ del self.data[-n:]
+ del self.items[-n:]
+
+ def remove(self, item):
+ index = self.index(item)
+ del self[index]
+
+ def count(self, item): return self.data.count(item)
+ def index(self, item): return self.data.index(item)
+
+ def reverse(self):
+ self.data.reverse()
+ self.items.reverse()
+ self.parent = None
+
+ def sort(self, *args):
+ tmp = zip(self.data, self.items)
+ tmp.sort(*args)
+ self.data = [entry[0] for entry in tmp]
+ self.items = [entry[1] for entry in tmp]
+ self.parent = None
+
+ def info(self, i):
+ """Return source & offset for index `i`."""
+ try:
+ return self.items[i]
+ except IndexError:
+ if i == len(self.data): # Just past the end
+ return self.items[i - 1][0], None
+ else:
+ raise
+
+ def source(self, i):
+ """Return source for index `i`."""
+ return self.info(i)[0]
+
+ def offset(self, i):
+ """Return offset for index `i`."""
+ return self.info(i)[1]
+
+ def disconnect(self):
+ """Break link between this list and parent list."""
+ self.parent = None
+
+
+class StringList(ViewList):
+
+ """A `ViewList` with string-specific methods."""
+
+ def trim_left(self, length, start=0, end=sys.maxint):
+ """
+ Trim `length` characters off the beginning of each item, in-place,
+ from index `start` to `end`. No whitespace-checking is done on the
+ trimmed text. Does not affect slice parent.
+ """
+ self.data[start:end] = [line[length:]
+ for line in self.data[start:end]]
+
+ def get_text_block(self, start, flush_left=0):
+ """
+ Return a contiguous block of text.
+
+ If `flush_left` is true, raise `UnexpectedIndentationError` if an
+ indented line is encountered before the text block ends (with a blank
+ line).
+ """
+ end = start
+ last = len(self.data)
+ while end < last:
+ line = self.data[end]
+ if not line.strip():
+ break
+ if flush_left and (line[0] == ' '):
+ source, offset = self.info(end)
+ raise UnexpectedIndentationError(self[start:end], source,
+ offset + 1)
+ end += 1
+ return self[start:end]
+
+ def get_indented(self, start=0, until_blank=0, strip_indent=1,
+ block_indent=None, first_indent=None):
+ """
+ Extract and return a StringList of indented lines of text.
+
+ Collect all lines with indentation, determine the minimum indentation,
+ remove the minimum indentation from all indented lines (unless
+ `strip_indent` is false), and return them. All lines up to but not
+ including the first unindented line will be returned.
+
+ :Parameters:
+ - `start`: The index of the first line to examine.
+ - `until_blank`: Stop collecting at the first blank line if true.
+ - `strip_indent`: Strip common leading indent if true (default).
+ - `block_indent`: The indent of the entire block, if known.
+ - `first_indent`: The indent of the first line, if known.
+
+ :Return:
+ - a StringList of indented lines with mininum indent removed;
+ - the amount of the indent;
+ - a boolean: did the indented block finish with a blank line or EOF?
+ """
+ indent = block_indent # start with None if unknown
+ end = start
+ if block_indent is not None and first_indent is None:
+ first_indent = block_indent
+ if first_indent is not None:
+ end += 1
+ last = len(self.data)
+ while end < last:
+ line = self.data[end]
+ if line and (line[0] != ' '
+ or (block_indent is not None
+ and line[:block_indent].strip())):
+ # Line not indented or insufficiently indented.
+ # Block finished properly iff the last indented line blank:
+ blank_finish = ((end > start)
+ and not self.data[end - 1].strip())
+ break
+ stripped = line.lstrip()
+ if not stripped: # blank line
+ if until_blank:
+ blank_finish = 1
+ break
+ elif block_indent is None:
+ line_indent = len(line) - len(stripped)
+ if indent is None:
+ indent = line_indent
+ else:
+ indent = min(indent, line_indent)
+ end += 1
+ else:
+ blank_finish = 1 # block ends at end of lines
+ block = self[start:end]
+ if first_indent is not None and block:
+ block.data[0] = block.data[0][first_indent:]
+ if indent and strip_indent:
+ block.trim_left(indent, start=(first_indent is not None))
+ return block, indent or 0, blank_finish
+
+ def get_2D_block(self, top, left, bottom, right, strip_indent=1):
+ block = self[top:bottom]
+ indent = right
+ for i in range(len(block.data)):
+ block.data[i] = line = block.data[i][left:right].rstrip()
+ if line:
+ indent = min(indent, len(line) - len(line.lstrip()))
+ if strip_indent and 0 < indent < right:
+ block.data = [line[indent:] for line in block.data]
+ return block
+
+ def pad_double_width(self, pad_char):
+ """
+ Pad all double-width characters in self by appending `pad_char` to each.
+ For East Asian language support.
+ """
+ if hasattr(unicodedata, 'east_asian_width'):
+ east_asian_width = unicodedata.east_asian_width
+ else:
+ return # new in Python 2.4
+ for i in range(len(self.data)):
+ line = self.data[i]
+ if isinstance(line, unicode):
+ new = []
+ for char in line:
+ new.append(char)
+ if east_asian_width(char) in 'WF': # 'W'ide & 'F'ull-width
+ new.append(pad_char)
+ self.data[i] = ''.join(new)
+
+ def replace(self, old, new):
+ """Replace all occurrences of substring `old` with `new`."""
+ for i in range(len(self.data)):
+ self.data[i] = self.data[i].replace(old, new)
+
+
+class StateMachineError(Exception): pass
+class UnknownStateError(StateMachineError): pass
+class DuplicateStateError(StateMachineError): pass
+class UnknownTransitionError(StateMachineError): pass
+class DuplicateTransitionError(StateMachineError): pass
+class TransitionPatternNotFound(StateMachineError): pass
+class TransitionMethodNotFound(StateMachineError): pass
+class UnexpectedIndentationError(StateMachineError): pass
+
+
+class TransitionCorrection(Exception):
+
+ """
+ Raise from within a transition method to switch to another transition.
+
+ Raise with one argument, the new transition name.
+ """
+
+
+class StateCorrection(Exception):
+
+ """
+ Raise from within a transition method to switch to another state.
+
+ Raise with one or two arguments: new state name, and an optional new
+ transition name.
+ """
+
+
+def string2lines(astring, tab_width=8, convert_whitespace=0,
+ whitespace=re.compile('[\v\f]')):
+ """
+ Return a list of one-line strings with tabs expanded, no newlines, and
+ trailing whitespace stripped.
+
+ Each tab is expanded with between 1 and `tab_width` spaces, so that the
+ next character's index becomes a multiple of `tab_width` (8 by default).
+
+ Parameters:
+
+ - `astring`: a multi-line string.
+ - `tab_width`: the number of columns between tab stops.
+ - `convert_whitespace`: convert form feeds and vertical tabs to spaces?
+ """
+ if convert_whitespace:
+ astring = whitespace.sub(' ', astring)
+ return [s.expandtabs(tab_width).rstrip() for s in astring.splitlines()]
+
+def _exception_data():
+ """
+ Return exception information:
+
+ - the exception's class name;
+ - the exception object;
+ - the name of the file containing the offending code;
+ - the line number of the offending code;
+ - the function name of the offending code.
+ """
+ type, value, traceback = sys.exc_info()
+ while traceback.tb_next:
+ traceback = traceback.tb_next
+ code = traceback.tb_frame.f_code
+ return (type.__name__, value, code.co_filename, traceback.tb_lineno,
+ code.co_name)
--- /dev/null
+<% foo %> <% bar %>
--- /dev/null
+ <tr>
+ <td><%= f.label((t('app.views.large_surveys_admin.new.gift'))) %></td>
+ <td><%= check_box_tag('gift',
+ 'checked',
+ !@large_survey.coupon_pool_id.nil?,
+ {:onclick => "$('coupon_pool').toggle()"}) %></td>
+ </tr>
--- /dev/null
+{% if athlete_list %}
+ <p>Here are the athletes: {{ athlete_list }}.</p>
+{% else %}
+ <p>No athletes are available.</p>
+ {% if coach_list %}
+ <p>Here are the coaches: {{ coach_list }}.</p>
+ {% endif %}
+{% endif %}
+{% block content %}
+
+ {% if morning %}
+ <p>Hello World!</p>
+ {% else %}
+ <p>Goodbye World!</p>
+ {% endif %}
+
+ {% endblock %}
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ </head>
+ <body>
+
+<<<<<<< .working
+the code from my version bla bla bla...
+=======
+the version from the repo bla bla bla...
+>>>>>>> .merge-right.r3379
+
+ </body>
+</html>
--- /dev/null
+<html>\r
+ <body>\r
+ Lorem ipsum dolor sit amet, <?php echo 'consectetur adipisicing elit, sed do eiusmod'?> tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim\r
+ veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea\r
+ commodo consequat. Duis aute irure dolor in reprehenderit in voluptate\r
+ velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint\r
+ occaecat cupidatat non proident, sunt in culpa qui officia deserunt\r
+ mollit anim id est laborum.\r
+ </body>\r
+</html>
\ No newline at end of file
--- /dev/null
+\r
+<p>\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ <?php\r
+ fun();\r
+ ?>\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+ Some text to wrap.\r
+</p>\r
--- /dev/null
+# -*- Python -*-
+
+
+"""
+===============
+This is a title
+===============
+
+This is some general description
+"""
+
+
+class SomeClass(object):
+ """
+ This is a class description.
+ """
+
+ def __init__(self, fileName):
+ """The constructor."""
+ pass
+
+ def oneMethod():
+ pass
--- /dev/null
+var x = 1;\r
+<% @ruby_var.each do |v| %>\r
+ alert(v);\r
+ <% end %>\r
+ var y = 2;\r
--- /dev/null
+var x = 1;\r
+var y = <%= v %>;\r
+ var z = 4;\r
--- /dev/null
+var x = 1;\r
+for (i in l) {\r
+alert(i);\r
+}\r
+<% var.each do |v| %>\r
+alert(<%= v %>);\r
+<% end %>\r
+var z = 4;\r
+for (i in l) {\r
+alert(i);\r
+}\r
--- /dev/null
+<% if true %>\r
+alert(<%= v %>);\r
+alert(<%= w %>);\r
+<% end %>\r
--- /dev/null
+var x = "<%= x %>";\r
+var y = 5;\r
+\r
+Second line is treated as if it was a string.\r
+\r
+Problem with multiple lines inside ruby if:\r
+\r
+<% if b %>\r
+ var x = 1;\r
+alert(1);\r
+<% end %>\r
--- /dev/null
+var x = 1;\r
+<%= ruby_code %>\r
+ var z = 3;\r
--- /dev/null
+<?php
+
+/*
+ * This file is part of the symfony package.
+ * (c) 2004-2006 Fabien Potencier <fabien.potencier@symfony-project.com>
+ * (c) 2004 David Heinemeier Hansson
+ *
+ * For the full copyright and license information, please view the LICENSE
+ * file that was distributed with this source code.
+ */
+
+/**
+ * TextHelper.
+ *
+ * @package symfony
+ * @subpackage helper
+ * @author Fabien Potencier <fabien.potencier@symfony-project.com>
+ * @author David Heinemeier Hansson
+ * @version SVN: $Id: TextHelper.php 3699 2007-04-02 11:47:32Z fabien $
+ */
+
+/**
+ * Truncates +text+ to the length of +length+ and replaces the last three characters with the +truncate_string+
+ * if the +text+ is longer than +length+.
+ */
+function truncate_text($text, $length = 30, $truncate_string = '...', $truncate_lastspace = false)
+{
+ if ($text == '')
+ {
+ return '';
+ }
+
+ if (strlen($text) > $length)
+ {
+ $truncate_text = substr($text, 0, $length - strlen($truncate_string));
+ if ($truncate_lastspace)
+ {
+ $truncate_text = preg_replace('/\s+?(\S+)?$/', '', $truncate_text);
+ }
+
+ return $truncate_text.$truncate_string;
+ }
+ else
+ {
+ return $text;
+ }
+}
+
+/**
+ * Highlights the +phrase+ where it is found in the +text+ by surrounding it like
+ * <strong class="highlight">I'm a highlight phrase</strong>. The highlighter can be specialized by
+ * passing +highlighter+ as single-quoted string with \1 where the phrase is supposed to be inserted.
+ * N.B.: The +phrase+ is sanitized to include only letters, digits, and spaces before use.
+ */
+function highlight_text($text, $phrase, $highlighter = '<strong class="highlight">\\1</strong>')
+{
+ if ($text == '')
+ {
+ return '';
+ }
+
+ if ($phrase == '')
+ {
+ return $text;
+ }
+
+ return preg_replace('/('.preg_quote($phrase, '/').')/i', $highlighter, $text);
+}
+
+/**
+ * Extracts an excerpt from the +text+ surrounding the +phrase+ with a number of characters on each side determined
+ * by +radius+. If the phrase isn't found, nil is returned. Ex:
+ * excerpt("hello my world", "my", 3) => "...lo my wo..."
+ */
+function excerpt_text($text, $phrase, $radius = 100, $excerpt_string = '...')
+{
+ if ($text == '' || $phrase == '')
+ {
+ return '';
+ }
+
+ $found_pos = strpos(strtolower($text), strtolower($phrase));
+ if ($found_pos !== false)
+ {
+ $start_pos = max($found_pos - $radius, 0);
+ $end_pos = min($found_pos + strlen($phrase) + $radius, strlen($text));
+
+ $prefix = ($start_pos > 0) ? $excerpt_string : '';
+ $postfix = $end_pos < strlen($text) ? $excerpt_string : '';
+
+ return $prefix.substr($text, $start_pos, $end_pos - $start_pos).$postfix;
+ }
+}
+
+/**
+ * Word wrap long lines to line_width.
+ */
+function wrap_text($text, $line_width = 80)
+{
+ return preg_replace('/(.{1,'.$line_width.'})(\s+|$)/s', "\\1\n", preg_replace("/\n/", "\n\n", $text));
+}
+
+/*
+ # Returns +text+ transformed into html using very simple formatting rules
+ # Surrounds paragraphs with <tt><p></tt> tags, and converts line breaks into <tt><br /></tt>
+ # Two consecutive newlines(<tt>\n\n</tt>) are considered as a paragraph, one newline (<tt>\n</tt>) is
+ # considered a linebreak, three or more consecutive newlines are turned into two newlines
+*/
+function simple_format_text($text, $options = array())
+{
+ $css = (isset($options['class'])) ? ' class="'.$options['class'].'"' : '';
+
+ $text = sfToolkit::pregtr($text, array("/(\r\n|\r)/" => "\n", // lets make them newlines crossplatform
+ "/\n{3,}/" => "\n\n", // zap dupes
+ "/\n\n/" => "</p>\\0<p$css>", // turn two newlines into paragraph
+ "/([^\n])\n([^\n])/" => "\\1\n<br />\\2")); // turn single newline into <br/>
+
+ return '<p'.$css.'>'.$text.'</p>'; // wrap the first and last line in paragraphs before we're done
+}
+
+/**
+ * Turns all urls and email addresses into clickable links. The +link+ parameter can limit what should be linked.
+ * Options are :all (default), :email_addresses, and :urls.
+ *
+ * Example:
+ * auto_link("Go to http://www.symfony-project.com and say hello to fabien.potencier@example.com") =>
+ * Go to <a href="http://www.symfony-project.com">http://www.symfony-project.com</a> and
+ * say hello to <a href="mailto:fabien.potencier@example.com">fabien.potencier@example.com</a>
+ */
+function auto_link_text($text, $link = 'all', $href_options = array())
+{
+ if ($link == 'all')
+ {
+ return _auto_link_urls(_auto_link_email_addresses($text), $href_options);
+ }
+ else if ($link == 'email_addresses')
+ {
+ return _auto_link_email_addresses($text);
+ }
+ else if ($link == 'urls')
+ {
+ return _auto_link_urls($text, $href_options);
+ }
+}
+
+/*
+ * Turns all links into words, like "<a href="something">else</a>" to "else".
+ */
+function strip_links_text($text)
+{
+ return preg_replace('/<a.*>(.*)<\/a>/m', '\\1', $text);
+}
+
+if (!defined('SF_AUTO_LINK_RE'))
+{
+ define('SF_AUTO_LINK_RE', '~
+ ( # leading text
+ <\w+.*?>| # leading HTML tag, or
+ [^=!:\'"/]| # leading punctuation, or
+ ^ # beginning of line
+ )
+ (
+ (?:https?://)| # protocol spec, or
+ (?:www\.) # www.*
+ )
+ (
+ [-\w]+ # subdomain or domain
+ (?:\.[-\w]+)* # remaining subdomains or domain
+ (?::\d+)? # port
+ (?:/(?:(?:[\~\w\+%-]|(?:[,.;:][^\s$]))+)?)* # path
+ (?:\?[\w\+%&=.;-]+)? # query string
+ (?:\#[\w\-]*)? # trailing anchor
+ )
+ ([[:punct:]]|\s|<|$) # trailing text
+ ~x');
+}
+
+/**
+ * Turns all urls into clickable links.
+ */
+function _auto_link_urls($text, $href_options = array())
+{
+ $href_options = _tag_options($href_options);
+ return preg_replace_callback(
+ SF_AUTO_LINK_RE,
+ create_function('$matches', '
+ if (preg_match("/<a\s/i", $matches[1]))
+ {
+ return $matches[0];
+ }
+ else
+ {
+ return $matches[1].\'<a href="\'.($matches[2] == "www." ? "http://www." : $matches[2]).$matches[3].\'"'.$href_options.'>\'.$matches[2].$matches[3].\'</a>\'.$matches[4];
+ }
+ ')
+ , $text);
+}
+
+/**
+ * Turns all email addresses into clickable links.
+ */
+function _auto_link_email_addresses($text)
+{
+ return preg_replace('/([\w\.!#\$%\-+.]+@[A-Za-z0-9\-]+(\.[A-Za-z0-9\-]+)+)/', '<a href="mailto:\\1">\\1</a>', $text);
+}
--- /dev/null
+<%!\r
+ import sys\r
+%>\r
+<html>\r
+ <head>\r
+ <title>Test</title>\r
+ </head>\r
+ <body>\r
+ </body>\r
+\r
+</html>\r
+\r
--- /dev/null
+print SOCKET << HTML or warn "Cannot write to socket: $!";
+<input type="text">html continues...
+
+HTML
--- /dev/null
+bteq << 'SQL part' | grep '\\$'| read start_dt_ya start_dt end_dt_ya end_dt\r
+-- SQL code here\r
+select '$',start_date- '1 year', start_date ....\r
+SQL part\r
+\r
+bteq <<SQL | grep '\\$'| read start_dt_ya start_dt end_dt_ya end_dt\r
+-- SQL code here\r
+select '$',start_date- '1 year', start_date ....\r
+SQL\r
--- /dev/null
+
+From EmacsWiki:
+
+I have chunk problems with 1.99. This works, it detects the PHP and JS chunks properly:
+
+<?
+
+
+$stuff = <<<EOTHTML
+
+ <script type="text/javascript">
+
+ //<![CDATA[
+
+ var stuff;
+
+ //]]>
+ </script>
+
+EOTHTML;
+
+
+However if I don’t close the inner chunk before EOTHTML, because I want to add some conditional code after it in PHP then it thinks the part of the buffer after EOTHTML is still in JS mode which is not good:
+
+<?
+
+
+$stuff = <<<EOTHTML
+
+ <script type="text/javascript">
+
+ //<![CDATA[
+
+ var stuff;
+
+EOTHTML;
+
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"\r
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\r
+<% @meta_keywords ||= nil -%>\r
+<% @meta_description ||= nil -%>\r
+\r
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">\r
+ <head>\r
+ <meta http-equiv="Content-type" content="text/html; charset=utf-8" />\r
+ <% unless @meta_keywords.blank? -%>\r
+ <meta name="keywords" content="<%= @meta_keywords %>" />\r
+ <% end -%>\r
+ <% unless @meta_description.blank? -%>\r
+ <meta name="description" content="<%= @meta_description %>" />\r
+ <% end -%>\r
+ <title><%= @page_title.blank? ? "Mysite" : "#{@page_title} : Mysite" %></title>\r
+ <%= stylesheet_link_tag 'global', 'sem', :media => 'all' %>\r
+ </head>\r
+ <body>\r
+ <div id="shadow">\r
+ <div id="container">\r
+\r
+ <div id="main" class="content">\r
+ <%= yield %>\r
+ </div>\r
+ <table>\r
+ This text is in the wrong place, but you have to apply a\r
+ schema to get it marked as invalid.\r
+ <%= yield %>\r
+ </table>\r
+\r
+ </div> <%# container %>\r
+ </div> <%# shadow %>\r
+ </body>\r
+ <% if live_site? %>\r
+ <%= render(:partial => 'shared/google_analytics') %>\r
+ <% end %>\r
+</html>\r
--- /dev/null
+$a = <<<EOTHTML\r
+\r
+<p>stuff</p>\r
+\r
+EOTHTML;\r
+\r
+\r
+$b = <<<EOT\r
+\r
+ <h2><a href="/">stuff</a></h2>\r
+\r
+EOT;\r
+\r
+$c = <<<EOT\r
+\r
+<button onclick="a()">test</button>\r
+\r
+\r
+EOT;\r
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ <script type="text/javascript">
+ // <![CDATA[
+ alert ("here");
+ /*
+ --------------------------------------------------------------------------
+ Do not edit past this point unless you know what you are doing.
+ --------------------------------------------------------------------------
+ ===== BUG: THIS LINE IS BLACK ==========
+ ===== BUG: THIS LINE IS BLACK ==========
+ */
+
+ addEvent(window, 'load', spamSpan);
+
+ function spamSpan() {
+ var allSpamSpans = getElementsByClass(spamSpanMainClass, document, 'span');
+ for (var i = 0; i < allSpamSpans.length; i++) {
+ // get data
+ var user = getSpanValue(spamSpanUserClass, allSpamSpans[i]);
+ var domain = getSpanValue(spamSpanDomainClass, allSpamSpans[i]);
+ var anchorText = getSpanValue(spamSpanAnchorTextClass, allSpamSpans[i]);
+ // prepare parameter data
+ var paramValues = new Array();
+ for (var j = 0; j < spamSpanParams.length; j++) {
+ var paramSpanValue = getSpanValue(spamSpanParams[j], allSpamSpans[i]);
+ if (paramSpanValue) {
+ paramValues.push(spamSpanParams[j] + '=' +
+ encodeURIComponent(paramSpanValue));
+ }
+ }
+ // create new anchor tag
+ var at = String.fromCharCode(32*2);
+ var email = cleanSpan(user) + at + cleanSpan(domain);
+ var anchorTagText = document.createTextNode(anchorText ? anchorText : email);
+ var mto = String.fromCharCode(109,97,105,108,116,111,58);
+ var hrefAttr = mto + email;
+ hrefAttr += paramValues.length ? '?' + paramValues.join('&') : '';
+ var anchorTag = document.createElement('a');
+ anchorTag.className = spamSpanMainClass;
+ anchorTag.setAttribute('href', hrefAttr);
+ anchorTag.appendChild(anchorTagText);
+ // replace the span with anchor
+ allSpamSpans[i].parentNode.replaceChild(anchorTag, allSpamSpans[i]);
+ }
+ }
+ // ]]>
+ </script>
+ <style type="text/css" media="all">
+ /* <![CDATA[ */
+ body {
+ margin-left: 1px;
+ /* ]]> */
+ </style>
+
+ </head>
+ <body>
+ </body>
+</html>
--- /dev/null
+;; This is just a test of cr-lf handling. Save this file with DOS
+;; cr-lf line endings and open it again.
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <title>Title</title>
+ <style type="text/css">
+ body { background: #ccc; }
+ p {
+ color: white;
+
+ }
+ </style>
+ </head>
+ <body>
+ <div id="container">
+ <script type="text/javascript">
+ var a = "aaa";
+
+ function test () {
+
+ }
+ </script>
+ </div>
+ </body>
+</html>
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml-strict.dtd">
+
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <title></title>
+ <link rel="Stylesheet" type="text/css" href="/style/style.css" media="all" />
+ <meta http-equiv="content-type" content="text/html; charset=utf-8" />
+ <style type="text/css" media="all">
+
+ </style>
+ </head>
+ <body>
+ <div id="container">
+ <script type="text/javascript">
+ var a = "aaa";
+
+ function test () {
+
+ }
+ </script>
+ </div>
+ </body>
+</html>
--- /dev/null
+<?php
+
+Zend_Loader::loadClass('Account','application/models');
+Zend_Loader::loadClass('Device','application/models');
+Zend_Loader::loadClass('Carrier','application/models');
+Zend_Loader::loadClass('DistributionChannel','application/models');
+
+/** Zend_Controller_Action */
+require_once 'Zend_Global_Controller_Action.php';
+
+class AccountController extends Zend_Global_Controller_Action
+{
+ public function indexAction($errors = array())
+ {
+
+ $this->view->assign('errors',$errors);
+ $this->view->assign('body','account_index.htm');
+echo $this->view->render('main_doc.htm');
+
+ }
+}
--- /dev/null
+<?php
+
+Zend_Loader::loadClass("Category","application/models");
+Zend_Loader::loadClass("CategoryDisplayName","application/models");
+
+/** Zend_Controller_Action */
+require_once 'Zend_Global_Controller_Action.php';
+
+class CategoryController extends Zend_Global_Controller_Action
+{
+ public function indexAction($notices = array(), $errors = array())
+ {
+
+ $request = $this->GetRequest();
+ blah, etc.
+ }
+}
+
--- /dev/null
+<?xml version="1.0" encoding="UTF-8"?>
+<data>
+</data>
--- /dev/null
+<outermost>\r
+ <inner1><inner2>\r
+ <inner3>Duh</inner3>\r
+ </inner2>\r
+ </inner1>\r
+</outermost>\r
--- /dev/null
+<!-- Since this file is not xhtml, nxhtml won't indent it correctly.
+ Therefore, turn on html mode before editing this file:
+ M-x html-mode -->
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+ <HEAD>
+ <TITLE>TDDB64 Avancerad programmering och interaktivitet på WWW</TITLE>
+ <META content="text/html; charset=windows-1252" http-equiv=Content-Type>
+ <META content="Microsoft FrontPage 4.0" name=GENERATOR>
+
+
+ <SCRIPT language="javascript" type="text/javascript">
+
+ </SCRIPT>
+
+
+ </HEAD>
+
+ <BODY bgColor="#ffffff">
+ <P>
+ <TABLE border=0 cellPadding=1 cellSpacing=0 width="100%">
+ <TR>
+ <TD align=CENTER bgColor="#ddffdd" width="15%">
+ <IMG align=MIDDLE alt="IDA " border=0 hspace=4 src="http://www.ida.liu.se/~TDDB06/labs/dhtml/simple_files/Ida-logo-tr-mini.gif"> </TD>
+ <TD width="1%">
+ <TD width="84%">
+
+ <B><A href="http://www.ida.liu.se/">Dept. of Computer and
+ Information Science</A>, <A href="http://www.liu.se/">Linköping
+ University</A></B> </TD>
+ </TR>
+ <TR>
+ <TD align=CENTER bgColor="#ddffdd" vAlign=top width="15%"><BR><BR>
+
+
+ <!-- -->
+ <!-- The Menue list starts here -->
+ <!-- -->
+ <DL>
+ <DT><B><A href="http://www.ida.liu.se/~TDDB06/index.shtm">Home</A></B>
+ <DT><B><A href="http://www.ida.liu.se/~TDDB06/faq.shtml">FAQ</A></B>
+ <DT><B><A
+ href="http://www.ida.liu.se/~TDDB06/labs/index.shtml">Labs</A></B>
+ <DT><B><A
+ href="http://www.ida.liu.se/~TDDB06/fo2000.shtml">Lectures</A></B>
+ <DT><B><A
+ href="http://www.ida.liu.se/~TDDB06/news2000.shtml">News</A></B>
+ <DT><B><A
+ href="http://www.lith.liu.se:4019/schema/schema?period=period+3+99-00&kurs=DDB06">Schedule</A></B>
+
+ <DT><B><A
+ href="http://www.ida.liu.se/~TDDB06/resources.shtml">Resources</A></B>
+ <DT><B><A href="http://www.ida.liu.se/~TDDB06/staff.shtml">Staff</A></B>
+
+ <DT><B><A href="http://www.ida.liu.se/~TDDB06/other.shtml">Other</A></B>
+
+ <DT><B><A href="http://www.ida.liu.se/~TDDB06/"></A></B>
+ <DT><B><A href="http://www.ida.liu.se/~TDDB06/"></A></B>
+ <DT><B><A href="http://www.ida.liu.se/~TDDB06/"></A></B>
+ <DT><B><A href="http://www.ida.liu.se/~TDDB06/"></A></B>
+ <DT><B><A href="http://www.ida.liu.se/~TDDB06/"></A></B></DT>
+
+ </DL>
+ <!-- -->
+ <!-- The Menue list ends here -->
+ <!-- -->
+
+
+ </TD>
+ <TD width="1%">
+ <TD width="84%">
+
+
+
+ <!-- -->
+ <!-- The page content starts here -->
+ <!-- -->
+ <img src="http://www.ida.liu.se/~TDDB06/const.gif" alt="JavaDude">
+ This page is not under construction. It is supposed to look like this.
+
+ <H1>TDDB64 Web Programming and Interactivity</H1>This
+ course covers an overview of WWW, HTML, basic Java programming, and
+ advanced Java programming. The course consists of a number of
+ <EM>lectures, programming assignments,</EM> and a <EM>programming
+ project,</EM> where the students practice advanced Java and WWW
+ implementation techniques.
+ <!-- -->
+ <!-- The page content starts here -->
+ <!-- -->
+
+
+
+ </TD></TR>
+ </TABLE>
+ <HR>
+ <p>
+ <a href="http://validator.w3.org/check?uri=referer"><img
+ src="http://www.w3.org/Icons/valid-html40"
+ alt="Valid HTML 4.0 Transitional" height="31" width="88"></a>
+ </p>
+
+</BODY></HTML>
--- /dev/null
+<?php
+ /* We must use this header to be correct and for the css validator to
+ find our stylesheet without us having to provide a fully qualified
+ path (address) to it. */
+header("Content-type:application/xhtml+xml; charset=utf-8");
+echo '<'.'?xml version="1.0" encoding="utf-8"?'.'>';
+?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <title>Lab 2 - Layout Control - Task 1 - XHTML/CSS version</title>
+ <link rel="stylesheet" type="text/css" href="stylesheet.css"/>
+ </head>
+ <body>
+ <div id="container">
+ <div id="header">Top area</div>
+ <div id="left-menu">
+ <ul>
+ <li><a style="hej" href="index.php">Home</a></li>
+ <li><a href="index.php?page=a">First Main Page</a></li>
+ <li><a href="index.php?page=b">Second Main Page</a></li>
+ </ul>
+ </div>
+ <div id="main">
+ <?php
+ if (isset($_GET['page'])) {
+ $thepage = $_GET['page'];
+
+ if ($thepage != 'a' && $thepage != 'b') {
+ print('You hacker you!');
+ }
+ else {
+ require('main-div-'.$thepage.'.html');
+ }
+ }
+ else {
+ require('main-div-a.html');
+ }
+ ?>
+ </div>
+ <div id="footer">
+ <p>
+ <a href="http://validator.w3.org/check?uri=referer">
+ <img src="valid-xhtml10.png" alt="Valid XHTML 1.0 Strict"></img>
+ </a>
+ <a href="http://jigsaw.w3.org/css-validator/check?uri=referer">
+ <img src="vcss.png" alt="Valid CSS!"></img>
+ </a>
+ </p>
+ </div>
+ </div>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>Dummy</title>
+ <link rel="stylesheet" type="text/css" href="<?php echo get_stylesheet();?>"/>
+ </head>
+ <body>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>\r
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"\r
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">\r
+<html xmlns="http://www.w3.org/1999/xhtml">\r
+ <head>\r
+ <title>Dummy</title>\r
+ <link rel="stylesheet" type="text/css" href="<?php echo get_stylesheet();?>"/>\r
+ </head>\r
+ <body>\r
+ </body>\r
+</html>\r
--- /dev/null
+<?php\r
+/* this is a comment\r
+ and it seems to work ok...\r
+*/\r
+?>\r
+\r
--- /dev/null
+(defun temp-el-070722 ()
+ (remove-text-properties 1 25 '(syntax-table nil))
+ (syntax-ppss-flush-cache -1)
+ (setq syntax-ppss-last nil)
+ (goto-char (point-min))
+ (let ((parse-sexp-lookup-properties t)) (syntax-ppss 24))
+ )
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"\r
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">\r
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">\r
+ <head>\r
+ <title>Lab 2 - Layout Control - Task 2 - XHTML/CSS version</title>\r
+ <link rel="stylesheet" type="text/css" href="stylesheet.css"/>\r
+ </head>\r
+ <body>\r
+ <div id="container">\r
+ <div id="header">Top area</div>\r
+ <div id="left-menu">\r
+ <ul>\r
+ <li><a href="index.php">Home</a></li>\r
+ <li><a href="index.php?page=a">First Main Page</a></li>\r
+ <li><a href="index.php?page=b">Second Main Page</a></li>\r
+ </ul>\r
+ </div>\r
+ <div id="main">\r
+ <?php\r
+ if (isset($_GET["page"])) {\r
+ $thepage = $_GET['page'];\r
+\r
+ if ($thepage != 'a' && $thepage != 'b') {\r
+ print('You hacker you!');\r
+ }\r
+ else {\r
+ require('main-div-'.$thepage.'.html');\r
+ }\r
+ }\r
+ else {\r
+ require('main-div-a.html');\r
+ }\r
+ ?>\r
+ </div>\r
+ <div id="right-menu">Right area</div>\r
+ <div id="footer">\r
+ <p>\r
+ <a href="http://validator.w3.org/check?uri=referer">\r
+ <img src="valid-xhtml10.png" alt="Valid XHTML 1.0 Strict"></img>\r
+ </a>\r
+ <a href="http://jigsaw.w3.org/css-validator/check?uri=referer">\r
+ <img src="vcss.png" alt="Valid CSS!"></img>\r
+ </a>\r
+ </p>\r
+ </div>\r
+ </div>\r
+ </body>\r
+</html>\r
--- /dev/null
+<?php
+/* We must use this header to be correct and for the css validator to
+ find our stylesheet without us having to provide a fully qualified
+ path (address) to it. */
+header("Content-type:application/xhtml+xml; charset=utf-8");
+echo '<'.'?xml version="1.0" encoding="utf-8"?'.'>';
+?>
+ <body>
+ <div id="container">
+ <div id="header">Top area</div>
+ <div id="left-menu">
+ <ul>
+ <li><a href="index.php">Home</a></li>
+ <li><a href="index.php?page=a">First Main Page</a></li>
+ <li><a href="index.php?page=b">Second Main Page</a></li>
+ </ul>
+ </div>
+ <div id="main">
+ <?php
+ if (isset($_GET["page"])) {
+ $thepage = $_GET['page'];
+
+ if ($thepage != 'a' && $thepage != 'b') {
+ print('You hacker you!');
+ }
+ else {
+ require('main-div-'.$thepage.'.html');
+ }
+ }
+ else {
+ require('main-div-a.html');
+ }
+ ?>
+ </div>
+ <div id="right-menu">Right area</div>
+ <div id="footer">
+ <p>
+ <a href="http://validator.w3.org/check?uri=referer">
+ <img src="valid-xhtml10.png" alt="Valid XHTML 1.0 Strict"></img>
+ </a>
+ <a href="http://jigsaw.w3.org/css-validator/check?uri=referer">
+ <img src="vcss.png" alt="Valid CSS!"></img>
+ </a>
+ </p>
+ </div>
+ </div>
+ </body>
+</html>
--- /dev/null
+<?php
+/* We must use this header to be correct and for the css validator to
+ find our stylesheet without us having to provide a fully qualified
+ path (address) to it. */
+header("Content-type:application/xhtml+xml; charset=utf-8");
+echo '<'.'?xml version="1.0" encoding="utf-8"?'.'>';
+?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <title>Lab 2 - Layout Control - Task 2 - XHTML/CSS version</title>
+ <link rel="stylesheet" type="text/css" href="stylesheet.css"/>
+ </head>
+ <body>
+ <div id="container">
+ <div id="header">Top area</div>
+ <div id="left-menu">
+ <ul>
+ <li><a href="index.php">Home</a></li>
+ <li><a href="index.php?page=a">First Main Page</a></li>
+ <li><a href="index.php?page=b">Second Main Page</a></li>
+ </ul>
+ </div>
+ <div id="main">
+ <?php
+ if (isset($_GET["page"])) {
+ $thepage = $_GET['page'];
+
+ if ($thepage != 'a' && $thepage != 'b') {
+ print('You hacker you!');
+ }
+ else {
+ require('main-div-'.$thepage.'.html');
+ }
+ }
+ else {
+ require('main-div-a.html');
+ }
+ ?>
+ </div>
+ <div id="right-menu">Right area</div>
+ <div id="footer">
+ <p>
+ <a href="http://validator.w3.org/check?uri=referer">
+ <img src="valid-xhtml10.png" alt="Valid XHTML 1.0 Strict"></img>
+ </a>
+ <a href="http://jigsaw.w3.org/css-validator/check?uri=referer">
+ <img src="vcss.png" alt="Valid CSS!"></img>
+ </a>
+ </p>
+ </div>
+ </div>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>\r
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"\r
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">\r
+<html xmlns="http://www.w3.org/1999/xhtml">\r
+ <head>\r
+ <title></title>\r
+ </head>\r
+ <frameset cols="50%, 50%">\r
+ <frame src="about:blank" />\r
+ <frame src="about:blank" />\r
+ </frameset>\r
+</html>\r
+<!-- A comment -->\r
--- /dev/null
+<?php\r
+\r
+ /* There was a problem reported 2008-01-19 on\r
+ http://www.emacswiki.org/cgi-bin/wiki/NxhtmlMode. The word\r
+ INCLUDE was highlighted with a different color. However this\r
+ should now work and the word APP_INCLUDE below should all be in\r
+ font-lock-warning-face.\r
+\r
+ FIXME: When deleting the first star the first time only the first\r
+ part of the comment is affected.\r
+ */\r
+\r
+define("APP_INCLUDE", "/home/app/include/"); include_once(APP_INCLUDE . "file.php");\r
+\r
+?>\r
--- /dev/null
+;;; This file is from a link on EmacsWiki to http://paste.lisp.org/display/59495
+;;
+;; As far as I can see this is a ruby-mode bug, not a mumamo bug.
+
+;;; The problem is that when a ruby ERB template is loaded with an
+;;; after-hook that modifies the font-lock keywords, nxhtml causes
+;;; font-lock not to occur on strings and comments. What's more is
+;;; this affects regular ruby-mode as well, not just within mumamo.
+
+(require 'ruby-mode)
+
+;; Extra keyword fontification for ruby
+(defun emacswiki-erb-bug-keywords ()
+ (font-lock-add-keywords nil
+ '(("\\<\\(FIX\\|TODO\\|FIXME\\|HACK\\|REFACTOR\\):"
+ 1 font-lock-warning-face t))))
+
+;; Adding the extra keywords at the beginning of ruby-mode-hook breaks
+;; ruby-mode fontification (use the test case at the bottom):
+(add-hook 'ruby-mode-hook 'emacswiki-erb-bug-keywords)
+;; removing this hook makes it not break anymore:
+(remove-hook 'ruby-mode-hook 'emacswiki-erb-bug-keywords)
+;; However adding the extra keywords at the end of the hook works fine:
+(add-hook 'ruby-mode-hook 'emacswiki-erb-bug-keywords t)
+
+
+;; run this to test:
+(progn
+ (find-file "bar.rb")
+ (insert "# Comments should be font-locked, but are not.
+class Bar
+ def baz
+ \"strings should also be font-locked but are not.\"
+ end
+end"))
+
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>News and Notes about nXhtml</title>
+ <link href="wd/grapes/nxhtml-grapes.css" rel="StyleSheet" type="text/css" />
+ </head>
+ <body>
+ <div id="container">
+
+ <div id="rgtcol">
+ <p id="nxhtml-home">
+ <a href="nxhtml.html">To nXhtml main page</a>
+ </p>
+
+ <h1>News and Notes about nXhtml</h1>
+
+ <dl>
+
+ <dt id="hadron-bugs" style="margin-top:1em;">Thanks for testing!</dt>
+ <dd>
+ <p>
+ I want to thanks the testers, especially Hadron Quark
+ and Eric Lilja, for helping me by testing and pointing
+ out bugs and weaknesses, most related to editing of PHP.
+ </p>
+ <p>
+ It is quite a big job trying to get rid of smaller annoying bugs and bigger ones.
+ In my mailbox folder for nXhtml I have more than 500 old messages currently.
+ </p>
+ </dd>
+
+ <dt id="state-of-the-art" style="margin-top:1em;
+ background-color: #00fa9a;
+ background-color: #20b2aa;
+ padding: 0.5em;
+ ">The State of the Art</dt>
+ <dd style="background-color: #54ff9f; padding: 0.5em">
+ <p>
+ I have more and more come to realize that there are two
+ main parts of nXhtml which are in quite different
+ degrees of maturity. The reason for the difference is
+ mainly that one of them, <strong>mumamo-mode</strong>, requires
+ very tight integration with Emacs in a way that
+ currently is not completely possible. Some things must
+ be changed in Emacs for this. There are also things to
+ discover in the interactions with other minor modes for
+ example.
+ </p>
+ <p>
+ That said I still think mumamo-mode is mature enough for
+ serious use (though it sometimes conflicts with some other modules).
+ </p>
+ <p>
+ The other part, <strong>nxhtml-mode</strong>, is more mature,
+ since it stands more by itself and since it builds on
+ the very stable nxml-mode. I would not say nxhtml-mode
+ is finished, but it is stable and useful.
+ </p>
+ </dd>
+
+ <dt id="magic-problems" style="margin-top:1em;">Magic major mode selection</dt>
+ <dd>
+ <p>
+ Sometimes the major mode that Emacs opens a file in is
+ not what you expect. This can happen with files like PHP
+ files. The reason might be that magic-mode-alist have
+ choosen a mode based on the content of the file. The way
+ this is done does not take files with mixes a mix of for
+ example XHTML and PHP into account.
+ </p>
+ <p>
+ You may try setting magic-mode-alist to nil if this is a
+ problem for you.
+ </p>
+ <p>
+ <em>
+ This is now no longer necessary since the introduction
+ of magic-fallback-mode-alist in CVS Emacs on 2007-05-16.
+ (If you have an Emacs newer than that, of course.)
+ </em>
+ </p>
+ </dd>
+
+ <dt id="underline-bug" style="margin-top:1em;">Long Red Underlines</dt>
+ <dd>
+ <p>
+ Because of a bug in Emacs 22.1 you can sometimes (at the
+ end of a line) get long red lines instead of just a
+ single underlined character. Many users (me included)
+ find this quite a bit disturbing. I have therefore added
+ a command to quickly hide/show the underlines. This is
+ on <em>C-c C-w</em>.
+ </p>
+ <p>
+ This is particular useful for example in the case where
+ you edit a PHP file and are bound to get a lot of XHTML
+ validation errors.
+ </p>
+ </dd>
+
+ <dt id="php-attribute-values" style="margin-top:1em;">Attribute values computed by PHP</dt>
+ <dd>
+ <p>
+ If you want to have attribute values computed by PHP
+ here is a way how to structure that to avoid breaking
+ completion and validation in the XHTML part unnessecary:
+ </p>
+ <p style="margin-left:2em">
+ <img src="images/linux.png" title="<?php foo("bar");?>"/>
+ </p>
+ <p>
+ Unfortunately that still breaks XHTML validation since
+ < is not allowed in strings. In the long run I
+ believe the XML validator has to be broken up so that it
+ avoids parsing the string here (in PHP files).
+ </p>
+ <p>
+ For now I have implemented a workaround.
+ If you are using constructs like those above then turn on <em>nxhtml-strval-mode</em>.
+ This will temporarily replace the above with
+ </p>
+ <p style="margin-left:2em">
+ <img src="images/linux.png" title="«?php foo("bar");?»"/>
+ </p>
+ <p>
+ However on the screen you will still see the original
+ string and when writing to file the correct characters
+ will be used.
+ </p>
+ </dd>
+
+ <dt id="pi-note" style="margin-top:1em;">A note for PHP and its cousins</dt>
+ <dd>
+ <p>
+ The rules for a process instruction in XML, like <?php
+ ... ?> says that the text can contain any text except
+ <em>?></em>. So if you want to output that string
+ from PHP then break it up so it does not look as ?> in
+ the source file.
+ </p>
+ <p>
+ It might be good to break up the beginning part of the
+ process instructions too. And please note that to use
+ XHTML validation or completion you should avoid using
+ < in strings, since it is not allowed there.
+ </p>
+ </dd>
+
+ <dt id="pi-note" style="margin-top:1em;">Perl Mode slow with Mumamo Mode</dt>
+ <dd>
+ <p>
+ Perl mode used with MuMaMo mode sometimes makes the
+ fontification slow for big files. I do not know the
+ reason, but I am trying to find a solution for this. If
+ you encounter this problem, just turn off mumamo-mode in
+ that buffer.
+ </p>
+ </dd>
+
+ <dt id="tab-width-problems" style="margin-top:1em;">Tab width</dt>
+ <dd>
+ <p>
+ Do you have <em>tab-width</em> to something different than 8
+ (the default)? Then please change this to 8. I have got
+ reports of problem with indentation when it is not 8.
+ </p>
+ </dd>
+
+ <dt id="mmm-compat" style="margin-top:1em;">Why the chunks are not compatible with mmm</dt>
+ <dd>
+ <p>
+ Some people have asked why the way to specify chunks in
+ mumamo-mode is not compatible with the old mmm-mode. The
+ answer is that I was not sure that the way used in
+ mmm-mode for specifying the chunks was flexible enough.
+ </p>
+ <p>
+ And I am sure that even the way used in mumamo-mode is
+ not good enough for all cases, but I let it be the way
+ it is until I have a better understanding of the
+ problem. Suggestions and comments are welcome!
+ </p>
+ </dd>
+
+ </dl>
+
+ <h1>nXhtml Changes</h1>
+
+ <dl>
+ <dt>0.89</dt>
+ <dd>
+ <ul>
+ <li>
+ Corrected autostart for nXhtml when not used together with EmacsW32.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.90</dt>
+ <dd>
+ <ul>
+ <li>
+ Improved display of XML path.
+ </li>
+ <li>
+ Discontinued xmple-mode.
+ </li>
+ <li>
+ New major modes nxhtml-part-mode/nxml-part-mode replaces
+ minor mode xmlpe-mode. (While moving the code to
+ nxhtml-part.el I also fixed a bug in Xmple minor mode that
+ made Emacs take 99% of the CPU.)
+ </li>
+ </ul>
+ </dd>
+ <dt>0.91</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed some calls to perl which prevented uploading of
+ a site of you did not have perl in the same location
+ as me.
+ </li>
+ <li>
+ Glued together things so that editing PHP files works
+ as I intended. (This means that Emacs switches between
+ php-mode and nxhtml-part-mode automatically when
+ moving point. And that you can use completion.)
+ </li>
+ <li>
+ Starting working on the documentation for nXhtml.
+ New layout to the documentation files.
+ Examples with images.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.92</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixes to make the switching between php and xhtml
+ style editing work better.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.93</dt>
+ <dd>
+ <ul>
+ <li>
+ Better error handling when switching to editing
+ embedded JavaScript and CSS.
+ </li>
+ <li>
+ Removed PHP spec from embedded switching since they
+ interfered with the automatic switching between php
+ and xhtml.
+ </li>
+ <li>
+ Gives an error message if web host is not defined in
+ site when trying to use View Uploaded File and
+ cousins.
+ </li>
+ <li>
+ Gives a ready message when finished uploading a single
+ file.
+ </li>
+ <li>
+ When using Mode Switching at <? ... ?> mode
+ switching could occur in wrong buffer. Fixed together
+ with some other buffer problems.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.94</dt>
+ <dd>
+ <ul>
+ <li>
+ Add http://www.w3.org/ to the help sites for CSS.
+ </li>
+ <li>
+ Included a CSS mode.
+ </li>
+ <li>
+ Added a menu entry for bug reporting.
+ </li>
+ <li>
+ Renamed menu bar entry from XHTML to nXhtml for clarity.
+ (But nXml menu bar entry is still called XML.)
+ </li>
+ <li>
+ Added work around for globalized minor modes in the
+ cases of MLinks, XML Path and mode switching at <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.95</dt>
+ <dd>
+ <ul>
+ <li>
+ Added workaround for the problem with the first
+ keyboard key after automatically switching of mode at
+ <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.96</dt>
+ <dd>
+ <ul>
+ <li>
+ Added support for multiple major modes with mumamo.el.
+ </li>
+ <li>
+ More conventient handling of links. They can now be
+ opened in the same window, 'other window' or in a new
+ frame.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.97</dt>
+ <dd>
+ <ul>
+ <li>
+ Schema was not setup after starting new page so
+ completion did not work. Fixed.
+ </li>
+ <li>
+ Added http://xhtml.com/ to help sites for XHTML.
+ </li>
+ <li>
+ Added the concept of <em>XML validation headers</em>.
+ These are just text parsed by the nXml validation
+ parser to get a start state before starting parsing a
+ buffer. This allows the use of the nXml completion in
+ buffers where there are no XML header. Such a header
+ is often lacking for example in PHP code since the
+ XHTML header is often generated dynamically.
+ </li>
+ <li>
+ Because of the change above <em>nxhtml-part-mode</em>
+ is no longer needed and is therefore declared
+ obsolete.
+ </li>
+ <li>
+ Corrected a bug in mlinks.el that prevented opening an
+ HTML link in a other window or a new frame.
+ </li>
+ <li>
+ Added support for JSP, eRuby and some support for perl
+ in mumamo.el.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.98</dt>
+ <dd id="v0.98">
+ <ul>
+ <li>
+ Mumamo was not found when nXhtml was installed with
+ just the zip file. Corrected. (nXhtml is also
+ installed when you install EmacsW32.)
+ </li>
+ <li>
+ Enhancement to mumamo error handling when a bad mode
+ specifier for an embedded mode is found.
+ </li>
+ <li>
+ Introduced a bug for empty XHTML documents in
+ 0.97. Corrected.
+ </li>
+ <li>
+ Corrected a bug for chunks 1 character long.
+ </li>
+ <li>
+ There is what I consider is a bug in Emacs 22.1 in the
+ handling of global minor mode that are not distributed
+ with Emacs. If they are turned on by customization,
+ but loaded after Emacs have loaded the customizations
+ (usually in .emacs) then they are not turned on
+ correctly. Added work-around for this.
+ </li>
+ <li>
+ <em>Extra XHTML Validation Header</em>:
+ <ul>
+ <li>
+ <em>Extra XHTML Validation Header</em> state was not saved when moving between chunks. Fixed.
+ </li>
+ <li>
+ Tried to make the concept of <em>Extra XHTML Validation Header</em>
+ more clear. Added this visually to the buffer.
+ </li>
+ <li>
+ <em>Extra XHTML Validation Headers</em> can now be turned on
+ automatically based on file name.
+ </li>
+ </ul>
+ </li>
+ <li>
+ <em>nXhtml menu:</em>
+ <ul>
+ <li>
+ Reorganized the nXhtml menu.
+ </li>
+ <li>
+ Added <em>customization</em> groups for help libraries to nXhtml.
+ </li>
+ <li>
+ Added an entry for customization of nXhtml to the menus.
+ </li>
+ <li>
+ Added <em>Tidy</em> to the menus again.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Corrected bug in <em>XML Path</em> (nxml-where) for single tags.
+ Other small fixes to nxhtml-where.
+ </li>
+ <li>
+ Documentation enhancements.
+ Added <em>The Quick Guide</em>.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.99</dt>
+ <dd id="v0.99">
+ <ul>
+ <li>
+ Fixed a serious bug in the cooperation between nxhtml-mode and mumamo-mode.
+ </li>
+ <li>
+ Turn on mumamo-mode by file name (mumamo-global-mode).
+ </li>
+ <li>
+ Extra XHTML Validation Header:
+ <ul>
+ <li>
+ The Extra XHTML Validation Header state were not saved when changing major mode in MuMaMo. Corrected.
+ </li>
+ <li>
+ Added more alternatives to the Extra XHTML Validation Header list.
+ This should make it easier to use completion with for example PHP.
+ </li>
+ <li>
+ Added default value for the Extra XHTML Validation Header.
+ </li>
+ <li>
+ Tried to make the use of Extra XHTML Validation Header more automatic and therefore useful.
+ Also tried to make it play better with setting schema file.
+ (There is no need normally to set schema file by hand.)
+ </li>
+ <li>
+ To turn this on by default customize nxhtml-global-validation-header-mode.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Possible to hide validation warnings without turning
+ on validation (which would make completion in the
+ XHTML part impossible).
+ </li>
+ <li>
+ Some fixes to php-mode:
+ <ul>
+ <li>Using the character # for comments now works for most cases.</li>
+ <li>Now uses the fontification faces in a more standard way which calms down the look.</li>
+ <li>Initialization bug fixes.</li>
+ <li>Renamed php-mode-user-hook to php-mode-hook to follow standard.</li>
+ </ul>
+ </li>
+ <li>
+ Indentation fixes:
+ <ul>
+ <li>
+ Various corrections to indentation in mumamo.
+ </li>
+ <li>
+ Added the possibility to use TAB to indent regions
+ (indent-region-mode).
+ </li>
+ <li>
+ Warn about bad indentation in mixed PHP/HTML code
+ when using php-mode only.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fontification now fontifies all text first in main
+ major mode and thereafter applies submodes. (This
+ avoids some problems with around a submode chunk.)
+ </li>
+ <li>
+ Reorganized the nXhtml menu:
+ <ul>
+ <li>
+ There is now a minor mode for the nXhtml
+ menu. This makes it possible to easier use common
+ features when in buffers not in nxhtml-mode.
+ </li>
+ <li>
+ The nXhtml menu does not disappear when moving
+ into a chunk where the major mode is not
+ nxhtml-mode. The changes also makes it easy to
+ access uploading functions functions etc from
+ other modes than nxhtml-mode since the
+ <em>nXhtml</em> may also be shown in them.
+ </li>
+ <li>
+ The nXhtml menu can be turned on globally by default.
+ Customize nxhtml-menu-mode for that.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt>1.00</dt>
+ <dd id="v1.00">
+ <ul>
+ <li>
+ Reached version number 1.00 - which you maybe believe
+ means the bugs should be gone? Sorry, it is just that
+ I ran out of version numbers ;-) However it looks like
+ much fewer bugs at least.
+ </li>
+ <li>
+ Fixed problems mostly related to global turn on of different features in nXhtml.
+ </li>
+ <li>
+ Small fixes to indentation.
+ <ul>
+ <li>
+ nxhtml-mode could get confused by php tags.
+ </li>
+ <li>
+ nxhtml-mode did not indent <!DOCTYPE in a sensible way.
+ </li>
+ <li>
+ Electric keys now works in embedded php when using mumamo-mode.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Tidy was very misbehaving since the output buffer was
+ not erased between different files. But I have got no
+ bug reports on this ;-)
+ </li>
+ <li>
+ Fixed a bug in validation that should up when using muamo-mode.
+ </li>
+ <li>
+ Fixed bug in <script ...> and <style ...> chunk dividing.
+ </li>
+ <li>
+ Added support for OpenLaszlo.
+ </li>
+ <li>
+ Corrections to mlinks-mode (visible mostly as links in
+ XHTML buffers):
+ <ul>
+ <li>
+ Links disappeared when a new file was
+ opened. Corrected.
+ </li>
+ <li>
+ Links were not correctly updated at changes in the
+ buffer when mumamo-mode was used. Fixed.
+ </li>
+ </ul>
+ </li>
+ <li>
+ The welcome message for nXhtml could be shown too
+ early sometimes when loading, before nXhtml actually
+ knew if it should be shown or not. Tried to fix it.
+ </li>
+ </ul>
+ </dd>
+ <dt>1.01</dt>
+ <dd id="v1.01">
+ <ul>
+ <li>
+ Reported wrong version number for nXhtml in the menus. Fixed.
+ </li>
+ <li>
+ <em>If you use the zip file to install nXhtml please
+ notice that it has now a top level nxml.</em> Sorry for not
+ having zipped it like that before!
+ </li>
+ <li>
+ The url links in <em>Welcome to nXhtml</em> was a bit
+ incorrect and did not work on all OS:es. Fixed.
+ </li>
+ <li>
+ Added customization of popup completion to the 'nxhtml
+ customization group so they are easier to find.
+ </li>
+ <li>
+ MuMaMo
+ <ul>
+ <li>
+ Struggled a bit with the load sequences of the elisp
+ libraries used by nXhtml when using MuMaMo.
+ </li>
+ <li>
+ Tried to get the global turn on of mumam-mode to work
+ in all cases.
+ </li>
+ <li>
+ The screen was blinking when changing overlays after
+ changes in the buffer. Tried to fix this.
+ </li>
+ <li>
+ Minor fixes do syntax highlighting, like taking care of single ':s.
+ </li>
+ <li>
+ Fixes to the support for JSP and eRuby.
+ </li>
+ <li>
+ Made the support for perl here documents a bit better.
+ Large perl documents are however still quite slow when
+ using mumamo-mode. I do not know the reason yet.
+ </li>
+ <li>
+ Refontification could miss some parts when buffer
+ changes caused chunk division changes. Complex,
+ tried to fix it, but I am a bit unsure that it
+ always works.
+ </li>
+ <li>
+ Cleaned up mumamo.el a bit.
+ </li>
+ <li>
+ Rewrote mumamo-test.el and functions called from it in
+ mumamo.el a bit to make tracebacks from errors more
+ useful. Changed keybindings in mumamo-test.el from
+ global to a minor mode <em>mumamo-test-mode</em>.
+ Renamed mumamo-notest.el to mumamo-test.el. Added it
+ to the zipped distribution of nXhtml.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fixed a bug related to links and buffer changes.
+ </li>
+ </ul>
+ </dd>
+ <dt>1.02</dt>
+ <dd id="v1.02">
+ <ul>
+ <li>
+ Fixed a refontification bug that occured after changes.
+ </li>
+ </ul>
+ </dd>
+ <dt>1.03</dt>
+ <dd id="v1.03">
+ <ul>
+ <li>
+ Added the possibility to call GIMP.
+ </li>
+ <li>
+ Reworked the messages for fontification errors to try
+ to catch an error that shows up sometimes. Tried to
+ avoid disturbing normal use in spite of that error.
+ </li>
+ <li>
+ Reverted to using a short delay before switching major
+ mode when moving between buffers.
+ </li>
+ </ul>
+ </dd>
+ <dt>1.04</dt>
+ <dd id="v1.04">
+ <ul>
+ <li>
+ Completion in empty buffers with a completion header
+ did not work. Fixed.
+ </li>
+ <li>
+ Multiple major modes:
+ <ul>
+ <li>
+ Better error tracing for some functions.
+ </li>
+ <li>
+ Position was garbled when a ;-char was inserted in php-mode chunk. Fixed.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Extra XHTML Validation Header:
+ <ul>
+ <li>
+ View File did not work correctly when an extra
+ XHTML validation header was used. Corrected.
+ </li>
+ <li>
+ Extra XHTML validation headers are no longer
+ turned on by default in any buffers.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Tried to fix a problem when using newline-and-indent.
+ When this was in a mode derived from C the indentation
+ sometimes became 0.
+ </li>
+ <li>
+ Added a workaround for <a
+ href="#php-attribute-values">Attribute values computed
+ by PHP</a>
+ </li>
+ <li>
+ Ruby
+ <ul>
+ <li>
+ Multiple major mode turned on by default for .rhtml files when this mode is global.
+ </li>
+ <li>
+ Multiple major mode is no longer turned on when rub-mode is turned on.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added .nosearch to subdirectories with no elisp files.
+ </li>
+ <li>
+ Added support for Firefox add-on It's All Text.
+ </li>
+ <li>
+ Added the possibility to easily view the output of scripts on the server (if they require no parameters).
+ You can now do that from the nXhtml menu.
+ Previously only html files on the server could be viewed that way.
+ Image files can also be viewed this way.
+ </li>
+ <li>
+ Upgraded htmlize.el to version 1.34
+ </li>
+ <li>
+ Added functions for unfilling.
+ </li>
+ <li>
+ Added keybindings and menu entries for longlines-mode, fill-paragraph and unfill-paragraph.
+ </li>
+ <li>
+ Added image-mode to those that are encompassed by
+ nxhtml-global-minor-mode so that images can be
+ uploaded more easily.
+ </li>
+ <li>
+ Added <em>edit with GIMP</em> and <em>upload</em> to the popup menu for links.
+ This avoids the need to load the linked files in Emacs first.
+ </li>
+ <li>
+ Fixed incorrect checks for mlinks-mode in menu building.
+ </li>
+ </ul>
+ </dd>
+ </dl>
+ </div>
+ </div>
+
+ <hr class="footer"/>
+ <p class="footer">
+ Copyright © 2007 OurComments.org
+ --
+ Latest update 2007-05-06
+ </p>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>nXhtml Notes and Changes</title>
+ <link href="wd/grapes/nxhtml-grapes.css" rel="StyleSheet" type="text/css" />
+ </head>
+ <body>
+ <div id="container">
+
+ <div id="rgtcol">
+ <p id="nxhtml-home">
+ <a href="nxhtml.html">To nXhtml main page</a>
+ </p>
+
+ <h1>nXhtml Notes and Bugs</h1>
+
+ <dl>
+<!-- <dt id="bugs-affect-mode-switching">Two Emacs 22 beta bugs affects PHP mode switching</dt> -->
+<!-- <dd> -->
+<!-- <p> -->
+<!-- <a href="nxhtml.html#php">PHP / nXhtml automatic mode switching</a> is affected: -->
+<!-- </p> -->
+<!-- <ul> -->
+<!-- <li> -->
+<!-- Because of a bug in Emacs 22 beta you may have to turn -->
+<!-- off and on the switch <em>Mode Switching at <? -->
+<!-- ... ?></em> in the menus to get the automatic mode -->
+<!-- switching to start. -->
+<!-- <em>(Work around added in 0.94)</em> -->
+<!-- </li> -->
+<!-- <li> -->
+<!-- There is the same problem with showing XML path. -->
+<!-- <em>(Work around added in 0.94)</em> -->
+<!-- </li> -->
+<!-- <li> -->
+<!-- It also affects MLinks. -->
+<!-- <em>(Work around added in 0.94)</em> -->
+<!-- </li> -->
+<!-- <li> -->
+<!-- Because of another bug in Emacs 22 beta immediately -->
+<!-- after mode the automatic mode switching the keyboard -->
+<!-- uses the key bindings from the <em>wrong mode for the -->
+<!-- first key</em>. Type any key on the keyboard, that -->
+<!-- cures it. -->
+<!-- <em>(Work around added in 0.95)</em> -->
+<!-- </li> -->
+<!-- </ul> -->
+<!-- </dd> -->
+ <dt id="new-mode-switching" style="margin-top:1em;">I have rewritten the PHP mode switching</dt>
+ <dd>
+ <p>
+ Because of some (fair) critique I have gotten about the way mode switching between php-mode and nxhtml-mode works
+ I have rewritten that part.
+ The new mode switching also includes embedded css, javascript, eRuby and JSP.
+ </p>
+ </dd>
+ <dt id="hadron-bugs" style="margin-top:1em;">A lot of bugs corrected for version 0.98</dt>
+ <dd>
+ <p>
+ I want to thanks Hadron Quark for helping me by testing
+ and pointing out bugs and weaknesses, most related to
+ editing of PHP. I have included fixes for many of them
+ in version 0.98 and more may follow.
+ </p>
+ </dd>
+ </dl>
+
+ <h1>nXhtml Changes</h1>
+
+ <dl>
+ <dt>0.89</dt>
+ <dd>
+ <ul>
+ <li>
+ Corrected autostart for nXhtml when not used together with EmacsW32.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.90</dt>
+ <dd>
+ <ul>
+ <li>
+ Improved display of XML path.
+ </li>
+ <li>
+ Discontinued xmple-mode.
+ </li>
+ <li>
+ New major modes nxhtml-part-mode/nxml-part-mode replaces
+ minor mode xmlpe-mode. (While moving the code to
+ nxhtml-part.el I also fixed a bug in Xmple minor mode that
+ made Emacs take 99% of the CPU.)
+ </li>
+ </ul>
+ </dd>
+ <dt>0.91</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed some calls to perl which prevented uploading of
+ a site of you did not have perl in the same location
+ as me.
+ </li>
+ <li>
+ Glued together things so that editing PHP files works
+ as I intended. (This means that Emacs switches between
+ php-mode and nxhtml-part-mode automatically when
+ moving point. And that you can use completion.)
+ </li>
+ <li>
+ Starting working on the documentation for nXhtml.
+ New layout to the documentation files.
+ Examples with images.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.92</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixes to make the switching between php and xhtml
+ style editing work better.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.93</dt>
+ <dd>
+ <ul>
+ <li>
+ Better error handling when switching to editing
+ embedded JavaScript and CSS.
+ </li>
+ <li>
+ Removed PHP spec from embedded switching since they
+ interfered with the automatic switching between php
+ and xhtml.
+ </li>
+ <li>
+ Gives an error message if web host is not defined in
+ site when trying to use View Uploaded File and
+ cousins.
+ </li>
+ <li>
+ Gives a ready message when finished uploading a single
+ file.
+ </li>
+ <li>
+ When using Mode Switching at <? ... ?> mode
+ switching could occur in wrong buffer. Fixed together
+ with some other buffer problems.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.94</dt>
+ <dd>
+ <ul>
+ <li>
+ Add http://www.w3.org/ to the help sites for CSS.
+ </li>
+ <li>
+ Included a CSS mode.
+ </li>
+ <li>
+ Added a menu entry for bug reporting.
+ </li>
+ <li>
+ Renamed menu bar entry from XHTML to nXhtml for clarity.
+ (But nXml menu bar entry is still called XML.)
+ </li>
+ <li>
+ Added work around for globalized minor modes in the
+ cases of MLinks, XML Path and mode switching at <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.95</dt>
+ <dd>
+ <ul>
+ <li>
+ Added workaround for the problem with the first
+ keyboard key after automatically switching of mode at
+ <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.96</dt>
+ <dd>
+ <ul>
+ <li>
+ Added support for multiple major modes with mumamo.el.
+ </li>
+ <li>
+ More conventient handling of links. They can now be
+ opened in the same window, 'other window' or in a new
+ frame.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.97</dt>
+ <dd>
+ <ul>
+ <li>
+ Schema was not setup after starting new page so
+ completion did not work. Fixed.
+ </li>
+ <li>
+ Added http://xhtml.com/ to help sites for XHTML.
+ </li>
+ <li>
+ Added the concept of <em>XML validation headers</em>.
+ These are just text parsed by the nXml validation
+ parser to get a start state before starting parsing a
+ buffer. This allows the use of the nXml completion in
+ buffers where there are no XML header. Such a header
+ is often lacking for example in PHP code since the
+ XHTML header is often generated dynamically.
+ </li>
+ <li>
+ Because of the change above <em>nxhtml-part-mode</em>
+ is no longer needed and is therefore declared
+ obsolete.
+ </li>
+ <li>
+ Corrected a bug in mlinks.el that prevented opening an
+ HTML link in a other window or a new frame.
+ </li>
+ <li>
+ Added support for JSP, eRuby and some support for perl
+ in mumamo.el.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.98</dt>
+ <dd id="0.98">
+ <ul>
+ <li>
+ Mumamo was not found when nXhtml was installed with
+ just the zip file. Corrected. (nXhtml is also
+ installed when you install EmacsW32.)
+ </li>
+ <li>
+ Enhancement to mumamo error handling when a bad mode
+ specifier for an embedded mode is found.
+ </li>
+ <li>
+ Introduced a bug for empty XHTML documents in
+ 0.97. Corrected.
+ </li>
+ <li>
+ Corrected a bug for chunks 1 character long.
+ </li>
+ <li>
+ There is a bug in Emacs 22 in the handling of global
+ minor mode that are not distributed with Emacs. If
+ they are turned on by customization, but loaded after
+ Emacs have loaded the customizations (usually in
+ .emacs) then they are not turned on correctly. Added
+ work-around for this.
+ </li>
+ <li>
+ <em>Extra XHTML Validation Header</em>:
+ <ul>
+ <li>
+ <em>Extra XHTML Validation Header</em> state was not saved when moving between chunks. Fixed.
+ </li>
+ <li>
+ Tried to make the concept of <em>Extra XHTML Validation Header</em>
+ more clear. Added this visually to the buffer.
+ </li>
+ <li>
+ <em>Extra XHTML Validation Headers</em> can now be turned on
+ automatically based on file name.
+ </li>
+ </ul>
+ </li>
+ <li>
+ <em>nXhtml menu:</em>
+ <ul>
+ <li>
+ Reorganized the nXhtml menu.
+ </li>
+ <li>
+ Added <em>customization</em> groups for help libraries to nXhtml.
+ </li>
+ <li>
+ Added an entry for customization of nXhtml to the menus.
+ </li>
+ <li>
+ Added <em>Tidy</em> to the menus again.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Corrected bug in <em>XML Path</em> (nxml-where) for single tags.
+ Other small fixes to nxhtml-where.
+ </li>
+ <li>
+ Documentation enhancements.
+ Added <em>The Quick Guide</em>.
+ </li>
+ <li>
+ </li>
+ </ul>
+ </dd>
+ <dt>0.99</dt>
+ <dd id="0.99">
+ <ul>
+ <li>
+ Corrections to indentation.
+ </li>
+ <li>
+ Turn on mumamo-mode by file name.
+ </li>
+ <li>
+ The Extra XHTML Validation Header state were not saved when changing major mode in MuMaMo. Corrected.
+ </li>
+ <li>
+ Added more alternatives to the Extra XHTML Validation Header list.
+ This should make it easier to use completion with for example PHP.
+ </li>
+ <li>
+ Added default value for the Extra XHTML Validation Header.
+ </li>
+ </ul>
+ </dd>
+ </dl>
+ </div>
+ </div>
+
+ <hr class="footer"/>
+ <p class="footer">
+ Copyright © 2007 OurComments.org
+ --
+ Latest update 2007-04-11
+ </p>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>nXhtml Notes and Changes</title>
+ <link href="wd/grapes/nxhtml-grapes.css" rel="StyleSheet" type="text/css" />
+ </head>
+ <body>
+ <div id="container">
+
+ <div id="rgtcol">
+ <p id="nxhtml-home">
+ <a href="nxhtml.html">To nXhtml main page</a>
+ </p>
+
+ <h1>nXhtml Notes and Bugs</h1>
+
+ <dl>
+<!-- <dt id="bugs-affect-mode-switching">Two Emacs 22 beta bugs affects PHP mode switching</dt> -->
+<!-- <dd> -->
+<!-- <p> -->
+<!-- <a href="nxhtml.html#php">PHP / nXhtml automatic mode switching</a> is affected: -->
+<!-- </p> -->
+<!-- <ul> -->
+<!-- <li> -->
+<!-- Because of a bug in Emacs 22 beta you may have to turn -->
+<!-- off and on the switch <em>Mode Switching at <? -->
+<!-- ... ?></em> in the menus to get the automatic mode -->
+<!-- switching to start. -->
+<!-- <em>(Work around added in 0.94)</em> -->
+<!-- </li> -->
+<!-- <li> -->
+<!-- There is the same problem with showing XML path. -->
+<!-- <em>(Work around added in 0.94)</em> -->
+<!-- </li> -->
+<!-- <li> -->
+<!-- It also affects MLinks. -->
+<!-- <em>(Work around added in 0.94)</em> -->
+<!-- </li> -->
+<!-- <li> -->
+<!-- Because of another bug in Emacs 22 beta immediately -->
+<!-- after mode the automatic mode switching the keyboard -->
+<!-- uses the key bindings from the <em>wrong mode for the -->
+<!-- first key</em>. Type any key on the keyboard, that -->
+<!-- cures it. -->
+<!-- <em>(Work around added in 0.95)</em> -->
+<!-- </li> -->
+<!-- </ul> -->
+<!-- </dd> -->
+ <dt id="new-mode-switching" style="margin-top:1em;">I have rewritten the PHP mode switching</dt>
+ <dd>
+ <p>
+ Because of some (fair) critique I have gotten about the way mode switching between php-mode and nxhtml-mode works
+ I have rewritten that part.
+ The new mode switching also includes embedded css, javascript, eRuby and JSP.
+ </p>
+ </dd>
+ <dt id="hadron-bugs" style="margin-top:1em;">A lot of bugs corrected for version 0.98</dt>
+ <dd>
+ <p>
+ I want to thanks Hadron Quark for helping me by testing
+ and pointing out bugs and weaknesses, most related to
+ editing of PHP. I have included fixes for many of them
+ in version 0.98 and more may follow.
+ </p>
+ </dd>
+ </dl>
+
+ <h1>nXhtml Changes</h1>
+
+ <dl>
+ <dt>0.89</dt>
+ <dd>
+ <ul>
+ <li>
+ Corrected autostart for nXhtml when not used together with EmacsW32.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.90</dt>
+ <dd>
+ <ul>
+ <li>
+ Improved display of XML path.
+ </li>
+ <li>
+ Discontinued xmple-mode.
+ </li>
+ <li>
+ New major modes nxhtml-part-mode/nxml-part-mode replaces
+ minor mode xmlpe-mode. (While moving the code to
+ nxhtml-part.el I also fixed a bug in Xmple minor mode that
+ made Emacs take 99% of the CPU.)
+ </li>
+ </ul>
+ </dd>
+ <dt>0.91</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed some calls to perl which prevented uploading of
+ a site of you did not have perl in the same location
+ as me.
+ </li>
+ <li>
+ Glued together things so that editing PHP files works
+ as I intended. (This means that Emacs switches between
+ php-mode and nxhtml-part-mode automatically when
+ moving point. And that you can use completion.)
+ </li>
+ <li>
+ Starting working on the documentation for nXhtml.
+ New layout to the documentation files.
+ Examples with images.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.92</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixes to make the switching between php and xhtml
+ style editing work better.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.93</dt>
+ <dd>
+ <ul>
+ <li>
+ Better error handling when switching to editing
+ embedded JavaScript and CSS.
+ </li>
+ <li>
+ Removed PHP spec from embedded switching since they
+ interfered with the automatic switching between php
+ and xhtml.
+ </li>
+ <li>
+ Gives an error message if web host is not defined in
+ site when trying to use View Uploaded File and
+ cousins.
+ </li>
+ <li>
+ Gives a ready message when finished uploading a single
+ file.
+ </li>
+ <li>
+ When using Mode Switching at <? ... ?> mode
+ switching could occur in wrong buffer. Fixed together
+ with some other buffer problems.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.94</dt>
+ <dd>
+ <ul>
+ <li>
+ Add http://www.w3.org/ to the help sites for CSS.
+ </li>
+ <li>
+ Included a CSS mode.
+ </li>
+ <li>
+ Added a menu entry for bug reporting.
+ </li>
+ <li>
+ Renamed menu bar entry from XHTML to nXhtml for clarity.
+ (But nXml menu bar entry is still called XML.)
+ </li>
+ <li>
+ Added work around for globalized minor modes in the
+ cases of MLinks, XML Path and mode switching at <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.95</dt>
+ <dd>
+ <ul>
+ <li>
+ Added workaround for the problem with the first
+ keyboard key after automatically switching of mode at
+ <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.96</dt>
+ <dd>
+ <ul>
+ <li>
+ Added support for multiple major modes with mumamo.el.
+ </li>
+ <li>
+ More conventient handling of links. They can now be
+ opened in the same window, 'other window' or in a new
+ frame.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.97</dt>
+ <dd>
+ <ul>
+ <li>
+ Schema was not setup after starting new page so
+ completion did not work. Fixed.
+ </li>
+ <li>
+ Added http://xhtml.com/ to help sites for XHTML.
+ </li>
+ <li>
+ Added the concept of <em>XML validation headers</em>.
+ These are just text parsed by the nXml validation
+ parser to get a start state before starting parsing a
+ buffer. This allows the use of the nXml completion in
+ buffers where there are no XML header. Such a header
+ is often lacking for example in PHP code since the
+ XHTML header is often generated dynamically.
+ </li>
+ <li>
+ Because of the change above <em>nxhtml-part-mode</em>
+ is no longer needed and is therefore declared
+ obsolete.
+ </li>
+ <li>
+ Corrected a bug in mlinks.el that prevented opening an
+ HTML link in a other window or a new frame.
+ </li>
+ <li>
+ Added support for JSP, eRuby and some support for perl
+ in mumamo.el.
+ </li>
+ </ul>
+ </dd>
+ <dt>0.98</dt>
+ <dd id="0.98">
+ <ul>
+ <li>
+ Mumamo was not found when nXhtml was installed with
+ just the zip file. Corrected. (nXhtml is also
+ installed when you install EmacsW32.)
+ </li>
+ <li>
+ Enhancement to mumamo error handling when a bad mode
+ specifier for an embedded mode is found.
+ </li>
+ <li>
+ Introduced a bug for empty XHTML documents in
+ 0.97. Corrected.
+ </li>
+ <li>
+ Corrected a bug for chunks 1 character long.
+ </li>
+ <li>
+ There is a bug in Emacs 22 in the handling of global
+ minor mode that are not distributed with Emacs. If
+ they are turned on by customization, but loaded after
+ Emacs have loaded the customizations (usually in
+ .emacs) then they are not turned on correctly. Added
+ work-around for this.
+ </li>
+ <li>
+ <em>Extra XHTML Validation Header</em>:
+ <ul>
+ <li>
+ <em>Extra XHTML Validation Header</em> state was not saved when moving between chunks. Fixed.
+ </li>
+ <li>
+ Tried to make the concept of <em>Extra XHTML Validation Header</em>
+ more clear. Added this visually to the buffer.
+ </li>
+ <li>
+ <em>Extra XHTML Validation Headers</em> can now be turned on
+ automatically based on file name.
+ </li>
+ </ul>
+ </li>
+ <li>
+ <em>nXhtml menu:</em>
+ <ul>
+ <li>
+ Reorganized the nXhtml menu.
+ </li>
+ <li>
+ Added <em>customization</em> groups for help libraries to nXhtml.
+ </li>
+ <li>
+ Added an entry for customization of nXhtml to the menus.
+ </li>
+ <li>
+ Added <em>Tidy</em> to the menus again.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Corrected bug in <em>XML Path</em> (nxml-where) for single tags.
+ Other small fixes to nxhtml-where.
+ </li>
+ <li>
+ Documentation enhancements.
+ Added <em>The Quick Guide</em>.
+ </li>
+ <li>
+ </li>
+ </ul>
+ </dd>
+ <dt>0.99</dt>
+ <dd id="0.99">
+ <ul>
+ <li>
+ Corrections to indentation.
+ </li>
+ <li>
+ Turn on mumamo-mode by file name.
+ </li>
+ <li>
+ The Extra XHTML Validation Header state were not saved when changing major mode in MuMaMo. Corrected.
+ </li>
+ <li>
+ Added more alternatives to the Extra XHTML Validation Header list.
+ This should make it easier to use completion with for example PHP.
+ </li>
+ <li>
+ Added default value for the Extra XHTML Validation Header.
+ </li>
+ </ul>
+ </dd>
+ </dl>
+ </div>
+ </div>
+
+ <hr class="footer"/>
+ <p class="footer">
+ Copyright © 2007 OurComments.org
+ --
+ Latest update 2007-04-11
+ </p>
+ </body>
+</html>
--- /dev/null
+<div xmlns="http://www.w3.org/1999/xhtml"
+ xmlns:py="http://genshi.edgewall.org/">
+
+ <!-- sadf -->
+
+ <div py:if="test">
+ Hello from hello!
+ Test ${name}
+ </div>
+</div>
--- /dev/null
+<div xmlns="http://www.w3.org/1999/xhtml"
+ xmlns:py="http://genshi.edgewall.org/">
+
+ <!-- sadf -->
+
+ <div py:if="test">
+ Hello from hello!
+ Test ${name}
+ </div>
+</div>
--- /dev/null
+<?python
+ title = "A Genshi Template"
+ fruits = ["apple", "orange", "kiwi"]
+?>
+<html xmlns:py="http://genshi.edgewall.org/">
+ <head>
+ <title py:content="title">This is replaced.</title>
+ </head>
+ <body>
+ <p>These are some of my favorite fruits:</p>
+ <ul>
+ <li py:for="fruit in fruits">
+ I like ${fruit}s
+ </li>
+ </ul>
+{% python
+ from genshi.builder import tag
+ def greeting(name):
+ return 'Hello, %s!' % name
+%}
+${greeting('world')}
+ </body>
+</html>
--- /dev/null
+<map version="0.9.0">
+<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->
+<node CREATED="1257868981125" ID="ID_1727486195" MODIFIED="1257869002408" TEXT="Testnote">
+<richcontent TYPE="NOTE"><html>
+ <head>
+
+ </head>
+ <body>
+ <p>
+ A note
+ </p>
+ </body>
+</html>
+</richcontent>
+</node>
+</map>
--- /dev/null
+<map version="0.9.0">
+<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->
+<node CREATED="1257868981125" ID="ID_1727486195" MODIFIED="1257869002408" TEXT="Testnote">
+<richcontent TYPE="NOTE"><html>
+ <head>
+
+ </head>
+ <body>
+ <p>
+ A note
+ </p>
+ </body>
+</html>
+</richcontent>
+</node>
+</map>
--- /dev/null
+<map version="0.9.0">
+<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->
+<node CREATED="1257868981125" ID="ID_1727486195" MODIFIED="1257869002408" TEXT="Testnote">
+<richcontent TYPE="NOTE"><html>
+ <head>
+
+ </head>
+ <body>
+ <p>
+ A note
+ </p>
+ </body>
+</html>
+</richcontent>
+</node>
+</map>
--- /dev/null
+* Testnote\r
+\r
+ :CLOCK:\r
+ my clock\r
+ :END:\r
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>\r
+<map version="0.9.0">\r
+<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\r
+<node text="Testnote">\r
+<richcontent TYPE="NOTE"><html>\r
+<head>\r
+</head>\r
+<body>\r
+--org-mode: :CLOCK:<br />\r
+--org-mode: my clock<br />\r
+--org-mode: :END:<br />\r
+</body>\r
+</html>\r
+</richcontent>\r
+</node>\r
+</map>\r
--- /dev/null
+!!! XML\r
+!!!\r
+\r
+%html{:xmlns => "http://www.w3.org/1999/xhtml", "xml:lang" => "en", :lang => "en"}\r
+\r
+%title\r
+ = @title\r
+ \= @title\r
+\r
+%script{:type => "text/javascript",\r
+ :src => "javascripts/script_#{2 + 7}"}\r
+\r
+%gee\r
+ %whiz\r
+ Wow this is cool!\r
+%p\r
+ <div id="blah">Blah!</div>\r
+%one\r
+ %two\r
+ %three Hey there\r
+\r
+%html(xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en")\r
+\r
+%a(title=@title href=href) Stuff\r
+%a{:title => @title, :href => href} Stuff\r
+\r
+%script(type="text/javascript"\r
+ src="javascripts/script_#{2 + 7}")\r
+\r
+%html{html_attrs('fr-fr')}\r
+\r
+%input{:selected => true}\r
+%input(selected)\r
+%input(selected=true)\r
+\r
+%div#things\r
+ %span#rice Chicken Fried\r
+ %p.beans{ :food => 'true' } The magical fruit\r
+ %h1.class.otherclass#id La La La\r
+\r
+#content .articles\r
+ .article.title Doogie Howser Comes Out\r
+ .article.date 2006-11-05\r
+ .article.entry\r
+ Neil Patrick Harris would like to dispel any rumors that he is straight\r
+\r
+%br/\r
+%meta{'http-equiv' => 'Content-Type', :content => 'text/html'}/\r
+\r
+%br\r
+%meta{'http-equiv' => 'Content-Type', :content => 'text/html'}\r
+\r
+%blockquote<\r
+ %div\r
+ Foo!\r
+\r
+%img\r
+%img>\r
+%img\r
+\r
+%img\r
+%pre><\r
+ foo\r
+ bar\r
+%img\r
+\r
+%peanutbutterjelly\r
+ / This is the peanutbutterjelly element\r
+ I like sandwiches!\r
+\r
+/\r
+ %p This doesn't render...\r
+ %div\r
+ %h1 Because it's commented out!\r
+\r
+/[if IE]\r
+ %a{ :href => 'http://www.mozilla.com/en-US/firefox/' }\r
+ %h1 Get Firefox\r
+\r
+%p foo\r
+-# This is a comment\r
+%p bar\r
+\r
+- foo = "hello"\r
+- foo << " there"\r
+- foo << " you!"\r
+%p= foo\r
+\r
+- (42...47).each do |i|\r
+ %p= i\r
+%p See, I can count!\r
+\r
+%p\r
+ - case 2\r
+ - when 1\r
+ = "1!"\r
+ - when 2\r
+ = "2?"\r
+ - when 3\r
+ = "3."\r
+\r
+%p This is #{h quality} cake!\r
+%p= "This is the #{h quality} cake!"\r
+\r
+%p\r
+ Look at \\#{h word} lack of backslash: \#{foo}\r
+ And yon presence thereof: \{foo}\r
+\r
+:javascript\r
+ $(document).ready(function() {\r
+ alert(#{@message.to_json});\r
+ });\r
+\r
+&= "I like cheese & crackers"\r
+\r
+= "I feel <strong>!"\r
+!= "I feel <strong>!"\r
+compiles to\r
+I feel <strong>!\r
+I feel <strong>!\r
+\r
+%p\r
+ :markdown\r
+ Textile\r
+ =======\r
+\r
+ Hello, *World*\r
+\r
+- flavor = "raspberry"\r
+#content\r
+ :textile\r
+ I *really* prefer _#{h flavor}_ jam.\r
--- /dev/null
+\r
+<?php\r
+\r
+/* Testing fill paragraph and friends, fill me fill me fill me fill me\r
+ fill me fill me fill me fill me fill me fill me fill me fill me\r
+ fill me fill me\r
+\r
+ However coloring it differently than the top level (or level 1) php\r
+ chunks may help detect nesting errors. */\r
+\r
+$name = "Joe Smith";\r
+$occupation = "Programmer";\r
+echo <<<EOF\r
+\r
+ This is a heredoc text-mode section.\r
+ For more information talk to $name, your local $occupation.\r
+\r
+EOF;\r
+\r
+$toprint = <<< HTMLEOF\r
+<!-- heredoc html-mode section -->\r
+<style type="text/css">\r
+.bugfix { color: red; }\r
+</style>\r
+\r
+<script type="text/javascript" language="javascript">\r
+\r
+ function onEndCrop( coords, dimensions ) {\r
+ alert("Test");\r
+ }\r
+</script>\r
+\r
+\r
+<a href="javascript:void window.open('');" title="Something">\r
+ <img src="/administrator/images/imprimir.png"\r
+ style="color:red;"\r
+ border="0"\r
+ alt="<?php echo _CMN_PDF;?>"\r
+ onmouseover="this.src='images/imprimir_on.png';swap('imprimir',1);"\r
+ onmouseout="this.src='images/imprimir.png'; swap('imprimir',0);"\r
+ class="bot" id="imprimir"/>\r
+ </a>\r
+\r
+<?php\r
+\r
+/* This inner php chunk is not very useful (except for presentation of\r
+ MuMaMo chunk dividing capabilities and deficiences...), since php\r
+ normally seems to run only one pass...\r
+\r
+ However coloring it differently than the top level (or level 1) php\r
+ chunks may help detect nesting errors. */\r
+\r
+echo <<<ONEMORELEVEL\r
+Just for testing the chunk background color...\r
+ONEMORELEVEL;\r
+?>\r
+\r
+HTMLEOF;\r
+echo strtolower($toprint);\r
+\r
+?>\r
--- /dev/null
+$text = 'Text from a Perl string.';
+print <<HTML;
+<html>
+<head>
+<title>Here-Doc Example</title>
+</head>
+<body>
+<h1>Here-Doc Example</h1>
+<p>$text</p>
+</body>
+HTML
--- /dev/null
+sender = 'Buffy the Vampire Slayer'\r
+recipient = 'Spike'\r
+\r
+print("""\\r
+Dear %(recipient)s,\r
+\r
+I wish you to leave Sunnydale and never return.\r
+\r
+Not Quite Love,\r
+%(sender)s\r
+""" % locals())\r
--- /dev/null
+now = Time.now\r
+puts <<-EOF\r
+ It's #{now.hour} o'clock John, where are your kids?\r
+ EOF\r
+now = Time.now\r
+puts <<EOF \r
+ It's #{now.hour} o'clock John, where are your kids?\r
+EOF\r
--- /dev/null
+tr a-z A-Z <<EOF\r
+\r
+\r
+EOF\r
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <meta name="generator" content=
+ "HTML Tidy for Linux/x86 (vers 6 November 2007), see www.w3.org" />
+ <title></title>
+ </head>
+ <body>
+ <script language="JavaScript" type="text/javascript">
+ //<![CDATA[
+function test() {
+ var xmlhttp = new XMLHttpRequest();
+ xmlhttp.onreadystatechange=function() {
+ if (xmlhttp.readystate==4) {
+ if (xmlhttp.status==200) {
+ alert(xmlhttp.responseText);
+ }else {
+ alert(xmlhttp.status);
+ }
+ #ffff00;
+ }
+ xmlhttp.open("post","/hello/cardCpu/queryList");
+ var body = "label="+encodeURIComponent("±£ÍÍ");
+ alert(body)
+ xmlhttp.setRequestHeader("Content-Type","application/x-www-form-urlencoded");
+ xmlhttp.send(body);
+ }
+}
+//]]>
+ </script>
+ <hr />
+ <address><a href="mailto:agile@agile">agile.guo</a></address>
+ <!-- Created: Thu Sep 14 22:01:37 CST 2006 -->
+ <!-- hhmts start -->
+ Last modified: Thu Sep 14 22:01:42 CST 2006 <!-- hhmts end -->
+ </body>
+</html>
--- /dev/null
+\r
+<?php\r
+require_once("include/utils.php");\r
+?>\r
+\r
+<div class="linkcontainer">\r
+<?php\r
+$_SESSION["linksfile"]="csv/links.csv";\r
+include("displaylinks.php");\r
+?>\r
+</div>\r
+\r
--- /dev/null
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+ <head>
+ <title>hq-070510-test.php</title>
+ <meta name="generator" content="emacs 22.1.1; htmlfontify 0.20">
+<style type="text/css"><!--
+body { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: none; }
+span.default { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: none; }
+span.default a { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: underline; }
+span.constant { color: rgb(95, 158, 160); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: none; }
+span.constant a { color: rgb(95, 158, 160); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: underline; }
+span.variable-name { color: rgb(184, 134, 11); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: none; }
+span.variable-name a { color: rgb(184, 134, 11); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: underline; }
+span.function-name { color: rgb(0, 0, 255); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: none; }
+span.function-name a { color: rgb(0, 0, 255); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: underline; }
+span.string { color: rgb(188, 143, 143); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: none; }
+span.string a { color: rgb(188, 143, 143); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: underline; }
+span.default { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: none; }
+span.default a { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: underline; }
+span.keyword { color: rgb(160, 32, 240); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: none; }
+span.keyword a { color: rgb(160, 32, 240); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: outline-courier new; font-size: 9pt; text-decoration: underline; }
+ --></style>
+
+ </head>
+ <body>
+
+<pre>
+
+<<span class="keyword">?php</span>
+<span class="default">require_once(</span><span class="string">"include/utils.php"</span>);
+?>
+
+<<span class="function-name">div</span> <span class="variable-name">class</span>=<span class="string">"linkcontainer"</span>>
+<<span class="keyword">?php</span>
+$<span class="constant">_SESSION</span>[<span class="string">"linksfile"</span>]=<span class="string">"csv/links.csv"</span>;
+<span class="default">include(</span><span class="string">"displaylinks.php"</span>);
+?>
+</<span class="function-name">div</span>>
+
+
+</pre>
+
+ </body>
+</html>
--- /dev/null
+<?php\r
+\r
+ Echo "why is this text red";\r
+\r
+ /* It looks like there is some sync problem with php-mode\r
+ here. Adding a ( before the string makes the string\r
+ beeing fontified as a string.\r
+ */\r
+\r
+?>\r
--- /dev/null
+<?php
+
+// some basic library functions
+include_once 'lib.php';
+
+$book = new Mybook($api_key, $secret);
+
+if (isset($_POST['to'])) {
+ $prints_id = (int)$_POST['to'];
+ $prints = do_step($user, $prints_id);
+} else {
+ if (isset($_GET['to'])) {
+ $prints_id = (int)$_GET['to'];
+ } else {
+ $prints_id = $user;
+ }
+ $prints = get_prints($prints_id);
+}
+
+?>
+<div style="padding: 10px;">
+ <h2>Hi <mb:name firstnameonly="true" uid="<?php=$user?>" useyou="false"/>!</h2><br/>
+ <a href="<?= $book->get_add_url() ?>">Put prints in your profile</a>.
+ <form method="post" action="http://my-domain.com/footprints/">
+<?php
+ if ($prints_id != $user) {
+ echo '<input type="hidden" name="to" value="' . $prints_id . '"/>';
+ } else {
+ echo '<br/>';
+ }
+?>
+ <input value="step" type="submit"/>
+ </form>
+ <hr/>
+ These are <mb:name uid="<?= $prints_id ?>" possessive="true"/> Footprints:<br/>
+ <?php echo render_prints($prints, 10); ?>
+ <div style="clear: both;"/>
+</div>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>News and Notes about nXhtml</title>
+ <link href="wd/grapes/nxhtml-grapes.css" rel="StyleSheet" type="text/css" />
+ </head>
+ <body>
+ <div id="container">
+
+ <div id="rgtcol">
+ <p id="nxhtml-home">
+ <a href="nxhtml.html">To nXhtml main page</a>
+ </p>
+
+ <h1>News and Notes about nXhtml</h1>
+
+ <dl>
+
+ <dt id="hadron-bugs" style="margin-top:1em;">Thanks for testing!</dt>
+ <dd>
+ <p>
+ I want to thanks the testers (who have been many now),
+ especially to my first testers Hadron Quark and Eric
+ Lilja, for helping me by testing and pointing out bugs
+ and weaknesses, most of them related to editing of PHP.
+ </p>
+ <p>
+ Without testers all kind of problems I just can't
+ imagine myself would still be there in nXhtml. For
+ example Hadron told me once that he got the error
+ <i>(wrong-type-argument stringp nil)</i>. Eh, I replied, are
+ you sure. Yes he was. I tried the same file as him. No
+ error.
+ </p>
+ <p>
+ The error happened during fontification so the error
+ message above was all we had. A real black box for
+ me. Or perhaps black magic? After much confusion and
+ some hard work we finally found out what it was and I
+ implemented a better way to catch such errors. If Hadron
+ would have given up the problem would still have been
+ there. Some problems are just impossible to solve
+ without good cooperation. So, again, thanks Hadron.
+ </p>
+ <p>
+ BTW, I will perhaps add some even better way to Emacs to
+ catch these errors so other can benefit from our
+ insights too, but that requires some time and effort
+ which I can't afford right now.
+ </p>
+ </dd>
+
+ <dt id="state-of-the-art" style="margin-top:1em;
+ background-color: #00fa9a;
+ background-color: #20b2aa;
+ padding: 0.5em;
+ ">The State of the Art</dt>
+ <dd style="background-color: #54ff9f; padding: 0.5em">
+ <p>
+ I have more and more come to realize that there are two
+ main parts of nXhtml which are in a bit different
+ degrees of maturity. The reason for the difference is
+ mainly that one of them, <strong>mumamo-mode</strong>,
+ requires very tight integration with Emacs in a way that
+ currently is difficult. There are also things to
+ discover, for example in the interactions with other
+ minor modes. Each minor mode actually have to be tested
+ with mumamo-mode. (Instruction for library authors are
+ in mumamo-mode.el)
+ </p>
+ <p>
+ That said I still think <strong>mumamo-mode</strong> is
+ mature enough for serious use. At least the
+ <i>fontification now works ok</i> I believe. Other
+ parts that also depends on the major mode used,
+ like <i>filling and indentation have some quirks</i>. To
+ make those work more reliably in all cases a bit more
+ standardisation across different major modes is
+ needed. (It is perhaps possible to work around those
+ problems in mumamo-mode, but the long term benefits of
+ doing that are probably small.)
+ </p>
+ <p>
+ The other part, <strong>nxhtml-mode</strong>, is more mature,
+ since it stands more by itself and since it builds on
+ the very stable nxml-mode. I would not say nxhtml-mode
+ is (ever) finished, but it is stable and useful.
+ </p>
+ </dd>
+
+ <dt id="magic-problems" style="margin-top:1em;">Magic major mode selection</dt>
+ <dd>
+ <p>
+ Sometimes the major mode that Emacs opens a file in is
+ not what you expect. This can happen with files like PHP
+ files. The reason might be that magic-mode-alist have
+ choosen a mode based on the content of the file. The way
+ this is done does not take files with mixes a mix of for
+ example XHTML and PHP into account.
+ </p>
+ <p>
+ You may try setting magic-mode-alist to nil if this is a
+ problem for you.
+ </p>
+ <p>
+ <em>
+ This is now no longer necessary since the introduction
+ of magic-fallback-mode-alist in CVS Emacs on 2007-05-16.
+ (If you have an Emacs newer than that, of course.)
+ </em>
+ </p>
+ </dd>
+
+ <dt id="underline-bug" style="margin-top:1em;">Long Red Underlines</dt>
+ <dd>
+ <p>
+ Because of a bug in Emacs 22.1 you can sometimes (at the
+ end of a line) get long red lines instead of just a
+ single underlined character. Many users (me included)
+ find this quite a bit disturbing. I have therefore added
+ a command to quickly hide/show the underlines. This is
+ on <em>C-c C-w</em>.
+ </p>
+ <p>
+ This is particular useful for example in the case where
+ you edit a PHP file and are bound to get a lot of XHTML
+ validation errors.
+ </p>
+ </dd>
+
+ <dt id="php-attribute-values" style="margin-top:1em;">Attribute values computed by PHP</dt>
+ <dd>
+ <p>
+ If you want to have attribute values computed by PHP
+ here is a way how to structure that to avoid breaking
+ completion and validation in the XHTML part unnessecary:
+ </p>
+ <p style="margin-left:2em">
+ <img src="images/linux.png" title="<?php foo("bar");?>"/>
+ </p>
+ <p>
+ Unfortunately that still breaks XHTML validation since
+ < is not allowed in strings. In the long run I
+ believe the XML validator has to be broken up so that it
+ avoids parsing the string here (in PHP files).
+ </p>
+ <p>
+ For now I have implemented a workaround.
+ If you are using constructs like those above then turn on <em>nxhtml-strval-mode</em>.
+ This will temporarily replace the above with
+ </p>
+ <p style="margin-left:2em">
+ <img src="images/linux.png" title="«?php foo("bar");?»"/>
+ </p>
+ <p>
+ However on the screen you will still see the original
+ string and when writing to file the correct characters
+ will be used.
+ </p>
+ </dd>
+
+ <dt id="pi-note" style="margin-top:1em;">A note for PHP and its cousins</dt>
+ <dd>
+ <p>
+ The rules for a process instruction in XML, like <?php
+ ... ?> says that the text can contain any text except
+ <em>?></em>. So if you want to output that string
+ from PHP then break it up so it does not look as ?> in
+ the source file.
+ </p>
+ <p>
+ It might be good to break up the beginning part of the
+ process instructions too. And please note that to use
+ XHTML validation or completion you should avoid using
+ < in strings, since it is not allowed there.
+ </p>
+ </dd>
+
+<!-- <dt id="pi-note" style="margin-top:1em;">Perl Mode slow with Mumamo Mode</dt> -->
+<!-- <dd> -->
+<!-- <p> -->
+<!-- Perl mode used with MuMaMo mode sometimes makes the -->
+<!-- fontification slow for big files. I do not know the -->
+<!-- reason, but I am trying to find a solution for this. If -->
+<!-- you encounter this problem, just turn off mumamo-mode in -->
+<!-- that buffer. -->
+<!-- </p> -->
+<!-- </dd> -->
+
+ <dt id="tab-width-problems" style="margin-top:1em;">Tab width</dt>
+ <dd>
+ <p>
+ Do you have <em>tab-width</em> to something different than 8
+ (the default)? Then please change this to 8. I have got
+ reports of problem with indentation when it is not 8.
+ </p>
+ </dd>
+
+ <dt id="mmm-compat" style="margin-top:1em;">Why the chunks are not compatible with mmm</dt>
+ <dd>
+ <p>
+ Some people have asked why the way to specify chunks in
+ mumamo-mode is not compatible with the old mmm-mode. The
+ answer is that I was not sure that the way used in
+ mmm-mode for specifying the chunks was flexible enough.
+ </p>
+ <p>
+ And I am sure that even the way used in mumamo-mode is
+ not good enough for all cases, but I let it be the way
+ it is until I have a better understanding of the
+ problem. Suggestions and comments are welcome!
+ </p>
+ </dd>
+
+ </dl>
+
+ <h1 id="change-history">nXhtml Changes</h1>
+
+ <div>
+ <a href="#v0.89">v0.89</a>
+ <a href="#v0.90">v0.90</a>
+ <a href="#v0.91">v0.91</a>
+ <a href="#v0.92">v0.92</a>
+ <a href="#v0.93">v0.93</a>
+ <a href="#v0.94">v0.94</a>
+ <a href="#v0.95">v0.95</a>
+ <a href="#v0.96">v0.96</a>
+ <a href="#v0.97">v0.97</a>
+ <a href="#v0.98">v0.98</a>
+ <a href="#v0.99">v0.99</a>
+ <a href="#v1.00">v1.00</a>
+ <a href="#v1.01">v1.01</a>
+ <a href="#v1.02">v1.02</a>
+ <a href="#v1.03">v1.03</a>
+ <a href="#v1.04">v1.04</a>
+ <a href="#v1.10">v1.10</a>
+ <a href="#v1.11">v1.10</a>
+ <a href="#v1.12">v1.10</a>
+ <a href="#v1.13">v1.10</a>
+ <a href="#v1.14">v1.10</a>
+ </div>
+
+ <dl>
+ <dt id="v0.89">0.89</dt>
+ <dd>
+ <ul>
+ <li>
+ Corrected autostart for nXhtml when not used together with EmacsW32.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.90">0.90</dt>
+ <dd>
+ <ul>
+ <li>
+ Improved display of XML path.
+ </li>
+ <li>
+ Discontinued xmple-mode.
+ </li>
+ <li>
+ New major modes nxhtml-part-mode/nxml-part-mode replaces
+ minor mode xmlpe-mode. (While moving the code to
+ nxhtml-part.el I also fixed a bug in Xmple minor mode that
+ made Emacs take 99% of the CPU.)
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.91">0.91</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed some calls to perl which prevented uploading of
+ a site of you did not have perl in the same location
+ as me.
+ </li>
+ <li>
+ Glued together things so that editing PHP files works
+ as I intended. (This means that Emacs switches between
+ php-mode and nxhtml-part-mode automatically when
+ moving point. And that you can use completion.)
+ </li>
+ <li>
+ Starting working on the documentation for nXhtml.
+ New layout to the documentation files.
+ Examples with images.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.92">0.92</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixes to make the switching between php and xhtml
+ style editing work better.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.93">0.93</dt>
+ <dd>
+ <ul>
+ <li>
+ Better error handling when switching to editing
+ embedded JavaScript and CSS.
+ </li>
+ <li>
+ Removed PHP spec from embedded switching since they
+ interfered with the automatic switching between php
+ and xhtml.
+ </li>
+ <li>
+ Gives an error message if web host is not defined in
+ site when trying to use View Uploaded File and
+ cousins.
+ </li>
+ <li>
+ Gives a ready message when finished uploading a single
+ file.
+ </li>
+ <li>
+ When using Mode Switching at <? ... ?> mode
+ switching could occur in wrong buffer. Fixed together
+ with some other buffer problems.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.94">0.94</dt>
+ <dd>
+ <ul>
+ <li>
+ Add http://www.w3.org/ to the help sites for CSS.
+ </li>
+ <li>
+ Included a CSS mode.
+ </li>
+ <li>
+ Added a menu entry for bug reporting.
+ </li>
+ <li>
+ Renamed menu bar entry from XHTML to nXhtml for clarity.
+ (But nXml menu bar entry is still called XML.)
+ </li>
+ <li>
+ Added work around for globalized minor modes in the
+ cases of MLinks, XML Path and mode switching at <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.95">0.95</dt>
+ <dd>
+ <ul>
+ <li>
+ Added workaround for the problem with the first
+ keyboard key after automatically switching of mode at
+ <? ... ?>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.96">0.96</dt>
+ <dd>
+ <ul>
+ <li>
+ Added support for multiple major modes with mumamo.el.
+ </li>
+ <li>
+ More conventient handling of links. They can now be
+ opened in the same window, 'other window' or in a new
+ frame.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.97">0.97</dt>
+ <dd>
+ <ul>
+ <li>
+ Schema was not setup after starting new page so
+ completion did not work. Fixed.
+ </li>
+ <li>
+ Added http://xhtml.com/ to help sites for XHTML.
+ </li>
+ <li>
+ Added the concept of <em>fictive XML validation
+ headers</em>. These are just text parsed by the nXml
+ validation parser to get a start state before starting
+ parsing a buffer. This allows the use of the nXml
+ completion in buffers where there are no XML header.
+ Such a header is often lacking for example in PHP code
+ since the XHTML header is often generated dynamically.
+ </li>
+ <li>
+ Because of the change above <em>nxhtml-part-mode</em>
+ is no longer needed and is therefore declared
+ obsolete.
+ </li>
+ <li>
+ Corrected a bug in mlinks.el that prevented opening an
+ HTML link in a other window or a new frame.
+ </li>
+ <li>
+ Added support for JSP, eRuby and some support for perl
+ in mumamo.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.98">0.98</dt>
+ <dd>
+ <ul>
+ <li>
+ Mumamo was not found when nXhtml was installed with
+ just the zip file. Corrected. (nXhtml is also
+ installed when you install EmacsW32.)
+ </li>
+ <li>
+ Enhancement to mumamo error handling when a bad mode
+ specifier for an embedded mode is found.
+ </li>
+ <li>
+ Introduced a bug for empty XHTML documents in
+ 0.97. Corrected.
+ </li>
+ <li>
+ Corrected a bug for chunks 1 character long.
+ </li>
+ <li>
+ There is what I consider is a bug in Emacs 22.1 in the
+ handling of global minor mode that are not distributed
+ with Emacs. If they are turned on by customization,
+ but loaded after Emacs have loaded the customizations
+ (usually in .emacs) then they are not turned on
+ correctly. Added work-around for this.
+ </li>
+ <li>
+ <em>Fictive XHTML Validation Header</em>:
+ <ul>
+ <li>
+ <em>Fictive XHTML Validation Header</em> state was not saved when moving between chunks. Fixed.
+ </li>
+ <li>
+ Tried to make the concept of <em>Fictive XHTML Validation Header</em>
+ more clear. Added this visually to the buffer.
+ </li>
+ <li>
+ <em>Fictive XHTML Validation Headers</em> can now be turned on
+ automatically based on file name.
+ </li>
+ </ul>
+ </li>
+ <li>
+ <em>nXhtml menu:</em>
+ <ul>
+ <li>
+ Reorganized the nXhtml menu.
+ </li>
+ <li>
+ Added <em>customization</em> groups for help libraries to nXhtml.
+ </li>
+ <li>
+ Added an entry for customization of nXhtml to the menus.
+ </li>
+ <li>
+ Added <em>Tidy</em> to the menus again.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Corrected bug in <em>XML Path</em> (nxml-where) for single tags.
+ Other small fixes to nxhtml-where.
+ </li>
+ <li>
+ Documentation enhancements.
+ Added <em>The Quick Guide</em>.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v0.99">0.99</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed a serious bug in the cooperation between nxhtml-mode and mumamo-mode.
+ </li>
+ <li>
+ Turn on mumamo-mode by file name (mumamo-global-mode).
+ </li>
+ <li>
+ Fictive XHTML Validation Header:
+ <ul>
+ <li>
+ The Fictive XHTML Validation Header state were not saved when changing major mode in MuMaMo. Corrected.
+ </li>
+ <li>
+ Added more alternatives to the Fictive XHTML Validation Header list.
+ This should make it easier to use completion with for example PHP.
+ </li>
+ <li>
+ Added default value for the Fictive XHTML Validation Header.
+ </li>
+ <li>
+ Tried to make the use of Fictive XHTML Validation Header more automatic and therefore useful.
+ Also tried to make it play better with setting schema file.
+ (There is no need normally to set schema file by hand.)
+ </li>
+ <li>
+ To turn this on by default customize nxhtml-global-validation-header-mode.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Possible to hide validation warnings without turning
+ on validation (which would make completion in the
+ XHTML part impossible).
+ </li>
+ <li>
+ Some fixes to php-mode:
+ <ul>
+ <li>Using the character # for comments now works for most cases.</li>
+ <li>Now uses the fontification faces in a more standard way which calms down the look.</li>
+ <li>Initialization bug fixes.</li>
+ <li>Renamed php-mode-user-hook to php-mode-hook to follow standard.</li>
+ </ul>
+ </li>
+ <li>
+ Indentation fixes:
+ <ul>
+ <li>
+ Various corrections to indentation in mumamo.
+ </li>
+ <li>
+ Added the possibility to use TAB to indent regions
+ (indent-region-mode).
+ </li>
+ <li>
+ Warn about bad indentation in mixed PHP/HTML code
+ when using php-mode only.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fontification now fontifies all text first in main
+ major mode and thereafter applies submodes. (This
+ avoids some problems with around a submode chunk.)
+ </li>
+ <li>
+ Reorganized the nXhtml menu:
+ <ul>
+ <li>
+ There is now a minor mode for the nXhtml
+ menu. This makes it possible to easier use common
+ features when in buffers not in nxhtml-mode.
+ </li>
+ <li>
+ The nXhtml menu does not disappear when moving
+ into a chunk where the major mode is not
+ nxhtml-mode. The changes also makes it easy to
+ access uploading functions functions etc from
+ other modes than nxhtml-mode since the
+ <em>nXhtml</em> may also be shown in them.
+ </li>
+ <li>
+ The nXhtml menu can be turned on globally by default.
+ Customize nxhtml-menu-mode for that.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.00">1.00</dt>
+ <dd>
+ <ul>
+ <li>
+ Reached version number 1.00 - which you maybe believe
+ means the bugs should be gone? Sorry, it is just that
+ I ran out of version numbers ;-) However it looks like
+ much fewer bugs at least.
+ </li>
+ <li>
+ Fixed problems mostly related to global turn on of different features in nXhtml.
+ </li>
+ <li>
+ Small fixes to indentation.
+ <ul>
+ <li>
+ nxhtml-mode could get confused by php tags.
+ </li>
+ <li>
+ nxhtml-mode did not indent <!DOCTYPE in a sensible way.
+ </li>
+ <li>
+ Electric keys now works in embedded php when using mumamo-mode.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Tidy was very misbehaving since the output buffer was
+ not erased between different files. But I have got no
+ bug reports on this ;-)
+ </li>
+ <li>
+ Fixed a bug in validation that should up when using muamo-mode.
+ </li>
+ <li>
+ Fixed bug in <script ...> and <style ...> chunk dividing.
+ </li>
+ <li>
+ Added support for OpenLaszlo.
+ </li>
+ <li>
+ Corrections to mlinks-mode (visible mostly as links in
+ XHTML buffers):
+ <ul>
+ <li>
+ Links disappeared when a new file was
+ opened. Corrected.
+ </li>
+ <li>
+ Links were not correctly updated at changes in the
+ buffer when mumamo-mode was used. Fixed.
+ </li>
+ </ul>
+ </li>
+ <li>
+ The welcome message for nXhtml could be shown too
+ early sometimes when loading, before nXhtml actually
+ knew if it should be shown or not. Tried to fix it.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.01">1.01</dt>
+ <dd>
+ <ul>
+ <li>
+ Reported wrong version number for nXhtml in the menus. Fixed.
+ </li>
+ <li>
+ <em>If you use the zip file to install nXhtml please
+ notice that it has now a top level nxml.</em> Sorry for not
+ having zipped it like that before!
+ </li>
+ <li>
+ The url links in <em>Welcome to nXhtml</em> was a bit
+ incorrect and did not work on all OS:es. Fixed.
+ </li>
+ <li>
+ Added customization of popup completion to the 'nxhtml
+ customization group so they are easier to find.
+ </li>
+ <li>
+ MuMaMo
+ <ul>
+ <li>
+ Struggled a bit with the load sequences of the elisp
+ libraries used by nXhtml when using MuMaMo.
+ </li>
+ <li>
+ Tried to get the global turn on of mumam-mode to work
+ in all cases.
+ </li>
+ <li>
+ The screen was blinking when changing overlays after
+ changes in the buffer. Tried to fix this.
+ </li>
+ <li>
+ Minor fixes do syntax highlighting, like taking care of single ':s.
+ </li>
+ <li>
+ Fixes to the support for JSP and eRuby.
+ </li>
+ <li>
+ Made the support for perl here documents a bit better.
+ Large perl documents are however still quite slow when
+ using mumamo-mode. I do not know the reason yet.
+ </li>
+ <li>
+ Refontification could miss some parts when buffer
+ changes caused chunk division changes. Complex,
+ tried to fix it, but I am a bit unsure that it
+ always works.
+ </li>
+ <li>
+ Cleaned up mumamo.el a bit.
+ </li>
+ <li>
+ Rewrote mumamo-test.el and functions called from it in
+ mumamo.el a bit to make tracebacks from errors more
+ useful. Changed keybindings in mumamo-test.el from
+ global to a minor mode <em>mumamo-test-mode</em>.
+ Renamed mumamo-notest.el to mumamo-test.el. Added it
+ to the zipped distribution of nXhtml.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fixed a bug related to links and buffer changes.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.02">1.02</dt>
+ <dd>
+ <ul>
+ <li>
+ Fixed a refontification bug that occured after changes.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.03">1.03</dt>
+ <dd>
+ <ul>
+ <li>
+ Added the possibility to call GIMP.
+ </li>
+ <li>
+ Reworked the messages for fontification errors to try
+ to catch an error that shows up sometimes. Tried to
+ avoid disturbing normal use in spite of that error.
+ </li>
+ <li>
+ Reverted to using a short delay before switching major
+ mode when moving between buffers.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.04">1.04</dt>
+ <dd id="v1.04-dd">
+ <ul>
+ <li>
+ Enhanced the documentation for nXhtml. Starting from
+ <i>C-h f nxhtml-mode</i> it should now be easier to
+ get an overview.
+ </li>
+ <li>
+ Bug fixes etc:
+ <ul id="v1.04-bugs">
+ <li>
+ Completion on an empty page gave a faulty frameset page. Fixed.
+ </li>
+ <li>
+ Insert end tag did not work with a fictive
+ validation header. Fixed.
+ </li>
+ <li>
+ Insert end tag when all preceding tags where
+ closed gave a strange error message. Fixed.
+ </li>
+ <li>
+ Changed some key bindings to comply with
+ <i>(info "(elisp) Key Binding Conventions")</i>
+ </li>
+ <li>
+ Completion in empty buffers with a completion
+ header did not work. Fixed.
+ </li>
+ <li id="mumamo-bugs">
+ Multiple major modes:
+ <ul>
+ <li>
+ Fixed a bug that prevented mumamo-global-mode from
+ beeing turned on in a file opened in
+ fundamental-mode.
+ </li>
+ <li>
+ Better error tracing for some functions,
+ including the call of major mode functions.
+ </li>
+ <li>
+ Position was garbled when a ;-char was inserted in php-mode chunk. Fixed.
+ </li>
+ <li>
+ A bad check for if mlinks-mode where available was fixed.
+ </li>
+ <li>
+ Some bugs concerning turning off mumamo-mode was fixed.
+ </li>
+ <li>
+ Fixed a bug in <i>perl here doc</i> chunks. Suddenly the
+ problem with slowness when using mumamo-mode in
+ perl buffers seems gone. (Note quite sure, but I
+ can't see any problems now.)
+ </li>
+ <li>
+ Fixed a bug in mumamo-mode when current buffer was
+ switched before the major mode had been set from
+ the current chunk.
+ </li>
+ <li>
+ Fixed a long standing bug in php fontification of
+ strings and comments.
+ </li>
+ <li>
+ Fixed a bug where <i>sgml-xml-mode</i> was not defined.
+ </li>
+ <li>
+ Fixed a bug related to get-text-property which
+ gives an error when buffer is narrowed.
+ </li>
+ <li>
+ Tried to refontify things outside of a narrowed part. Fixed.
+ </li>
+ <li>
+ Too little where refontified after changes. I hope I have fixed this.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fictive XHTML Validation Header:
+ <ul id="v1.04-fic-bugs">
+ <li>
+ View File did not work correctly when a fictive
+ XHTML validation header was used. Corrected.
+ </li>
+ <li>
+ Fictive XHTML validation headers are no longer
+ turned on by default in any buffers.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Indentation:
+ <ul>
+ <li>
+ Tried to fix a problem when using
+ newline-and-indent. When this was in a mode
+ derived from C the indentation sometimes became 0.
+ </li>
+ <li>
+ Speeded up the indentation of regions a bit when
+ using <i>mumamo-mode</i>.
+ </li>
+ <li>
+ Indentation: TAB now only indents a region if it
+ is visibly marked (see transient-mark-mode and
+ cua-mode).
+ </li>
+ <li>
+ Simplified the indentation code.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Fixed a problem where string fontification got out
+ of phase so that wrong parts of buffer could be
+ fontified as a string.
+ </li>
+ <li>
+ Added a workaround for <a
+ href="#php-attribute-values">Attribute values
+ computed by PHP</a>
+ </li>
+ <li>
+ Added .nosearch to subdirectories with no elisp files.
+ </li>
+ <li>
+ Fixed incorrect checks for mlinks-mode in menu building.
+ </li>
+ <li>
+ File extensions where used in a case sensitive way
+ in some places. Fixed.
+ </li>
+ <li>
+ appmenu: Worked only in html files. Fixed.
+ </li>
+ <li>
+ html-site: Fixed the error <em>Error
+ (html-site-current): Can't find site:
+ your-site-name</em>.
+ </li>
+ <li>
+ Fixed a problem with longlines-mode in the support
+ for Firefox add-on It's All Text. (Note however
+ that there are some bugs in longlines-mode
+ itself.) Rewrote the support to be more
+ general. It is now in the file as-external.el, see
+ this file.
+ </li>
+ <li>
+ Fixed an encoding problem in
+ <i>tidy-buffer</i>. Output from tidy was not read
+ using the same coding system as tidy was using.
+ </li>
+ <li>
+ Fixed some problems with face definitions, possibly bugs (not sure).
+ </li>
+ <li>
+ Made the fontification faster when using mumamo-mode.
+ (It is still slower than single mode fontification of course.)
+ </li>
+ <li>
+ nxml-where.el: Made it aware of mumamo.el.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Menu changes:
+ <ul>
+ <li>
+ Completion menu: Renamed to <i>Completion and
+ Validation</i> menu and reorganized a little bit to
+ make it more clear.
+ </li>
+ <li>
+ Renamed <i>view</i> to <i>browse</i> since this is
+ the normal emacs name for showing files in a web
+ browser. Also made corresponding changes to
+ function names. Put back the possibility to view
+ only the region in a web browser.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Uploading:
+ <ul>
+ <li>
+ Added remote dired to the menus.
+ </li>
+ <li>
+ Fixed problems with file names starting with ~.
+ </li>
+ <li>
+ Fixed more problems with file names with spaces.
+ </li>
+ </ul>
+ </li>
+ <li>
+ nxml-where:
+ <ul>
+ <li>
+ nxml-where now uses a timeout for more smooth performance.
+ </li>
+ <li>
+ nxml-where can now recognizes both id and name attribute.
+ </li>
+ <li>
+ Hyphens are now accepted in tag names.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Ruby
+ <ul>
+ <li>
+ Multiple major mode turned on by default for .rhtml files when this mode is global.
+ </li>
+ <li>
+ Multiple major mode is no longer turned on when rub-mode is turned on.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added support for switching major mode dependent on if
+ Emacs was called as an external editor. This makes it
+ possible for example to switch to relevant major and
+ minor modes when Firefox add-on It's All Text.
+ </li>
+ <li>
+ Added the possibility to easily view the output of scripts on the server (if they require no parameters).
+ You can now do that from the nXhtml menu.
+ Previously only html files on the server could be viewed that way.
+ Image files can also be viewed this way.
+ </li>
+ <li>
+ Filling:
+ <ul>
+ <li>
+ Added functions for unfilling.
+ </li>
+ <li>
+ Added keybindings and menu entries for longlines-mode, fill-paragraph and unfill-paragraph.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Quoting:
+ Added HTML quoting of & and < in text areas. Bound to C-c C-q.
+ </li>
+ <li>
+ Images:
+ <ul>
+ <li>
+ Added image-mode to those that are encompassed by
+ nxhtml-global-minor-mode so that images can be
+ uploaded more easily.
+ </li>
+ <li>
+ Added <em>edit with GIMP</em> and <em>upload</em> to the popup menu for links.
+ This avoids the need to load the linked files in Emacs first.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added <em>nxml-untag-element</em>.
+ </li>
+ <li>
+ Added a modified version of wikipedia-mode.el. Seems likely to be useful if you are doing web editing.
+ </li>
+ <li>
+ Added html-imenu.el
+ </li>
+ <li>
+ MuMaMo:
+ <ul>
+ <li>
+ Removed the lighter <i>"MuMaMo"</i> for
+ mumamo-mode. Instead the active major mode now has
+ <b>"/m"</b> appended to mode-name (that is what you see
+ in the mode line).
+ </li>
+ <li>
+ The normal way to turn on <i>mumamo-mode</i> has
+ changed. There are now functions that you can use
+ in <i>auto-mode-alist</i> to directly set up the
+ buffer for mumamo-mode. The available functions
+ are in the
+ variable <i>mumamo-defined-turn-on-functions</i>.
+ <p>
+ You are not supposed to call mumamo-mode
+ yourself any more and mumamo-global-mode is
+ gone. So is also mumamo-chunk-family-by-mode and
+ mumamo-filenames-list. The functionality those
+ gave are all replaced by the new functions for
+ turning on mumamo mode.
+ </p>
+ </li>
+ <li>
+ Added support for buffer local values in
+ hooks. This is necessary for example to support
+ minor modes that are meant to be buffer local but
+ not major mode specific. Instructions for authors
+ of this kind of minor modes are in the file
+ mumamo.el.
+ </li>
+ <li>
+ Added support for Django.
+ </li>
+ <li>
+ Added support for Embperl.
+ </li>
+ <li>
+ Added support for PHP Smarty. The <i>{literal}
+ ... {/literal}</i> construct is not supported.
+ This mean that you can not use <style ..> or <script ..>.
+ </li>
+ <li>
+ Added support for imenu for the main major mode.
+ Turned on this by default in nxhtml-mode.
+ </li>
+ <li>
+ Made the temporary replacement of the
+ attr="<?php ... ?>" a bit better. They are
+ now more visible and also still mumamo chunks
+ during the temporary replacement.
+ </li>
+ <li>
+ Added support for <i>flymake-mode</i>.
+ Maybe add support for checking chunks?
+ </li>
+ <li>
+ Printing: Added htmlfontify.el and
+ hfyview.el. These makes if possible to print a
+ buffer fontified with <i>mumamo-mode</i> on in
+ colors (through your web browser). There is an
+ example of the capabilities of htmlfontify <a
+ href="htmlfontify-example.html">here</a> (made
+ with a little function in hfyview.el).
+ </li>
+ </ul>
+ </li>
+ <li>
+ PHP:
+ <ul>
+ <li>
+ Did a first merge with Aaron Hawleys fixes for php-mode.el.
+ </li>
+ </ul>
+ </li>
+ <li>
+ CSS: Upgraded to Stefan's latest css-mode.el.
+ </li>
+ <li>
+ Fictive XHTML Validation Headers: Changed the way they
+ are turned on. They may now be turned on when
+ mumamo-mode is turned on.
+ </li>
+ <li>
+ Some users want to use their own patched version of
+ nXml. Next version of Emacs will come with
+ nXml. Therefore, the loading routine for nXhtml now
+ checks if nXml is is already loaded. Thanks to Eric
+ Lilja for testing this. Eric also made me aware of
+ that if nXhtml was placed in the site-lisp directory
+ tree then things did not work as I expected. I think I
+ have corrected that by placing a <i>.nosearch</i> file
+ at the top of the nxml tree in nXhtml.
+ </li>
+ <li>
+ Restructured the directories. Moved some files out of
+ the <i>nxhtml</i> subdir. Some of them went into the
+ <i>util</i> subdir (those are written by me) and some
+ to the new subdir <i>related</i> (those that are
+ inherited from others, maybe changed by me - most
+ often to work with mumamo-mode).
+ </li>
+ <li>
+ Changed all licenses to be GNU GPL.
+ </li>
+ <li>
+ Additions to tidy support: It is now possible to use
+ the tidy support to tidy the XHTML part of php etc.
+ (Thanks to Hadron for this suggestion.)
+ </li>
+ <li>
+ Added <i>winsize.el</i> which allows interactive resizing of
+ windows. Also added <i>winsav.el</i> which adds the
+ capability to rotate window configurations and also to
+ save window configuration to file.
+ </li>
+ <li>
+ Made nXhtml work with CVS Emacs 23.0.50.1.
+ </li>
+ <li>
+ Added freemind.el to the parcel. After all FreeMind
+ supports web publishing too so why not have the Emacs
+ support here ...
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.10">1.10</dt>
+ <dd id="v1.10-dd">
+ Just jumped the version number for the new release of
+ nXhtml. There are really significant changes in this
+ release, not only minor bug fixes.
+ </dd>
+ <dt id="v1.11">1.11</dt>
+ <dd id="v1.11-dd">
+ Minor bug fixes to completion. Added fictive validation
+ header to completion alternatives when buffer is empty and
+ mumamo is used.
+ </dd>
+ <dt id="v1.12">1.12</dt>
+ <dd id="v1.12-dd">
+ <ul>
+ <li>
+ Fixed a bug in image link insertion in nxhtml-mode, thanks Niels Giesen!
+ </li>
+ <li>
+ Restructured, reordered and documented mumamo.el. It is now two
+ separate files, mumamo.el and mumamo-fun.el.
+ </li>
+ <li>
+ Added move by chunk to the nXhtml menu.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.13">1.13</dt>
+ <dd id="v1.13-dd">
+ <ul>
+ <li>
+ Better handling of the case when no validation header
+ is needed and the user tries to turn it on.
+ </li>
+ <li>
+ Added .phtml as php file.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.14">1.14</dt>
+ <dd id="v1.14-dd">
+ <ul>
+ <li>
+ Completion of links in XHTML was broken. Fixed, thanks
+ to Niels Giesen.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.15">1.15</dt>
+ <dd id="v1.15-dd">
+ <ul>
+ <li>
+ Added `mumamo-map' keymap.
+ </li>
+ <li>
+ Added a keymap to all multi major modes.
+ </li>
+ <li>
+ Some more refinement to fictive validation headers.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.16">1.16</dt>
+ <dd id="v1.16-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Changes to indentation:
+ <ul>
+ <li>
+ Removed indent-region-mode since that
+ functionality is now in indent-for-tab-command in
+ Emacs 22.
+ </li>
+ <li>
+ Removed some code that checked if indentation was 0.
+ </li>
+ <li>
+ Added indent-for-tab-command to mumamo-map.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Reordering and renaming:
+ <ul>
+ <li>
+ Reordered and move some functions in mumamo.el et al.
+ Added new file nxhtml-mumamo.el.
+ </li>
+ <li>
+ Renamed <i>define-mumamo-turn-on</i> to
+ <i>define-mumamo-multi-major-mode</i>.
+ </li>
+ <li>
+ Removed the ending <i>-turn-on</i> from the
+ functions defined by the macro above.
+ </li>
+ <li>
+ Introduced <i>multi major mode</i> as a name for
+ the functions defined by the macro above. Those
+ works in many respects like major mode functions,
+ but they support multiple major modes in a buffer.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Added support for noweb as multiple major mode.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.17">1.17</dt>
+ <dd id="v1.17-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Added support for flyspell.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Bug fixes to the version of find-recursive.el that
+ ships with nXhtml. Thanks to Cezar Halmagean.
+ </li>
+ <li>
+ Added tabkey2.el which tries to make it easy to use
+ the Tab key for completion. (You must load it and turn
+ on tabkey2-mode to use it.)
+ </li>
+ <li>
+ Folding:
+ <ul>
+ <li>
+ Added <i>nxhtml-heading-element-name-regexp</i> as
+ default for nxml style folding.
+ </li>
+ <li>
+ Some changes to fold-dwim.el.
+ </li>
+ </ul>
+ </li>
+ <li>
+ AppMenu:
+ <ul>
+ <li>
+ Simplified: Removed the possibility to
+ automatically show minor and major mode menus.
+ There is now only one list, <i>appmenu-alist</i>.
+ </li>
+ <li>
+ Added menu item <i>At Current Point</i> for
+ bindings found in character and overlay keymaps at
+ point. Those you always forget.
+ </li>
+ </ul>
+ </li>
+ <li>
+ Physical line:
+ <ul>
+ <li>
+ Added physical-line.el to nXhtml.
+ </li>
+ <li>
+ Added new functions to move to beginning and end
+ of line to ourcomments-util.el that supports
+ physical-line.el.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.18">1.18</dt>
+ <dd id="v1.18-dd">
+ <ul>
+ <li>
+ Better Tab completion in tabkey2.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.19">1.19</dt>
+ <dd id="v1.19-dd">
+ <ul>
+ <li>
+ Even better Tab completion in tabkey2.el.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.20">1.20</dt>
+ <dd id="v1.20-dd">
+ <ul>
+ <li>
+ Once again even better Tab completion in tabkey2.el.
+ </li>
+ <li>
+ Fixed bug in hiding of validation errors (they could
+ disappear totally).
+ </li>
+ <li>
+ Cleaned up menus in nXhtml.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.21">1.21</dt>
+ <dd id="v1.21-dd">
+ <ul>
+ <li>
+ Added a bit support for dired (upload, browse, browse
+ remote).
+ </li>
+ <li>
+ Fixed some strange menu problems (i hope).
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.22">1.22</dt>
+ <dd id="v1.22-dd">
+ <ul>
+ <li>
+ Bug fix.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.23">1.23</dt>
+ <dd id="v1.23-dd">
+ <ul>
+ <li>
+ Bug fix.
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.24">1.24</dt>
+ <dd id="v1.24-dd">
+ <ul>
+ <li>
+ Tried again to make hexcolor-mode more readable.
+ </li>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Added support for <i>hi-lock-mode</i>. At present
+ it might however be very puzzling. The hilight
+ added by hi-lock-mode may be hidden by the
+ overlays used by mumamo. Tip: you can always use
+ the face <span
+ style="font-size:1.5em;">hi-black-hb</span>.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.25">1.25</dt>
+ <dd id="v1.25-dd">
+ <ul>
+ <li>
+ Mumamo:
+ <ul>
+ <li>
+ Handle hi-lock-mode in a more general way
+ using <i>font-lock-mode-hook</i>.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.26">1.26</dt>
+ <dd id="v1.26-dd">
+ <ul>
+ <li>
+ nxhtml-mode:
+ <ul>
+ <li>
+ Removed the indent line patch for nxml-mode.
+ </li>
+ <li>
+ Better test for empty page during completion.
+ </li>
+ </ul>
+ </li>
+ <li>
+ tabkey2-mode:
+ <ul>
+ <li>
+ A lot of improvements.
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </dd>
+ <dt id="v1.27">1.27</dt>
+ <dd id="v1.27-dd">
+ <ul>
+ <li>
+ Fixed a bug in html-site when comparing file
+ names. File names where not made unique before
+ comparision.
+ </li>
+ <li>
+ Fixed documentation and reordered code in mumamo.el
+ and mumamo-fun.el.
+ </li>
+ <li>
+ Fixed a bug in mumamo concerning indentation. The
+ desired indentation function replacement where not
+ used.
+ </li>
+ <li>
+ Fixed tabkey2 bugs.
+ </li>
+ <li>
+ Changed javascript.el indentation to make it work with
+ mumamo.el.
+ </li>
+ <li>
+ Introduced the function
+ <i>mumamo-make-variable-buffer-permanent</i> as an aid for
+ minor mode authors.
+ </li>
+ <li>
+ Made nXhtml menu available in sub-chunks.
+ </li>
+ <li>
+ Included a slightly changed version of Steve Yegge's
+ js2.el + js2-fl-mode.el with support for
+ jit-lock-mode. This support has some flaws and maybe
+ js2 is not ready for use, I am not sure. However if you want
+ to use this instead of Karl Landströms javascript-mode
+ then please customize <i>mumamo-major-modes</i>.
+ </li>
+ </ul>
+ </dd>
+ </dl>
+ </div>
+ </div>
+
+ <hr class="footer"/>
+ <p class="footer">
+ Copyright © 2008 OurComments.org
+ --
+ Latest update 2008-03-09
+ </p>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>\r
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"\r
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">\r
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">\r
+ <head>\r
+ <title>Lab 2 - Layout Control - Task 2 - XHTML/CSS version</title>\r
+ </head>\r
+ <body>\r
+ <?php\r
+ // comment\r
+ $thepage = $_GET['page'];\r
+\r
+ if (empty($thepage)) {\r
+ require('main-div-a.html');\r
+ }\r
+ else {\r
+ if ($thepage != 'a' && $thepage != 'b') {\r
+ print('You hacker you!');\r
+ }\r
+ else {\r
+ require('main-div-'.$thepage.'.html');\r
+ }\r
+ for (;;) {\r
+ }\r
+ }\r
+ ?>\r
+ </body>\r
+</html>\r
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+<head>
+<title>Indentation bug at <</title>
+</head>
+<body>
+Try to indent the whole file several times.
+The first time both the html and the php code is badly indented.
+<div id="main">
+<?php
+for ($i = 0; $i < 4711; ++$i) {
+}
+?>
+</div>
+</body>
+</html>
--- /dev/null
+public class FirstProgram\r
+\r
+{\r
+\r
+ public static void main(String[] args)\r
+\r
+ {\r
+\r
+ System.out.println("Hey! you are going to compile and run your first Java program");\r
+\r
+ }\r
+\r
+}\r
--- /dev/null
+<h2>Mensajes recibidos</h2>\r
+<p class="small" style="color:red;margin: 10px">\r
+ Solo se muestran los ultimos 10 mensajes, aquí hay que añadir\r
+ paginación y ¿lógica?.\r
+</p>\r
+<div id="received-messages" class="message-list">\r
+ <% for message in @messages %>\r
+ <div id="received-message-<%= message.id -%>" class="received-message">\r
+ <span class="header"><%= message.sender.roster_name %> escribió a fecha <%= message.created_at -%></span>\r
+ <div class="content">\r
+ <%=h truncate(message.message, 100) %>\r
+ </div>\r
+ <%= link_to "Mostrar", message_path(message) %>\r
+</div>\r
+<% end %>\r
+</div>\r
--- /dev/null
+class MessagesController < BaseController\r
+\r
+ before_filter :enable_chat\r
+ skip_before_filter :verify_authenticity_token\r
+\r
+ # GET /messages\r
+ # GET /messages.xml\r
+ def index\r
+ @messages = ChatMessage.to_user(current_user).last_week.all\r
+ \r
+ respond_to do |format|\r
+ format.html # index.html.erb\r
+ format.xml { render :xml => @messages }\r
+ end\r
+ end\r
+\r
+ # GET /messages/1\r
+ # GET /messages/1.xml\r
+ def show\r
+ @message = ChatMessage.find(params[:id])\r
+\r
+ respond_to do |format|\r
+ format.html # show.html.erb\r
+ format.xml { render :xml => @message }\r
+ end\r
+ end\r
+\r
+ # POST /messages\r
+ # POST /messages.xml\r
+ def create\r
+ @message = ChatMessage.new(:receiver_id => params[:receiver_id],\r
+ :message => params[:messageText],\r
+ :sender => current_user)\r
+\r
+ if @message.save\r
+ send_message\r
+ end\r
+\r
+ render :nothing => true\r
+\r
+ end\r
+\r
+ protected\r
+\r
+ def send_message\r
+ formatted_message = render_to_string(:partial => "message_for_chat", :object => @message)\r
+ shooter_action_for_receiver = render_to_string :update do |page|\r
+ page.call "showMessage", @message.sender.to_param, formatted_message\r
+ end\r
+ shooter_action_for_sender = render_to_string :update do |page|\r
+ page.call "showMessage", @message.receiver.to_param, formatted_message\r
+ page.call "messageTextBox.reset"\r
+ end\r
+ Meteor.shoot 'futura-chat', shooter_action_for_sender, [@message.sender.login]\r
+ Meteor.shoot 'futura-chat', shooter_action_for_receiver, [@message.receiver.login]\r
+ end\r
+end\r
--- /dev/null
+<script type="text/javascript">
+ // <![CDATA[
+ // Set this to the URL you used to fetch recommendations, whether you
+ // fetched them on the client or the server.
+ var request_url="%(json_url)s";
+
+ // This function is used track click-throughs by fetching a web
+ // beacon
+ function trackClickThrough(elem) {
+ var img = new Image();
+ img.src = '%(beacon_url)s' +
+ '?request_url=' + escape(request_url) +
+ '&click_through_url=' + escape(elem.href);
+ return true;
+ }
+ // ]]>
+</script>
+<p>
+ <!--
+ Imagine this is one of the recommendations that was returned.
+ Just add an onclick handler that calls trackClickThrough.
+ -->
+ <a href="http://www.google.com"
+ onclick="return trackClickThrough(this);">Click me!</a>
+</p>
+
--- /dev/null
+<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0"
+ xmlns:set="http://exslt.org/sets">
+
+ <xsl:output method="html"/>
+ <xsl:output encoding="utf-8"/>
+ <xsl:output doctype-system="http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"/>
+ <xsl:output doctype-public="-//W3C//DTD XHTML 1.0 Transitional//EN"/>
+
+ <xsl:template match="/">
+
+ <html>
+ <head>
+ <title>Cancer Summary: <xsl:value-of select="//individual/@name"/> <xsl:value-of select="//individual/@gender"/> <xsl:value-of select="//individual/@id"/></title>
+
+ <link rel="shortcut icon" href="/resources/report_resources/apipe_dashboard/images/gc_favicon.png" type="image/png" />
+
+ <link rel="stylesheet" href="/resources/report_resources/apipe_dashboard/css/master.css" type="text/css" media="screen" />
+ <link rel="stylesheet" href="/resources/report_resources/apipe_dashboard/css/tablesorter.css" type="text/css" media="screen" />
+ <script type="text/javascript" src="/resources/report_resources/jquery/jquery.js"></script>
+ <script type="text/javascript" src="/resources/report_resources/jquery/jquery.tablesorter.min.js"></script>
+ <script type="text/javascript">
+ $(document).ready(function() {
+ $("#tier_1_snps").tablesorter({
+ // sort on first column, ascending
+ // sortList: [[0,0]]
+ });
+
+ $("#tier_1_insertions").tablesorter({
+ // sort on first column, ascending
+ //sortList: [[0,0]]
+ });
+
+ $("#tier_1_deletions").tablesorter({
+ // sort on first column, ascending
+ //sortList: [[0,0]]
+ });
+ });
+ </script>
+ <link rel="stylesheet" href="/resources/report_resources/cancer_card/css/zoom2.css" type="text/css" media="screen"></link>
+ <script type="text/javascript" src="/resources/report_resources/cancer_card/js/dom-drag.js"></script>
+
+ <script type="text/javascript" src="/resources/report_resources/cancer_card/js/HotSpot2.js"></script>
+ <script type="text/javascript">
+ addEvent(window, 'load', function() {
+ HotSpotController.init("zoomImage",300, '<xsl:value-of select="//individual/circos-images/@large"/>','ZTbutton'); });
+
+ function addEvent(obj, evType, fn) {
+ if (obj.addEventListener) {
+ obj.addEventListener(evType, fn, false);
+ return true;
+ } else if (obj.attachEvent) {
+ var r = obj.attachEvent("on" + evType, fn);
+ return r;
+ } else {
+ return false;
+ }
+ }
+ </script>
+
+ <script type="text/javascript">
+ $(document).ready(function() {
+ $("input[type=checkbox]").click(function() {
+ alert("Clicked: " + this.value);
+ });
+ });
+ </script>
+
+ <style type="text/css" media="screen">
+ table.info_table_group td {
+ padding-right: 10px;
+ }
+
+ div.content_padding {
+ padding: 0 10px 20px 10px;
+ }
+
+ h3.group_header {
+ border-bottom: 2px solid #CCC;
+ }
+ div.circos_graph {
+ float: left;
+ width: 920px;
+ }
+
+ form.status_selector {
+ margin: 0;
+ padding: 0;
+ float: right;
+ font-size: 85%;
+ font-weight: normal;
+ }
+
+ form.status_selector table {
+ margin: 0;
+ padding: 0;
+ }
+
+ form.status_selector table td.lbl {
+ padding-right: 10px;
+ padding-left: 5px;
+ }
+
+
+ form.status_selector table td.table_lbl {
+ font-weight: bold;
+ padding-right: 8px;
+ padding-left: 3px;
+ }
+ </style>
+ </head>
+
+ <body>
+ <div class="container">
+ <div class="background">
+ <div class="page_header">
+ <table cellpadding="0" cellspacing="0" border="0">
+ <tr>
+ <td>
+ <img src="/resources/report_resources/apipe_dashboard/images/gc_header_logo2.png" width="44" height="45" align="absmiddle" />
+ </td>
+ <td>
+ <h1><xsl:value-of select="//individual/@name"/> <xsl:value-of select="//individual/@gender"/> <xsl:value-of select="//individual/@id"/> Cancer Summary</h1>
+ </td>
+ </tr>
+ </table>
+ </div>
+ <div class="page_padding">
+ <!-- <h2 class="page_title icon_instrument_data">Flow Cell <xsl:value-of select="//flow-cell/@id"/> Status</h2> -->
+ <table cellpadding="0" cellspacing="0" border="0" class="info_table_group">
+ <tr>
+ <td>
+ <h3 class="group_header">Clinical Data</h3>
+ <table border="0" cellpadding="0" cellspacing="0">
+ <tr>
+ <td>
+ <table border="0" cellpadding="0" cellspacing="0" class="info_table" width="100%">
+ <colgroup>
+ <col/>
+ <col width="100%"/>
+ </colgroup>
+ <tr><td class="label">Name:</td><td class="value"><xsl:value-of select="//individual/@name"/></td></tr>
+ <tr>
+ <td class="label">Gender:</td>
+ <td class="value">
+ <xsl:choose>
+ <xsl:when test="string(//individual/@gender)">
+ <xsl:value-of select="//individual/@gender"/>
+ </xsl:when>
+ <xsl:otherwise>
+ Not Provided
+ </xsl:otherwise>
+ </xsl:choose>
+ </td>
+ </tr>
+ <tr><td class="label">ID:</td><td class="value"><xsl:value-of select="//individual/@id"/></td></tr>
+
+ </table>
+ </td>
+ <td>
+ <table border="0" cellpadding="0" cellspacing="0" class="info_table" width="100%" style="float: left;">
+ <colgroup>
+ <col/>
+ <col width="100%"/>
+ </colgroup>
+
+ <tr><td class="label">Year Diagnosed:</td><td class="value"><xsl:value-of select="//clinical-data/@diagnosis-year"/></td></tr>
+ <tr><td class="label">Diagnosed at Age:</td><td class="value"><xsl:value-of select="//clinical-data/@diagnosis-age"/></td></tr>
+ <xsl:choose>
+ <xsl:when test="//clinical-data/@alive = '1'">
+ <tr><td class="label">Survived:</td><td class="value">Yes</td></tr>
+ </xsl:when>
+ <xsl:otherwise>
+ <tr><td class="label">Survived:</td><td class="value">No</td></tr>
+ <tr><td class="label">Days Survived:</td><td class="value"><xsl:value-of select="//clinical-data/@days-survived"/></td></tr>
+ </xsl:otherwise>
+ </xsl:choose>
+ </table>
+ </td>
+ <td>
+ <table border="0" cellpadding="0" cellspacing="0" class="info_table" width="100%" style="float: left;">
+ <colgroup>
+ <col/>
+ <col width="100%"/>
+ </colgroup>
+
+ <tr><td class="label">Treatment:</td><td class="value"><xsl:value-of select="//clinical-data/@treatment"/></td></tr>
+ <tr><td class="label">Outcome:</td><td class="value"><xsl:value-of select="//clinical-data/@outcome"/></td></tr>
+ <tr><td class="label">AMP:</td><td class="value"><xsl:value-of select="//clinical-data/@amp"/></td></tr>
+
+ </table>
+ </td>
+ </tr>
+ </table>
+ </td>
+ <td>
+ <h3 class="group_header">Sequencing Stats</h3>
+ <table border="0" cellpadding="0" cellspacing="0" class="info_table" width="100%">
+ <colgroup>
+ <col/>
+ <col width="100%"/>
+ </colgroup>
+ <tr><td class="label">Normal Coverage:</td><td class="value"><xsl:value-of select="//samples/sample/models/model/@normal-haploid-coverage"/>X</td></tr>
+ <tr><td class="label">Tumor Coverage:</td><td class="value"><xsl:value-of select="//samples/sample/models/model/@tumor-haploid-coverage"/>X</td></tr>
+ </table>
+ </td>
+ </tr>
+ </table>
+ <hr style="margin-bottom: 0;"/>
+ <h2 class="report_section" style="margin-bottom: 0; margin-top: 0">Circos Graph   <a id="ZTbutton" href="javascript: void(0);" style="font-size: 85%; font-weight: normal;">[toggle zoom]</a></h2>
+ <p id="ZTthumbnail">
+ <img>
+ <xsl:attribute name="id">zoomImage</xsl:attribute>
+ <xsl:attribute name="src"><xsl:value-of select="//individual/circos-images/@small"/></xsl:attribute>
+ <xsl:attribute name="width">920</xsl:attribute>
+ <xsl:attribute name="height">920</xsl:attribute>
+ </img>
+ </p>
+ <h2 class="report_section" style="margin-bottom: 0">Tier 1 SNPs
+<!-- <form class="status_selector">
+ <input type="hidden" name="table" value="tier_1_snps"/>
+ <table cellpadding="0" cellspacing="0">
+ <tr>
+ <td class="table_lbl">Show:</td>
+ <xsl:for-each select="set:distinct(//variants/snps/snp/@validation-status)">
+ <td class="cb">
+ <input type="checkbox"><xsl:attribute name="value"><xsl:value-of select="."/></xsl:attribute></input>
+ </td>
+ <td class="lbl">
+ <xsl:value-of select="."/>
+ </td>
+ </xsl:for-each>
+ </tr>
+ </table>
+ </form>
+-->
+
+ </h2>
+ <table id="tier_1_snps" class="list tablesorter" width="100%" cellspacing="0" cellpadding="0" border="0" style="margin-top: 0;">
+ <xsl:choose>
+ <xsl:when test="count(//variants/snps/snp) > 0">
+
+ <thead>
+ <tr>
+ <th>validation status</th>
+ <th>chromosome</th>
+ <th class="last">start</th>
+ <th class="last">reference</th>
+ <th class="last">variant</th>
+ <th class="last">gene</th>
+ <th class="last">amino acid change</th>
+ <th class="last">trv type</th>
+ </tr>
+ </thead>
+ <tbody>
+ <xsl:for-each select="//variants/snps/snp">
+ <xsl:sort select="@validation-status" data-type="text" order="ascending"/>
+ <xsl:sort select="@chromosome" data-type="number" order="ascending"/>
+ <tr>
+ <td class="validation_status"><xsl:value-of select="@validation-status"/></td>
+ <td><xsl:value-of select="@chromosome"/></td>
+ <td class="last">
+ <xsl:variable name="start" select="@start"/><xsl:value-of select="format-number($start, '#,##0')"/>
+ </td>
+ <td class="last"><xsl:value-of select="@reference-allele"/></td>
+ <td class="last"><xsl:value-of select="@variant-allele"/></td>
+ <td class="last"><xsl:value-of select="@gene"/></td>
+ <td class="last"><xsl:value-of select="@amino-acid-change"/></td>
+ <td class="last"><xsl:value-of select="@trv-type"/></td>
+ </tr>
+ </xsl:for-each>
+ </tbody>
+ </xsl:when>
+ <xsl:otherwise>
+ <tr><td><span class="note">None found.</span></td></tr>
+ </xsl:otherwise>
+ </xsl:choose>
+ </table>
+
+ <h2 class="report_section" style="margin-bottom: 0">Tier 1 Insertions</h2>
+ <table id="tier_1_insertions" class="list tablesorter" width="100%" cellspacing="0" cellpadding="0" border="0" style="margin-top: 0;">
+ <xsl:choose>
+ <xsl:when test="count(//variants/insertions/insertion) > 0">
+ <thead>
+ <tr>
+ <th>validation status</th>
+ <th>chromosome</th>
+ <th class="last">start</th>
+ <th class="last">stop</th>
+ <th class="last">variant</th>
+ <th class="last">gene</th>
+ <th class="last">amino acid change</th>
+ <th class="last">trv type</th>
+ </tr>
+ </thead>
+ <tbody>
+ <xsl:for-each select="//variants/insertions/insertion">
+ <xsl:sort select="@validation-status" data-type="text" order="ascending"/>
+ <xsl:sort select="@chromosome" data-type="number" order="ascending"/>
+ <tr>
+ <td class="validation_status"><xsl:value-of select="@validation-status"/></td>
+ <td><xsl:value-of select="@chromosome"/></td>
+ <td class="last">
+ <xsl:variable name="start" select="@start"/><xsl:value-of select="format-number($start, '#,##0')"/>
+ </td>
+ <td class="last">
+ <xsl:variable name="stop" select="@stop"/><xsl:value-of select="format-number($stop, '#,##0')"/>
+ </td>
+ <td class="last"><xsl:value-of select="@variant-allele"/></td>
+ <td class="last"><xsl:value-of select="@gene"/></td>
+ <td class="last"><xsl:value-of select="@amino-acid-change"/></td>
+ <td class="last"><xsl:value-of select="@trv-type"/></td>
+ </tr>
+ </xsl:for-each>
+ </tbody>
+ </xsl:when>
+ <xsl:otherwise>
+ <tr><td><span class="note">None found.</span></td></tr>
+ </xsl:otherwise>
+ </xsl:choose>
+ </table>
+
+ <h2 class="report_section" style="margin-bottom: 0">Tier 1 Deletions</h2>
+ <table id="tier_1_deletions" class="list tablesorter" width="100%" cellspacing="0" cellpadding="0" border="0" style="margin-top: 0;">
+ <xsl:choose>
+ <xsl:when test="count(//variants/deletions/deletion) > 0">
+ <thead>
+ <tr>
+ <th>validation status</th>
+ <th>chromosome</th>
+ <th class="last">start</th>
+ <th class="last">stop</th>
+ <th class="last">reference</th>
+ <th class="last">gene</th>
+ <th class="last">amino acid change</th>
+ <th class="last">trv type</th>
+ </tr>
+ </thead>
+ <tbody>
+ <xsl:for-each select="//variants/deletions/deletion">
+ <xsl:sort select="@validation-status" data-type="text" order="ascending"/>
+ <xsl:sort select="@chromosome" data-type="number" order="ascending"/>
+ <tr>
+ <td class="validation_status"><xsl:value-of select="@validation-status"/></td>
+ <td><xsl:value-of select="@chromosome"/></td>
+ <td class="last">
+ <xsl:variable name="start" select="@start"/><xsl:value-of select="format-number($start, '#,##0')"/>
+ </td>
+ <td class="last">
+ <xsl:variable name="stop" select="@stop"/><xsl:value-of select="format-number($stop, '#,##0')"/>
+ </td>
+ <td class="last"><xsl:value-of select="@reference-allele"/></td>
+ <td class="last"><xsl:value-of select="@gene"/></td>
+ <td class="last"><xsl:value-of select="@amino-acid-change"/></td>
+ <td class="last"><xsl:value-of select="@trv-type"/></td>
+ </tr>
+ </xsl:for-each>
+ </tbody>
+ </xsl:when>
+ <xsl:otherwise>
+ <tr><td><span class="note">None found.</span></td></tr>
+ </xsl:otherwise>
+ </xsl:choose>
+ </table>
+
+ <h2 class="report_section" style="margin-bottom: 0;">Structural Variations (translocations)</h2>
+ <table id="sv_translocations" class="list" width="100%" cellspacing="0" cellpadding="0" border="0" style="margin-top: 0;">
+ <xsl:choose>
+ <xsl:when test="count(//structural-variants/translocations/translocation) > 0">
+ <thead>
+ <tr>
+ <th>validation status</th>
+ <th class="last">chromosome</th>
+ <th class="last">position</th>
+ <th> </th>
+ <th class="last">chromosome</th>
+ <th class="last">position</th>
+ </tr>
+ </thead>
+ <tbody>
+ <xsl:for-each select="//structural-variants/translocations/translocation">
+ <xsl:sort select="@validation-status" data-type="text" order="ascending"/>
+ <xsl:sort select="start/@chromosome" data-type="number" order="ascending"/>
+ <tr>
+ <td class="validation_status"><xsl:value-of select="@validation-status"/></td>
+ <td class="last"><xsl:value-of select="start/@chromosome"/></td>
+ <td class="last">
+ <xsl:variable name="start_position" select="start/@position"/><xsl:value-of select="format-number($start_position, '#,##0')"/>
+ </td>
+
+ <td class="last"><span style="font-size: 100%; font-weight: bold;">→</span></td>
+
+ <td class="last"><xsl:value-of select="stop/@chromosome"/></td>
+ <td class="last">
+ <xsl:variable name="stop_position" select="stop/@position"/><xsl:value-of select="format-number($stop_position, '#,##0')"/>
+ </td>
+ </tr>
+ </xsl:for-each>
+ </tbody>
+ </xsl:when>
+ <xsl:otherwise>
+ <tr><td><span class="note">None found.</span></td></tr>
+ </xsl:otherwise>
+ </xsl:choose>
+ </table>
+
+ <h2 class="report_section" style="margin-bottom: 0;">Structural Variations (insertions)</h2>
+ <table id="sv_insertions" class="list" width="100%" cellspacing="0" cellpadding="0" border="0" style="margin-top: 0;">
+ <tbody>
+ <xsl:choose>
+ <xsl:when test="count(//structural-variants/insertions/insertion) > 0">
+ <thead>
+ <tr>
+ <th>validation status</th>
+ <th class="last">chromosome</th>
+ <th class="last">start</th>
+ <th class="last">stop</th>
+ <th class="last">size</th>
+ </tr>
+ </thead>
+ <xsl:for-each select="//structural-variants/insertions/insertion">
+ <xsl:sort select="@validation-status" data-type="number" order="ascending"/>
+ <xsl:sort select="start/@chromosome" data-type="number" order="ascending"/>
+ <tr>
+ <td class="validation_status"><xsl:value-of select="@validation-status"/></td>
+ <td class="last"><xsl:value-of select="start/@chromosome"/></td>
+ <td class="last">
+ <xsl:variable name="start_position" select="start/@position"/><xsl:value-of select="format-number($start_position, '#,##0')"/>
+ </td>
+ <td class="last">
+ <xsl:variable name="stop_position" select="stop/@position"/><xsl:value-of select="format-number($stop_position, '#,##0')"/>
+ </td>
+ <xsl:variable name="size" select="@size"/><xsl:value-of select="format-number($size, '#,##0')"/>
+
+ </tr>
+ </xsl:for-each>
+ </xsl:when>
+ <xsl:otherwise>
+ <tr><td><span class="note">None found.</span></td></tr>
+ </xsl:otherwise>
+ </xsl:choose>
+ </tbody>
+ </table>
+
+ <h2 class="report_section" style="margin-bottom: 0;">Structural Variations (deletions)</h2>
+ <table id="sv_deletions" class="list" width="100%" cellspacing="0" cellpadding="0" border="0" style="margin-top: 0;">
+ <xsl:choose>
+ <xsl:when test="count(//structural-variants/deletions/deletion) > 0">
+ <thead>
+ <tr>
+ <th>validation status</th>
+ <th class="last">chromosome</th>
+ <th class="last">start</th>
+ <th class="last">stop</th>
+ <th class="last">size</th>
+ </tr>
+ </thead>
+ <tbody>
+ <xsl:for-each select="//structural-variants/deletions/deletion">
+ <xsl:sort select="@validation-status" data-type="number" order="ascending"/>
+ <xsl:sort select="start/@chromosome" data-type="number" order="ascending"/>
+ <tr>
+ <td class="validation_status"><xsl:value-of select="@validation-status"/></td>
+ <td class="last"><xsl:value-of select="start/@chromosome"/></td>
+ <td class="last">
+ <xsl:variable name="start_position" select="start/@position"/><xsl:value-of select="format-number($start_position, '#,##0')"/>
+ </td>
+ <td class="last">
+ <xsl:variable name="stop_position" select="stop/@position"/><xsl:value-of select="format-number($stop_position, '#,##0')"/>
+ </td>
+ <td class="last">
+ <xsl:variable name="size" select="@size"/><xsl:value-of select="format-number($size, '#,##0')"/>
+ </td>
+ </tr>
+ </xsl:for-each>
+ </tbody>
+ </xsl:when>
+ <xsl:otherwise>
+ <tr><td><span class="note">None found.</span></td></tr>
+ </xsl:otherwise>
+ </xsl:choose>
+ </table>
+ </div>
+ </div>
+ </div>
+ </body>
+ </html>
+
+ </xsl:template>
+
+</xsl:stylesheet>
--- /dev/null
+<h1>Listing People</h1>
+
+<table>
+<% for person in @people %>
+<tr>
+</tr>
+</table>
--- /dev/null
+<h1>Listing People</h1>
+
+<table>
+
+<% <testnxmlparsed> for person in @people %>
+
+<tr>
+</tr>
+</table>
--- /dev/null
+<?php\r
+require_once dirname(__FILE__) . '/foo.php';\r
+require_once dirname(__FILE__) . '/bar.php';\r
+\r
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ { % block pagestyle % }
+ * {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ { % endblock % }
+ </style>
+ <script type="text/javascript" src="{% media_url %}/homepage/js/jquery.js"></script>
+ <script type="text/javascript" src="{% media_url %}/homepage/js/jquery.preload.js"></script>
+ <script type="text/javascript" src="{% media_url %}/homepage/js/swfobject.js"></script>
+ <script type="text/javascript">
+ function image_loaded(info) {
+ /* now we know that the image is loaded, we can add in to the
+ * document and position it as we want */
+ // create the element, set the ID and add in to the DOM,
+ // otherwise it won't have dimensions
+ var pointer = $('<img src="' + info.image + '" />');
+ pointer.attr('id', 'pointer');
+ var frame = $('#container');
+ pointer.appendTo(frame);
+
+ // put it into the center and make top & left be in the center
+ // of the image (cool hack)
+ pointer.css({
+ position: 'absolute',
+ top: '50%',
+ left: '50%',
+ margin: (-pointer.height() / 2) + 'px 0 0 ' +
+ (-pointer.width() / 2) + 'px'
+ });
+
+ // continue with the animation now
+ play_animation();
+ }
+
+ function prepare_animation() {
+ /* prepares animation by preloading stuff */
+ // hide all panels
+ $('a > img').css('visibility', 'hidden');
+ // create the logo - 'pointer': preload and center it
+ $.preload(['logo'], {
+ base: '{ % media_url % }/homepage/img/intro/',
+ ext: '.png',
+ onFinish: image_loaded
+ });
+ }
+
+ function play_animation() {
+ /* plays the animations, adds callbacks */
+ var frame = $('#container');
+ var pointer = $('#pointer');
+
+ /* run the effects now: first fade in the pointer, then move it
+ * to the edge of the frame, then fade in the panels
+ */
+ pointer.hide().fadeIn(2000)
+ .animate({
+ top: pointer.height() / 2 + 10,
+ left: frame.width() - pointer.width() / 2
+ }, 3000, undefined, function() {
+ var panels = $('a > img');
+ // show panels, fade them in and add callbacks
+ panels.css({ visibility: 'visible',
+ opacity: '0'})
+ .fadeTo(1000, 0.5)
+ .mouseover(fade_in)
+ .mouseout(fade_out);
+ });
+ }
+
+ function fade_in() {
+ /* fade in the panel */
+ $(this).fadeTo(300, 1);
+ }
+
+ function fade_out() {
+ /* fade out the panel */
+ $(this).fadeTo(300, 0.5);
+ }
+
+ // start JS magic when the page has loaded
+ $(document).ready(prepare_animation);
+ </script>
+
+ </head>
+
+{% block body %}
+<body>
+
+<div id="distance"></div>
+<div id="container">
+ <div id="flashcontent">
+
+ <table border="0">
+ <tr>
+ <td colspan="3"><div style="height: 63px;" /></td>
+ </tr>
+ <tr>
+ <td><a href="/junkers/"><img src="{% media_url %}/homepage/img/intro/panel_junkers.jpg" alt="junkers" width="166" height="221" /></a></td>
+ <td><a href="/zeppelin/"><img src="{% media_url %}/homepage/img/intro/panel_zeppelin.jpg" alt="zeppelin" width="168" height="221" /></a></td>
+ <td><a href="/maximilian/"><img src="{% media_url %}/homepage/img/intro/panel_maximilian.jpg" alt="maximilian" width="162" height="221" /></a></td>
+ </tr>
+ <tr>
+ <td colspan="3"><div style="height: 66px;" /></td>
+ </tr>
+ </table>
+ </div>
+
+ <script type="text/javascript">
+ // <![CDATA[
+ var so = new SWFObject("{% media_url % }/homepage/swf/intro_{ % translate "LANGUAGE_NAME" % }.swf", "intro", "500", "370", "9", "#FFF");
+ so.addParam("allowScriptAccess", "always");
+ so.write("flashcontent");
+ // ]]>
+ </script>
+
+</div>
+</div>
+
+</body>
+{% endblock %}
+
+</html>
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+
+ * {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ { % endblock % }
+ </style>
+ <script type="text/javascript" src="{% media_url %}/homepage/js/jquery.js"></script>
+ <script type="text/javascript" src="{% media_url %}/homepage/js/jquery.preload.js"></script>
+ <script type="text/javascript" src="{% media_url %}/homepage/js/swfobject.js"></script>
+ <script type="text/javascript">
+ function image_loaded(info) {
+ /* now we know that the image is loaded, we can add in to the
+ * document and position it as we want */
+ // create the element, set the ID and add in to the DOM,
+ // otherwise it won't have dimensions
+ var pointer = $('<img src="' + info.image + '" />');
+ pointer.attr('id', 'pointer');
+ var frame = $('#container');
+ pointer.appendTo(frame);
+
+ // put it into the center and make top & left be in the center
+ // of the image (cool hack)
+ pointer.css({
+ position: 'absolute',
+ top: '50%',
+ left: '50%',
+ margin: (-pointer.height() / 2) + 'px 0 0 ' +
+ (-pointer.width() / 2) + 'px'
+ });
+
+ // continue with the animation now
+ play_animation();
+ }
+
+ function prepare_animation() {
+ /* prepares animation by preloading stuff */
+ // hide all panels
+ $('a > img').css('visibility', 'hidden');
+ // create the logo - 'pointer': preload and center it
+ $.preload(['logo'], {
+ base: '{ % media_url % }/homepage/img/intro/',
+ ext: '.png',
+ onFinish: image_loaded
+ });
+ }
+
+ function play_animation() {
+ /* plays the animations, adds callbacks */
+ var frame = $('#container');
+ var pointer = $('#pointer');
+
+ /* run the effects now: first fade in the pointer, then move it
+ * to the edge of the frame, then fade in the panels
+ */
+ pointer.hide().fadeIn(2000)
+ .animate({
+ top: pointer.height() / 2 + 10,
+ left: frame.width() - pointer.width() / 2
+ }, 3000, undefined, function() {
+ var panels = $('a > img');
+ // show panels, fade them in and add callbacks
+ panels.css({ visibility: 'visible',
+ opacity: '0'})
+ .fadeTo(1000, 0.5)
+ .mouseover(fade_in)
+ .mouseout(fade_out);
+ });
+ }
+
+ function fade_in() {
+ /* fade in the panel */
+ $(this).fadeTo(300, 1);
+ }
+
+ function fade_out() {
+ /* fade out the panel */
+ $(this).fadeTo(300, 0.5);
+ }
+
+ // start JS magic when the page has loaded
+ $(document).ready(prepare_animation);
+ </script>
+
+ </head>
+
+{% block body %}
+<body>
+
+<div id="distance"></div>
+<div id="container">
+ <div id="flashcontent">
+
+ <table border="0">
+ <tr>
+ <td colspan="3"><div style="height: 63px;" /></td>
+ </tr>
+ <tr>
+ <td><a href="/junkers/"><img src="{% media_url %}/homepage/img/intro/panel_junkers.jpg" alt="junkers" width="166" height="221" /></a></td>
+ <td><a href="/zeppelin/"><img src="{% media_url %}/homepage/img/intro/panel_zeppelin.jpg" alt="zeppelin" width="168" height="221" /></a></td>
+ <td><a href="/maximilian/"><img src="{% media_url %}/homepage/img/intro/panel_maximilian.jpg" alt="maximilian" width="162" height="221" /></a></td>
+ </tr>
+ <tr>
+ <td colspan="3"><div style="height: 66px;" /></td>
+ </tr>
+ </table>
+ </div>
+
+ <script type="text/javascript">
+ // <![CDATA[
+ var so = new SWFObject("{% media_url % }/homepage/swf/intro_{ % translate "LANGUAGE_NAME" % }.swf", "intro", "500", "370", "9", "#FFF");
+ so.addParam("allowScriptAccess", "always");
+ so.write("flashcontent");
+ // ]]>
+ </script>
+
+</div>
+</div>
+
+</body>
+{% endblock %}
+
+</html>
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ {% block pagestyle %}
+ * {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ {% endblock %}
+ </style>
+ <script type="text/javascript" src="{% media_url %}/homepage/js/jquery.js"></script>
+ <script type="text/javascript" src="{% media_url %}/homepage/js/jquery.preload.js"></script>
+ <script type="text/javascript" src="{% media_url %}/homepage/js/swfobject.js"></script>
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ {% block pagestyle %}
+ * {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ {% endblock %}
+ </style>
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ { % block pagestyle % }
+ * {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ { % endblock % }
+ </style>
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ * {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ { block pagestyle }
+ * {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ * {
+ margin: 0;
+ padding: 0;
+ }
+ { block pagestyle }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+{% load transdigest helpers %}
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ {% endblock %}
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+ {% block htmlhead %}
+
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ </style>
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+
+ </style>
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+
+ <style type="text/css">
+
+ p {
+ margin: 0;
+ padding: 0;
+ }
+
+ </style>
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head profile="http://dublincore.org/documents/dcq-html/">
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />
+
+ <meta name="DC.title" content="Homepage of point TEC" />
+ <meta name="DC.creator" content="Marek Kubica" />
+ <meta name="DC.subject" content="Presentation of products" />
+ <meta name="DC.publisher" content="point TEC" />
+ <meta name="DC.rights" content="copyright by point TEC" />
+
+ <style type="text/css">
+ { xlock }
+ p {
+ margin: 0;
+ padding: 0;
+ }
+
+ </style>
--- /dev/null
+ {% block pagestyle %}
+ * {
+ margin: 0;
+ padding: 0;
+ }
+ img {
+ border: 0
+ }
+
+ html, body {
+ height: 100%;
+ }
+
+ #distance {
+ width: 1px;
+ height: 50%;
+ margin-bottom: -175px;
+ }
+ #container {
+ position: relative;
+ margin: 0 auto;
+ height: 370px;
+ width: 500px;
+ background-color: #ffffff;
+ }
+ /* the horizontal bars */
+ #flashcontent * div {
+ background-color: #292926;
+ }
+
+ #pointer {
+ display: block;
+ margin: 0 auto;
+ }
+
+ {% endblock %}
--- /dev/null
+{% load transdigest helpers %}\r
+<?xml version="1.0" encoding="UTF-8"?>\r
+<!DOCTYPE html PUBLIC\r
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"\r
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\r
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">\r
+ <head profile="http://dublincore.org/documents/dcq-html/">\r
+ <link rel="schema.DC" href="http://purl.org/dc/elements/1.1/" />\r
+ <link rel="schema.DCTERMS" href="http://purl.org/dc/terms/" />\r
+ <link rel="stylesheet" type="text/css" href="{% media_url %}/homepage/css/web0.5.css" media="screen" />\r
+\r
+ <title>{% block title %}{% translate "WELCOME_TO_POINTTEC" %}{% endblock %}</title>\r
+ <meta name="DC.title" content="Homepage of point TEC" />\r
+ <meta name="DC.creator" content="Marek Kubica" />\r
+ <meta name="DC.subject" content="Presentation of products" />\r
+ <meta name="DC.publisher" content="point TEC" />\r
+ <meta name="DC.rights" content="copyright by point TEC" />\r
+ {% block htmlhead %}\r
+\r
+ {% endblock %}\r
+ <style type="text/css">\r
+ {% block pagestyle %}\r
+ * {\r
+ margin: 0;\r
+ padding: 0;\r
+ }\r
+ img {\r
+ border: 0\r
+ }\r
+\r
+ html, body {\r
+ height: 100%;\r
+ }\r
+\r
+ #distance {\r
+ width: 1px;\r
+ height: 50%;\r
+ margin-bottom: -175px;\r
+ }\r
+ #container {\r
+ position: relative;\r
+ margin: 0 auto;\r
+ height: 370px;\r
+ width: 500px;\r
+ background-color: #ffffff;\r
+ }\r
+ /* the horizontal bars */\r
+ #flashcontent * div {\r
+ background-color: #292926;\r
+ }\r
+\r
+ #pointer {\r
+ display: block;\r
+ margin: 0 auto;\r
+ }\r
+\r
+ {% endblock %}\r
+ </style>\r
+ <script type="text/javascript" src="{% media_url %}/homepage/js/jquery.js"></script>\r
+ <script type="text/javascript" src="{% media_url %}/homepage/js/jquery.preload.js"></script>\r
+ <script type="text/javascript" src="{% media_url %}/homepage/js/swfobject.js"></script>\r
+ <script type="text/javascript">\r
+ function image_loaded(info) {\r
+ /* now we know that the image is loaded, we can add in to the\r
+ * document and position it as we want */\r
+ // create the element, set the ID and add in to the DOM,\r
+ // otherwise it won't have dimensions\r
+ var pointer = $('<img src="' + info.image + '" />');\r
+ pointer.attr('id', 'pointer');\r
+ var frame = $('#container');\r
+ pointer.appendTo(frame);\r
+\r
+ // put it into the center and make top & left be in the center\r
+ // of the image (cool hack)\r
+ pointer.css({\r
+ position: 'absolute',\r
+ top: '50%',\r
+ left: '50%',\r
+ margin: (-pointer.height() / 2) + 'px 0 0 ' +\r
+ (-pointer.width() / 2) + 'px'\r
+ });\r
+\r
+ // continue with the animation now\r
+ play_animation();\r
+ }\r
+ \r
+ function prepare_animation() {\r
+ /* prepares animation by preloading stuff */\r
+ // hide all panels\r
+ $('a > img').css('visibility', 'hidden');\r
+ // create the logo - 'pointer': preload and center it\r
+ $.preload(['logo'], {\r
+ base: '{% media_url %}/homepage/img/intro/',\r
+ ext: '.png',\r
+ onFinish: image_loaded\r
+ });\r
+ }\r
+ \r
+ function play_animation() {\r
+ /* plays the animations, adds callbacks */\r
+ var frame = $('#container');\r
+ var pointer = $('#pointer');\r
+\r
+ /* run the effects now: first fade in the pointer, then move it\r
+ * to the edge of the frame, then fade in the panels\r
+ */\r
+ pointer.hide().fadeIn(2000)\r
+ .animate({\r
+ top: pointer.height() / 2 + 10,\r
+ left: frame.width() - pointer.width() / 2\r
+ }, 3000, undefined, function() {\r
+ var panels = $('a > img');\r
+ // show panels, fade them in and add callbacks\r
+ panels.css({ visibility: 'visible', \r
+ opacity: '0'})\r
+ .fadeTo(1000, 0.5)\r
+ .mouseover(fade_in)\r
+ .mouseout(fade_out);\r
+ });\r
+ }\r
+\r
+ function fade_in() {\r
+ /* fade in the panel */\r
+ $(this).fadeTo(300, 1);\r
+ }\r
+\r
+ function fade_out() {\r
+ /* fade out the panel */\r
+ $(this).fadeTo(300, 0.5);\r
+ }\r
+\r
+ // start JS magic when the page has loaded\r
+ $(document).ready(prepare_animation);\r
+ </script>\r
+\r
+ </head>\r
+\r
+{% block body %}\r
+<body>\r
+\r
+<div id="distance"></div>\r
+<div id="container">\r
+ <div id="flashcontent">\r
+\r
+ <table border="0">\r
+ <tr>\r
+ <td colspan="3"><div style="height: 63px;" /></td>\r
+ </tr>\r
+ <tr>\r
+ <td><a href="/junkers/"><img src="{% media_url %}/homepage/img/intro/panel_junkers.jpg" alt="junkers" width="166" height="221" /></a></td>\r
+ <td><a href="/zeppelin/"><img src="{% media_url %}/homepage/img/intro/panel_zeppelin.jpg" alt="zeppelin" width="168" height="221" /></a></td>\r
+ <td><a href="/maximilian/"><img src="{% media_url %}/homepage/img/intro/panel_maximilian.jpg" alt="maximilian" width="162" height="221" /></a></td>\r
+ </tr>\r
+ <tr>\r
+ <td colspan="3"><div style="height: 66px;" /></td>\r
+ </tr>\r
+ </table>\r
+ </div>\r
+\r
+ <script type="text/javascript">\r
+ // <![CDATA[\r
+ var so = new SWFObject("{% media_url %}/homepage/swf/intro_{% translate "LANGUAGE_NAME" %}.swf", "intro", "500", "370", "9", "#FFF");\r
+ so.addParam("allowScriptAccess", "always");\r
+ so.write("flashcontent");\r
+ // ]]>\r
+ </script>\r
+\r
+</div>\r
+</div>\r
+\r
+</body>\r
+{% endblock %}\r
+\r
+</html>\r
--- /dev/null
+The problem seems to have to do with the { block pagestyle } thing
+below. If that is removed then the freezing does not happen.
+
+ <style type="text/css">
+ { block pagestyle }
+ p {
+ margin: 0;
+
+Try the files kubica-080516-freezing-i.html and dito j. The former
+freezes Emacs, but the latter does not.
--- /dev/null
+<?
+
+class Baz
+{
+ // This class was written after the file was opened
+}
+
+class Bar
+{
+ public function foo()
+ {
+ var_dump("foo");
+ return null;
+ }
+}
+
+class Foo
+{
+ public function bar()
+ {
+ var_dump("bar");
+ }
+}
\ No newline at end of file
--- /dev/null
+\begin{section}
+Test file for latex-clojure-mumamo-mode!
+
+\begin{subsection}
+Define some vars here!
+\begin{clojure}
+(def zero 0)
+\end{clojure}
+
+\begin{subsection}
+Define some functions here!
+\begin{clojure}
+(defn id [arg]
+ arg)
+\end{clojure}
+
+\end{section}
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ <meta http-equiv="Content-Type" content="text/html;" />
+ <!-- There was a typo above, a missing " after content -->
+ </head>
+ <body>
+ <div>
+ <div>
+ <p><a href="">marked invalid</a></p>
+ </div>
+ </div>
+ </body>
+</html>
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head><title></title></head>
+ <body>
+ <p>
+ Since nXml do not have a schema for xhtml 1.0 transitional it
+ uses strict instead. Therefore it gaves false errors here.
+ </p>
+ <form action="" method="get">
+ <label for="inputname">Label for field: </label>
+ <input type="text" name="inputname" id="inputname" />
+ </form>
+ </body>
+</html>
--- /dev/null
+this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line this is a very long line\r
--- /dev/null
+\r
+This is a regular paragraph.\r
+\r
+<table>\r
+ <tr>\r
+ <td>Foo</td>\r
+ </tr>\r
+</table>\r
+\r
+This is another regular paragraph.\r
+\r
+Those look alike should not be in html-mode:\r
+\r
+ <http://example.com/>\r
+ <address@example.com>\r
+\r
--- /dev/null
+
+<%perl>
+ my $noun = 'World';
+my @time = localtime;
+</%perl>
+Hello <% $noun %>,
+% if ( $time[2] < 12 ) {
+ good morning.
+ % } else {
+ good afternoon.
+ % }
+
+ <%text>
+ Some text
+ </%text>
+
+<%doc>
+ Some doc
+</%doc>
+
+<& simple_comp &>
+
+ <%args>
+ $a
+ @b # a comment
+ %c
+
+ # another comment
+ $d => 5
+ $e => $d*2
+ @f => ('foo', 'baz')
+ %g => (joe => 1, bob => 2)
+ </%args>
+
+<&| /path/to/comp &> this is the content </&>
+<&| comp, arg1 => 'hi' &> filters can take arguments </&>
+<&| comp &> content can include <% "tags" %> of all kinds </&>
+something
+<& simple_comp &>
+<&| SELF:method1 &> subcomponents can be filters </&>
+<&| compit &>
+ <&| comp1 &>
+ nesting is also
+ <&| comp2 &> OK </&>
+xx
+</&>
--- /dev/null
+Debugger entered--Lisp error: (error "No file on this line")\r
+ signal(error ("No file on this line"))\r
+ error("No file on this line")\r
+ dired-get-file-for-visit()\r
+ (if (derived-mode-p (quote dired-mode)) (dired-get-file-for-visit) buffer-file-name)\r
+ html-site-buffer-or-dired-file-name()\r
+ (setq file (html-site-buffer-or-dired-file-name))\r
+ (if file nil (setq file (html-site-buffer-or-dired-file-name)))\r
+ (unless file (setq file (html-site-buffer-or-dired-file-name)))\r
+ nxhtml-buffer-possibly-local-viewable()\r
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<link rel="stylesheet" href="feedstyle.css" type="text/css" />
+<title>mjt google feeds</title>
+<script type="text/javascript" src="http://mjtemplate.org/dist/mjt-0.6/mjt.js"></script>
+<script type="text/javascript" src="./google-api-keys.js"></script>
+<script type="text/javascript">
+ load_google_api('http://www.google.com/jsapi?key=');
+</script>
+<script type="text/javascript">
+
+ google.load("feeds", "1");
+
+ function initialize() {
+ var top = mjt.run('top');
+
+ var feeduri = mjt.urlquery.feed;
+ if (typeof feeduri == 'undefined')
+ feeduri = "http://blog.freebase.com/?feed=atom";
+ document.title = 'feed: ' + feeduri;
+
+ var feed = new google.feeds.Feed(feeduri);
+ feed.load(function(result) { mjt.run('feed', top.showfeed, [result]); });
+ }
+ google.setOnLoadCallback(initialize);
+</script>
+</head>
+<body>
+<div>
+This is a toy feed reader using <a href="http://mjtemplate.org">Mjt</a> to
+read Google's new <a href="http://code.google.com/apis/ajaxfeeds/documentation/">AJAX feed API</a>.
+</div>
+<div>
+some feeds:
+<a href="?feed=http://blog.freebase.com/%3Ffeed%3Datom">The Freebase Dev Blog</a>
+| <a href="?feed=http://googleajaxsearchapi.blogspot.com/atom.xml">Google AJAX Search API Blog</a>
+</div>
+<!-- compare to <a href="http://code.google.com/apis/ajaxfeeds/documentation/helloworld.html">google example</a> -->
+<div id="top" style="display:none;">
+<div class="feedform">
+<form action="feed.html">
+<div>xml feed uri:
+ <input type="text" size="70" name="feed" value="${mjt.urlquery.feed||''}" />
+<input type="submit" value="read" />
+</div>
+</form>
+</div>
+<div mjt.def="showfeed(result)">
+<div mjt.choose="">
+<div mjt.when="result.status != '200' && result.error">
+ error: <b>$result.error.message</b>
+</div>
+<div mjt.when="result.status.code == 200">
+<pre mjt.script="">
+ document.title = 'feed: ' + result.feed.title;
+ </pre>
+<h1 class="feedtitle"><a href="$result.feed.link">$result.feed.title</a></h1>
+<div mjt.for="entry in result.feed.entries" class="entry">
+<div class="entryheader">
+<a href="$entry.link" class="entrytitle">$entry.title</a>
+<span mjt.if="entry.categories instanceof Array && entry.categories.length>0">
+ in: <span mjt.for="cat in (entry.categories||[])" class="category">$cat</span>
+</span>
+<div>
+
+ <span class="author">${entry.author||''}</span> -
+ <span class="date">${entry.publishedDate||''}</span>
+</div>
+</div>
+<!-- XXX security - does google sanitize? we sure don't... -->
+<div class="content">${mjt.bless(entry.content)}</div>
+</div>
+</div>
+<div mjt.otherwise="">
+<b>unknown response type from google feed api</b>
+</div>
+</div>
+</div>
+</div>
+<!-- the feed view gets pasted here when ready -->
+<div id="feed"></div>
+</body>
+</html>
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<title>mjt yahoo test</title>
+<script type="text/javascript" src="http://mjtemplate.org/dist/mjt-0.6/mjt.js"></script>
+<script type="text/javascript" src="http://mjtemplate.org/dist/mjt-0.6/src/yahooapi/yahooapi.js"></script>
+</head>
+<body onload="mjt.run('top')">
+<h2>Yahoo image search example</h2>
+using
+<a href="http://mjtemplate.org">mjt</a>
+to interact with the
+<a href="http://developer.yahoo.com/common/json.html">yahoo json api</a>
+<div id="top" style="display:none;">
+<div mjt.task="o">
+ mjt.yahooapi.ImageSearch(mjt.urlquery.query||'kathakali')
+ </div>
+<form method="get" action="">
+<div>
+<input type="text" name="query" value="${mjt.urlquery.query||''}" />
+<input type="submit" value="search" />
+</div>
+</form>
+<div mjt.choose="o.state">
+<div mjt.when="ready">
+<div mjt.for="img in o.result.Result">
+<h3>$img.Title</h3>
+<img alt="image" src="#" mjt.src="$img.Thumbnail.Url" style="float:left" />
+<div>$img.Summary</div>
+<hr style="clear:both" />
+</div>
+</div>
+<div mjt.when="wait">
+ loading...
+ </div>
+<div mjt.when="error">
+<div mjt.for="msg in o.messages">
+ $msg.message
+ </div>
+</div>
+</div>
+</div>
+</body>
+</html>
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<script type="text/javascript" src="http://mjtemplate.org/dist/mjt-0.6/mjt.js"></script>
+<title>a minimal mjt example</title>
+</head>
+<body onload="mjt.run()" style="display:none">
+ running mjt version ${mjt.VERSION}
+</body></html>
--- /dev/null
+* Test of org and mumamo\r
+\r
+ Below is a html chunk\r
+\r
+#+BEGIN_HTML \r
+<p>\r
+ I have no idea of how to use this yet.\r
+</p>\r
+#+END_HTML\r
+\r
+#+BEGIN_SRC emacs-lisp-mode\r
+ (defun\r
+#+END_SRC\r
+\r
+Where are the "..." in org-mumamo-mode???\r
+\r
+** Some subnode\r
+\r
+Hm, org full header lines are broken, why?\r
+Does not seem related to mumamo.\r
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>\r
+<map version="0.9.0">\r
+<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\r
+<node text="Test of org and mumamo">\r
+<node style="bubble" background_color="#eeee00">\r
+<richcontent TYPE="NODE"><html>\r
+<head>\r
+<style type="text/css">\r
+<!--\r
+p { margin-top: 0 }\r
+-->\r
+</style>\r
+</head>\r
+<body>\r
+<p><br /> Below is a html chunk</p><p><br /></p>\r
+\r
+<p>\r
+ I have not idea of how to use this yet.\r
+</p>\r
+<p><br /></p>\r
+</body>\r
+</html>\r
+</richcontent>\r
+<richcontent TYPE="NOTE"><html><head></head><body><p>-- This is more about "Test of org and mumamo" --</p></body></html></richcontent>\r
+</node>\r
+<node text="Some subnode">\r
+<node style="bubble" background_color="#eeee00">\r
+<richcontent TYPE="NODE"><html>\r
+<head>\r
+<style type="text/css">\r
+<!--\r
+p { margin-top: 0 }\r
+-->\r
+</style>\r
+</head>\r
+<body>\r
+<p><br />Hm, header lines are broken, why?</p>\r
+</body>\r
+</html>\r
+</richcontent>\r
+<richcontent TYPE="NOTE"><html><head></head><body><p>-- This is more about "Some subnode" --</p></body></html></richcontent>\r
+</node>\r
+</node>\r
+</node>\r
+</map>\r
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ </head>
+ <body>
+ <a href="rgr-080307.php" ></a>
+ </body>
+</html>
--- /dev/null
+<?php\r
+\r
+include_once(APP_AAA_INCLUDE."bb.php");\r
+include_once(APP_AAA_INCLUDE."cc.php");\r
+include_once(APP_AAA_INCLUDE."dd.php");\r
+include_once(APP_AAA_INCLUDE."ee.php");\r
+include_once(APP_AAA_INCLUDE."ff.php");\r
+include_once(APP_AAA_INCLUDE."gg.php");\r
+\r
+class Test\r
+{\r
+ public $var1;\r
+ \r
+ function __construct()\r
+ {\r
+ $This->var1 = 5;\r
+ }\r
+}
\ No newline at end of file
--- /dev/null
+Illegal char in prolog\r
+undo!\r
+mumamo-jit-lock-after-change 1 2 0\r
+ mumamo-jit-lock-after-change: font-lock-extend-after-change-region-function=nil\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (progn (let ((jit-lock-start (\, min)) (jit-lock-end (\, max))) (mumamo-with-buffer-prepared-for-jit-lock (run-hook-with-args (quote jit-lock-after-change-extend-region-functions) min max old-len)) (setq min jit-lock-start) (setq max jit-lock-end) (syntax-ppss-flush-cache min)))))\r
+>>>>>>>>>>\r
+mumamo-jit-lock-after-change r-min,max=(1 . 7),nil major-min,max=nxhtml-mode,nil\r
+mumamo-jit-lock-after-change new-min,max=1,7\r
+mumamo-mark-for-refontification A min,max=1,7 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=1,7 point-min,max=1,329\r
+mumamo-jit-lock-after-change.unfontify-pos=1\r
+mumamo-jit-lock-function 1, ff=nil, just-changed=nil\r
+++++++ mumamo-fontify-region 1 8 nil, skip=nil\r
+here 1, here=1, end=8\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (progn (let (ppss ret) (setq ppss (parse-partial-sexp (\, syntax-start) (+ (\, syntax-end) 0))) (if (or (nth 3 ppss) (nth 4 ppss)) (progn nil t) t)))))\r
+>>>>>>>>>>\r
+ fn=mumamo-chunk-xml-pi, r=(1 6 nil nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 1 to 329 in no-php-end-2.php> cv-min/cv-max 1/6\r
+mumamo-mark-for-refontification A min,max=7,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=7,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (1 6 nil nil nil nil)\r
+mumamo-remove-chunk-overlays 1 6\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 1 nil, chunk-max: 6 nil\r
+*** mumamo-fontify-region-1.here=1, chunk=#<overlay from 1 to 6 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=1, start=1, chunk-min=1,max=6 end=8 chunk-major=nxhtml-mode\r
+mumamo-fontify-region-with 1 6 nil nxhtml-mode, ff=t\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 1 6 nil 1 6 nxhtml-mode\r
+mumamo-do-fontify 1 6, chunk-syntax-min,max=1,6, new: 1 6\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (parse-partial-sexp (point-min) last-pos)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify exit >>>>>>> 1 6 nil 1 6 nxhtml-mode\r
+here 1, here=6, end=8\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=nil cv-min/cv-max 6/nil\r
+mumamo-mark-for-refontification A min,max=8,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=8,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (6 nil php-mode nil nil nil)\r
+mumamo-remove-chunk-overlays 6 329\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+ mumamo-major-mode-from-modespec php-mode => php-mode\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=6, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=6, start=1, chunk-min=6,max=329 end=8 chunk-major=php-mode\r
+mumamo-fontify-region-with 6 8 nil php-mode, ff=nil\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 6 8 nil 6 329 php-mode\r
+mumamo-do-fontify 6 8, chunk-syntax-min,max=6,329, new: 6 8\r
+mumamo-do-fontify exit >>>>>>> 6 8 nil 6 329 php-mode\r
+mumamo-mark-for-refontification A min,max=8,8 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=1,end=329, start=1, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+\r
+++++++ mumamo-fontify-region 8 329 nil, skip=nil\r
+here 1, here=8, end=329\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=8, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=8, start=8, chunk-min=6,max=329 end=329 chunk-major=php-mode\r
+mumamo-fontify-region-with 8 329 nil php-mode, ff=t\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 8 329 nil 6 329 php-mode\r
+mumamo-do-fontify 8 329, chunk-syntax-min,max=6,329, new: 8 329\r
+mumamo-do-fontify exit >>>>>>> 8 329 nil 6 329 php-mode\r
+mumamo-mark-for-refontification A min,max=329,329 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=8, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+mumamo-jit-lock-function 6, ff=nil, just-changed=nil\r
+\r
+++++++ mumamo-fontify-region 1 48 nil, skip=nil\r
+here 1, here=1, end=48\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (progn (let (ppss ret) (setq ppss (parse-partial-sexp (\, syntax-start) (+ (\, syntax-end) 0))) (if (or (nth 3 ppss) (nth 4 ppss)) (progn nil t) t)))))\r
+>>>>>>>>>>\r
+ fn=mumamo-chunk-xml-pi, r=(1 6 nil nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 1 to 6 in no-php-end-2.php> cv-min/cv-max 1/6\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 1 nil, chunk-max: 6 nil\r
+*** mumamo-fontify-region-1.here=1, chunk=#<overlay from 1 to 6 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=1, start=1, chunk-min=1,max=6 end=48 chunk-major=nxhtml-mode\r
+mumamo-fontify-region-with 1 6 nil nxhtml-mode, ff=t\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 1 6 nil 1 6 nxhtml-mode\r
+mumamo-do-fontify 1 6, chunk-syntax-min,max=1,6, new: 1 6\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (parse-partial-sexp (point-min) last-pos)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify exit >>>>>>> 1 6 nil 1 6 nxhtml-mode\r
+here 1, here=6, end=48\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-mark-for-refontification A min,max=48,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=48,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (6 nil php-mode nil nil nil)\r
+mumamo-remove-chunk-overlays 6 329\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+ mumamo-major-mode-from-modespec php-mode => php-mode\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=6, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=6, start=1, chunk-min=6,max=329 end=48 chunk-major=php-mode\r
+mumamo-fontify-region-with 6 48 nil php-mode, ff=nil\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 6 48 nil 6 329 php-mode\r
+mumamo-do-fontify 6 48, chunk-syntax-min,max=6,329, new: 6 48\r
+mumamo-do-fontify exit >>>>>>> 6 48 nil 6 329 php-mode\r
+mumamo-mark-for-refontification A min,max=48,48 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=1,end=329, start=1, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+\r
+++++++ mumamo-fontify-region 48 329 nil, skip=nil\r
+here 1, here=48, end=329\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=48, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=48, start=48, chunk-min=6,max=329 end=329 chunk-major=php-mode\r
+mumamo-fontify-region-with 48 329 nil php-mode, ff=t\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 48 329 nil 6 329 php-mode\r
+mumamo-do-fontify 48 329, chunk-syntax-min,max=6,329, new: 48 329\r
+mumamo-do-fontify exit >>>>>>> 48 329 nil 6 329 php-mode\r
+mumamo-mark-for-refontification A min,max=329,329 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=48, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+mumamo-jit-lock-function 7, ff=nil, just-changed=nil\r
+\r
+++++++ mumamo-fontify-region 7 88 nil, skip=nil\r
+here 1, here=7, end=88\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-mark-for-refontification A min,max=88,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=88,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (6 nil php-mode nil nil nil)\r
+mumamo-remove-chunk-overlays 6 329\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+ mumamo-major-mode-from-modespec php-mode => php-mode\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=7, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=7, start=7, chunk-min=6,max=329 end=88 chunk-major=php-mode\r
+mumamo-fontify-region-with 7 88 nil php-mode, ff=nil\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 7 88 nil 6 329 php-mode\r
+mumamo-do-fontify 7 88, chunk-syntax-min,max=6,329, new: 7 88\r
+mumamo-do-fontify exit >>>>>>> 7 88 nil 6 329 php-mode\r
+mumamo-mark-for-refontification A min,max=88,88 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=7, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+++++++ mumamo-fontify-region 88 329 nil, skip=nil\r
+here 1, here=88, end=329\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=88, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=88, start=88, chunk-min=6,max=329 end=329 chunk-major=php-mode\r
+mumamo-fontify-region-with 88 329 nil php-mode, ff=t\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 88 329 nil 6 329 php-mode\r
+mumamo-do-fontify 88 329, chunk-syntax-min,max=6,329, new: 88 329\r
+mumamo-do-fontify exit >>>>>>> 88 329 nil 6 329 php-mode\r
+mumamo-mark-for-refontification A min,max=329,329 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=88, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+mumamo-jit-lock-function 8, ff=nil, just-changed=nil\r
+++++++ mumamo-fontify-region 8 128 nil, skip=nil\r
+here 1, here=8, end=128\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-mark-for-refontification A min,max=128,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=128,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (6 nil php-mode nil nil nil)\r
+mumamo-remove-chunk-overlays 6 329\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+ mumamo-major-mode-from-modespec php-mode => php-mode\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=8, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=8, start=8, chunk-min=6,max=329 end=128 chunk-major=php-mode\r
+mumamo-fontify-region-with 8 128 nil php-mode, ff=nil\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 8 128 nil 6 329 php-mode\r
+mumamo-do-fontify 8 128, chunk-syntax-min,max=6,329, new: 8 128\r
+mumamo-do-fontify exit >>>>>>> 8 128 nil 6 329 php-mode\r
+mumamo-mark-for-refontification A min,max=128,128 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=8, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+++++++ mumamo-fontify-region 128 329 nil, skip=nil\r
+here 1, here=128, end=329\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=128, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=128, start=128, chunk-min=6,max=329 end=329 chunk-major=php-mode\r
+mumamo-fontify-region-with 128 329 nil php-mode, ff=t\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 128 329 nil 6 329 php-mode\r
+mumamo-do-fontify 128 329, chunk-syntax-min,max=6,329, new: 128 329\r
+mumamo-do-fontify exit >>>>>>> 128 329 nil 6 329 php-mode\r
+mumamo-mark-for-refontification A min,max=329,329 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=128, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+mumamo-jit-lock-function 20, ff=nil, just-changed=nil\r
+++++++ mumamo-fontify-region 8 168 nil, skip=nil\r
+here 1, here=8, end=168\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-mark-for-refontification A min,max=168,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=168,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (6 nil php-mode nil nil nil)\r
+mumamo-remove-chunk-overlays 6 329\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+ mumamo-major-mode-from-modespec php-mode => php-mode\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=8, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=8, start=8, chunk-min=6,max=329 end=168 chunk-major=php-mode\r
+mumamo-fontify-region-with 8 168 nil php-mode, ff=nil\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 8 168 nil 6 329 php-mode\r
+mumamo-do-fontify 8 168, chunk-syntax-min,max=6,329, new: 8 168\r
+mumamo-do-fontify exit >>>>>>> 8 168 nil 6 329 php-mode\r
+mumamo-mark-for-refontification A min,max=168,168 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=8, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+++++++ mumamo-fontify-region 168 329 nil, skip=nil\r
+here 1, here=168, end=329\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
--- /dev/null
+Illegal char in prolog\r
+undo!\r
+mumamo-jit-lock-after-change 1 2 0\r
+ mumamo-jit-lock-after-change: font-lock-extend-after-change-region-function=nil\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (progn (let ((jit-lock-start (\, min)) (jit-lock-end (\, max))) (mumamo-with-buffer-prepared-for-jit-lock (run-hook-with-args (quote jit-lock-after-change-extend-region-functions) min max old-len)) (setq min jit-lock-start) (setq max jit-lock-end) (syntax-ppss-flush-cache min)))))\r
+>>>>>>>>>>\r
+mumamo-jit-lock-after-change r-min,max=(1 . 7),nil major-min,max=nxhtml-mode,nil\r
+mumamo-jit-lock-after-change new-min,max=1,7\r
+mumamo-mark-for-refontification A min,max=1,7 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=1,7 point-min,max=1,329\r
+mumamo-jit-lock-after-change.unfontify-pos=1\r
+mumamo-jit-lock-function 1, ff=nil, just-changed=nil\r
+++++++ mumamo-fontify-region 1 8 nil, skip=nil\r
+here 1, here=1, end=8\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (progn (let (ppss ret) (setq ppss (parse-partial-sexp (\, syntax-start) (+ (\, syntax-end) 0))) (if (or (nth 3 ppss) (nth 4 ppss)) (progn nil t) t)))))\r
+>>>>>>>>>>\r
+ fn=mumamo-chunk-xml-pi, r=(1 6 nil nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 1 to 329 in no-php-end-2.php> cv-min/cv-max 1/6\r
+new-is-closed=6\r
+mumamo-mark-for-refontification A min,max=7,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=7,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (1 6 nil nil nil nil)\r
+mumamo-remove-chunk-overlays 1 6\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 1 nil, chunk-max: 6 nil\r
+*** mumamo-fontify-region-1.here=1, chunk=#<overlay from 1 to 6 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=1, start=1, chunk-min=1,max=6 end=8 chunk-major=nxhtml-mode\r
+mumamo-fontify-region-with 1 6 nil nxhtml-mode, ff=t\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 1 6 nil 1 6 nxhtml-mode\r
+mumamo-do-fontify 1 6, chunk-syntax-min,max=1,6, new: 1 6\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (parse-partial-sexp (point-min) last-pos)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify exit >>>>>>> 1 6 nil 1 6 nxhtml-mode\r
+here 1, here=6, end=8\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=nil cv-min/cv-max 6/nil\r
+(when (and end new-real-end (> new-real-end end))\r
+mumamo-mark-for-refontification A min,max=8,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=8,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (6 nil php-mode nil nil nil)\r
+mumamo-remove-chunk-overlays 6 329\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+ mumamo-major-mode-from-modespec php-mode => php-mode\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=6, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=6, start=1, chunk-min=6,max=329 end=8 chunk-major=php-mode\r
+mumamo-fontify-region-with 6 8 nil php-mode, ff=nil\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 6 8 nil 6 329 php-mode\r
+mumamo-do-fontify 6 8, chunk-syntax-min,max=6,329, new: 6 8\r
+mumamo-do-fontify exit >>>>>>> 6 8 nil 6 329 php-mode\r
+\r
+not sure\r
+mumamo-mark-for-refontification A min,max=8,8 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=1,end=329, start=1, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+++++++ mumamo-fontify-region 8 329 nil, skip=nil\r
+here 1, here=8, end=329\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=8, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=8, start=8, chunk-min=6,max=329 end=329 chunk-major=php-mode\r
+mumamo-fontify-region-with 8 329 nil php-mode, ff=t\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 8 329 nil 6 329 php-mode\r
+mumamo-do-fontify 8 329, chunk-syntax-min,max=6,329, new: 8 329\r
+mumamo-do-fontify exit >>>>>>> 8 329 nil 6 329 php-mode\r
+\r
+\r
+not sure\r
+mumamo-mark-for-refontification A min,max=329,329 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=8, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+mumamo-jit-lock-function 6, ff=nil, just-changed=nil\r
+++++++ mumamo-fontify-region 1 48 nil, skip=nil\r
+here 1, here=1, end=48\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (progn (let (ppss ret) (setq ppss (parse-partial-sexp (\, syntax-start) (+ (\, syntax-end) 0))) (if (or (nth 3 ppss) (nth 4 ppss)) (progn nil t) t)))))\r
+>>>>>>>>>>\r
+ fn=mumamo-chunk-xml-pi, r=(1 6 nil nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 1 to 6 in no-php-end-2.php> cv-min/cv-max 1/6\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 1 nil, chunk-max: 6 nil\r
+*** mumamo-fontify-region-1.here=1, chunk=#<overlay from 1 to 6 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=1, start=1, chunk-min=1,max=6 end=48 chunk-major=nxhtml-mode\r
+mumamo-fontify-region-with 1 6 nil nxhtml-mode, ff=t\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 1 6 nil 1 6 nxhtml-mode\r
+mumamo-do-fontify 1 6, chunk-syntax-min,max=1,6, new: 1 6\r
+mumamo-with-major-mode-setup nxhtml-mode => html-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (parse-partial-sexp (point-min) last-pos)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify exit >>>>>>> 1 6 nil 1 6 nxhtml-mode\r
+here 1, here=6, end=48\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+(when (and end new-real-end (> new-real-end end))\r
+mumamo-mark-for-refontification A min,max=48,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=48,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (6 nil php-mode nil nil nil)\r
+mumamo-remove-chunk-overlays 6 329\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+ mumamo-major-mode-from-modespec php-mode => php-mode\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=6, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=6, start=1, chunk-min=6,max=329 end=48 chunk-major=php-mode\r
+mumamo-fontify-region-with 6 48 nil php-mode, ff=nil\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 6 48 nil 6 329 php-mode\r
+mumamo-do-fontify 6 48, chunk-syntax-min,max=6,329, new: 6 48\r
+mumamo-do-fontify exit >>>>>>> 6 48 nil 6 329 php-mode\r
+\r
+\r
+not sure\r
+mumamo-mark-for-refontification A min,max=48,48 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=1,end=329, start=1, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+++++++ mumamo-fontify-region 48 329 nil, skip=nil\r
+here 1, here=48, end=329\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=48, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=48, start=48, chunk-min=6,max=329 end=329 chunk-major=php-mode\r
+mumamo-fontify-region-with 48 329 nil php-mode, ff=t\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 48 329 nil 6 329 php-mode\r
+mumamo-do-fontify 48 329, chunk-syntax-min,max=6,329, new: 48 329\r
+mumamo-do-fontify exit >>>>>>> 48 329 nil 6 329 php-mode\r
+\r
+\r
+not sure\r
+mumamo-mark-for-refontification A min,max=329,329 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=48, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+mumamo-jit-lock-function 7, ff=nil, just-changed=nil\r
+++++++ mumamo-fontify-region 7 88 nil, skip=nil\r
+here 1, here=7, end=88\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+(when (and end new-real-end (> new-real-end end))\r
+mumamo-mark-for-refontification A min,max=88,329 point-min,max=1,329\r
+mumamo-mark-for-refontification B min,max=88,329 point-min,max=1,329\r
+mumamo-create-chunk-from-chunk-values (6 nil php-mode nil nil nil)\r
+mumamo-remove-chunk-overlays 6 329\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (quote (if syntax-begin-function (progn syntax-begin-function) (when (and (not syntax-begin-function) (boundp (quote font-lock-beginning-of-syntax-function)) font-lock-beginning-of-syntax-function) font-lock-beginning-of-syntax-function))))\r
+>>>>>>>>>>\r
+ mumamo-major-mode-from-modespec php-mode => php-mode\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=7, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=7, start=7, chunk-min=6,max=329 end=88 chunk-major=php-mode\r
+mumamo-fontify-region-with 7 88 nil php-mode, ff=nil\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 7 88 nil 6 329 php-mode\r
+mumamo-do-fontify 7 88, chunk-syntax-min,max=6,329, new: 7 88\r
+mumamo-do-fontify exit >>>>>>> 7 88 nil 6 329 php-mode\r
+\r
+\r
+not sure\r
+mumamo-mark-for-refontification A min,max=88,88 point-min,max=1,329\r
+*** mumamo-fontify-region-1: here 3 ovl-start=6,end=329, start=7, chunks-to-remove=nil\r
+*** mumamo-fontify-region-1: here 4\r
+++++++ mumamo-fontify-region 88 329 nil, skip=nil\r
+here 1, here=88, end=329\r
+ fn=mumamo-chunk-xml-pi, r=(6 nil php-mode nil nil)\r
+ fn=mumamo-chunk-inlined-style, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-inlined-script, r=(1 nil nil nil nil)\r
+ fn=mumamo-chunk-style=, r=(nil nil nil)\r
+ fn=mumamo-chunk-onjs=, r=(nil nil nil)\r
+old-chunk=#<overlay from 6 to 329 in no-php-end-2.php> cv-min/cv-max 6/nil\r
+mumamo-fontify-region-1 FACE FACE FACE chunk-min: 6 font-lock-keyword-face, chunk-max: 329 nil\r
+*** mumamo-fontify-region-1.here=88, chunk=#<overlay from 6 to 329 in no-php-end-2.php>\r
+*** mumamo-fontify-region-1: here 2 here=88, start=88, chunk-min=6,max=329 end=329 chunk-major=php-mode\r
+mumamo-fontify-region-with 88 329 nil php-mode, ff=t\r
+mumamo-with-major-mode-setup php-mode => php-mode\r
+mumamo-with-major-mode-setup <<<<<<<<<< body=(progn (\` (mumamo-do-fontify (\, start) (\, end) (\, verbose) (\, chunk-syntax-min) (\, chunk-syntax-max) major)))\r
+>>>>>>>>>>\r
+mumamo-do-fontify <<<<<<< 88 329 nil 6 329 php-mode\r
+mumamo-do-fontify 88 329, chunk-syntax-min,max=6,329, new: 88 329\r
+mumamo-do-fontify exit >>>>>>> 88 329 nil 6 329 php-mode\r
+\r
+\r
+not sure\r
+mumamo-mark-for-refontification A min,max=329,329 point-min,max=1,329\r
+*** muma\r
--- /dev/null
+<?php\r
+\r
+include_once(APP_AAA_INCLUDE."bb.php");\r
+include_once(APP_AAA_INCLUDE."cc.php");\r
+include_once(APP_AAA_INCLUDE."dd.php");\r
+include_once(APP_AAA_INCLUDE."ee.php");\r
+include_once(APP_AAA_INCLUDE."ff.php");\r
+include_once(APP_AAA_INCLUDE."gg.php");\r
+\r
+class Test\r
+{\r
+ public $var1;\r
+ \r
+ function __construct()\r
+ {\r
+ $This->var1 = 5;\r
+ }\r
+}\r
--- /dev/null
+<?php\r
+\r
+include_once(APP_AAA_INCLUDE."bb.php");\r
+include_once(APP_AAA_INCLUDE."cc.php");\r
+include_once(APP_AAA_INCLUDE."dd.php");\r
+include_once(APP_AAA_INCLUDE."ee.php");\r
+include_once(APP_AAA_INCLUDE."ff.php");\r
+include_once(APP_AAA_INCLUDE."gg.php");\r
+\r
+class Test\r
+{\r
+ public $var1;\r
+ \r
+ function __construct()\r
+ {\r
+ $This->var1 = 5;\r
+ }\r
+}\r
--- /dev/null
+<?php\r
+\r
+$parent_id = 5;\r
+var_dump($parent_id);\r
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ <script type="text/javascript">
+<testnxmlparsed>
+ </script>
--- /dev/null
+@\r
+\section{Hello world}\r
+\r
+Today I awakened and decided to write\r
+some code, so I started to write a Hello World in \textsf C.\r
+\r
+<<hello.c>>=\r
+/*\r
+ <<license>>\r
+*/\r
+#include <stdio.h>\r
+\r
+int main(int argc, char *argv[]) {\r
+ printf("Hello World!\n");\r
+ return 0;\r
+}\r
+@\r
+\noindent \ldots then I did the same in PHP.\r
+\r
+<<hello.sql>>=\r
+SELECT * FROM Persons\r
+WHERE FirstName LIKE '%a'\r
+@\r
+<<hello.php>>=\r
+<?php\r
+ /*\r
+ <<license>>\r
+ */\r
+ echo "Hello world!\n";\r
+?>\r
+@\r
+\section{License}\r
+Later, same day some lawyer reminded me about licenses.\r
+So, here it is:\r
+\r
+<<license>>=\r
+This work is placed in the public domain.\r
+@\r
--- /dev/null
+ % for row in rows:
+<%inherit file="base.html"/>
+
+<%
+ rows = [[v for v in range(0,10)] for row in range(0,10)]
+%>
+<%!
+ rows = [[v for v in range(0,10)] for row in range(0,10)]
+%>
+aaa
+<table>
+ ## This is a comment.
+ % for row in rows:
+ ${makerow(row)}
+ % endfor
+</table>
+
+<%def name="makerow(row)">
+ <tr>
+ % for name in row:
+ <td>${name}</td>\
+ % endfor
+ </tr>
+</%def>
+<%doc>
+This should be a comment too...
+</%doc>
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head><title></title></head>
+ <body>
+ <form action="" method="get">
+ <label for="inputname">Label for field: </label>
+ <input type="text" name="inputname" id="inputname" />
+ </form>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>Kimpro Malmö & Sydsverige - AKTUELLT I MALMÖ</title>
+ <link href="textmall.css" rel="stylesheet" type="text/css" />
+ <link href="layout.css" rel="stylesheet" type="text/css" />
+ </head>
+ <body>
+ <div class="kolumn1">
+ <span class="rubrik">Aktuellt våren 2008</span><br />
+ <i>Välkommen till dansens magiska universum!</i><br />
+ Här i kalendariet kan du se vad som händer i kimprosammanhang
+ just nu. De arrangemang med rosa botten är utöver våra
+ vanliga söndags-träffar i Malmö. Vill du veta mer om de olika
+ verksamheterna, ta en titt under <u><a href=
+ "index_verksamhet.html" target="index3s">Verksamhet</a>.
+ <b>OBS!</b> Notera att vi bytt danstid till kl 19-21! Detta
+ gäller endast en period nu i vår.<br />
+ <br /></u><b>Mars</b>
+ <table width="370" cellspacing="5">
+ <!--
+ <tr>
+ <td class="kalendariecell_special">
+ <img src="grafik/aktuelltbild_januari.jpg" border=0><br>
+ <i>Några av oss som dansar i Malmö</i><br>
+
+<span class="mellanrubrik">
+<br>
+<b>OBS: Ny tid!</b><br></span>
+Vi har ny tid för dansen på söndagar! 19-21 är nya tiden som gäller en tid framöver. <br>
+<br>
+
+<br>
+Sofia och Rebecka har arbetat tillsammans sedan år 2000. De träffades
+på Nordens dåvarande enda cirkusgymnasium i Gävle och utbildade sig
+sedan i Köpenhamn på AFUK, Akademiet för Utaemet Kreativitet -
+Artistlinien, med parakrobatik som huvuddiciplin. Sedan följde en
+treårig
+utbildning" Centre des Arts du Cirque de Lomme-Et vous trouvez ca
+drole!!!" i Lille, Frankrike. 2003 startade de nycirkusföretaget
+"Stint"
+tillsammans och de jobbar nu som frilansande cirkusartister främst i
+Frankrike.<br>
+<br>
+Med Rebecka som överman och Sofia som underman kör de både liggande och
+stående parakrobatik, spänningsövningar, huvud- och handhandbalanser.
+Tillsammans har de jobbat ihop flera olika akter á 5 minuter. Däribland
+hittar man kvinnlig styrka och pur pondus, komisk vardagstristess,
+hisnande teknik och tyngdpunkt i relationerna mellan människor och
+samhällets uppochned vända verklighet, ur ett verkligt uppochnedvänt
+perspektiv. Sedan år 2006 har fokuset flyttats mer och mer åt
+improvisationshållet, parakrobatikimprovisation i samarbete med fri
+improviserad musik och kontaktimprovisation.<br>
+<a href="http://www.stint.nu" target=blank><u>www.stint.nu</u></a><br>
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 24 Februari<br>
+<span class="mellanrubrik">
+Musikjam!</span><br>
+kl 19-21, 30 kr<br>
+<br>
+Denna söndag kommer inga inhyrda musiker till jammet,
+utan då det är vi själva som står för musiken!<br>
+<br>
+Så alla som kan och vill -ta med er instrument eller
+andra ljudframbringande prylar. Att använda sin röst går förståss
+också bra.<br>
+<br>
+Vill man inte musisera så dansar man som vanligt.
+(..och därför kostar det bara 30 kr, då vi inte har några musiker som
+ska betalas)<br>
+<br>
+VÄLKOMNA!
+</td>
+</tr>
+ -->
+ <tr>
+ <td class="kalendariecell">
+ Söndag 2 Mars<br />
+ <span class="mellanrubrik">Nybörjarintroduktion &
+ Jam med Karin R och Jenny</span><br />
+ Kl. 19-21, 30 kr.
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 9 Mars<br />
+ <span class="mellanrubrik">Blind fold jam - jam med
+ ögonbindel!</span><br />
+ ... med Sofi och Tove. Kl 19-21, 30 kr<br />
+ På ett blind fold jam dansar man med ögonen förbundna,
+ för att öka känsligheten, lyssnandet och samspelet. Det
+ är också ett sätt att försöka komma förbi
+ föreställningar man (medvetet eller omedvetet) har runt
+ vem man väljer att dansa med. Det blir i slutändan en
+ spegling till en själv om de val man gör på dansgolvet,
+ där kroppen denna gång får bestämma i stället för
+ huvudet. Vi inleder som vanligt med en introduktion.
+ Tag gärna med egen ögonbindel!<br />
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 16 Mars<br />
+ <span class="mellanrubrik">Introduktion och
+ jam</span><br />
+ 19-21, 30 kr<br />
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 23 Mars<br />
+ <span class="mellanrubrik">Ingenting här för då är vi
+ på NIM i Köpenhamn!
+ <!-- Introduktion och jam</span><br> -->
+ <!-- 19-21, 30 kr<br> --></span>
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen den 30:e<br />
+ <span class="mellanrubrik">Kort introduktion och
+ Livejam!!</span><br />
+ 19-21, 50 kr<br />
+ </td>
+ </tr>
+ </table>
+ </div>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>
+ Kimpro Malmö & Sydsverige - AKTUELLT I MALMÖ
+ </title>
+ <link href="textmall.css" rel="stylesheet" type="text/css" />
+ <link href="layout.css" rel="stylesheet" type="text/css" />
+ </head>
+ <body>
+ <div class="kolumn1">
+ <span class="rubrik">Aktuellt våren 2008</span><br />
+ <i>Välkommen till dansens magiska universum!</i><br />
+ Här i kalendariet kan du se vad som händer i kimprosammanhang
+ just nu. De arrangemang med rosa botten är utöver våra
+ vanliga söndags-träffar i Malmö. Vill du veta mer om de olika
+ verksamheterna, ta en titt under <u><a href=
+ "index_verksamhet.html" target="index3s">Verksamhet</a>.
+ <b>OBS!</b> Notera att vi bytt danstid till kl 19-21! Detta
+ gäller endast en period nu i vår.<br />
+ <br /></u><b>Mars</b>
+ <table width="370" cellspacing="5">
+ <!--
+ <tr>
+ <td class="kalendariecell_special">
+ <img src="grafik/aktuelltbild_januari.jpg" border=0><br>
+ <i>Några av oss som dansar i Malmö</i><br>
+
+<span class="mellanrubrik">
+<br>
+<b>OBS: Ny tid!</b><br></span>
+Vi har ny tid för dansen på söndagar! 19-21 är nya tiden som gäller en tid framöver. <br>
+<br>
+
+<br>
+Sofia och Rebecka har arbetat tillsammans sedan år 2000. De träffades
+på Nordens dåvarande enda cirkusgymnasium i Gävle och utbildade sig
+sedan i Köpenhamn på AFUK, Akademiet för Utaemet Kreativitet -
+Artistlinien, med parakrobatik som huvuddiciplin. Sedan följde en
+treårig
+"Stint"
+tillsammans och de jobbar nu som frilansande cirkusartister främst i
+Frankrike.<br>
+<br>
+Med Rebecka som överman och Sofia som underman kör de både liggande och
+stående parakrobatik, spänningsövningar, huvud- och handhandbalanser.
+Tillsammans har de jobbat ihop flera olika akter á 5 minuter. Däribland
+hittar man kvinnlig styrka och pur pondus, komisk vardagstristess,
+hisnande teknik och tyngdpunkt i relationerna mellan människor och
+samhällets uppochned vända verklighet, ur ett verkligt uppochnedvänt
+perspektiv. Sedan år 2006 har fokuset flyttats mer och mer åt
+improvisationshållet, parakrobatikimprovisation i samarbete med fri
+improviserad musik och kontaktimprovisation.<br>
+<a href="http://www.stint.nu" target=blank><u>www.stint.nu</u></a><br>
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 24 Februari<br>
+<span class="mellanrubrik">
+Musikjam!</span><br>
+kl 19-21, 30 kr<br>
+<br>
+Denna söndag kommer inga inhyrda musiker till jammet,
+utan då det är vi själva som står för musiken!<br>
+<br>
+Så alla som kan och vill -ta med er instrument eller
+andra ljudframbringande prylar. Att använda sin röst går förståss
+också bra.<br>
+<br>
+Vill man inte musisera så dansar man som vanligt.
+(..och därför kostar det bara 30 kr, då vi inte har några musiker som
+ska betalas)<br>
+<br>
+VÄLKOMNA!
+</td>
+</tr>
+ -->
+ <tr>
+ <td class="kalendariecell">
+ Söndag 2 Mars<br />
+ <span class="mellanrubrik">Nybörjarintroduktion &
+ Jam med Karin R och Jenny</span><br />
+ Kl. 19-21, 30 kr.
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 9 Mars<br />
+ <span class="mellanrubrik">Blind fold jam - jam med
+ ögonbindel!</span><br />
+ ... med Sofi och Tove. Kl 19-21, 30 kr<br />
+ På ett blind fold jam dansar man med ögonen förbundna,
+ för att öka känsligheten, lyssnandet och samspelet. Det
+ är också ett sätt att försöka komma förbi
+ föreställningar man (medvetet eller omedvetet) har runt
+ vem man väljer att dansa med. Det blir i slutändan en
+ spegling till en själv om de val man gör på dansgolvet,
+ där kroppen denna gång får bestämma i stället för
+ huvudet. Vi inleder som vanligt med en introduktion.
+ Tag gärna med egen ögonbindel!<br />
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 16 Mars<br />
+ <span class="mellanrubrik">Introduktion och
+ jam</span><br />
+ 19-21, 30 kr<br />
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 23 Mars<br />
+ <span class="mellanrubrik">Ingenting här för då är vi
+ på NIM i Köpenhamn!
+ <!-- Introduktion och jam</span><br> -->
+ <!-- 19-21, 30 kr<br> --></span>
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen den 30:e<br />
+ <span class="mellanrubrik">Kort introduktion och
+ Livejam!!</span><br />
+ 19-21, 50 kr<br />
+ </td>
+ </tr>
+ </table>
+ </div>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>
+ Kimpro Malmö & Sydsverige - AKTUELLT I MALMÖ
+ </title>
+ <link href="textmall.css" rel="stylesheet" type="text/css" />
+ <link href="layout.css" rel="stylesheet" type="text/css" />
+ </head>
+ <body>
+ <div class="kolumn1">
+ <span class="rubrik">Aktuellt våren 2008</span><br />
+ <i>Välkommen till dansens magiska universum!</i><br />
+ Här i kalendariet kan du se vad som händer i kimprosammanhang
+ just nu. De arrangemang med rosa botten är utöver våra
+ vanliga söndags-träffar i Malmö. Vill du veta mer om de olika
+ verksamheterna, ta en titt under <u><a href=
+ "index_verksamhet.html" target="index3s">Verksamhet</a>.
+ <b>OBS!</b> Notera att vi bytt danstid till kl 19-21! Detta
+ gäller endast en period nu i vår.<br />
+ <br /></u><b>Mars</b>
+ <table width="370" cellspacing="5">
+ <!--
+ <tr>
+ <td class="kalendariecell_special">
+ <img src="grafik/aktuelltbild_januari.jpg" border=0><br>
+ <i>Några av oss som dansar i Malmö</i><br>
+
+<span class="mellanrubrik">
+<br>
+<b>OBS: Ny tid!</b><br></span>
+Vi har ny tid för dansen på söndagar! 19-21 är nya tiden som gäller en tid framöver. <br>
+<br>
+
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 6 Januari<br>
+<span class="mellanrubrik">
+Grundklass & Jam</span><br>
+Årets första nybörjarintro! Kl. 17-19, 30 kr.
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 13 Januari<br>
+<span class="mellanrubrik">
+Introduktion & Jam</span><br>
+Kl. 17-19, 30 kr.
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 20 Januari<br>
+<span class="mellanrubrik">
+Introduktion & Jam</span><br>
+Kl. 17-19, 30 kr.
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 27 Januari<br>
+<span class="mellanrubrik">
+Introduktion & Jam</span><br>
+Kl. 17-19, 30 kr.
+</td>
+</tr>
+
+<tr>
+<td class="kalendariecell_special">
+<b>23-24 februari</b><br>
+<span class="mellanrubrik">WORKSHOP I AKROBATIK
+FÖR KONTAKTIMPROVISATÖRER</span><br>
+<br>
+Två parakrobater, Sofia och Rebecka, bosatta i Frankrike kommer till
+Malmö
+för att hålla en workshop speciellt för Kimpro Malmö!
+Workshopen kommer handla om hur man kan använda akrobatik i
+kontaktimprovisation. Inga förkunskaper i akrobatik behövs.<br>
+<br>
+23-24/2, kl.13-16 båda dagarna.<br>
+Kostnad: 350 kr.<br>
+Betalas senast den 21/2 till plusgirokonto: 1136904-8, Nordea,
+skriv: akro + namn.<br>
+Plats: meddelas senare.<br>
+Anmälan senast 19/2 till Clara, claravara00@yahoo.se<br>
+<br>
+Begränsat antal platser. Först till kvarn!<br>
+<br>
+<br>
+Sofia och Rebecka har arbetat tillsammans sedan år 2000. De träffades
+på Nordens dåvarande enda cirkusgymnasium i Gävle och utbildade sig
+sedan i Köpenhamn på AFUK, Akademiet för Utaemet Kreativitet -
+Artistlinien, med parakrobatik som huvuddiciplin. Sedan följde en
+treårig
+utbildning" Centre des Arts du Cirque de Lomme-Et vous trouvez ca
+drole!!!" i Lille, Frankrike. 2003 startade de nycirkusföretaget
+"Stint"
+tillsammans och de jobbar nu som frilansande cirkusartister främst i
+Frankrike.<br>
+<br>
+Med Rebecka som överman och Sofia som underman kör de både liggande och
+stående parakrobatik, spänningsövningar, huvud- och handhandbalanser.
+Tillsammans har de jobbat ihop flera olika akter á 5 minuter. Däribland
+hittar man kvinnlig styrka och pur pondus, komisk vardagstristess,
+hisnande teknik och tyngdpunkt i relationerna mellan människor och
+samhällets uppochned vända verklighet, ur ett verkligt uppochnedvänt
+perspektiv. Sedan år 2006 har fokuset flyttats mer och mer åt
+improvisationshållet, parakrobatikimprovisation i samarbete med fri
+improviserad musik och kontaktimprovisation.<br>
+<a href="http://www.stint.nu" target=blank><u>www.stint.nu</u></a><br>
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 24 Februari<br>
+<span class="mellanrubrik">
+Musikjam!</span><br>
+kl 19-21, 30 kr<br>
+<br>
+Denna söndag kommer inga inhyrda musiker till jammet,
+utan då det är vi själva som står för musiken!<br>
+<br>
+Så alla som kan och vill -ta med er instrument eller
+andra ljudframbringande prylar. Att använda sin röst går förståss
+också bra.<br>
+<br>
+Vill man inte musisera så dansar man som vanligt.
+(..och därför kostar det bara 30 kr, då vi inte har några musiker som
+ska betalas)<br>
+<br>
+VÄLKOMNA!
+</td>
+</tr>
+ -->
+ <tr>
+ <td class="kalendariecell">
+ Söndag 2 Mars<br />
+ <span class="mellanrubrik">Nybörjarintroduktion &
+ Jam med Karin R och Jenny</span><br />
+ Kl. 19-21, 30 kr.
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 9 Mars<br />
+ <span class="mellanrubrik">Blind fold jam - jam med
+ ögonbindel!</span><br />
+ ... med Sofi och Tove. Kl 19-21, 30 kr<br />
+ På ett blind fold jam dansar man med ögonen förbundna,
+ för att öka känsligheten, lyssnandet och samspelet. Det
+ är också ett sätt att försöka komma förbi
+ föreställningar man (medvetet eller omedvetet) har runt
+ vem man väljer att dansa med. Det blir i slutändan en
+ spegling till en själv om de val man gör på dansgolvet,
+ där kroppen denna gång får bestämma i stället för
+ huvudet. Vi inleder som vanligt med en introduktion.
+ Tag gärna med egen ögonbindel!<br />
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 16 Mars<br />
+ <span class="mellanrubrik">Introduktion och
+ jam</span><br />
+ 19-21, 30 kr<br />
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 23 Mars<br />
+ <span class="mellanrubrik">Ingenting här för då är vi
+ på NIM i Köpenhamn!
+ <!-- Introduktion och jam</span><br> -->
+ <!-- 19-21, 30 kr<br> --></span>
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen den 30:e<br />
+ <span class="mellanrubrik">Kort introduktion och
+ Livejam!!</span><br />
+ 19-21, 50 kr<br />
+ </td>
+ </tr>
+ </table>
+ </div>
+ </body>
+</html>
--- /dev/null
+(nxml-scan-element-backward 6407 nil 2407)
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>
+ Kimpro Malmö & Sydsverige - AKTUELLT I MALMÖ
+ </title>
+ <link href="textmall.css" rel="stylesheet" type="text/css" />
+ <link href="layout.css" rel="stylesheet" type="text/css" />
+ </head>
+ <body>
+ <div class="kolumn1">
+ <span class="rubrik">Aktuellt våren 2008</span><br />
+ <i>Välkommen till dansens magiska universum!</i><br />
+ Här i kalendariet kan du se vad som händer i kimprosammanhang
+ just nu. De arrangemang med rosa botten är utöver våra
+ vanliga söndags-träffar i Malmö. Vill du veta mer om de olika
+ verksamheterna, ta en titt under <u><a href=
+ "index_verksamhet.html" target="index3s">Verksamhet</a>.
+ <b>OBS!</b> Notera att vi bytt danstid till kl 19-21! Detta
+ gäller endast en period nu i vår.<br />
+ <br /></u><b>Mars</b>
+ <table width="370" cellspacing="5">
+ <!--
+ <tr>
+ <td class="kalendariecell_special">
+ <img src="grafik/aktuelltbild_januari.jpg" border=0><br>
+ <i>Några av oss som dansar i Malmö</i><br>
+
+<span class="mellanrubrik">
+<br>
+<b>OBS: Ny tid!</b><br></span>
+Vi har ny tid för dansen på söndagar! 19-21 är nya tiden som gäller en tid framöver. <br>
+<br>
+
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 6 Januari<br>
+<span class="mellanrubrik">
+Grundklass & Jam</span><br>
+Årets första nybörjarintro! Kl. 17-19, 30 kr.
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 13 Januari<br>
+<span class="mellanrubrik">
+Introduktion & Jam</span><br>
+Kl. 17-19, 30 kr.
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 20 Januari<br>
+<span class="mellanrubrik">
+Introduktion & Jam</span><br>
+Kl. 17-19, 30 kr.
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 27 Januari<br>
+<span class="mellanrubrik">
+Introduktion & Jam</span><br>
+Kl. 17-19, 30 kr.
+</td>
+</tr>
+
+<tr>
+<td class="kalendariecell_special">
+<b>23-24 februari</b><br>
+<span class="mellanrubrik">WORKSHOP I AKROBATIK
+FÖR KONTAKTIMPROVISATÖRER</span><br>
+<br>
+Två parakrobater, Sofia och Rebecka, bosatta i Frankrike kommer till
+Malmö
+för att hålla en workshop speciellt för Kimpro Malmö!
+Workshopen kommer handla om hur man kan använda akrobatik i
+kontaktimprovisation. Inga förkunskaper i akrobatik behövs.<br>
+<br>
+23-24/2, kl.13-16 båda dagarna.<br>
+Kostnad: 350 kr.<br>
+Betalas senast den 21/2 till plusgirokonto: 1136904-8, Nordea,
+skriv: akro + namn.<br>
+Plats: meddelas senare.<br>
+Anmälan senast 19/2 till Clara, claravara00@yahoo.se<br>
+<br>
+Begränsat antal platser. Först till kvarn!<br>
+<br>
+<br>
+Sofia och Rebecka har arbetat tillsammans sedan år 2000. De träffades
+på Nordens dåvarande enda cirkusgymnasium i Gävle och utbildade sig
+sedan i Köpenhamn på AFUK, Akademiet för Utaemet Kreativitet -
+Artistlinien, med parakrobatik som huvuddiciplin. Sedan följde en
+treårig
+utbildning" Centre des Arts du Cirque de Lomme-Et vous trouvez ca
+drole!!!" i Lille, Frankrike. 2003 startade de nycirkusföretaget
+"Stint"
+tillsammans och de jobbar nu som frilansande cirkusartister främst i
+Frankrike.<br>
+<br>
+Med Rebecka som överman och Sofia som underman kör de både liggande och
+stående parakrobatik, spänningsövningar, huvud- och handhandbalanser.
+Tillsammans har de jobbat ihop flera olika akter á 5 minuter. Däribland
+hittar man kvinnlig styrka och pur pondus, komisk vardagstristess,
+hisnande teknik och tyngdpunkt i relationerna mellan människor och
+samhällets uppochned vända verklighet, ur ett verkligt uppochnedvänt
+perspektiv. Sedan år 2006 har fokuset flyttats mer och mer åt
+improvisationshållet, parakrobatikimprovisation i samarbete med fri
+improviserad musik och kontaktimprovisation.<br>
+<a href="http://www.stint.nu" target=blank><u>www.stint.nu</u></a><br>
+</td>
+</tr>
+<tr>
+<td class="kalendariecell">
+Söndag 24 Februari<br>
+<span class="mellanrubrik">
+Musikjam!</span><br>
+kl 19-21, 30 kr<br>
+<br>
+Denna söndag kommer inga inhyrda musiker till jammet,
+utan då det är vi själva som står för musiken!<br>
+<br>
+Så alla som kan och vill -ta med er instrument eller
+andra ljudframbringande prylar. Att använda sin röst går förståss
+också bra.<br>
+<br>
+Vill man inte musisera så dansar man som vanligt.
+(..och därför kostar det bara 30 kr, då vi inte har några musiker som
+ska betalas)<br>
+<br>
+VÄLKOMNA!
+</td>
+</tr>
+ -->
+ <tr>
+ <td class="kalendariecell">
+ Söndag 2 Mars<br />
+ <span class="mellanrubrik">Nybörjarintroduktion &
+ Jam med Karin R och Jenny</span><br />
+ Kl. 19-21, 30 kr.
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 9 Mars<br />
+ <span class="mellanrubrik">Blind fold jam - jam med
+ ögonbindel!</span><br />
+ ... med Sofi och Tove. Kl 19-21, 30 kr<br />
+ På ett blind fold jam dansar man med ögonen förbundna,
+ för att öka känsligheten, lyssnandet och samspelet. Det
+ är också ett sätt att försöka komma förbi
+ föreställningar man (medvetet eller omedvetet) har runt
+ vem man väljer att dansa med. Det blir i slutändan en
+ spegling till en själv om de val man gör på dansgolvet,
+ där kroppen denna gång får bestämma i stället för
+ huvudet. Vi inleder som vanligt med en introduktion.
+ Tag gärna med egen ögonbindel!<br />
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 16 Mars<br />
+ <span class="mellanrubrik">Introduktion och
+ jam</span><br />
+ 19-21, 30 kr<br />
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen 23 Mars<br />
+ <span class="mellanrubrik">Ingenting här för då är vi
+ på NIM i Köpenhamn!
+ <!-- Introduktion och jam</span><br> -->
+ <!-- 19-21, 30 kr<br> --></span>
+ </td>
+ </tr>
+ <tr>
+ <td class="kalendariecell">
+ Söndagen den 30:e<br />
+ <span class="mellanrubrik">Kort introduktion och
+ Livejam!!</span><br />
+ 19-21, 50 kr<br />
+ </td>
+ </tr>
+ </table>
+ </div>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ </head>
+ <body>
+ For testing fontification.
+ </body>
+</html>
--- /dev/null
+<?php\r
+include 'header.php';\r
+if (dff) {\r
+ thank();\r
+ // Bad indentation on next line?\r
+ }\r
+for (;;) {\r
+ you();\r
+}\r
+?>\r
--- /dev/null
+ <html>
+{% extends "base.html" %}
+<head>
+<title>Muzikanti z lekce 4</title>
+</head>
+<body>
+<table>
+some text not within django block
+{# some comment else #}
+{% for muzikant in people %}
+<tr>
+<td>
+{{ muzikant.name }}
+<b>
+{% comment %}
+something else
+{% if muzikant.nemamezeru %}*{% endif %} {% endcomment %}
+</b>
+</td>
+<td>
+<i {% if muzikant.ma_duraz %} style="font-weight: bold;"{% else %}{% endif %}>
+{{ muzikant.genre|rjust|lower }}
+</i>
+</td>
+</tr>
+{% endfor %}
+</table>
+{% get_current_time "%Y-%M-%d %I:%M %p" as my_current_time %}
+<p>The current time is {{ my_current_time }}.</p>
+</body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ </head>
+ <body>
+ <img alt="ALT" src="<?php some_code("txt"); ?>" />
+ </body>
+</html>
--- /dev/null
+<table>
+<tr>
+<td>
+<table>
+<tr>
+<td>Hello</td>
+</tr>
+<?php
+for ($i=1;$i<5; $i++) {
+if (1) {
+}
+if (1) {
+if (1) {
+if (1) {
+?>
+<tr>
+<td>
+<p>the brace below (should have 2 spaces in front of it!)</p>
+</td>
+</tr>
+<?php
+}
+}
+$foo = "test".bar;
+for ($i=1;$i<5; $i++) {
+if () {
+}
+}
+}
+}
+?>
+</table>
+</td>
+</tr>
+</table>
--- /dev/null
+<table>
+
+
+<!--Mėnesio pasirinkimas -->
+
+<tr>
+ <td width='50' colspan='1' class='men-met'>
+ <input type='button' value=' < ' onClick='goLastMonth(<?php echo date("t", strtotime("$year1-$month1-$day1")).", ".$month . ", " . $year.", ".date("w", strtotime("$year-$month-$day1")); ?>)' />
+ </td>
+ <td width='250' colspan='5' class='men-met'>
+ <span class='title'><?php echo $men . " " . $year; ?></span><br />
+ </td>
+ <td width='50' colspan='1' align='right' class='men-met'>
+ <input type='button' value=' > ' onClick='goNextMonth(1, <?php echo $month . ", " . $year.", ".date("w", strtotime("$year2-$month2-$day1")); ?>)' />
+ </td>
+</tr>
+
+<!-- Antraštė su savaitės dienom -->
+<tr>
+ <td class='head' >Pir</td>
+ <td class='head' >Ant</td>
+ <td class='head' >Tre</td>
+ <td class='head' >Ket</td>
+ <td class='head' >Pen</td>
+ <td class='head' >Šeš</td>
+ <td class='head' style="color: red;" >Sek</td>
+</tr>
+</table>
--- /dev/null
+#!/bin/ksh
+. /bin/shared/.mkt.cfg
+
+
+STORE_TMP=/tmp/stores.txt
+cd /spool/xml
+
+rm -f $STORE_TMP
+
+bteq << EOF
+.SESSIONS 1
+.LOGON $UserId,$Password;
+
+.EXPORT DATA FILE "$STORE_TMP"
+select division_id,store_id,
+trim(store)||' '||trim(store_addr_line2_txt)||', '||
+trim(store_city)
+from stores
+where status_id='A'
+ and division_id in (517,1920,2445)
+order by division_id,store_city,store_id;
+
+.EXIT 0
+EOF
+
+perl <<EOF > $1
+print qq(<?xml version="1.0" encoding="utf-8"?>\n<stores>);
+open IN, '<$STORE_TMP';
+while (read IN,\$info, 12) {
+ my (\$div, \$s) = unpack 'x2 i i', \$info; # read binary nums
+ \$_ = <IN>; # Read store name
+ chop; # Remove newline
+ s/(\w+)/\u\L\$1/g; # Title case
+ s/&/&/g; # Fix ampersands
+ s/"/"/g; # Fix quotes
+ printf qq(<s d="%02d" i="%d" n="%s"/>\n),\$div,\$s,\$_;
+}
+print "</stores>";
+EOF
+
+rm $STORE_TMP
--- /dev/null
+\r
+<h1><div class="pagetitle"><?php echoMessage("website.title");?></div></h1>\r
+\r
+<img class="indeximage1" src="images/indeximage1.jpg"/>\r
+\r
+<div class="textcontainer latestnewscontainer">\r
+\r
+ <div class="indexspecialevent">\r
+ <?php $numrows=displaySpecialEvent("nextevent");?>\r
+ </div>\r
+\r
+ <div class="pubquizpreview">\r
+ <div>\r
+ <h3>\r
+ <?php echo createLink("pubquiz","pubquiz.comingnext");?>\r
+ </h3>\r
+ </div>\r
+ <div>\r
+ <?php previewEvents("pubquiz");?>\r
+ </div>\r
+ </div>\r
+\r
+ <div class="latestnewstitle">\r
+ <?php\r
+ echoMessage("index.latest.title");\r
+ ?>\r
+ </div>\r
+ <div class="latestnewsbody">\r
+ <?php echoMessage("index.latest.body");?>\r
+ <?php include("menu.php");?>\r
+ </div>\r
+</div>\r
+\r
+<div class="textcontainer" title="English Books Hamburg">\r
+\r
+ <div>\r
+ <?php echoMessage("index.about1");?>\r
+ </div>\r
+\r
+ <div>\r
+ <h2>\r
+ <?php echo createLink("general","index.whatsnew");?>\r
+ </h2>\r
+ </div>\r
+\r
+ <div>\r
+ <img class="newsimage" src="images/newsimage1.jpg"/>\r
+ </div>\r
+\r
+ <div>\r
+ <?php echoMessage("index.news.n1");?>\r
+ </div>\r
+ <div>\r
+ <?php echoMessage("index.news.about2");?>\r
+ </div>\r
+\r
+</div>\r
--- /dev/null
+<div src="hello"></div>\r
+<img alt="angry" src="hello.gif"/>\r
--- /dev/null
+<?php require_once("utils.php"); ?>
+
+<?php echo '<?xml version="1.0" encoding="utf-8"/?/>'; ?>
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+
+<head>
+
+ <link type="text/css" href="stylesheet.css" rel="stylesheet" title="Style Sheet" />
+ <link type="text/css" href="custom.css" rel="stylesheet" title="Style Sheet" />
+
+ <title><?php echoMessage("website.title")?></title>
+
+ <meta name="keywords" content="irish bar,irish pub,finnegans wake , hamburg"/>
+ <meta name="description" content="Finnegans Wake Irish Pub"/>
+
+ <style type="text/css">@import url(calendar-win2k-1.css);</style>
+ <script type="text/javascript" src="jscalendar-1.0/calendar.js"></script>
+ <script type="text/javascript" src="jscalendar-1.0/lang/calendar-en.js"></script>
+ <script type="text/javascript" src="jscalendar-1.0/calendar-setup.js"></script>
+
+
+</head>
+
+<body class="body" title="Irish Bar">
+
+ <div class="webcontainer">
+
+ <div class="headerbanner">
+ <img src="images/banner.gif" alt="Irish Bar"/>
+ </div>
+
+ <div class="logo">
+ <img src="images/logo.gif" alt="Irish Pubs"/>
+ </div>
+
+ <div>
+ <?php include("navigation.php");?>
+ </div>
+
+ <?php
+ if(isDemo()){
+ echo '<div class="demomode">';
+ echoMessage("admin.demo");
+ echo "</div>";
+ }
+
+ include("address.php");
+ include("sportpreview.php");
+
+ ?>
+
+ <div class="centercontainer" title="Irish Pubs Germany">
--- /dev/null
+<?php require_once("utils.php"); ?>
+
+<?php echo '<?xml version="1.0" encoding="utf-8"/?/>'; ?>
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+
+<head>
+
+ <link type="text/css" href="stylesheet.css" rel="stylesheet" title="Style Sheet" />
+ <link type="text/css" href="custom.css" rel="stylesheet" title="Style Sheet" />
+
+ <title><?php echoMessage("website.title")?></title>
+
+ <meta name="keywords" content="irish bar,irish pub,finnegans wake , hamburg"/>
+ <meta name="description" content="Finnegans Wake Irish Pub"/>
+
+ <style type="text/css">@import url(calendar-win2k-1.css);</style>
+ <script type="text/javascript" src="jscalendar-1.0/calendar.js"></script>
+ <script type="text/javascript" src="jscalendar-1.0/lang/calendar-en.js"></script>
+ <script type="text/javascript" src="jscalendar-1.0/calendar-setup.js"></script>
+
+
+</head>
+
+<body class="body" title="Irish Bar">
+
+ <div class="webcontainer">
+
+ <div class="headerbanner">
+ <img src="images/banner.gif" alt="Irish Bar"/>
+ </div>
+
+ <div class="logo">
+ <img src="images/logo.gif" alt="Irish Pubs"/>
+ </div>
+
+ <div>
+ <?php include("navigation.php");?>
+ </div>
+
+ <?php
+ if(isDemo()){
+ echo '<div class="demomode">';
+ echoMessage("admin.demo");
+ echo "</div>";
+ }
+
+ include("address.php");
+ include("sportpreview.php");
+
+ ?>
+
+ <div class="centercontainer" title="Irish Pubs Germany">
--- /dev/null
+\r
+<h1><div class="pagetitle"><?php echoMessage("website.title");?></div></h1>\r
+\r
+<img class="indeximage1" src="images/indeximage1.jpg"/>\r
+\r
+<div class="textcontainer latestnewscontainer">\r
+\r
+ <div class="indexspecialevent">\r
+ <?php $numrows=displaySpecialEvent("nextevent");?>\r
+ </div>\r
+\r
+ <div class="pubquizpreview">\r
+ <div>\r
+ <h3>\r
+ <?php echo createLink("pubquiz","pubquiz.comingnext");?>\r
+ </h3>\r
+ </div>\r
+ <div>\r
+ <?php previewEvents("pubquiz");?>\r
+ </div>\r
+ </div>\r
+\r
+ <div class="latestnewstitle">\r
+ <?php\r
+ echoMessage("index.latest.title");\r
+ ?>\r
+ </div>\r
+ <div class="latestnewsbody">\r
+ <?php echoMessage("index.latest.body");?>\r
+ <?php include("menu.php");?>\r
+ </div>\r
+</div>\r
+\r
+<div class="textcontainer" title="English Books Hamburg">\r
+\r
+ <div>\r
+ <?php echoMessage("index.about1");?>\r
+ </div>\r
+\r
+ <div>\r
+ <h2>\r
+ <?php echo createLink("general","index.whatsnew");?>\r
+ </h2>\r
+ </div>\r
+\r
+ <div>\r
+ <img class="newsimage" src="images/newsimage1.jpg"/>\r
+ </div>\r
+\r
+ <div>\r
+ <?php echoMessage("index.news.n1");?>\r
+ </div>\r
+ <div>\r
+ <?php echoMessage("index.news.about2");?>\r
+ </div>\r
+\r
+</div>\r
--- /dev/null
+<?php require_once("utils.php");?>
+
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
+ "http://www.w3.org/TR/html4/strict.dtd">
+
+<html>
+
+<?php
+ if ($_SESSION["CurrentLanguage"]==0){
+ $_SESSION["CurrentLanguage"]=$Default_Lang;
+ }
+?>
+
+ <head>
+
+ <meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
+
+ <style type="text/css">@import url(calendar-win2k-1.css);</style>
+ <script type="text/javascript" src="jscalendar-1.0/calendar.js"></script>
+ <script type="text/javascript" src="jscalendar-1.0/lang/calendar-en.js"></script>
+ <script type="text/javascript" src="jscalendar-1.0/calendar-setup.js"></script>
+
+ <link type="text/css" href="stylesheet.css" rel="stylesheet" title="Style Sheet" >
+ <style type="text/css"><?php echoMessage("admin.css.source");?> </style>
+
+ <link type="text/css" href="custom.css" rel="stylesheet" title="Style Sheet">
+ <link type="text/css" href="local.css" rel="stylesheet" title="Style Sheet">
+
+ <link type="text/css" href="print.css" rel="stylesheet" media="print">
+
+ <meta name="keywords" content='<?php echoMessage("header.keywords");?>'>
+ <meta name="description" content='<?php echoMessage("header.description");?>'>
+
+ <title><?php echoMessage("website.title")?></title>
+
+
+ </head>
+
+ <body class="body">
+ <div class="wc">
+ <table class="language">
+<tr>
+ <td>
+ <?php generateLanguageForm(true);?>
+ </td>
+ <td><a href="cyclelanguage"><img class="languageflag" src="flags/<?php echo getCurrentLanguage();?>" alt="<?php echoMessage("language.selectnext");?>" title="<?php echoMessage("language.selectnext");?>"></a></td>
+</tr>
+ </table>
+
+ <?php include("navigation.php");?>
+ <div class="ical">
+ <?php echoMessage("index.ical");?>
+ </div>
+
+ <div class="wb">
+
+ <?php
+
+ if(adminMode()){
+ echo '<div class="admincontrolcontainer clearfix">';
+ createNavigationLinks("navlinks",1);
+ echo '<div class="clear"></div>';
+ echo '</div>';
+ }
+
+ if(isDemo()){
+ echo '<div class="demomode">';
+ echoMessage("admin.demo");
+ echo "</div>";
+ }
+
+ ?>
+
+ <?php include("previews.php");?>
+
+ <div class="centercontainer clearfix">
--- /dev/null
+<?php
+ require_once("utils.php");
+?>
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+
+ <?php if(!processLanguageURL())
+ {
+ if ($_SESSION["CurrentLanguage"]==0){
+ $_SESSION["CurrentLanguage"]=$Default_Lang;
+ }
+ }
+ ?>
+
+ <head>
+
+ <title><?php echo getMessage("website.title");?></title>
+
+ <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
+
+ <?php
+ if (AUTO_REFRESH_DELAY>0 && !adminMode())
+ echo '<meta http-equiv="refresh" content="'.AUTO_REFRESH_DELAY.'"/>';
+ ?>
+
+
+ <link type="text/css" href="jscalendar-1.0/calendar-win2k-1.css" rel="stylesheet" title="Style Sheet"/> <!-- indicate local copy -->
+ <script type="text/javascript" src="jscalendar-1.0/calendar.js"></script>
+ <script type="text/javascript" src="jscalendar-1.0/lang/calendar-en.js"></script>
+ <script type="text/javascript" src="jscalendar-1.0/calendar-setup.js"></script>
+
+
+ <link type="text/css" href="stylesheet.css" rel="stylesheet" title="Style Sheet" />
+ <link type="text/css" href="print.css" rel="stylesheet" media="print"/>
+
+ <!--[if lt IE 7]>
+ <link type="text/css" href="ie.css" rel="stylesheet" title="Style Sheet"/>
+ <link type="text/css" href="site-ie.css" rel="stylesheet" title="Style Sheet"/>
+ <![endif]-->
+
+
+ <link type="text/css" href="/custom/site.css" rel="stylesheet" title="Style Sheet"/> <!-- project custom -->
+ <style type="text/css"><?php echo htmlentities(getMessage("header.custom.css"));?> </style>
+
+
+<?php undercon();
+echoHeaderContent("keywords",curPageName());
+echoHeaderContent("description",curPageName());
+echoHeaderContent("verify-v1",curPageName());
+?>
+
+ <link rel="SHORTCUT ICON" href="favicon.ico"/>
+
+ <META NAME="AUTHOR" CONTENT="Richard G. Riley"/>
+ <meta name="copyright" content="Copyright Richard G. Riley 2009" />
+
+
+
+ </head>
+
+ <body id="body">
+
+ <div id="wcbg">
+
+ <div id="wc" class="clearfix">
+
+ <?php
+ checkWebLicense();
+ ?>
+
+ <?php
+ include("navigation.php");
+ ?>
+
+ <div id="wb">
+
+ <?php
+ if(isDemo()){
+ echo '<div class="demomode">';
+ echoMessage("admin.demo");
+ echo "</div>";
+ }
+ if(adminMode()){
+ echo '<div id="admincontrolcontainer">';
+ createNavigationLinks("navlinks",1);
+ echo '<div class="clear"></div>';
+ echo '</div>';
+ }
+ ?>
+
+ <div id="centercontainer">
+ <?php
+ if(messageMode()){
+ echo '<div class="editwebtitle">';
+ echoMessage("website.title");
+ echo '</div>';
+ }
+ ?>
+
--- /dev/null
+<div class="addresscontainer" title="Hot Love Fan Mail">
+
+<a target="_self" href="/Site/Content/Exhibitors/exhibitors-welcome.aspx"><img height="100" border="0" width="170" vspace="7" onmouseout="MM_swapImgRestore()" onmouseover="MM_swapImage('Image21','','/site/images/intro_button_exhib_over.jpg',1)" id="Image21" name="Image21" alt="Exhibitors button" src="http://www.farnborough.com/site/images/intro_button_exhib_static.jpg"/></a>
+</div>
\ No newline at end of file
--- /dev/null
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+
+<head>
+
+<script type="text/javascript" src="jscalendar-1.0/calendar.js"></script>
+<script type="text/javascript" src="jscalendar-1.0/lang/calendar-en.js"></script>
--- /dev/null
+{include file="library/header.tpl"}
+
+{* comment *}
+
+{literal}
+<script language="JavaScript" type="text/javascript">
+function validate_form(f){
+ allElements = f.getInputs('text');
+ var get_time = /^times\[(.+)\]$/;
+ var get_date = /^dates\[(.+)\]$/;
+ for(var index=0; index < allElements.length; ++index){
+ var item = allElements[index];
+ if(get_time.test(item.name)){
+ if($F(item)){
+ var key = get_time.exec(item.name)
+ var sibling_date = 'dates[' + key[1] + ']';
+ if(! $F(sibling_date)){
+ alert("Date is required if entering a manual time!");
+ $(sibling_date).addClassName('problem');
+ return false;
+ }
+ }
+
+ }
+ }
+ else if(get_date.test(item.name)){
+ if($F(item)){
+ var key = get_date.exec(item.name)
+ var sibling_time = 'times[' + key[1] + ']';
+ if(! $F(sibling_time)){
+ alert("Time is required if entering a manual date!");
+ $(sibling_time).addClassName('problem');
+ return false;
+ }
+ }
+ }
+ return true;
+}
+
+function validate_date( el )
+{
+ var date = /^\d\d\d\d-\d\d-\d\d$/;
+ if ( !date.test(el.value) ) {
+ alert('The date you have entered is not properly formatted (yyyy-mm-dd). Please re-enter it.');
+ el.value='';
+ el.focus();
+ el.className='problem';
+ return false;
+ }
+ el.className='';
+ return true;
+}
+
+function validate_time( el )
+{
+ var time = /^\d\d:\d\d$/;
+ if ( !time.test(el.value) ) {
+ alert('The time you have entered is not properly formatted (hh:mm). Please re-enter it.');
+ el.value='';
+ el.focus();
+ el.className = 'problem';
+ return false;
+ }
+ el.className = '';
+ return true;
+}
+</script>
+
+<style type="text/css">
+ foo: {
+ font-weight: bold;
+ color: #F00;
+ }
+</style>
+{/literal}
+
+{if $containers|@count }
+
+<form name="test" method=post onsubmit="return validate_form(this);">
+<input type="hidden" name="date" value="{$smarty.request.date}">
+<input type="hidden" name="page_name" value="{$page_name}" />
+
+<table frame="void" bordercolor="#000000" rules="cols" class="data" style="float:center;">
+<thead>
+<tr class="sortHeader">
+ {if $goahead}
+ <th onclick="sortTable(this)">{t}Date{/t}<br /><span class="ex">YYYY-MM-DD</span></th>
+ {/if}
+ {if $goahead}
+ <th onclick="sortTable(this)">{t}Time{/t}<br /><span class="ex">HH:MM</span></th>
+ {/if}
+
+ <th onclick="sortTable(this)">{t}Quantity{/t}</th>
+</tr>
+</thead>
+
+{foreach from=$widgets item="widget"}
+<tbody class="{cycle values=",highlight}" ondblclick="return insertHeader(this);">
+ {if $widget->date != $today}
+ {assign var=newday value=true}
+ {assign var=today value=$widget->date}
+ {else}
+ {assign var=newday value=false}
+ {/if}
+
+<tr class="{if $newday}group{/if}">
+ {if $goahead}
+ {if $widget->activity_allowed}
+ <td class="ctext"><input type="text" value="" onchange="validate_date(this, this.form );" name="dates[{$widget->widget_id_for_web}]" id="dates[{$widget->widget_id_for_web}]" size=10 maxlength=10></td>
+ {else}
+ <td></td>
+ {/if}
+ {/if}
+
+ {if $goahead}
+ {if $widget->activity_allowed}
+ <td class="ctext"><input type="text" value="" onchange="validate_time(this, this.form);" name="times[{$widget->widget_id_for_web}]" id="times[{$widget->widget_id_for_web}]"size=5 maxlength=5></td>
+ {else}
+ <td></td>
+ {/if}
+ {/if}
+
+ <td>{$widget->quantity}</td>
+</tr>
+</tbody>
+{/foreach}
+</table>
+
+<hr />
+ {if $goahead}
+ <br />
+ <b>{t}Note{/t}:</b> {t}Changes may not occur immediately.{/t}
+ <br />
+ <input type=submit value="Update Widgets">
+ {/if}
+
+ </form>
+{else}
+ {t}There are no widgets on this day{/t}
+{/if}
+
+{literal}
+<hr/>test
+
+<p>Paragraph</p>
+{/literal}
+
+{include file="library/footer.tpl"}
--- /dev/null
+<script language="javascript" type="text/javascript">
+//<!--
+{literal}
+$('account').observe("change", function(event) {should_get_account_data(
+'first', 'acct' );});
+$('desc').observe("change", function(event) {should_get_account_data(
+'first', 'name' );});
+{/literal}
+{if $autocomplete}
+{literal}
+document.observe("dom:loaded", function(event)
+{auto_complete_customers('first', 'acct');});
+document.observe("dom:loaded", function(event)
+{auto_complete_customers('first', 'name');});
+{/literal}
+{/if}
+//-->
+</script>
--- /dev/null
+<?xml version="1.0"?>\r
+<locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0">\r
+</locatingRules>\r
--- /dev/null
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">\r
+<html>\r
+ <head>\r
+ <style type="text/css">\r
+ table {\r
+ border-collapse: collapse;\r
+ }\r
+ </style>\r
+ </head>\r
+ <body>\r
+ <h1><?= $title ?></h1>\r
+ </body>\r
+</html>\r
+\r
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>PostFinance - Home</title>
+<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1" />
+<meta http-equiv="Content-Style-Type" content="text/css" />
+<meta name="description" content="" />
+<meta name="keywords" content="" />
+<meta name="language" content="en" />
+<meta name="copyright" content="Copyright (c) by PostFinance" />
+<meta name="robots" content="all" />
+<link rel="canonical" href="http://www.postfinance.ch/pf/content/en" />
+
+
+
+<meta name="WT.pf_nav_L1" content="HOMEPAGE" />
+<meta name="WT.pf_nav_L2" content="" />
+<meta name="WT.pf_nav_L3" content="" />
+
+
+<!-- WT meta tag library 0.0.30 -->
+<!-- Execution time: 0ms -->
+<script type="text/javascript">
+var aWtAdviews = new Array();
+var aWtTags = new Array();
+</script>
+
+
+<link rel="stylesheet" href="./../../../staticcontent/css/styles.css" type="text/css" media="screen,print" />
+
+<!--[if IE 6]>
+<link rel="stylesheet" href="./../../../staticcontent/css/styles_ie6.css" type="text/css" media="screen,print" />
+<![endif]-->
+
+<!--[if IE 7]>
+<link rel="stylesheet" href="./../../../staticcontent/css/styles_ie7.css" type="text/css" media="screen,print" />
+<![endif]-->
+
+<link rel="stylesheet" href="./../../../staticcontent/css/bok.css" type="text/css" media="screen,print" />
+<link rel="stylesheet" href="./../../../staticcontent/css/print.css" type="text/css" media="print" />
+
+
+
+
+</head><body>
+
+ <!-- WT1 start -->
+<script type="text/javascript" src="./../../../staticcontent/js/webtrends.js"></script>
+<noscript>
+<img alt="" style="border:none;" name="DCSIMG" width="1" height="1" src="/dcsez1c8510000g4ydy8x63gm_3g9z/njs.gif?dcsuri=/nojavascript&WT.js=No&WT.tv=8.6.2"/>
+</noscript>
+<script type="text/javascript">
+<!--
+var _tag=new WebTrends();
+_tag.domain = window.location.hostname;
+_tag.dcsid = "dcsez1c8510000g4ydy8x63gm_3g9z";
+_tag.fpcdom = ".postfinance.ch";
+_tag.dcsGetId();
+//-->
+</script>
+<!-- WT1 end -->
+
+
+
+
+
+
+
+
+
+<script type="text/javascript" src="./../../../staticcontent/js/old/util.js"></script>
+<script type="text/javascript" src="./../../../staticcontent/js/old/AJAXService.js"></script>
+<script type="text/javascript" src="./../../../staticcontent/js/old/engine.js"></script>
+
+<script type="text/javascript">document.documentElement.className+=" js";</script>
+<script type="text/javascript" src="./../../../staticcontent/js/jquery-1.2.6.min.js"></script>
+<script type="text/javascript" src="./../../../staticcontent/js/jquery.bgiframe.pack.js"></script>
+<script type="text/javascript" src="./../../../staticcontent/js/definitions.js"></script>
+<script type="text/javascript" src="./../../../staticcontent/js/main.js"></script>
+<script type="text/javascript" src="./../../../staticcontent/js/tabbed.js"></script>
+<script type="text/javascript" src="./../../../staticcontent/js/aria.js"></script>
+<script type="text/javascript" src="./../../../staticcontent/js/tooltip2.js"></script>
+
+
+
+<script type="text/javascript">
+//<![CDATA[
+// SubContentGroup
+_tag.WT.cg_s='_home';
+//]]>
+</script>
+
+
+<div id="page">
+ <div id="header" class="header-en">
+ <!-- Skip Navigation Start -->
+
+
+
+<h1>Navigation of PostFinance.ch</h1>
+<ul id="skipLinks">
+ <li>
+ <a accesskey="1" href="#navTopRoot" title="Directly to the navigation">Navigation</a>
+ </li>
+ <li>
+ <a accesskey="2" href="#mainContent" title="Directly to the content">Content</a>
+ </li>
+ <li>
+ <a accesskey="3" href="/pf/ref/de/seg/bridge/nav/efinoverview.html" title="Directly to E-Finance">E-Finance</a>
+ </li>
+ <li>
+ <a accesskey="4" href="/pf/content/en/service/sitemap.html" title="Directly to the sitemap">Sitemap</a>
+ </li>
+</ul>
+
+
+
+
+
+<!-- Logo/Claim Start --><a accesskey="0" href="/pf/content/en.html" id="pfLogo">PostFinance, Swiss Post</a><p id="pfClaim" class="pfClaim-en"><strong>Surpassing support</strong></p>
+<!-- Logo/Claim End -->
+
+ <!-- Skip Navigation End -->
+
+ <h2>Language, tools and important links</h2>
+ <!-- Language Selector Start -->
+<div id="languageSelector"><ul><li class="first-child "><a href="/pf/content/de.html"><abbr xml:lang="de">de</abbr></a></li><li ><a href="/pf/content/fr.html"><abbr xml:lang="fr">fr</abbr></a></li><li ><a href="/pf/content/it.html"><abbr xml:lang="it">it</abbr></a></li><li class="selected"><a href="/pf/content/en.html"><abbr xml:lang="en">en</abbr></a></li></ul></div>
+<!-- Language Selector End -->
+
+
+
+
+ <!-- globalNavRoot Start -->
+ <div id="globalNavRoot">
+
+
+
+
+<div class="globalLinks"><p><a href="http://www.post.ch/en/" rel="external">Swiss Post</a></p>
+
+
+<ul class="serviceLinks"><li class="first-child"><a href="/pf/content/en/service/contact.html">Contact</a></li><li><a href="/pf/content/en/service/sitemap.html">Sitemap</a></li></ul></div>
+ </div>
+ <!-- globalNavRoot End -->
+
+ <!-- Suche start --><form action="/pf/content/en/single/search.html" method="get" id="searchform"><div id="search"><label for="searchfield">Search</label><input value="" maxlength="2048" type="text" class="search-field" name="query" id="searchfield" /><input value="Search" type="submit" class="search-button" name="searchsubmit" /><input value="/content/pf/content/en" type="hidden" name="nav" /></div></form><!-- Suche end -->
+
+
+
+<!-- Topnavigation start --><div id="topNav"><a name="navTopRoot"></a><h2 class="hd">Main navigation</h2><ul class="top-nav-links"><li><a href="/pf/content/en/seg/priv.html">Private customers</a></li><li><a href="/pf/content/en/seg/biz.html">Business customers</a></li><li><a href="/pf/content/en/seg/about.html">About us</a></li></ul>
+ <div class="user-login">
+
+ </div>
+</div>
+<!-- end navTop -->
+
+ </div>
+ <div id="mainArea">
+ <div class="hp-split">
+ <div id="content">
+ <div class="mood-home" style="background: transparent url(/content/pf/content/en.parsys-0001-Image.0.0.0.mainImage1.jpg) no-repeat scroll 0 0; z-index: 100000;">
+<span class="hidden">
+ <a href="https://e-finance.postfinance.ch/ef/secure/html/">
+ E-finance login
+ </a>
+</span>
+</div>
+
+<div class="tri-split">
+ <div class="col col0">
+ <div class="mod"><a name="mainContent"></a>
+ <h2 class="hd"><a href="/pf/content/en/seg/priv.html" rel="nofollow" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Private');">Private customers</a></h2>
+ <div class="bd">
+ <p>Everything you need <br/>for your private finances.</p>
+ <ul class="list-links"><li><a href="/pf/content/en/seg/priv/prod.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Products_priv');">Products<span class="hidden">Private customers</span></a></li><li><a href="/pf/content/en/seg/priv/customer.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Customer_priv');">Customer Service<span class="hidden">Private customers</span></a></li><li><a href="/pf/ref/de/seg/bridge/nav/efinoverview.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_E-finance');">E-finance</a></li><li><a href="/pf/content/en/seg/priv/etrade.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_E-trading');">E-trading</a></li></ul>
+ </div>
+ </div>
+ </div>
+ <div class="col col1">
+ <div class="mod">
+ <h2 class="hd"><a href="/pf/content/en/seg/biz.html" rel="nofollow" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Business');">Business customers </a></h2>
+ <div class="bd">
+ <p>Everything you need <br/>for your business finances.</p>
+ <ul class="list-links"><li><a href="/pf/content/en/seg/biz/product.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Products_biz');">Products<span class="hidden">Business customers </span></a></li><li><a href="/pf/content/en/seg/biz/customer.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Customer_biz');">Customer Service<span class="hidden">Business customers </span></a></li><li><a href="/pf/content/en/seg/biz/offer/startup.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_startup');">Company founder and start-up company<span class="hidden">Business customers </span></a></li><li><a href="/pf/content/en/seg/biz/offer/sbiz.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_sbiz');">Small and medium-sized enterprises</a></li><li><a href="/pf/content/en/seg/biz/offer/smbiz.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_smbiz');">Medium-sized/large businesses</a></li><li><a href="/pf/content/en/seg/biz/offer/publicentity.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Public');">Public entities</a></li><li><a href="/pf/content/en/seg/biz/offer/club.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Associations');">Associations</a></li><li><a href="/pf/content/en/seg/biz/offer/bank.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Banks');">Banks</a></li></ul>
+ </div>
+ </div>
+ </div>
+ <div class="col col2">
+ <div class="mod">
+ <h2 class="hd"><a href="/pf/content/en/seg/about.html" rel="nofollow" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Aboutus');">About us</a></h2>
+ <div class="bd">
+ <p>Key facts about PostFinance.</p>
+ <ul class="list-links"><li><a href="/pf/content/en/seg/about/pf.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Company');">Company</a></li><li><a href="/pf/content/en/seg/about/media.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Media');">Media</a></li><li><a href="/pf/content/en/seg/about/job.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Jobs');">Jobs</a></li><li><a href="/pf/content/en/seg/about/event.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_Events');">Events</a></li></ul>
+ </div>
+ </div>
+ </div>
+</div>
+ </div>
+
+ <!-- serviceArea Start -->
+ <div id="serviceArea">
+ <h1>Related content</h1>
+ <div class="mod nofoot"><h2 class="hd">E-Services</h2><div class="bd"><ul class="list-links"><li><a href="/pf/ref/de/seg/bridge/nav/efinloginhomeen.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_le_home_LoginE-Finance');">Login E-Finance</a></li><li><a href="/pf/ref/de/seg/bridge/etrade/loginen.html" title="" onmousedown="_tag.dcsAdTrack('WT.ac', '_li_home_LoginE-Trading');">Login E-Trading</a></li></ul></div></div>
+ <!-- Kudicontainer -->
+ <div id="AJAX_Teaser" lang="en"><div class="mod nofoot teaser one-click"><h2 class="hd">
+<a href="/pf/content/en/seg/priv/prod/eserv/etrade/promotion.html" title="More information about the offer." onmousedown="_tag.dcsAdTrack('WT.ac', 'PK952_APK_TE_A_EN_L0_A_Homepage_1_en', 'WT.mc_id', 'PK952', 'WT.mc_ev', 'click');">E-trading</a></h2>
+<p class="bd">
+<a href="/pf/content/en/seg/priv/prod/eserv/etrade/promotion.html" title="More information about the offer." onmousedown="_tag.dcsAdTrack('WT.ac', 'PK952_APK_TE_A_EN_L0_A_Homepage_1_en', 'WT.mc_id', 'PK952', 'WT.mc_ev', 'click');"><img src="/staticcontent/teasers/content/_etc_medialib_pf_de_teaser_camp_2009_pk952_Par_0009_Image.jpg" alt="" /><span class="hidden"> More information about the offer.</span>
+<span>No brokerage fees until the end of January 2010.*
+ <em>More</em></span></a></p></div><div class="mod nofoot teaser one-click"><h2 class="hd">
+<a href="/pf/content/en/seg/bcase/lohnkonto.html" title="More information on the salary account" onmousedown="_tag.dcsAdTrack('WT.ac', 'PK920_APK_TE_A_EN_L0_A_Homepage_2_en', 'WT.mc_id', 'PK920', 'WT.mc_ev', 'click');">Competition</a></h2>
+<p class="bd">
+<a href="/pf/content/en/seg/bcase/lohnkonto.html" title="More information on the salary account" onmousedown="_tag.dcsAdTrack('WT.ac', 'PK920_APK_TE_A_EN_L0_A_Homepage_2_en', 'WT.mc_id', 'PK920', 'WT.mc_ev', 'click');"><img src="/staticcontent/teasers/content/_content_teaser_content_en_seg_running_kampagnen_ci_pk920_pfch_parsys_0001_Image.jpg" alt="" /><span class="hidden"> More information on the salary account</span>
+<span>Double your income: switch your salary account to PostFinance.
+ <em>More</em></span></a></p></div>
+<script type="text/javascript"> aWtTags[aWtTags.length] = "WT.pf_nav_L1"; aWtTags[aWtTags.length] = "HOMEPAGE"; aWtTags[aWtTags.length] = "WT.ad"; aWtTags[aWtTags.length] = "PK952_APK_TE_A_EN_L0_A_Homepage_1_en;PK920_APK_TE_A_EN_L0_A_Homepage_2_en"; aWtTags[aWtTags.length] = "WT.pf_logstatus"; aWtTags[aWtTags.length] = "anonym"; aWtTags[aWtTags.length] = "WT.pf_segment"; aWtTags[aWtTags.length] = "anonym"; aWtTags[aWtTags.length] = "WT.cg_n"; aWtTags[aWtTags.length] = "PF HOME anonym"; aWtTags[aWtTags.length] = "WT.pf_pagetype"; aWtTags[aWtTags.length] = "L0_A_Homepage"; </script></div>
+ </div>
+
+ </div>
+ </div>
+</div>
+
+
+<!-- Footer start --><div id="footer"><h1>References</h1><ul id="footerLinks"><li><a href="/pf/content/en/footer/access.html">Accessibility</a></li><li><a href="/pf/content/en/footer/legal.html">Legal disclaimer</a></li><li><a href="/pf/content/en/footer/cond.html">Prices/Conditions/GTC</a></li><li><a href="/pf/content/en/footer/impressum.html">Publishing details</a></li></ul><!-- Footernavigation end -->
+<p>Copyright (c) 2009 by PostFinance. All rights reserved.</p>
+</div><!-- Footer end -->
+
+
+
+
+
+
+
+
+
+
+<script type="text/javascript">
+ if (typeof(_tag) != "undefined") {
+ _tag.dcsCollect();
+ }
+</script>
+
+
+
+</body>
+</html>
+
--- /dev/null
+<?php\r
+/**\r
+ *\r
+ * @param string $name\r
+ */\r
+ public function setName($name) {\r
+ $this->name = $name;\r
+ }\r
+?>\r
--- /dev/null
+<? $foo=1 ?>, <?= "bla" ?>
+ instead of
+<?php $foo=1 ?>, <?php echo "bla" ?>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ </head>
+ <body>
+ <?>
+ </body>
+</html>
--- /dev/null
+<p id="msg"></p>
+<script runat="server">
+ var nme = document.createTextNode(
+ "Hello my name is Jaxer.");
+ var para = document.getElementById("name");
+ para.appendChild(nme);
+</script>
+
+<p>Hello, my name is <% response.name %>.</p>
--- /dev/null
+ <?= "bla" ?>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ </head>
+ <body>
+ <p style="">
+ </p>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>News and Notes about nXhtml</title>
+ </head>
+ <body>
+ <p id="hadron-bugs" style="margin-top:1em;">Thanks for testing!</p>
+
+ <p id="state-of-the-art" style="margin-top:1em;
+ background-color: #00fa9a;
+ background-color: #20b2aa;
+ padding: 0.5em;
+ ">The State of the Art</p>
+ <p id="something"></p>
+ <p id="something" style="background-color: #54ff9f; padding: 0.5em"></p>
+ <p id="something"></p>
--- /dev/null
+something\r
--- /dev/null
+<?php
+/* We must use this header to be correct and for the css validator to
+ find our stylesheet without us having to provide a fully qualified
+ path (address) to it. */
+header("Content-type:application/xhtml+xml; charset=utf-8");
+echo '<'.'?xml version="1.0" encoding="utf-8"?'.'>';
+?>
+ <body>
+ <div id="container">
+ <div id="header">Top area</div>
+ <div id="left-menu">
+ <ul>
+ <li><a href="index.php">Home</a></li>
+ <li><a href="index.php?page=a">First Main Page</a></li>
+ <li><a href="index.php?page=b">Second Main Page</a></li>
+ </ul>
+ </div>
+ <div id="main">
+ <?php
+ if (isset($_GET["page"])) {
+ $thepage = $_GET['page'];
+
+ if ($thepage != 'a' && $thepage != 'b') {
+ print('You hacker you!');
+ }
+ else {
+ require('main-div-'.$thepage.'.html');
+ }
+ }
+ else {
+ require('main-div-a.html');
+ }
+ ?>
+ </div>
+ <div id="right-menu">Right area</div>
+ <div id="footer">
+ <p>
+ <a href="http://validator.w3.org/check?uri=referer">
+ <img src="valid-xhtml10.png" alt="Valid XHTML 1.0 Strict"></img>
+ </a>
+ <a href="http://jigsaw.w3.org/css-validator/check?uri=referer">
+ <img src="vcss.png" alt="Valid CSS!"></img>
+ </a>
+ </p>
+ </div>
+ </div>
+ </body>
+</html>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>News and Notes about nXhtml</title>
+ <link href="wd/grapes/nxhtml-grapes.css" rel="StyleSheet" type="text/css" />
+<style type="text/css">
+#nxhtml-home a {
+ /* Image */
+ display: block;
+ background: transparent url("img/getitbuttons.png") 0 0 no-repeat;
+ overflow: hidden;
+ width: 200px;
+ xheight: 35px;
+ /* Text placement and size, etc */
+ text-align: center;
+ padding-top: 11px;
+ font-size: 12px;
+ padding-bottom: 9px;
+ text-decoration: none;
+ white-space: nowrap;
+ margin: 0;
+ border: none;
+}
+#nxhtml-home a:hover {
+ background-position: 0 -35px;
+ color: yellow;
+}
+
+</style>
+ </head>
+ <body>
+ <div id="container">
+
+ <div id="rgtcol">
+ <p id="nxhtml-home"><a href='nxhtml.html'>To nXhtml main page</a></p>
+
+ <h1>News and Notes about nXhtml</h1>
+
+ <dl>
+
+ <dt id="hadron-bugs" style="margin-top:1em;">Thanks for testing!</dt>
+ <dd>
--- /dev/null
+<?php
+
+// some basic library functions
+include_once 'lib.php';
+
+$book = new Mybook($api_key, $secret);
+
+if (isset($_POST['to'])) {
+ $prints_id = (int)$_POST['to'];
+ $prints = do_step($user, $prints_id);
+} else {
+ if (isset($_GET['to'])) {
+ $prints_id = (int)$_GET['to'];
+ } else {
+ $prints_id = $user;
+ }
+ $prints = get_prints($prints_id);
+}
+
+?>
+<div style="padding: 10px;">
+ <h2>Hi <mb:name firstnameonly="true" uid="<?php=$user?>" useyou="false"/>!</h2><br/>
+ <a href="<?= $book->get_add_url() ?>">Put prints in your profile</a>.
+ <form method="post" action="http://my-domain.com/footprints/">
+<?php
+ if ($prints_id != $user) {
+ echo '<input type="hidden" name="to" value="' . $prints_id . '"/>';
+ } else {
+ echo '<br/>';
+ }
+?>
+ <input value="step" type="submit"/>
+ </form>
+ <hr/>
+ These are <mb:name uid="«?= $prints_id ?»" possessive="true"/> Footprints:<br/>
+ <?php echo render_prints($prints, 10); ?>
+ <div style="clear: both;"/>
+</div>
--- /dev/null
+[% IF blah %]
+
+[%# test GET ]
+ # comment
+[% test %] and [% test %]
+
+[% test % test %]
+
+[%+ test -%]
+
+[% BLOCK %]
--- /dev/null
+<HTML>\r
+ <BODY>\r
+ Hello! The time is now <%= new java.util.Date() %>\r
+ </BODY>\r
+</HTML>\r
--- /dev/null
+
+(defvar utf8-problem
+ "\\(?:^\\|[[:space:]]\\)\\(?:href\\|src\\)[[:space:]]*=[[:space:]]*\"\\([^<«\"]*\\)\"")
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
--- /dev/null
+<?php\r
+\r
+include_once(APP_AAA_INCLUDE."bb.php");\r
+include_once(APP_AAA_INCLUDE."cc.php");\r
+include_once(APP_AAA_INCLUDE."dd.php");\r
+include_once(APP_AAA_INCLUDE."ee.php");\r
+include_once(APP_AAA_INCLUDE."ff.php");\r
+include_once(APP_AAA_INCLUDE."gg.php");\r
+\r
+class Test\r
+{\r
+ public $var1;\r
+\r
+ function __construct()\r
+ {\r
+ $this->var1 = 5;\r
+ }\r
+}
\ No newline at end of file
--- /dev/null
+<%= t("Hola") %>
+ <%= ink_to name, target %>
+ <% if quiero do %>
+ <%= do_something_nifty(with_me) %>
+ <% end %>
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ </head>
+ <body>
+
+ <script type="text/javascript">
+ // <![CDATA[
+ Some code to see if we can find the problem
+ // ]]>
+</script>
+
+<?php
+ $htmlstuff = <<<EOTHTML
+
+ <p>some stuff</p>
+ <p>some other stuff</p>
+
+ <script type="text/javascript">
+ // <![CDATA[
+ Some code to see if we can find the problem
+ // ]]>
+</script>
+
+EOTHTML;
+
+?>
+ </body>
+</html>
--- /dev/null
+<div class="widget">
--- /dev/null
+<?php\r
+/*\r
+ '\r
+ */\r
+/*\r
+ Problem updating comments during editing. To reproduce place cursor after the single x above and press RET and some other character.\r
+\r
+ Or just edit here, fill the paragraph above etc. Seems like problem\r
+ with mumamo-after-change which assumes that it is only called once\r
+ before post-command-hook is called.\r
+\r
+ BTW fill-paragraph does not work either ... - why does it run\r
+ c-fill-paragraph in php-mode? (Mailed Alan about this. The only\r
+ reason seems to be to support filladapt.el, but is that needed any\r
+ more?\r
+\r
+ It looks like more code (like filling) needs to be run under the\r
+ correct syntax table etc. Implemented.\r
+ */\r
+?>\r
--- /dev/null
+<html>
+<body>
+<span style="color:red">red</span>
+</body>
+</html>
--- /dev/null
+<?php header("Content-type:application/xml; charset=utf-8"); echo '<'; echo '?xml version="1.0" encoding="utf-8"?'; echo '>'; ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <title>Lab 2 - Layout Control - Task 2 - XHTML/CSS version</title>
+ <link rel="stylesheet" type="text/css" href="stylesheet.css" />
+ </head>
+ <body>
+ <div id="container">
+ <div id="header">Top area</div>
+ <div id="left-menu">
+ <ul>
+ <li><a href="index.php">Home</a></li>
+ <li><a href="index.php?page=a">First Main Page</a></li>
+ <li><a href="index.php?page=b">Second Main Page</a></li>
+ </ul>
+ </div>
+ <!--
+ <?
+ ?>
+ -->
+ <div id="main">
+ <?php
+ // comment
+ $thepage = $_GET['page'];
+
+ if (empty($thepage)) {
+ require('main-div-a.html');
+ }
+ else {
+ if ($thepage != 'a' && $thepage != 'b') {
+ print('You hacker you!');
+ }
+ else {
+ require('main-div-'.$thepage.'.html');
+ }
+ for (;;) {
+ }
+ }
+ ?>
+ </div>
+ <div id="right-menu">Right area</div>
+ <div id="footer">
+ <p>
+ <a href="http://validator.w3.org/check?uri=referer">
+ <img src="valid-xhtml10.png" alt="Valid XHTML 1.0 Strict"></img>
+ </a>
+ <a href="http://jigsaw.w3.org/css-validator/validator?uri=http%3A%2F%2Fwww-und.ida.liu.se%2F%7Emikas493%2Ftask-2%2Fxhtml-css%2Fstylesheet.css">
+ <img src="vcss.png" alt="Valid CSS!"></img>
+ </a>
+ </p>
+ </div>
+ </div>
--- /dev/null
+<?php\r
+// hotproperty.html.php\r
+/**\r
+ * Something's Presentation Code\r
+ *\r
+ * @package Something\r
+ * @copyright (C) 2004 Lee Cher Yeong\r
+ * @url http://www.somewhere.com/\r
+ * @author Lee Cher Yeong <cy@somewhere.com>\r
+ **/\r
+\r
+defined( '_VALID_MOS' ) or die( 'Direct Access to this location is not allowed.' );\r
+\r
+class hotproperty_HTML {\r
+\r
+ /***\r
+ * Include CSS file\r
+ ***/\r
+ function include_CSS() {\r
+ global $hp_css;\r
+ ?>\r
+ <link rel="stylesheet" href="components/com_hotproperty/css/<?php echo $hp_css; ?>.css" type="text/css">\r
+ <?php\r
+ }\r
+\r
+ function include_Container_Start() {\r
+ ?>\r
+<div id="con_global">\r
+<div class="componentheading"><!--<?php echo _HP_COM_TITLE; ?>--></div>\r
+ <?php\r
+ }\r
+ function include_Container_End() {\r
+ ?>\r
+</div>\r
+\r
+\r
+ <?php\r
+ }\r
+\r
+\r
+ /***\r
+ * Front Page\r
+ ***/\r
+ function show_Frontpage(&$campos, &$featured, &$featured_fields_caption, &$featured_total, &$types, &$types_hotproperty, &$types_total) {\r
+ global $hp_fp_show_featured, $hp_fp_show_search, $mainframe, $hp_css, $mosConfig_live_site, $my;\r
+\r
+ $mainframe->setPageTitle( _HP_COM_TITLE );?>\r
+\r
+ <link rel="stylesheet" href="components/com_hotproperty/css/ppal_<?php echo $hp_css; ?>.css" type="text/css"/>\r
+\r
+ <div id="total_alojamientos">\r
+ <span class="saludo"><?= _HP_HOLA ?></span> <?= _HP_TENEMOS ?>\r
+ <?php hotproperty_HTML::show_ResumenTipos() ?>\r
+ </div>\r
+\r
+ <div id="buscar_alojamiento">\r
+ </div>\r
+ <div id="incluir_alojamiento">\r
+ </div>\r
+\r
+ <br clear="all"/>\r
+\r
+<?php\r
+\r
+/* if ($hp_fp_show_featured && count($featured) > 0 ){\r
+ hotproperty_HTML::show_fp_Featured($featured, $featured_fields_caption, $featured_total);\r
+ echo '<br class="clearboth" />';\r
+ }\r
+\r
+ if ($hp_fp_show_search) {\r
+ hotproperty_HTML::show_Search($types);\r
+ echo '<br class="clearboth" />';\r
+ }\r
+\r
+ hotproperty_HTML::show_Types($types, $types_hotproperty, $types_total);*/\r
+ }\r
+\r
+ /***\r
+ * Featured Listing\r
+ ***/\r
+ function show_fp_Featured(&$prop, &$caption, $featured_total) {\r
+ global $hp_fp_featured_count, $Itemid;\r
+ ?>\r
+ <div id="con_featured1">\r
+ <div id="heading_Featured"><?php echo _HP_FEATURED_TITLE; ?></div>\r
+ <div id="list_featured">\r
+ <?php hotproperty_HTML::list_properties($prop, $caption); ?>\r
+ <br class="clearboth" />\r
+ <?php if ($featured_total > $hp_fp_featured_count) {\r
+ echo "<a href=\"". sefRelToAbs("index.php?option=com_hotproperty&task=viewfeatured&Itemid=$Itemid") ."\">"._HP_MOREFEATURED."</a>";\r
+ } ?>\r
+ </div>\r
+ </div>\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * List Types\r
+ ***/\r
+ function show_Types(&$types, &$types_hotproperty, $types_total) {\r
+ global $Itemid;\r
+ ?>\r
+ <div id="con_types1">\r
+ <div id="heading_Types"><?php echo _HP_TYPES_TITLE; ?></div>\r
+ <div id="con_types2">\r
+ <?php\r
+ foreach($types AS $t) {\r
+ if ($types_total[$t->id]->total > 0) {\r
+ ?>\r
+ <div class="con_types3">\r
+ <a class="types_title" href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewtype&id=$t->id&Itemid=$Itemid"); ?>"><?php echo $t->name ."</a>(".$types_total[$t->id]->total.")"; ?><br />\r
+ <div class="types_desc">\r
+ <?php echo $t->desc; ?>\r
+ <ul class="types_hp">\r
+ <?php\r
+ foreach($types_hotproperty[$t->id] AS $t_hp) {\r
+ if ($t_hp->name <> "" && $t_hp->id <> "") {\r
+ ?>\r
+ <li><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=view&id=$t_hp->id&Itemid=$Itemid"); ?>"><?php echo $t_hp->name; ?></a></li>\r
+ <?php\r
+ }\r
+ }\r
+ ?>\r
+ </ul>\r
+ <?php\r
+ if ($types_total[$t->id]->total > 3) { ?>\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewtype&id=$t->id&Itemid=$Itemid"); ?>"><?php echo _HP_MORE; ?></a>\r
+ <?php\r
+ }\r
+ ?>\r
+ </div>\r
+ </div>\r
+ <?php\r
+ }\r
+ }\r
+ ?>\r
+ </div>\r
+ </div>\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Search Facility\r
+ ***/\r
+ function show_Search(&$types) {\r
+ global $Itemid, $hp_use_advsearch, $mosConfig_live_site;\r
+ /*\r
+ global $custom404, $mosConfig_sef, $sufix;\r
+\r
+ # Using Built in SEF feature in Mambo\r
+ if ( !isset($custom404) && $mosConfig_sef ) {\r
+ $onclickCmd = "document.location.href= '$mosConfig_live_site/component/option,com_hotproperty/task,search/Itemid,$Itemid/type,0/search,' + encodeURI(document.searchfrm.hp_search.value) + '/'";\r
+ } elseif ( $mosConfig_sef && isset($custom404) && !empty($sufix) ) {\r
+\r
+ global $custom_comp, $hp_default_limit_search;\r
+ $hotproperty = "hotproperty";\r
+ if (in_array("hotproperty", $custom_comp)) {\r
+ $hotproperty = array_search($component_name, $custom_comp);\r
+ }\r
+\r
+ $onclickCmd = "document.location.href='" . $hotproperty . "/" . _HP_SEF_SEARCH . "/0/".$hp_default_limit_search."/0/" . "' + encodeURI(document.searchfrm.hp_search.value)";\r
+\r
+ } else {\r
+ # Using SEF advance or no SEF at all\r
+ $onclickCmd = "document.location.href='" . sefRelToAbs("index.php?option=com_hotproperty&task=search&Itemid=$Itemid&type=0&search=' + encodeURI(document.searchfrm.hp_search.value)");\r
+ }\r
+ */\r
+ ?>\r
+ <div id="con_search1">\r
+ <div id="heading_Search"><?php echo _HP_SEARCH_TITLE; ?></div>\r
+ <div id="con_search2">\r
+ <form action="index.php" method="POST" name="searchfrm">\r
+ <strong><?php echo _HP_SEARCH_TEXT; ?></strong>\r
+ <input type="text" name="search" class="inputbox" />\r
+ <input type="submit" class="button" value="<?php echo _HP_SEARCH; ?>" /><?php\r
+ if ($hp_use_advsearch == '1') {\r
+ ?> <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=advsearch&Itemid=$Itemid"); ?>"><?php echo _HP_SEARCH_ADV_TITLE; ?></a><?php\r
+ }\r
+ ?>\r
+ <input type="hidden" name="option" value="com_hotproperty" />\r
+ <input type="hidden" name="task" value="search" />\r
+ <input type="hidden" name="Itemid" value="<?php echo $Itemid;?>" />\r
+ </form>\r
+ </div>\r
+ </div>\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Advanced Search Facility\r
+ ***/\r
+ function show_AdvSearch($fields, $tipos_renta) {\r
+ global $Itemid, $mainframe;\r
+\r
+ $mainframe->setPageTitle( _HP_SEARCH_ADV_TITLE );\r
+ ?>\r
+ <script language="javascript">\r
+ /* Selecciona por defecto España como país para la búsqueda */\r
+ function select_idioma(id) {\r
+ select=document.getElementById(id);\r
+ select.options[62].selected="1";\r
+ }\r
+ /* Muestra o oculta la búsqueda por disponibilidad y el precio según el tipo de oferta */\r
+ function swap_tipo_oferta(id) {\r
+ select=document.getElementById(id);\r
+ disp=document.getElementById('disp_busq_av');\r
+ precio=document.getElementById('precio_busq_av');\r
+ if (select.options[1].selected) { // Alquiler\r
+ disp.style.display = "block";\r
+ precio.style.display = "none";\r
+ }\r
+ if (select.options[2].selected) { // Venta\r
+ disp.style.display = "none";\r
+ precio.style.display = "block";\r
+ }\r
+ if (select.options[0].selected) { // Cualquiera\r
+ disp.style.display = "block";\r
+ precio.style.display = "block";\r
+ }\r
+\r
+\r
+ }\r
+ /* Muestra o oculta una capa, y cambia el texto del enlace lanzador */\r
+ function swap(id, llamador)\r
+ {\r
+ id=document.getElementById(id);\r
+ if (id.style.display == "none" || id.style.display == "") {\r
+ id.style.display = "block";\r
+ llamador.innerHTML = "<?= _HP_OCULTAR ?>";\r
+ }\r
+ else {\r
+ id.style.display = "none";\r
+ llamador.innerHTML = "<?= _HP_MOSTRAR ?>";\r
+ }\r
+ }\r
+ /* Selecciona todos los alojamientos O sólo las viviendas en un combobox con los tipos de alojamiento */\r
+ function selecc_vivienda(select)\r
+ {\r
+ select = document.getElementById(select);\r
+ if (select.selectedIndex == 1)\r
+ {\r
+ select.options[select.selectedIndex].selected = "";\r
+ for (i=2; i <= select.length-1; i++)\r
+ if (i != 11 && i!= 13) select.options[i].selected="1";\r
+ }\r
+ }\r
+ /* Muestra u oculta los campos de búsqueda por disponibilidad */\r
+ function swap_disp(input,id) {\r
+ if (input.checked)\r
+ document.getElementById(id).style.display="block";\r
+ else\r
+ document.getElementById(id).style.display="none";\r
+ }\r
+ </script>\r
+ <div id="heading_AdvSearch"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN; ?></a><em><?php echo _HP_ARROW; ?></em><?php echo _HP_SEARCH_ADV_TITLE; ?></div>\r
+ <div id="con_asearch1">\r
+ <form action="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=asearch&Itemid=$Itemid"); ?>" method="POST" name="searchfrm">\r
+ <div class="cabecera_busq_avzda">\r
+ <div class="titulo_cabecera_busq_avzda"><?= _HP_DATOS_GENERALES ?></div>\r
+ </div><br class="clearboth"/>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['type']->caption; ?>:</div>\r
+ <?= $fields['type']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="campo_con_ayuda">\r
+ <div class="titulo_campo"><?= $fields['Tipo_Alojamiento']->caption; ?>:</div>\r
+ <?= $fields['Tipo_Alojamiento']->input; ?>\r
+ </div>\r
+ <div class="msj_ayuda"><?= _HP_AYUDA_TIPO_ALOJ ?></div>\r
+ </div>\r
+ <br class="clearboth"/>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Superficie_habitable']->caption; ?>:</div>\r
+ <?php echo $fields['Superficie_habitable']->input; ?>\r
+ <?php echo $fields['Superficie_habitable']->append_text; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Num_plazas']->caption; ?>:</div>\r
+ <?= $fields['Num_plazas']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Numero_dormitorios']->caption; ?>:</div>\r
+ <?= $fields['Numero_dormitorios']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['country']->caption; ?>:</div>\r
+ <?= $fields['country']->input; ?>\r
+ <script language="javascript">\r
+ select_idioma('idioma');\r
+ </script>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['state']->caption; ?>:</div>\r
+ <?= $fields['state']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['suburb']->caption; ?>:</div>\r
+ <?= $fields['suburb']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['postcode']->caption; ?>:</div>\r
+ <?= $fields['postcode']->input; ?>\r
+ </div>\r
+ <div id="precio_busq_av">\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['price']->caption; ?>:</div>\r
+ <?= $fields['price']->input; ?>\r
+ </div>\r
+ </div>\r
+ <div id="disp_busq_av">\r
+ <div class="cont_form">\r
+ <input type="checkbox" name="busq_disp" onclick="swap_disp(this,'campos_disp');"><?= _HP_BUSQ_POR_DISP ?></input>\r
+ <div id="campos_disp">\r
+ <div class="titulo_campo"><?= _HP_BUSQ_DISP ?> </div>\r
+ <div class="flota_izq interl_doble">\r
+ <?php hotproperty_HTML::seleccion_fecha("desde"); ?>\r
+ <?php hotproperty_HTML::seleccion_fecha("hasta"); ?>\r
+ </div>\r
+ <div class="campo_avl">\r
+ <?= _HPAVL_RENTA; ?>\r
+ <select size="1" class="campo_dcha inputbox" name="renta">\r
+ <option value="0"><?= _HP_SEARCH_ALLTYPES ?></option>\r
+ <?php foreach ($tipos_renta AS $tipo_renta) { ?>\r
+ <option value="<?php echo $tipo_renta->id; ?>"><?php echo $tipo_renta->nombre; ?></option>\r
+ <?php } ?>\r
+ </select>\r
+ </div>\r
+ </div>\r
+ </div>\r
+ </div>\r
+ <!-- Otros datos -->\r
+ <div class="cabecera_busq_avzda">\r
+ <div class="titulo_cabecera_busq_avzda"><?= _HP_OTROS_DATOS ?></div>\r
+ <div class="botonera_dcha">\r
+ <a href="#" class="enlace_blanco" onclick="swap('otros_datos', this);"><?= _HP_MOSTRAR; ?></a>\r
+ </div>\r
+ </div><br class="clearboth"/>\r
+ <div id="otros_datos">\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['MetrosConstruidos']->caption; ?>:</div>\r
+ <?= $fields['MetrosConstruidos']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Superficie_parcela']->caption; ?>:</div>\r
+ <?= $fields['Superficie_parcela']->input; ?>\r
+ <?= $fields['Superficie_parcela']->append_text; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Numero_dormitorios']->caption; ?>:</div>\r
+ <?= $fields['Numero_dormitorios']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Cuartos_banio_con_duchas']->caption; ?>:</div>\r
+ <?= $fields['Cuartos_banio_con_duchas']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Aseos']->caption; ?>:</div>\r
+ <?= $fields['Aseos']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['AnioConstruccion']->caption; ?>:</div>\r
+ <?= $fields['AnioConstruccion']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['UltimaReforma']->caption; ?>:</div>\r
+ <?= $fields['UltimaReforma']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Amueblado']->caption; ?>:</div>\r
+ <?= $fields['Amueblado']->input; ?>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Dispone']->caption; ?>:</div>\r
+ <?= $fields['Dispone']->input; ?>\r
+ <br class="clearboth"/>\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="titulo_campo"><?= $fields['Zona']->caption; ?>:</div>\r
+ <?= $fields['Zona']->input; ?>\r
+ <br class="clearboth"/>\r
+ </div>\r
+ </div>\r
+\r
+ <br/>\r
+ <div class="centro">\r
+ <input type="submit" value="Buscar" class="button" >\r
+ </div>\r
+\r
+ </div>\r
+\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Empty Advanced Search Results\r
+ ***/\r
+ function show_advSearchResults_error($msg) {\r
+ global $Itemid, $mainframe;\r
+ $mainframe->setPageTitle( _HP_SEARCH_ADV_TITLE );\r
+ ?>\r
+ <div id="con_asearch1">\r
+ <div id="heading_AdvSearch"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN; ?></a><em><?php echo _HP_ARROW; ?></em><?php echo _HP_SEARCH_ADV_TITLE; ?></div>\r
+ <p />\r
+ <?php echo $msg; ?>\r
+ <p />\r
+ <a href=""><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=advsearch&Itemid=$Itemid"); ?>"><?php echo _HP_SEARCH_TRYAGAIN; ?></a>\r
+ </div>\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Advanced Search Results\r
+ ***/\r
+ function show_advSearchResults(&$search_id, &$prop, &$caption, &$pageNav, &$searchString) {\r
+ global $Itemid, $mainframe;\r
+ $mainframe->setPageTitle( _HP_SEARCH_ADV_TITLE );\r
+ ?>\r
+ <div id="con_asearch1">\r
+ <div id="heading_AdvSearch"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN; ?></a><em><?php echo _HP_ARROW; ?></em><?php echo _HP_SEARCH_ADV_TITLE; ?></div>\r
+ <!-- <div id="hp_searchresult_con">\r
+ <div id="hp_search_pagecounter_top">\r
+ <div class="right"><?php echo $pageNav->writePagesCounter(); ?></div>\r
+ <br class="clearboth" />\r
+ <?php echo $pageNav->writePagesLinks('index.php?option=com_hotproperty&task=asearch&Itemid='.$Itemid.'&search_id='.$search_id); ?>\r
+ </div>\r
+ </div> -->\r
+ <div id="list_searchresults">\r
+ <?php hotproperty_HTML::list_properties($prop, $caption); ?>\r
+ </div>\r
+ </div>\r
+ <br class="clearboth" />\r
+ <div id="hp_search_pagecounter_bottom">\r
+ <div class="dcha"><?php echo $pageNav->writePagesCounter(); ?></div>\r
+ <br class="clearboth" />\r
+ <?php echo $pageNav->writePagesLinks('index.php?option=com_hotproperty&task=asearch&Itemid='.$Itemid.'&search_id='.$search_id); ?>\r
+ </div>\r
+\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Search Results\r
+ ***/\r
+ function show_SearchResults(&$types, &$prop, &$caption, &$pageNav, &$searchString) {\r
+ global $Itemid, $hp_use_advsearch, $mosConfig_live_site, $mainframe;\r
+ global $custom404, $mosConfig_sef, $sufix;\r
+ $mainframe->setPageTitle( _HP_SEARCH_RESULT_TITLE );\r
+\r
+ # Using Built in SEF feature in Mambo\r
+ /*\r
+ if ( !isset($custom404) && $mosConfig_sef ) {\r
+\r
+ $onclickCmd = "document.location.href= '$mosConfig_live_site/component/option,com_hotproperty/task,search/Itemid,$Itemid/type,' + document.searchfrm.type.options[document.searchfrm.type.selectedIndex].value + '/search,' + encodeURI(document.searchfrm.hp_search.value) + '/'";\r
+\r
+ } elseif ( $mosConfig_sef && isset($custom404) && !empty($sufix) ) {\r
+\r
+ global $custom_comp, $hp_default_limit_search;\r
+ $hotproperty = "hotproperty";\r
+ if (in_array("hotproperty", $custom_comp)) {\r
+ $hotproperty = array_search($component_name, $custom_comp);\r
+ }\r
+\r
+ $onclickCmd = "document.location.href='" . $hotproperty . "/" . _HP_SEF_SEARCH . "/' + document.searchfrm.type.options[document.searchfrm.type.selectedIndex].value + '/".$hp_default_limit_search."/0/" . "' + encodeURI(document.searchfrm.hp_search.value)";\r
+\r
+ } else {\r
+\r
+ # Using SEF advance or no SEF at all\r
+ $onclickCmd = "document.location.href='" . sefRelToAbs("index.php?option=com_hotproperty&task=search&Itemid=$Itemid&type=' + document.searchfrm.type.options[document.searchfrm.type.selectedIndex].value + '&search=' + encodeURI(document.searchfrm.hp_search.value)");\r
+ }\r
+ */\r
+ ?>\r
+ <div id="con_search1">\r
+ <form action="index.php" method="POST" name="searchfrm">\r
+ <div id="heading_Search"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN ." "._HP_ARROW." "; ?></a><?php echo _HP_SEARCH_RESULT_TITLE; ?></div>\r
+ <div id="hp_searchresult_con">\r
+ <strong><?php echo _HP_SEARCH_TEXT; ?></strong>\r
+ <input type="text" name="search" class="inputbox" value="<?php echo $searchString->search; ?>" /> <?php echo _HP_IN; ?>\r
+ <select name="type" class="inputbox" size="1">\r
+ <option value="0"><?php echo _HP_SEARCH_ALLTYPES; ?></option>\r
+ <?php\r
+ foreach($types AS $t) { ?>\r
+ <option value="<?php echo $t->id; ?>"<?php echo (($searchString->type==$t->id) ? " selected" : ""); ?>><?php echo $t->name; ?></option>\r
+ <?php }\r
+ ?></select>\r
+ \r
+ <input type="submit" class="button" value="<?php echo _HP_SEARCH; ?>" /><?php\r
+ if ($hp_use_advsearch == '1') {\r
+ ?> <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=advsearch&Itemid=$Itemid"); ?>"><?php echo _HP_SEARCH_ADV_TITLE; ?></a><?php\r
+ }\r
+ ?>\r
+ <div id="hp_search_pagecounter_top">\r
+ <div class="right"><?php echo $pageNav->writePagesCounter(); ?></div>\r
+ <br class="clearboth" />\r
+ <?php echo $pageNav->writePagesLinks('index.php?option=com_hotproperty&task=search&Itemid='.$Itemid.'&type='.$searchString->type.'&search='.$searchString->search); ?>\r
+ </div>\r
+ </div>\r
+ <input type="hidden" name="option" value="com_hotproperty" />\r
+ <input type="hidden" name="task" value="search" />\r
+ </form>\r
+ </div>\r
+\r
+ <div id="list_searchresults">\r
+ <?php hotproperty_HTML::list_properties($prop, $caption); ?>\r
+ </div>\r
+ <br class="clearboth" />\r
+ <div id="hp_search_pagecounter_bottom">\r
+ <div class="right"><?php echo $pageNav->writePagesCounter(); ?></div>\r
+ <br class="clearboth" />\r
+ <?php echo $pageNav->writePagesLinks('index.php?option=com_hotproperty&task=search&Itemid='.$Itemid.'&type='.$searchString->type.'&search='.$searchString->search); ?>\r
+ </div>\r
+\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * List Properties for a particular Type\r
+ ***/\r
+ function show_Type($prop, $type, $caption, $pageNav, $sortby_sort, $sortby_order) {\r
+ global $hp_use_diplaynum, $hp_use_sort_name, $hp_use_sort_agent, $hp_use_sort_price, $hp_use_sort_suburb, $hp_use_sort_state, $hp_use_sort_country, $hp_use_sort_type, $hp_use_sort_modified, $hp_use_sort_hits;\r
+\r
+ global $Itemid, $database, $mainframe;\r
+\r
+ $mainframe->setPageTitle( $type->name );\r
+ ?>\r
+ <div id="con_type1">\r
+ <?php if ($type != '') { ?>\r
+ <div id="heading_Type"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN; ?></a><em><?php echo _HP_ARROW; ?></em><?php echo $type->name; ?></div>\r
+ <?php } ?>\r
+ <?php\r
+ if ($hp_use_diplaynum == '1' || !empty($hp_use_sort_name) || !empty($hp_use_sort_agent) || !empty($hp_use_sort_price) || !empty($hp_use_sort_suburb) || !empty($hp_use_sort_state) || !empty($hp_use_sort_country) || !empty($hp_use_sort_type) || !empty($hp_use_sort_modified) || !empty($hp_use_sort_hits)) {\r
+ ?>\r
+ <div id="con_sort">\r
+ <?php if ($hp_use_diplaynum == '1') { ?>\r
+ <div id="con_sort1">\r
+ <?php echo _PN_DISPLAY_NR; ?>\r
+ <?php echo $pageNav->writeLimitBox('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort='.$sortby_sort.'&order='.$sortby_order.'&Itemid='.$Itemid); ?>\r
+ </div>\r
+ <?php\r
+ }\r
+ if (!empty($hp_use_sort_name) || !empty($hp_use_sort_agent) || !empty($hp_use_sort_price) || !empty($hp_use_sort_suburb) || !empty($hp_use_sort_state) || !empty($hp_use_sort_country) || !empty($hp_use_sort_type) || !empty($hp_use_sort_modified) || !empty($hp_use_sort_hits)) {\r
+ ?>\r
+ <div id="con_sort2"> \r
+ <?php echo _HP_SORT_BY; ?>\r
+ |\r
+\r
+ <?php if (!empty($hp_use_sort_name)) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=name&order=asc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>" title="<?php echo _HP_SORT_A_Z; ?>"> <?php echo _HP_SORT_ASC; ?> </a> <?php echo _HP_SORT_AZ; ?> <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=name&order=desc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>" title="<?php echo _HP_SORT_Z_A; ?>"> <?php echo _HP_SORT_DESC; ?> </a> |\r
+ <?php } ?>\r
+\r
+ <?php if (!empty($hp_use_sort_agent) && !empty($caption['agent']->caption)) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=agent&order=desc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_ASC; ?> </a> <?php echo $caption['agent']->caption; ?> <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=agent&order=asc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_DESC; ?> </a> |\r
+ <?php } ?>\r
+\r
+ <?php if (!empty($hp_use_sort_price) && !empty($caption['price']->caption)) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=price&order=asc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>" title="<?php echo _HP_SORT_LOWEST_PRICE; ?>"> <?php echo _HP_SORT_ASC; ?> </a> <?php echo $caption['price']->caption; ?> <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=price&order=desc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>" title="<?php echo _HP_SORT_HIGHEST_PRICE; ?>"> <?php echo _HP_SORT_DESC; ?> </a> |\r
+ <?php } ?>\r
+\r
+ <?php if (!empty($hp_use_sort_suburb) && !empty($caption['suburb']->caption)) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=suburb&order=asc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_ASC; ?> </a> <?php echo $caption['suburb']->caption; ?> <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=suburb&order=desc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_DESC; ?> </a> |\r
+ <?php } ?>\r
+\r
+ <?php if (!empty($hp_use_sort_state) && !empty($caption['state']->caption)) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=state&order=asc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_ASC; ?> </a> <?php echo $caption['state']->caption; ?> <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=state&order=desc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_DESC; ?> </a> |\r
+ <?php } ?>\r
+\r
+ <?php if (!empty($hp_use_sort_country) && !empty($caption['country']->caption)) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=country&order=asc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_ASC; ?> </a> <?php echo $caption['country']->caption; ?> <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=country&order=desc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_DESC; ?> </a> |\r
+ <?php } ?>\r
+\r
+ <?php if (!empty($hp_use_sort_type) && !empty($caption['type']->caption)) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=type&order=asc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_ASC; ?> </a> <?php echo $caption['type']->caption; ?> <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=type&order=desc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_DESC; ?> </a> |\r
+ <?php } ?>\r
+\r
+ <?php if (!empty($hp_use_sort_modified) && !empty($caption['modified']->caption)) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=modified&order=asc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_ASC; ?> </a> <?php echo $caption['modified']->caption; ?> <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=modified&order=desc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_DESC; ?> </a> |\r
+ <?php } ?>\r
+\r
+ <?php if (!empty($hp_use_sort_hits) && !empty($caption['hits']->caption)) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=hits&order=asc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_ASC; ?> </a> <?php echo $caption['hits']->caption; ?> <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort=hits&order=desc&limit='.$pageNav->limit.'&limitstart='.$pageNav->limitstart.'&Itemid='.$Itemid); ?>"> <?php echo _HP_SORT_DESC; ?> </a> |\r
+ <?php } ?>\r
+\r
+ </div>\r
+ <?php } ?>\r
+ </div>\r
+ <?php } ?>\r
+ <div id="list_properties">\r
+ <?php hotproperty_HTML::list_properties($prop, $caption); ?>\r
+ </div>\r
+\r
+\r
+ <?php if ($type != '') { ?>\r
+ <div id="hp_pagecounter_bottom">\r
+ <div align="right"><?php $pageNav->writePagesCounter(); ?></div>\r
+ <?php echo $pageNav->writePagesLinks('index.php?option=com_hotproperty&task=viewtype&id='.$prop[0]->typeid.'&sort='.$sortby_sort.'&order='.$sortby_order.'&Itemid='.$Itemid); ?>\r
+ </div>\r
+ <?php } ?>\r
+ </div>\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * List Featured Properties\r
+ ***/\r
+ function show_Featured($prop, $caption, $pageNav) {\r
+ global $Itemid, $mainframe;\r
+ $mainframe->setPageTitle( _HP_FEATURED );\r
+ ?>\r
+ <div id="con_type1">\r
+ <div id="heading_Featured"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN ." "._HP_ARROW." "; ?></a><?php echo _HP_FEATURED; ?></div>\r
+ <div id="list_properties">\r
+ <?php hotproperty_HTML::list_properties($prop, $caption); ?>\r
+ </div>\r
+ <br class="clearboth" />\r
+ <div id="hp_pagecounter_bottom">\r
+ <div align="right"><?php echo $pageNav->writePagesCounter(); ?></div>\r
+ <br class="clearboth" />\r
+ <?php echo $pageNav->writePagesLinks('index.php?option=com_hotproperty&task=viewfeatured'); ?>\r
+ </div>\r
+ </div>\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Display Company's contact details and list all agents under it.\r
+ ***/\r
+ function show_Company(&$company, &$agent, &$prop, &$caption, $pageNav) {\r
+ global $mosConfig_live_site, $hp_imgdir_agent, $mainframe, $Itemid;\r
+ $mainframe->setPageTitle( $company[0]->name );\r
+ ?>\r
+\r
+ <div id="hp_view_agent_title_nav"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN; ?></a><em><?php echo _HP_ARROW; ?></em> <?php echo _HP_CO_TITLE; ?></div>\r
+ <div id="hp_view_co_con">\r
+ <?php hotproperty_HTML::show_CoInfo($company, $agent) ?>\r
+ </div>\r
+ <br class="clearboth" />\r
+\r
+ <div id="heading_Agent"><span class="flecha_big">› </span><?= _HP_PROPBYAGENT.$company[0]->name; ?></div>\r
+ <div id="list_properties">\r
+ <?php hotproperty_HTML::list_properties($prop, $caption); ?>\r
+ </div>\r
+\r
+ <br class="clearboth" />\r
+ <div id="hp_pagecounter_bottom">\r
+ <div align="right"><?php echo $pageNav->writePagesCounter(); ?></div>\r
+ <br class="clearboth" />\r
+ <?php echo $pageNav->writePagesLinks('index.php?option=com_hotproperty&task=viewco&id='.$company[0]->id); ?>\r
+ </div>\r
+\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Display Agent's information and list all properties under it.\r
+ ***/\r
+ function show_Agent($prop_alq, $prop_vta, $caption, $agent, $types, $pageNav) {\r
+ global $mosConfig_live_site, $hp_imgdir_agent, $Itemid, $mainframe;\r
+ $mainframe->setPageTitle( $agent->name );\r
+ ?>\r
+\r
+ <div id="hp_view_agent_title_nav"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN; ?></a><em><?php echo _HP_ARROW; ?></em><?php echo $agent->name; ?></div>\r
+\r
+ <div id="hp_view_agent_con">\r
+ <?php hotproperty_HTML::show_AgentInfo($agent) ?>\r
+ </div>\r
+ <br class="clearboth" />\r
+\r
+ <div id="heading_Agent"><span class="flecha_big">› </span><?= _HP_PROPBYAGENT.$agent->name; ?></div>\r
+ <div class="cabecera_ver_ofertas"><?= _OFER_ALQ; ?></div>\r
+ <?php hotproperty_HTML::show_Type($prop_alq, "", $caption, $pageNav, "desc", "modified"); ?>\r
+ <br class="clearboth" />\r
+ <div class="cabecera_ver_ofertas"><?= _OFER_VEN; ?></div>\r
+ <?php hotproperty_HTML::show_Type($prop_vta, "", $caption, $pageNav, "desc", "modified"); ?>\r
+\r
+\r
+<!-- <div id="hp_pagecounter_bottom">\r
+ <div align="right"><?php echo $pageNav->writePagesCounter(); ?></div>\r
+ <br class="clearboth" />\r
+ <?php echo $pageNav->writePagesLinks('index.php?option=com_hotproperty&task=viewagent&id='.$agent->id); ?>\r
+ </div>-->\r
+ <br class="clearboth" />\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Display Company's information and an enquiry form.\r
+ ***/\r
+ function show_CoEmail($company) {\r
+ global $Itemid, $mainframe;\r
+ $mainframe->setPageTitle( _HP_CO_CONTACT .' - '.$company[0]->name );\r
+\r
+ ?>\r
+ <div id="heading_Co"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN; ?></a><em><?php echo _HP_ARROW; ?></em><?php echo _HP_CO_TITLE; ?></div>\r
+ <div id="hp_view_co_con">\r
+ <?php hotproperty_HTML::show_CoInfo($company) ?>\r
+ </div>\r
+ <br class="clearboth" />\r
+ <div id="heading_Co_Contact"><?php echo _HP_CO_CONTACT; ?></div>\r
+ <div id="hp_emailform_con">\r
+ <?php hotproperty_HTML::show_EmailForm('company',$company[0]->id) ?>\r
+ </div>\r
+\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Display Agent's information and an enquiry form.\r
+ ***/\r
+ function show_AgentEmail($agent) {\r
+ global $Itemid, $mainframe;\r
+ $mainframe->setPageTitle( _HP_VIEW_AGENT_CONTACT .' - '.$agent[0]->name );\r
+ ?>\r
+ <!--<div id="hp_view_agent_title_nav"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN; ?><em><?php echo _HP_ARROW; ?></em></a> <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewco&id=".$agent[0]->companyid."&Itemid=".$Itemid); ?>"><?php echo $agent[0]->company; ?></a><em><?php echo _HP_ARROW; ?></em><?php echo _HP_VIEW_AGENT_TITLE; ?></div> -->\r
+<!-- <div id="hp_view_agent_con">\r
+ <?php hotproperty_HTML::show_AgentInfo($agent) ?>\r
+ </div> -->\r
+ <div id="hp_view_agent_contact"><span class="flecha_big"><?= _HP_ARROW ?></span><?php echo _HP_VIEW_AGENT_CONTACT; ?></div>\r
+ <div id="hp_emailform_con">\r
+ <?php hotproperty_HTML::show_EmailForm('agent',$agent[0]->id) ?>\r
+ </div>\r
+\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Show Property\r
+ ***/\r
+ function show_Prop(&$prop, &$caption, &$images, &$agent, $num_periodos) {\r
+ global $Itemid, $my, $mosConfig_live_site, $mosConfig_absolute_path, $pop, $mainframe;\r
+ global $hp_imgdir_thumb, $hp_imgdir_standard, $hp_currency, $hp_imgsize_thumb, $hp_img_noimage_thumb, $hp_imgdir_agent, $hp_show_agentdetails, $hp_show_enquiryform, $hp_thousand_sep, $hp_dec_point, $hp_link_open_newwin, $hp_show_moreinfo, $hp_use_companyagent, $hp_dec_string, $hp_thousand_string;\r
+ global $hp_show_pdficon, $hp_show_printicon, $hp_show_emailicon;\r
+\r
+ $mainframe->appendMetaTag( 'description', $prop[0]->metadesc );\r
+ $mainframe->appendMetaTag( 'keywords', $prop[0]->metakey );\r
+ $mainframe->setPageTitle( $prop[0]->name );\r
+ if ($pop == '') $pop = 0;\r
+ ?>\r
+ <script language="javascript">\r
+ // Si es una pop-up, es la ventana de impresión: imprime.\r
+ if (<?= $pop ?> == 1 ) { window.print(); }\r
+ </script>\r
+ <script src="components/com_hotproperty/js/resalte.js" type="text/javascript"></script>\r
+\r
+ <div id="con_hp1">\r
+ <?php if (!$pop) { ?>\r
+ <div id="heading_Prop">\r
+ <div class="obj_con_botonera">\r
+ <div class="nombre_objeto">\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&Itemid=$Itemid"); ?>"><?php echo _HP_COM_PATHWAY_MAIN; ?></a><em><?php echo _HP_ARROW; ?></em><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewtype&id=".$prop[0]->typeid."&Itemid=$Itemid"); ?>"><?php echo $prop[0]->type; ?> </a> <em><?php echo _HP_ARROW; ?></em> <?php echo $prop[0]->name; ?>\r
+ </div>\r
+ <?php } ?>\r
+ <div class="botonera_dcha">\r
+ <div class="mini_botones">\r
+\r
+ <?php\r
+\r
+ # Show edit icon for authorized agent\r
+ if (!$pop && $prop[0]->user == $my->id && $prop[0]->user > 0 && $my->id > 0) { ?>\r
+ <div class="mini_boton">\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=editprop&id=". $prop[0]->id ."&Itemid=$Itemid"); ?>" title="<?= _E_EDIT; ?>"><img src="administrator/images/editar.png" alt="<?= _E_EDIT ?>" title="<?= _E_EDIT ?>" onmouseover="this.src='administrator/images/editar_on.png';swap_resalte('editar',1);" onmouseout="this.src='administrator/images/editar.png';swap_resalte('editar',0);" class="bot_gestionar" id="img_editar"/></a>\r
+ </div>\r
+ <div class="texto_mini_boton"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=editprop&id=". $prop[0]->id ."&Itemid=$Itemid"); ?>" onmouseover="swap_resalte('editar',1);" onmouseout="swap_resalte('editar',0);" title="<?= _E_EDIT; ?>" id="a_editar"><?= _E_EDIT ?></a></div>\r
+ <?php } ?>\r
+\r
+ <?php\r
+ if ($hp_show_pdficon && !$pop) {\r
+ ?>\r
+ <div class="mini_boton">\r
+ <a href="javascript:void window.open('<?php echo $mosConfig_live_site; ?>/components/com_hotproperty/pdf.php?id=<?php echo $prop[0]->id; ?>', 'win2', 'status=no,toolbar=no,scrollbars=yes,titlebar=no,menubar=no,resizable=yes,width=640,height=480,directories=no,location=no');" title="<?php echo _CMN_PRINT;?>">\r
+ <img src="<?php echo $mosConfig_live_site;?>/administrator/images/imprimir.png" border="0" alt="<?php echo _CMN_PDF;?>" onmouseover="this.src='administrator/images/imprimir_on.png';swap_resalte('imprimir',1);" onmouseout="this.src='administrator/images/imprimir.png'; swap_resalte('imprimir',0);" class="bot_gestionar" id="img_imprimir"/></a>\r
+ </div>\r
+ <div class="texto_mini_boton">\r
+ <a href="javascript:void window.open('<?php echo $mosConfig_live_site; ?>/components/com_hotproperty/pdf.php?id=<?php echo $prop[0]->id; ?>', 'win2', 'status=no,toolbar=no,scrollbars=yes,titlebar=no,menubar=no,resizable=yes,width=640,height=480,directories=no,location=no');" onmouseover="swap_resalte('imprimir',1);" onmouseout="swap_resalte('imprimir',0);" class="enlace" id="a_imprimir"><?php echo _CMN_PDF;?></a>\r
+ </div>\r
+ <?php\r
+ } // End of if $hp_show_pdficon\r
+\r
+ if ($hp_show_printicon && !$pop) { ?>\r
+ <div class="mini_boton">\r
+ <a href="javascript:void window.open('<?php echo $mosConfig_live_site; ?>/index2.php?option=com_hotproperty&task=view&id=<?php echo $prop[0]->id; ?>&pop=1', 'win2', 'status=no,toolbar=no,scrollbars=yes,menubar=no,resizable=yes,width=940,height=480,directories=no,location=no');" title="<?php echo _CMN_PRINT;?>" onmouseover="swap_resalte('imprimir',1);">\r
+ <img src="administrator/images/imprimir.png" alt="<?= _CMN_PRINT ?>" title="<?= _CMN_PRINT ?>" onmouseover="this.src='administrator/images/imprimir_on.png';" onmouseout="this.src='administrator/images/imprimir.png'; swap_resalte('imprimir',0);" class="bot_gestionar" id="img_imprimir"/></a>\r
+ </div>\r
+ <div class="texto_mini_boton">\r
+ <a href="javascript:void window.open('<?php echo $mosConfig_live_site; ?>/index2.php?option=com_hotproperty&task=view&id=<?php echo $prop[0]->id; ?>&pop=1', 'win2', 'status=no,toolbar=no,scrollbars=yes,titlebar=no,menubar=no,resizable=yes,width=940,height=480,directories=no,location=no');" title="<?php echo _CMN_PRINT;?>" onmouseover="swap_resalte('imprimir',1);" onmouseout="swap_resalte('imprimir',0);" class="enlace" id="a_imprimir">\r
+ <?= _CMN_PRINT ?></a> </div>\r
+\r
+ <?php } // End of if $hp_show_printicon\r
+\r
+ if ($hp_show_emailicon && !$pop) { ?>\r
+ <div class="mini_boton">\r
+ <a href="javascript:void window.open('<?php echo $mosConfig_live_site; ?>/index2.php?option=com_hotproperty&task=emailform&id=<?php echo $prop[0]->id; ?>', 'win2', 'status=no,toolbar=no,scrollbars=no,titlebar=no,menubar=no,resizable=yes,width=400,height=285,directories=no,location=no');" title="<?php echo _CMN_EMAIL;?>"><img src="administrator/images/correo.png" alt="<?= _CMN_EMAIL ?>" title="<?= _CMN_EMAIL ?>" onmouseover="this.src='administrator/images/correo_on.png';swap_resalte('correo',1);" onmouseout="this.src='administrator/images/correo.png'; swap_resalte('correo',0);" class="bot_gestionar" id="img_correo"/></a>\r
+ </div>\r
+ <div class="texto_mini_boton">\r
+ <a href="javascript:void window.open('<?php echo $mosConfig_live_site; ?>/index2.php?option=com_hotproperty&task=emailform&id=<?php echo $prop[0]->id; ?>', 'win2', 'status=no,toolbar=no,scrollbars=no,titlebar=no,menubar=no,resizable=yes,width=400,height=285,directories=no,location=no');" title="<?php echo _CMN_EMAIL;?>" onmouseover="swap_resalte('correo',1);" onmouseout="swap_resalte('correo',0);" id="a_correo">\r
+ <?= _HP_EMAIL_AMIGO ?></a> </div>\r
+ <?php } ?>\r
+ </div>\r
+ </div>\r
+ </div> <!-- fin div.mini_botones -->\r
+ </div>\r
+\r
+ <br class="clearboth">\r
+ <br class="clearboth">\r
+\r
+<?php\r
+ // Copyright © 2006, Michael Rice\r
+ // License: GPL but you must email when you use it to let me know and this copyright MUST remain intact.\r
+ // Email: meikeric {at] gmail [dot} com\r
+ // You can donate to my Paypal and request hacks for HotProperty. Every little bit helps.\r
+ // Paypal: meikeric {at] gmail [dot} com\r
+\r
+ ?>\r
+ <?php $iCount = count($images); ?>\r
+ <script language="JavaScript" type="text/javascript">\r
+ //for image viewer slide show\r
+\r
+ myCount = 0;\r
+\r
+ function UpdateCounter( currentCount )\r
+ {\r
+ myCount = currentCount;\r
+ }\r
+\r
+ function loadImgArray( strList ){\r
+ myImgList = strList.split(",");\r
+ }\r
+ function NextSlideShow( maxCount ){\r
+ if(myCount >= maxCount){\r
+ myCount = 0;\r
+ }else{\r
+ myCount++;\r
+ }\r
+ //alert( myImgList[myCount] );\r
+ show('MainPhoto',myImgList[myCount]);\r
+ }\r
+ function PrevSlideShow( maxCount ){\r
+ if(myCount <= 0){\r
+ myCount = maxCount;\r
+ }else{\r
+ myCount--;\r
+ }\r
+ //alert( myImgList[myCount] );\r
+ show('MainPhoto',myImgList[myCount]);\r
+ }\r
+\r
+ function fillLabel(inField,inValue){\r
+ if(inValue == ''){\r
+ inValue = myCount + 1;\r
+ }\r
+ if(document.layers) //NN4+\r
+ {\r
+ document.layers[inField].innerHTML = inValue;\r
+ }\r
+ else if(document.getElementById) //gecko(NN6) + IE 5+\r
+ {\r
+ var obj = document.getElementById(inField);\r
+ obj.innerHTML = inValue;\r
+ }\r
+ else if(document.all) // IE 4\r
+ {\r
+ document.all[inField].innerHTML = inValue;\r
+ }\r
+ }\r
+\r
+ function show(name,src) {\r
+ if (document.images)\r
+ document.images[name].src = src;\r
+ }\r
+ </script>\r
+\r
+\r
+ <div id="hp_view_standard_photo_con1">\r
+ <a href='javascript:NextSlideShow( <?php echo $iCount-1; ?>);'><img src='<?php echo $mosConfig_live_site.$hp_imgdir_standard.$images[0]->standard; ?>' name='MainPhoto' alt='Click here to view the next image' border='0' class='search01'/></a>\r
+ <br/>\r
+ <?php if (!$pop) { ?>\r
+ <a href='javascript:PrevSlideShow( <?php echo $iCount-1; ?> );'>< <?php echo _CMN_PREV;?></a> \r
+ <a href='javascript:NextSlideShow( <?php echo $iCount-1; ?> );'><?php echo _CMN_NEXT;?> ></a>\r
+ <?php } ?>\r
+\r
+ <script language='Javascript' type="text/javascript">\r
+ loadImgArray( '<?php\r
+ $i = 1;\r
+ foreach($images AS $image) {\r
+ echo $mosConfig_live_site.$hp_imgdir_standard.$image->standard;\r
+ if($iCount > 1 && $i != $iCount) {\r
+ echo ',';\r
+ }\r
+ $i++;\r
+ }\r
+ ?>' );\r
+ </script>\r
+ </div>\r
+\r
+ <?php foreach($prop AS $p) {\r
+ ?>\r
+<?php\r
+ /* Escupe los campos de manera poco flexible pero práctica (igual que en listado) */\r
+\r
+ echo '<div id="datos_inmueble">';\r
+\r
+\r
+ // Name (Titulo)\r
+ echo '<div id="titulo_inmueble">'.$p->name.'.</div>';\r
+\r
+ // Referencia propia\r
+ echo '<div class="linea_inmueble">';\r
+ echo '<span class="hp_caption"> › '._OFER_REF."</span>: ";\r
+ if ($p->id <> "") echo $p->id.".<br />"; else echo _OFER_NO_DEF;\r
+ echo '</div>';\r
+\r
+\r
+ // Type (Tipo de oferta)\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['type']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['type']->caption."</span>: ";\r
+ echo $p->type.".<br/>";\r
+ echo '</div>';\r
+\r
+ // Tipo_Alojamiento\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['Tipo_Alojamiento']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Tipo_Alojamiento']->caption."</span>: ";\r
+ if ($p->Tipo_Alojamiento<>"") echo $p->Tipo_Alojamiento.".<br/>"; else echo _OFER_NO_DEF;\r
+ echo '</div>';\r
+\r
+ // Address y postcode (Dirección y CP)\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['address']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['address']->caption."</span>: ";\r
+ if ($p->address<>"") echo $p->address." ".$p->postcode."<br/>"; else echo _OFER_NO_DEF;\r
+ echo '</div>';\r
+\r
+\r
+ // Barrio\r
+ if ( $p->Barrio <> "")\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['Barrio']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Barrio']->caption."</span>: ";\r
+ echo $p->Barrio;\r
+ echo '</div>';\r
+ }\r
+\r
+ // Suburb y State (Población y Provincia)\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['suburb']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['suburb']->caption."</span>: ";\r
+ if ($p->suburb<>"") echo $p->suburb." (".$p->state.")"."<br/>"; else echo _OFER_NO_DEF;\r
+ echo '</div>';\r
+\r
+ // Precio\r
+ if ($p->typeid == 2) // Venta\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['price']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['price']->caption."</span>: ";\r
+ if ($p->price<>"") echo number_format($p->price,2,',','.')." ".$caption['price']->append_text."<br />"; else echo _OFER_NO_DEF;\r
+ echo '</div>';\r
+ }\r
+\r
+\r
+ // Num_plazas\r
+ if ($p->typeid == 1) // Alquiler\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['Num_plazas']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Num_plazas']->caption."</span>: ";\r
+ if ($p->Num_plazas<>"") echo $p->Num_plazas.".<br />"; else echo _OFER_NO_DEF;\r
+ echo '</div>';\r
+ }\r
+\r
+ // Numero_dormitorios\r
+ echo '<div class="linea_inmueble">';\r
+ if ($p->typeid == 1) // Alquiler\r
+ {\r
+ if (!$caption['Numero_dormitorios']->hideCaption)\r
+ {\r
+ echo '<span class="hp_caption"> › '.$caption['Numero_dormitorios']->caption."</span>: ";\r
+ }\r
+ }\r
+ else\r
+ echo '<span class="hp_caption"> › Nº habitaciones: </span>';\r
+\r
+ if ($p->Numero_dormitorios<>"") echo $p->Numero_dormitorios.".<br />"; else echo _OFER_NO_DEF;\r
+ echo '</div>';\r
+\r
+\r
+ // Cuartos_banio_con_duchas\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['Cuartos_banio_con_duchas']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Cuartos_banio_con_duchas']->caption."</span>: ";\r
+ if ($p->Cuartos_banio_con_duchas<>"") echo $p->Cuartos_banio_con_duchas.". "; else echo _OFER_NO_DEF." ";\r
+\r
+ // Aseos\r
+ if ($p->Aseos <> "")\r
+ {\r
+ if (!$caption['Aseos']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Aseos']->caption."</span>: ";\r
+ if ($p->Aseos<>"") echo $p->Aseos.".<br />"; else echo _OFER_NO_DEF;\r
+ }\r
+ echo '</div>';\r
+\r
+ // Dispone\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['Dispone']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Dispone']->caption."</span>: ";\r
+ if ($p->Dispone<>"") echo str_replace("|",", ",$p->Dispone).".<br />"; else echo _OFER_NO_DEF;\r
+ echo '</div>'; ?>\r
+\r
+ </div> <!-- fin capa datos_inmueble -->\r
+\r
+ <div class="hp_view_details">\r
+ <div id="mas_datos">\r
+ <div class="titulito_inmueble">Características del inmueble</div>\r
+ <?php\r
+ // Año Construcción\r
+ if ($p->typeid == 2) // Venta\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['AnioConstruccion']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['AnioConstruccion']->caption."</span>: ";\r
+ if ($p->AnioConstruccion <> "") echo $p->AnioConstruccion.". "; else echo _OFER_NO_DEF;\r
+ if (!$caption['UltimaReforma']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['UltimaReforma']->caption."</span>: ";\r
+ if ($p->UltimaReforma <> "") echo $p->UltimaReforma.". "; else echo _OFER_NO_DEF;\r
+ echo '</div>';\r
+ }\r
+\r
+ // Metros construidos\r
+ echo '<div class="linea_inmueble">';\r
+ if ($p->typeid == 2) // Venta\r
+ {\r
+ if (!$caption['MetrosConstruidos']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['MetrosConstruidos']->caption."</span>: ";\r
+ if ($p->MetrosConstruidos <> "") echo $p->MetrosConstruidos." ".$caption['Superficie_habitable']->append_text.". "; else echo _OFER_NO_DEF;\r
+ }\r
+\r
+ if (!$caption['Superficie_habitable']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Superficie_habitable']->caption."</span>: ";\r
+ echo $p->Superficie_habitable." ".$caption['Superficie_habitable']->append_text.". ";\r
+\r
+ // Superficie_parcela\r
+ if ($p->Superficie_parcela <> "")\r
+ {\r
+ if (!$caption['Superficie_parcela']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Superficie_parcela']->caption."</span>: ";\r
+ echo $p->Superficie_parcela." ".$caption['Superficie_parcela']->append_text.".";\r
+ }\r
+ echo "<br />";\r
+ echo '</div>';\r
+\r
+\r
+ if ($p->Camas_dobles <> 0 || $p->Camas_individuales <> 0 || $p->Camas_supletorias <> 0 || $p->Camas_litera <> 0)\r
+ echo '<div class="linea_inmueble">';\r
+\r
+\r
+ if ($p->typeid == 1) // Alquiler\r
+ {\r
+ // Camas_dobles\r
+ if ($p->Camas_dobles <> 0)\r
+ {\r
+ if (!$caption['Camas_dobles']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Camas_dobles']->caption."</span>: ";\r
+ echo $p->Camas_dobles.". ";\r
+ }\r
+\r
+ // Camas_individuales\r
+ if ($p->Camas_individuales <> 0)\r
+ {\r
+ if (!$caption['Camas_individuales']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Camas_individuales']->caption."</span>: ";\r
+ echo $p->Camas_individuales.". ";\r
+ }\r
+\r
+ // Camas_supletorias\r
+ if ($p->Camas_supletorias <> 0)\r
+ {\r
+ if (!$caption['Camas_supletorias']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Camas_supletorias']->caption."</span>: ";\r
+ echo $p->Camas_supletorias.". ";\r
+ }\r
+\r
+ // Camas_litera\r
+ if ($p->Camas_litera <> 0)\r
+ {\r
+ if (!$caption['Camas_litera']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Camas_litera']->caption."</span>: ";\r
+ echo $p->Camas_litera.". ";\r
+ }\r
+ if ($p->Camas_dobles <> 0 || $p->Camas_individuales <> 0 || $p->Camas_supletorias <> 0 || $p->Camas_litera <> 0)\r
+ {\r
+ echo "<br/>";\r
+ echo "</div>";\r
+ }\r
+\r
+ // Sofa_cama_individual\r
+ if ($p->Sofa_cama_individual<>"" && $p->Sofa_cama_individual<>"")\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ // Sofa_cama_individual\r
+ if ( $p->Sofa_cama_individual <> "")\r
+ {\r
+ if (!$caption['Sofa_cama_individual']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Sofa_cama_individual']->caption."</span>: ";\r
+ echo $p->Sofa_cama_individual.". ";\r
+ }\r
+\r
+ // Sofa_cama_doble\r
+ if ( $p->Sofa_cama_doble <> "")\r
+ {\r
+ if (!$caption['Sofa_cama_doble']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Sofa_cama_doble']->caption."</span>: ";\r
+ echo $p->Sofa_cama_doble.". ";\r
+ }\r
+ echo "</div>";\r
+ }\r
+\r
+ // Superficie_terraza_solarium\r
+ if ($p->Superficie_terraza_solarium <> "")\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['Superficie_terraza_solarium']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Superficie_terraza_solarium']->caption."</span>: ";\r
+ echo $p->Superficie_terraza_solarium." ".$caption['Superficie_terraza_solarium']->append_text.".<br />";\r
+ echo "</div>";\r
+ }\r
+ }\r
+ // Enseres\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['Enseres']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Enseres']->caption."</span>: ";\r
+ echo str_replace("|",", ",$p->Enseres).".<br />";\r
+ echo '</div>';\r
+\r
+ // Animales\r
+ if ($p->typeid == 1) // Alquiler\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['Animales']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Animales']->caption."</span>: ";\r
+ echo $p->Animales.".<br />";\r
+ echo '</div>';\r
+ }\r
+\r
+\r
+ // *** Características de la zona **\r
+ echo '<div class="titulito_inmueble">Características de la zona</div>';\r
+\r
+ // Zona\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['Zona']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Zona']->caption."</span>: ";\r
+ echo str_replace("|",", ",$p->Zona).".<br />";\r
+ echo '</div>';\r
+\r
+ // ActividadesDeportivas\r
+ if ($p->typeid == 1) // Alquiler\r
+ {\r
+ if($caption['ActividadesDeportivas'] != '')\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ if (!$caption['ActividadesDeportivas']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['ActividadesDeportivas']->caption."</span>: ";\r
+ echo str_replace("|",", ",$p->ActividadesDeportivas).".<br />";\r
+ echo '</div>';\r
+ }\r
+ }\r
+\r
+ // Distancia_a_la_playa\r
+ echo '<div class="linea_inmueble">';\r
+ if ($p->Distancia_a_la_playa <> "")\r
+ {\r
+ if (!$caption['Distancia_a_la_playa']->hideCaption)\r
+ echo '<span class="hp_caption"> › '.$caption['Distancia_a_la_playa']->caption."</span>: ";\r
+ echo $p->Distancia_a_la_playa." ".$caption['Distancia_a_la_playa']->append_text.".<br />";\r
+ }\r
+ echo '</div>';\r
+\r
+ if ($p->A_minutos_andando <> "")\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ echo '<span class="hp_caption">';\r
+ if (!$caption['A_minutos_andando']->hideCaption)\r
+ echo ' › '.$caption['A_minutos_andando']->caption.' ';\r
+ echo $p->A_minutos_andando." ".$caption['A_minutos_andando']->append_text." ";\r
+ if (!$caption['de_andando']->hideCaption)\r
+ echo ' '.$caption['de_andando']->caption.' ';\r
+ echo $p->de_andando.".</span><br />";\r
+ echo '</div>';\r
+ }\r
+\r
+ if ($p->A_minutos_coche <> "")\r
+ {\r
+ echo '<div class="linea_inmueble">';\r
+ echo '<span class="hp_caption">';\r
+ if (!$caption['A_minutos_coche']->hideCaption)\r
+ echo ' › '.$caption['A_minutos_coche']->caption.' ';\r
+ echo $p->A_minutos_coche." ".$caption['A_minutos_coche']->append_text." ";\r
+ if (!$caption['de_coche']->hideCaption)\r
+ echo ' '.$caption['de_coche']->caption.' ';\r
+ echo $p->de_coche.".</span><br />";\r
+ echo '</div>';\r
+ echo '<br/>';\r
+ }\r
+\r
+ // *** Descripción detallada ***\r
+ echo '<div class="titulito_inmueble">'.$caption['full_text']->caption.'</div>';\r
+ echo '<div class="linea_inmueble">';\r
+ echo '<div class="descripcion">';\r
+ echo $p->full_text;\r
+ echo '</div>';\r
+ echo '</div>';\r
+\r
+ // *** Disponibilidad ***\r
+ if ($p->typeid == 1 && $num_periodos > 0) // Alquiler\r
+ {\r
+ echo '<div class="titulito_inmueble">'.$caption['intro_text']->caption.'</div>';\r
+ echo '<div class="linea_inmueble">'; ?>\r
+ <iframe src="index2.php?option=com_hp_avl&task=ext_show_year&lang=<?php echo $_GET['lang']?>&property_id=<?php echo $p->id; ?>" name="com_hp_avl" id="com_hp_avl" width="97%" height="<?php echo (($num_periodos * 20)+580); ?>" marginwidth="0" marginheight="0" align="top" scrolling="no" frameborder="0" hspace="0" vspace="0" background="white"></iframe>\r
+ <div id="combo_num_anios">\r
+ <script language="javascript">\r
+ function RecargaCalendario(id,alto,num_anios,lang,property_id)\r
+ {\r
+ iframe=document.getElementById(id);\r
+\r
+ iframe.src="index2.php?option=com_hp_avl&task=ext_show_year&num_anios="+num_anios+"&lang=" +lang+"&property_id="+property_id;\r
+ if (num_anios > 1)\r
+ iframe.height=alto * 0.9 * num_anios;\r
+ else\r
+ iframe.height=alto;\r
+ }\r
+ </script>\r
+ <form action="" method="GET" name="calendarioForm">\r
+ <p>Mostrar <select name="num_anios" size="1" onChange="RecargaCalendario('com_hp_avl',<?php echo (($num_periodos * 20)+580); ?>,this.value,'<?php echo mosGetParam( $_GET, 'lang',0);?>',<?php echo $p->id; ?>);">\r
+ <option value="1" label="1" <?php if ($num_years==1) echo "selected"; ?>>1</option>\r
+ <option value="2" label="2" <?php if ($num_years==2) echo "selected"; ?>>2</option>\r
+ </select>\r
+ años.\r
+ <input type="hidden" name="option" value="<?php echo $option; ?>" />\r
+ <input type="hidden" name="task" value="ext_show_year" />\r
+ <input type="hidden" name="property_id" value="<?php echo $property_id; ?>" />\r
+ </form>\r
+ </div>\r
+ </div>\r
+ </div>\r
+ <?php }\r
+ } ?>\r
+ <br class="clearboth" />\r
+\r
+ <?php if ($hp_show_agentdetails && $hp_use_companyagent) { ?>\r
+ <div id="hp_view_agent_title"><span class="flecha_big">› </span><?php echo _HP_VIEW_AGENT_TITLE; ?></div>\r
+ <div id="hp_view_agent_con">\r
+ <?php hotproperty_HTML::show_AgentInfo($agent) ?>\r
+ </div>\r
+ <?php } ?>\r
+ <?php if ($hp_show_enquiryform && !$pop) { ?>\r
+ <br class="clearboth" />\r
+ <div id="hp_view_agent_contact"><span class="flecha_big">› </span><?php echo _HP_VIEW_AGENT_CONTACT; ?></div>\r
+ <div id="hp_emailform_con">\r
+ <?php hotproperty_HTML::show_EmailForm('property',$prop[0]->id,$prop[0]->name,$prop[0]->typeid); ?>\r
+ </div>\r
+ <?php }\r
+ if ($pop) {\r
+ ?>\r
+ <center><a href='javascript:window.close();'><span class="small"><?php echo _PROMPT_CLOSE;?></span></a></center>\r
+ <?php } ?>\r
+ </div>\r
+ <?php\r
+ }\r
+\r
+ /***\r
+ * Common Routine to display Agent's Info\r
+ **/\r
+ function show_AgentInfo($agent) {\r
+ global $mosConfig_live_site, $hp_imgdir_agent, $task, $Itemid, $my;\r
+\r
+ if (empty($agent)) {\r
+ echo _HP_AGENT_ERROR_EMPTY;\r
+ } else { ?>\r
+ <script src="components/com_hotproperty/js/resalte.js" type="text/javascript"></script>\r
+ <div class="hp_view_agent">\r
+ <div id="hp_view_agent_details">\r
+ <?php if (!empty($agent->photo)) { ?>\r
+ <div id="hp_view_agent_photo">\r
+ <?php if ($task <> "viewagent") { ?>\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewagent&id=$agent->id&Itemid=$Itemid"); ?>">\r
+ <img border="0" src="<?php echo $mosConfig_live_site.$hp_imgdir_agent.$agent->photo; ?>" alt="<?php echo $agent->name; ?>" />\r
+ </a>\r
+ <?php } else { ?>\r
+ <img border="0" src="<?php echo $mosConfig_live_site.$hp_imgdir_agent.$agent->photo; ?>" alt="<?php echo $agent->name; ?>" />\r
+ <?php } ?>\r
+ </div>\r
+ <?php } ?>\r
+ <div class="obj_con_botonera">\r
+ <div class="nombre_objeto">\r
+ <span id="hp_caption_agentname"><?php if ($task <> "viewagent") { ?><a id="hp_caption_agentname" href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewagent&id=$agent->id&Itemid=$Itemid"); ?>"><?php echo $agent->name; ?></a><?php } else { ?><?php echo $agent->name; ?><?php } ?></span>\r
+ </div>\r
+ <div class="botonera_dcha">\r
+ <?php\r
+ # Muestra el icono para modificar el perfil si somos el usuario adecuado\r
+ if ($agent->user == $my->id && $agent->user > 0 && $my->id > 0) { ?>\r
+ <div class="mini_boton">\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=editagent&Itemid=$Itemid"); ?>" title="<?= _HP_AGENT_MODIFY ?>"><img src="administrator/images/modif_perfil.png" alt="<?= _HP_AGENT_MODIFY ?>" title="<?= _HP_AGENT_MODIFY ?>" onmouseover="swap_resalte('modif_perfil',1);" onmouseout="swap_resalte('modif_perfil',0);" class="bot_gestionar" id="img_modif_perfil"/></a>\r
+ </div>\r
+ <div class="texto_mini_boton">\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=editagent&Itemid=$Itemid"); ?>" title="<?= _HP_AGENT_MODIFY ?>" id="a_modif_perfil" onmouseover="swap_resalte('modif_perfil',1);" onmouseout="swap_resalte('modif_perfil',0);"> <?= _HP_AGENT_MODIFY ?> </a>\r
+ </div>\r
+ <?php } ?>\r
+\r
+ <?php\r
+ # Muestra icono enviar email si estamos en viewagent|viewco y somos un usuario distinto\r
+ if( ($task == "viewagent" || $task == "viewco") && !empty($agent->email) && $agent->user != $my->id) { ; ?>\r
+ <div class="mini_boton">\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewagentemail&id=$agent->id&Itemid=$Itemid"); ?>"><img src="administrator/images/correo.png" alt="<?= _HP_AGENT_SENDEMAIL ?>" title="<?= _HP_AGENT_SENDEMAIL ?>" onmouseover="this.src='administrator/images/correo_on.png';swap_resalte('correo',1);" onmouseout="this.src='administrator/images/correo.png';swap_resalte('correo',0);" class="bot_gestionar" id="img_correo"/></a>\r
+ </div>\r
+ <div class="texto_mini_boton">\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewagentemail&id=$agent->id&Itemid=$Itemid"); ?>" id="a_correo" onmouseover="swap_resalte('correo',1);" onmouseout="swap_resalte('correo',0);"><?= _HP_AGENT_SENDEMAIL ?></a>\r
+ </div>\r
+ <?php } ?>\r
+ <?php\r
+ # Muestra enlace ver todas las ofertas si estamos en página detalle\r
+ if( $task == "view" ) { ?>\r
+ <div class="mini_boton">\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewagent&id=$agent->id&Itemid="); ?>"><img src="administrator/images/ver.png" alt="<?= _HP_VER_OFERTAS ?>" title="<?= _HP_VER_OFERTAS ?>" onmouseover="swap_resalte('ver',1);" onmouseout="swap_resalte('ver',0);" class="bot_gestionar" id="img_ver"/></a>\r
+ </div>\r
+ <div class="texto_mini_boton">\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewagent&id=$agent->id&Itemid="); ?>" id="a_ver" onmouseover="swap_resalte('ver',1);" onmouseout="swap_resalte('ver',0);"><?= _HP_VER_OFERTAS ?></a>\r
+ </div>\r
+ <?php } ?>\r
+\r
+ </div>\r
+ </div>\r
+ <br class="clearboth"/>\r
+ <br class="clearboth"/>\r
+\r
+ <?php if (!empty($agent->desc)) { ?>\r
+ <div id="hp_view_agent_desc"><?php echo $agent->desc; ?></div>\r
+ <?php } ?>\r
+\r
+ <?php\r
+ # Display Mobile number if not empty\r
+ if (!empty($agent->mobile)) { ?>\r
+ <span class="hp_caption"><?= _HP_AGENT_MOBILE; ?>:</span> <?= $agent->mobile; ?>.<br/>\r
+ <?php # Muestra disponibiblidad teléfono móvil\r
+ if (!empty($agent->disp_mov_from)) { ?>\r
+ <span class="hp_caption"><?= _HP_AGENT_DISP; ?></span> de <?= dia_semana($agent->disp_mov_from); ?> a <?= dia_semana($agent->disp_mov_to); ?> de <?= $agent->disp_mov_from_hora; ?> a <?= $agent->disp_mov_to_hora; ?>.<br/>\r
+ <?php }\r
+ } ?> <!-- fin movil -->\r
+\r
+ <?php\r
+ # Muestra el teléfono fijo si existe\r
+ if (!empty($agent->fijo)) { ?>\r
+ <span class="hp_caption"><?php echo _HP_AGENT_PHONE; ?>:</span> <?php echo $agent->fijo; ?>.\r
+ <br/>\r
+ <?php\r
+ # Muestra disponibilidad teléfono fijo\r
+ if (!empty($agent->disp_fijo_from)) { ?>\r
+ <span class="hp_caption"><?= _HP_AGENT_DISP ?></span> de <?= dia_semana($agent->disp_fijo_from); ?> a <?= dia_semana($agent->disp_fijo_to); ?> de <?= $agent->disp_fijo_from_hora; ?> a <?= $agent->disp_fijo_to_hora; ?>.<br />\r
+ <?php } ?> <!-- fin disponibilidad -->\r
+\r
+ <?php } ?> <!-- fin fijo -->\r
+\r
+ <?php\r
+ # Muestra los idiomas hablados si no está vacío\r
+ if (!empty($agent->idiomas_hablados)) { ?>\r
+ <span class="hp_caption"><?php echo _HP_AGENT_IDIOMAS; ?>:</span> <?= str_replace("|",", ",$agent->idiomas_hablados) ?>.\r
+ <br />\r
+ <?php } ?>\r
+ </div>\r
+ </div>\r
+ <?php\r
+ } // End If\r
+ }\r
+\r
+ /***\r
+ * Common Routine to display Company's Info\r
+ **/\r
+ function show_CoInfo($companies, $agent) {\r
+ global $mosConfig_live_site, $hp_imgdir_company, $task, $Itemid, $my;\r
+\r
+ foreach($companies AS $co) {\r
+ ?>\r
+ <div class="hp_view_co">\r
+ <?php if (!empty($co->photo)) { ?>\r
+ <div id="hp_view_co_photo"><img src="<?php echo $mosConfig_live_site.$hp_imgdir_company.$co->photo; ?>" alt="<?php echo $co->name; ?>" /></div>\r
+ <?php } ?>\r
+ <div class="obj_con_botonera">\r
+ <div class="nombre_objeto_corto">\r
+ <div id="hp_view_co_details">\r
+ <span id="hp_caption_coname">\r
+ <?php if ($task <> "viewco") { ?><a id="hp_caption_coname" href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewco&id=$co->id&Itemid=$Itemid"); ?>"><?php echo $co->name; ?></a><?php } else {\r
+ echo $co->name;\r
+ } ?></span>\r
+ </div>\r
+ <br/>\r
+ <div id="hp_co_addr">\r
+ <?php\r
+ if (trim($co->address)!="") {\r
+ echo "$co->address <br />";\r
+ }\r
+ if ((trim($co->suburb)!="") && (trim($co->state)!="") && (trim($co->postcode)!="")) {\r
+ echo "$co->suburb, $co->state, $co->postcode <br />";\r
+ } elseif ((trim($co->suburb)!="") && (trim($co->state)!="")) {\r
+ echo "$co->suburb, $co->state <br />";\r
+ } elseif ((trim($co->suburb)!="") && (trim($co->postcode)!="")) {\r
+ echo "$co->suburb, $co->postcode <br />";\r
+ } elseif ((trim($co->state)!="") && (trim($co->postcode)!="")) {\r
+ echo "$co->state, $co->postcode <br />";\r
+ } elseif ((trim($co->state)!="")) {\r
+ echo "$co->state <br />";\r
+ } elseif ((trim($co->suburb)!="")) {\r
+ echo "$co->suburb <br />";\r
+ } elseif ((trim($co->postcode)!="")) {\r
+ echo "$co->postcode <br />";\r
+ }\r
+ if (trim($co->country)!="") {\r
+ echo "$co->country <br />";\r
+ }\r
+ ?></div>\r
+ </div>\r
+ <div class="botonera_dcha">\r
+ <?php\r
+ # Show an edit icon to allow user to edit their own profile\r
+ if ($agent->user == $my->id && $agent->user > 0 && $my->id > 0) { ?>\r
+ \r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=editagent&Itemid=$Itemid"); ?>" title="<?= _HP_AGENT_MODIFY ?>"><img src="administrator/images/editar.png" alt="<?= _HP_AGENT_MODIFY ?>" title="<?= _HP_AGENT_MODIFY ?>" onmouseover="this.src='administrator/images/editar_on.png';" onmouseout="this.src='administrator/images/editar.png'" class="bot_gestionar"/></a>\r
+ <?php } ?>\r
+\r
+ <?php\r
+ # Display "Send email link" if user at viewagent or viewco\r
+ if( ($task == "viewagent" || $task == "viewco") && !empty($agent->email) ) { ; ?>\r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewagentemail&id=$agent->id&Itemid=$Itemid"); ?>"><img src="administrator/images/correo.png" alt="<?= _HP_AGENT_SENDEMAIL ?>" title="<?= _HP_AGENT_SENDEMAIL ?>" onmouseover="this.src='administrator/images/correo_on.png';" onmouseout="this.src='administrator/images/correo.png'" class="bot_gestionar"/></a><br />\r
+ <?php } ?>\r
+ </div> <!-- FIN div.botonera_dcha -->\r
+ </div> <!-- FIN div.obj_con_botonera -->\r
+\r
+ <br class="clearboth"/>\r
+ <div id="hp_view_co_other_data">\r
+ <br/>\r
+\r
+ <!-- Teléfono fijo -->\r
+ <?php if (!empty($co->telephone)) { ?>\r
+ <span class="hp_caption"><?php echo _HP_CONTACTNUMBER; ?>: </span><?php echo $co->telephone; ?>.\r
+ <br/>\r
+ <?php\r
+ # Muestra disponibilidad teléfono fijo\r
+ if (!empty($co->disp_fijo_from)) { ?>\r
+ <span class="hp_caption"><?= _HP_AGENT_DISP ?></span> <?= dia_semana($co->disp_fijo_from); ?> a <?= dia_semana($co->disp_fijo_to); ?> de <?= $co->disp_fijo_from_hora; ?> a <?= $co->disp_fijo_to_hora; ?>.<br />\r
+ <?php } ?> <!-- fin disponibilidad -->\r
+ <?php }?> <!-- fin teléfono fijo -->\r
+\r
+ <!-- Teléfono móvil -->\r
+ <?php if (!empty($co->mobile)) { ?>\r
+ <span class="hp_caption"><?php echo _HP_AGENT_MOBILE; ?>: </span><?php echo $co->mobile; ?><br />\r
+ <?php\r
+ # Muestra disponibilidad teléfono móvil\r
+ if (!empty($co->disp_mov_from)) { ?>\r
+ <span class="hp_caption"><?= _HP_AGENT_DISP ?></span> <?= dia_semana($co->disp_mov_from); ?> a <?= dia_semana($co->disp_mov_to); ?> de <?= $co->disp_mov_from_hora; ?> a <?= $co->disp_mov_to_hora; ?>.<br />\r
+ <?php } ?> <!-- fin disponibilidad -->\r
+ <?php }?> <!-- fin teléfono móvil -->\r
+\r
+ <?php if (!empty($co->website)) { ?>\r
+ <span class="hp_caption"><?php echo _HP_CO_WEBSITE; ?> </span><a href="<?php echo $co->website; ?>" target="_blank"><?php echo $co->website; ?></a><br />\r
+ <?php }?>\r
+ <?php if (!empty($co->desc)) { ?>\r
+ <p />\r
+ <?php echo $co->desc; ?>\r
+ <?php } ?>\r
+ </div>\r
+ <?php\r
+ # Muestra los idiomas hablados si no está vacío\r
+ if (!empty($co->idiomas_hablados)) { ?>\r
+ <span class="hp_caption"><?php echo _HP_AGENT_IDIOMAS; ?>:</span> <?= str_replace("|",", ",$co->idiomas_hablados) ?>.\r
+ <br/>\r
+ <?php } ?>\r
+\r
+ </div>\r
+ <br class="clearboth" />\r
+ <?php\r
+ }\r
+ }\r
+\r
+ /***\r
+ * Display Email form\r
+ ***/\r
+ function show_EmailForm($subject, $id, $titulo=null, $tipo_oferta=null) {\r
+ global $Itemid;\r
+\r
+ if ($subject <> "agent" && $subject <> "property" && $subject <> "company") return false;\r
+ ?>\r
+ <form method="POST" action="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=sendenquiry&id=".$id."&Itemid=".$Itemid); ?>">\r
+ <input type="hidden" name="titulo" value="<?= $titulo ?>">\r
+ <input type="hidden" name="tipo_oferta" value="<?= $tipo_oferta ?>">\r
+\r
+ <div class="cont_form"><div class="agent_text"><?php echo _CMN_NAME; ?>*:</div>\r
+ <input type="text" class="inputbox" name="hp_name" size="24" /></div>\r
+\r
+ <div class="cont_form"><div class="agent_text"><?php echo _CMN_EMAIL; ?>*:</div>\r
+ <input type="text" class="inputbox" name="hp_email" size="30" /></div>\r
+\r
+ <div class="cont_form"><div class="agent_text"><?php echo _HP_CONTACTNUMBER; ?>*:</div>\r
+ <input type="text" class="inputbox" name="hp_contactnumber" size="30" /></div>\r
+\r
+ <div class="cont_form ">\r
+ <span class="agent_text"><?= _HP_AGENT_DISP ?><?= _HP_AGENT_DISP_DE ?></span>\r
+ <select name="disp_mov_from" class="inputbox">\r
+ <?php $valor=$row->disp_mov_from; ?>\r
+ <option value='0'><?= _HP_DIA; ?></option>\r
+ <option value ='1'><?= _HP_L; ?></option>\r
+ <option value ='2'><?= _HP_M; ?></option>\r
+ <option value ='3'><?= _HP_X; ?></option>\r
+ <option value ='4'><?= _HP_J; ?></option>\r
+ <option value ='5'><?= _HP_V; ?></option>\r
+ <option value ='6'><?= _HP_S; ?></option>\r
+ <option value ='7'><?= _HP_D; ?></option>\r
+ </select>\r
+ <?= _HP_AGENT_DISP_A ?>\r
+ <select name="disp_mov_to" class="inputbox">\r
+ <?php $valor=$row->disp_mov_to; ?>\r
+ <option value='0'><?php echo _HP_DIA; ?></option>\r
+ <option value ='1'><?php echo _HP_L; ?></option>\r
+ <option value ='2'><?php echo _HP_M; ?></option>\r
+ <option value ='3'><?php echo _HP_X; ?></option>\r
+ <option value ='4'><?php echo _HP_J; ?></option>\r
+ <option value ='5'><?php echo _HP_V; ?></option>\r
+ <option value ='6'><?php echo _HP_S; ?></option>\r
+ <option value ='7'><?php echo _HP_D; ?></option>\r
+ </select>\r
+ <?= _HP_AGENT_DISP_DE ?>\r
+ <select name="disp_mov_from_hora" class="inputbox">\r
+ <?php $valor=$row->disp_mov_from_hora; ?>\r
+ <option value='0' ><?= _HP_HORA ?></option>\r
+ <option value ='06:00'>06:00</option>\r
+ <option value ='07:00'>07:00</option>\r
+ <option value ='08:00'>08:00</option>\r
+ <option value ='09:00'>09:00</option>\r
+ <option value ='10:00'>10:00</option>\r
+ <option value ='11:00'>11:00</option>\r
+ <option value ='12:00'>12:00</option>\r
+ <option value ='13:00'>13:00</option>\r
+ <option value ='14:00'>14:00</option>\r
+ <option value ='15:00'>15:00</option>\r
+ <option value ='16:00'>16:00</option>\r
+ <option value ='17:00'>17:00</option>\r
+ <option value ='18:00'>18:00</option>\r
+ <option value ='19:00'>19:00</option>\r
+ <option value ='20:00'>20:00</option>\r
+ <option value ='21:00'>21:00</option>\r
+ <option value ='22:00'>22:00</option>\r
+ <option value ='23:00'>23:00</option>\r
+ <option value ='00:00'>00:00</option>\r
+ </select>\r
+ <?= _HP_AGENT_DISP_A ?>\r
+ <select name="disp_mov_to_hora" class="inputbox">\r
+ <?php $valor=$row->disp_mov_to_hora; ?>\r
+ <option value='0' ><?= _HP_HORA ?></option>\r
+ <option value ='06:00'>06:00</option>\r
+ <option value ='07:00'>07:00</option>\r
+ <option value ='08:00'>08:00</option>\r
+ <option value ='09:00'>09:00</option>\r
+ <option value ='10:00'>10:00</option>\r
+ <option value ='11:00'>11:00</option>\r
+ <option value ='12:00'>12:00</option>\r
+ <option value ='13:00'>13:00</option>\r
+ <option value ='14:00'>14:00</option>\r
+ <option value ='15:00'>15:00</option>\r
+ <option value ='16:00'>16:00</option>\r
+ <option value ='17:00'>17:00</option>\r
+ <option value ='18:00'>18:00</option>\r
+ <option value ='19:00'>19:00</option>\r
+ <option value ='20:00'>20:00</option>\r
+ <option value ='21:00'>21:00</option>\r
+ <option value ='22:00'>22:00</option>\r
+ <option value ='23:00'>23:00</option>\r
+ <option value ='00:00'>00:00</option>\r
+ </select>\r
+ </div>\r
+\r
+\r
+ <div class="cont_form"><div class="agent_text"><?php echo _HP_SPOKEN_LANG; ?>:</div>\r
+ <?php\r
+\r
+ $idiomas = explode("|",_HP_IDIOMAS);\r
+ $hablados = explode("|",$row->idiomas_hablados);\r
+\r
+ foreach($hablados as $hablado)\r
+ $idiomas_hablados[$hablado]=true;\r
+\r
+\r
+ foreach($idiomas as $idioma) { ?>\r
+ <input type='checkbox' value='<?= $idioma ?>' name='habla[]'/><?= $idioma ?>\r
+ <?php } ?>\r
+ </div>\r
+\r
+\r
+ <?php if ( $tipo_oferta==1 ) /* Alquiler */ { ?>\r
+ <div class="cont_form"><div class="agent_text"><?php echo _HP_DIA_LLEGADA ?>:</div>\r
+ <input class="inputbox" type="text" name="dia_llegada" size="10" maxlength="10">\r
+ </div>\r
+ <div class="cont_form"><div class="agent_text"><?php echo _HP_DIA_SALIDA ?>:</div>\r
+ <input class="inputbox" type="text" name="dia_salida" size="10" maxlength="10">\r
+ </div>\r
+ <?php } ?>\r
+\r
+ <div class="cont_form"><div class="agent_text"><?php echo _ENQUIRY; ?>*:</div>\r
+ <textarea rows="4" cols="40" class="inputbox" name="hp_enquiry"></textarea>\r
+ <br/>\r
+ <input type="hidden" name="sbj" value="<?php echo $subject; ?>" />\r
+ <input class="button" type="submit" value="<?php echo _HP_SENDENQUIRY; ?>" /></div>\r
+\r
+ </form>\r
+ <?php\r
+ }\r
+\r
+ function sendEmailForm($id, $title) {\r
+ global $mosConfig_sitename;\r
+?>\r
+<script language="javascript" type="text/javascript">\r
+ function submitbutton() {\r
+ var form = document.frontendForm;\r
+\r
+ // do field validation\r
+ if (form.email.value == "" || form.youremail.value == "") {\r
+ alert( '<?php echo addslashes( _EMAIL_ERR_NOINFO ); ?>' );\r
+ return false;\r
+ }\r
+ return true;\r
+ }\r
+ function textCounter(field, maxlimit) {\r
+ if (field.value.length > maxlimit) // if too long...trim it!\r
+ field.value = field.value.substring(0, maxlimit);\r
+ }\r
+ </script>\r
+<title><?php echo $mosConfig_sitename; ?> :: <?php echo $title; ?></title>\r
+<body class="contentpane">\r
+<form action="index2.php?option=com_hotproperty&task=emailsend" name="frontendForm" method="POST" onSubmit="return submitbutton();">\r
+ <br/>\r
+ <div class="titulo"><span class="flecha_big">› </span><?php echo _EMAIL_FRIEND; ?></div>\r
+ <br/>\r
+ <div class="cont_form">\r
+ <div class="agent_text"><?php echo _EMAIL_FRIEND_ADDR; ?></div>\r
+ <input type="text" name="email" class="inputbox" size="25">\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="agent_text"><?php echo _EMAIL_YOUR_NAME; ?></div>\r
+ <input type="text" name="yourname" class="inputbox" size="25">\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="agent_text"><?php echo _EMAIL_YOUR_MAIL; ?></div>\r
+ <input type="text" name="youremail" class="inputbox" size="25">\r
+ </div>\r
+ <div class="cont_form">\r
+ <div class="agent_text"><?php echo _EMAIL_YOUR_MESS; ?></div>\r
+ <textarea name="yourmess" class="inputbox" cols="23" rows="4" onkeydown="textCounter(this.form.yourmess, 250);" onkeyup="textCounter(this.form.yourmess, 250);"></textarea>\r
+ </div>\r
+ <br/>\r
+ <div class="centro">\r
+ <input type="submit" name="submit" class="button" value="<?php echo _BUTTON_SUBMIT_MAIL; ?>">\r
+ <input type="button" name="cancel" value="<?php echo _BUTTON_CANCEL; ?>" class="button" onClick="window.close();"></td>\r
+ </div>\r
+ <input type="hidden" name="id" value="<?php echo $id; ?>">\r
+</form>\r
+<?php\r
+ }\r
+\r
+ function emailSent( $to ) {\r
+ global $mosConfig_sitename;\r
+?>\r
+<br />\r
+<?php echo _EMAIL_SENT; ?>\r
+<br />\r
+<br />\r
+<?php if (!$hide_js) { php?>\r
+ <a href='javascript:window.close();'>\r
+ <span class="small"><?php echo _PROMPT_CLOSE;?></span>\r
+ </a>\r
+<?php\r
+ }\r
+ }\r
+ /***\r
+ * Common Routine to display properties\r
+ ***/\r
+ function list_properties(&$prop, &$caption) {\r
+ global $Itemid, $task, $my, $mosConfig_live_site, $mosConfig_absolute_path;\r
+ global $hp_imgdir_thumb, $hp_currency, $hp_imgsize_thumb, $hp_img_noimage_thumb, $hp_thousand_sep, $hp_dec_point, $hp_link_open_newwin, $hp_show_thumb, $hp_dec_string, $hp_thousand_string;\r
+\r
+ if(empty($prop)) {\r
+ ?>\r
+ <div id="hp_error_empty">\r
+ <?php echo _HP_PROP_ERROR_EMPTY; ?>\r
+ </div>\r
+ <?php\r
+ } else {\r
+ foreach($prop AS $p) {\r
+ if ($p->thumb <> '') {\r
+ $thumb_imgsize = GetImageSize ($mosConfig_absolute_path.$hp_imgdir_thumb.$p->thumb);\r
+ } else {\r
+ $thumb_imgsize = GetImageSize ($mosConfig_absolute_path.$hp_imgdir_thumb.$hp_img_noimage_thumb);\r
+ }\r
+ ?>\r
+ <div class="hp_prop">\r
+ <div class="hp_details">\r
+ <?php if ($hp_show_thumb) { ?>\r
+ <div class="img_thumb"><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=view&id=$p->id&Itemid=$Itemid"); ?>"><img <?php echo $thumb_imgsize[3]; ?> border="0" src="<?php\r
+ if ($p->thumb <> '') echo $mosConfig_live_site.$hp_imgdir_thumb.$p->thumb;\r
+ else echo $mosConfig_live_site.$hp_imgdir_thumb.$hp_img_noimage_thumb;\r
+ ?>" alt="<?php echo $p->thumb_title ?>" /></a></div>\r
+ <?php } ?>\r
+ <div class="datos_oferta">\r
+ <div class="nombre_objeto">\r
+ <a class="hp_title" href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=view&id=$p->id&Itemid=$Itemid"); ?>"><?php echo $p->name; ?></a>\r
+ </div>\r
+ <div class="botonera_dcha">\r
+ <?php\r
+ # Show an edit icon to allow user to edit the property\r
+ if ($p->user == $my->id && $p->user > 0 && $my->id > 0) { ?>\r
+ \r
+ <a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=editprop&id=$p->id&Itemid=$Itemid"); ?>" title="<?php echo _E_EDIT; ?>"><img src="administrator/images/editar.png" alt="<?= _E_EDIT ?>" title="<?= _E_EDIT ?>" onmouseover="this.src='administrator/images/editar_on.png';" onmouseout="this.src='administrator/images/editar.png'" class="bot_gestionar"/></a>\r
+ <?php }\r
+ ?>\r
+ </div>\r
+ <br class="clearboth"/>\r
+ <?php\r
+ /* Escupe los campos de manera poco flexible pero práctica */\r
+ echo '<div class="columna_listado_izq">';\r
+ // Población\r
+ if (!$caption['suburb']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['suburb']->caption."</span>: ";\r
+ echo $p->suburb.".<br />";\r
+ // Provincia\r
+ if (!$caption['state']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['state']->caption."</span>: ";\r
+ echo $p->state.".<br />";\r
+\r
+ // Barrio\r
+ if (!$p->Barrio=="")\r
+ {\r
+ if (!$caption['Barrio']->hideCaption)\r
+\r
+ echo '<span class="hp_caption">'.$caption['Barrio']->caption."</span>: ";\r
+ echo $p->Barrio.".<br />";\r
+ }\r
+\r
+\r
+ // Nº plazas\r
+ if ($p->typeid == 1 && $p->Num_plazas != "")\r
+ {\r
+ if (!$caption['Num_plazas']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['Num_plazas']->caption."</span>: ";\r
+ echo $p->Num_plazas.".<br />";\r
+ }\r
+\r
+ // Metros construidos\r
+ if ($p->MetrosConstruidos != "") // Venta\r
+ {\r
+ if (!$caption['MetrosConstruidos']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['MetrosConstruidos']->caption."</span>: ";\r
+ echo $p->MetrosConstruidos." ".$caption['MetrosConstruidos']->append_text.".<br />";\r
+ }\r
+\r
+ // Año construccion\r
+ if ($p->AnioConstruccion != "") // Venta\r
+ {\r
+ if (!$caption['AnioConstruccion']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['AnioConstruccion']->caption."</span>: ";\r
+ echo $p->AnioConstruccion."<br />";\r
+ }\r
+\r
+ // Número de dormitorios\r
+ if ($p->Numero_dormitorios != "") // Alquiler\r
+ {\r
+ if (!$caption['Numero_dormitorios']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['Numero_dormitorios']->caption."</span>: ";\r
+ echo $p->Numero_dormitorios.".<br/>";\r
+ }\r
+\r
+ // Precio\r
+ if ($p->price != "0") // Venta\r
+ {\r
+ if (!$caption['price']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['price']->caption."</span>: ";\r
+ echo number_format($p->price,2,',','.')." ".$caption['price']->append_text."<br/>";\r
+ }\r
+\r
+ echo '</div>';\r
+\r
+ echo '<div class="columna_listado_dcha">';\r
+ // Cuartos de baño\r
+ if (!$caption['Cuartos_banio_con_duchas']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['Cuartos_banio_con_duchas']->caption."</span>: ";\r
+ if ($p->Cuartos_banio_con_duchas <> "")\r
+ echo $p->Cuartos_banio_con_duchas.". ";\r
+ else\r
+ echo _OFER_NINGUNO." ";\r
+ // Aseos\r
+ if (!$caption['Aseos']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['Aseos']->caption."</span>: ";\r
+\r
+ if ($p->Aseos <> "")\r
+ echo $p->Aseos.".<br />";\r
+ else\r
+ echo _OFER_NINGUNO."<br />";\r
+ // Dispone\r
+ if (!$caption['Dispone']->hideCaption)\r
+ echo '<span class="hp_caption">'.$caption['Dispone']->caption."</span>: ";\r
+\r
+ echo str_replace("|",", ",$p->Dispone).".<br />";\r
+ echo '</div>';\r
+ ?>\r
+ <?php\r
+ echo '<br class="clearboth">';\r
+ // Resumen\r
+ # echo $p->Resumen."<br/><br/>";\r
+\r
+\r
+ /* Antiguo código que escupÃa los campos */\r
+ /*foreach($p as $key => $value) {\r
+ if ( array_key_exists($key,$caption) && ($caption[$key]->name <> 'name' && $caption[$key]->name <> 'thumb' && $caption[$key]->name <> 'thumb_title' && $caption[$key]->name <> '' && $value <> "") )\r
+ # Replace '|' with a comma for checkbox and select multiple fields\r
+ if ($caption[$key]->field_type == "checkbox" || $caption[$key]->field_type == "selectmultiple") {\r
+ if (!$caption[$key]->hideCaption) echo '<span class="hp_caption">'.$caption[$key]->caption."</span>: ";\r
+ echo str_replace("|",", ",$value).".<br />";\r
+ # Web Link\r
+ } elseif ($caption[$key]->field_type == "link") {\r
+\r
+ // Evaluate mambot style data\r
+ $value = str_replace( '{property_id}', $p->id, $value );\r
+ $value = str_replace( '{type_id}', $p->typeid, $value );\r
+ $value = str_replace( '{agent_id}', $p->agentid, $value );\r
+ $value = str_replace( '{company_id}', $p->companyid, $value );\r
+ $value = str_replace( '{Itemid}', $Itemid, $value );\r
+\r
+ if (!$caption[$key]->hideCaption) {\r
+ ?><span class="hp_caption"><?php echo $caption[$key]->caption; ?></span>: <?php }\r
+ echo $caption[$key]->prefix_text;\r
+ $link = explode("|",$value);\r
+ if (count($link) == 1 && ( substr(trim($link[0]),0,4) == "http" || substr(trim($link[0]),0,5) == "index" ) ) {\r
+ ?><a <?php echo ($hp_link_open_newwin) ? 'target="_blank" ': ''; ?>href="<?php echo $link[0]; ?>"><?php echo $link[0]; ?></a><?php\r
+ } elseif (count($link) > 1 && ( substr(trim($link[1]),0,4) == "http" || substr(trim($link[1]),0,5) == "index" ) ) {\r
+ ?><a <?php echo ($hp_link_open_newwin) ? 'target="_blank" ': ''; ?>href="<?php echo $link[1]; ?>"><?php echo $link[0]; ?></a><?php\r
+ } else {\r
+ echo $value;\r
+ }\r
+ echo $caption[$key]->prefix_text."<br />";\r
+\r
+ } else {\r
+ # Do not display agent field when viewing agent's properties\r
+ # Do not display type field when viewing type's properties\r
+ if ( !($key == "agent" && $task == "viewagent") && !($key =="type" && $task == "viewtype") ) {\r
+ # Show agent link\r
+ if ($key == "agent") {\r
+ if (!$caption[$key]->hideCaption) {\r
+ ?><span class="hp_caption"><?php echo $caption[$key]->caption; ?></span>: <?php\r
+ }\r
+ ?><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewagent&id=$p->agentid&Itemid=$Itemid"); ?>"><?php echo $caption[$key]->prefix_text.$value.$caption[$key]->append_text; ?></a><br /><?php\r
+ # Show company link\r
+ } elseif ($key == "company") {\r
+ if (!$caption[$key]->hideCaption) {\r
+ ?><span class="hp_caption"><?php echo $caption[$key]->caption; ?></span>: <?php }\r
+ ?><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewco&id=".$p->companyid."&Itemid=$Itemid"); ?>"> <?php echo $caption[$key]->prefix_text.$value.$caption[$key]->append_text; ?></a><br /> <?php\r
+ # Show type link\r
+ } elseif ($key == "type") {\r
+ if (!$caption[$key]->hideCaption) {\r
+ ?><span class="hp_caption"><?php echo $caption[$key]->caption; ?></span>: <?php }\r
+ ?><a href="<?php echo sefRelToAbs("index.php?option=com_hotproperty&task=viewtype&id=".$p->typeid."&Itemid=$Itemid"); ?>"> <?php echo $caption[$key]->prefix_text.$value.$caption[$key]->append_text; ?></a><br /> <?php\r
+ # Show Price with proper formating\r
+ } elseif ($key == "price") {\r
+ if (!$caption[$key]->hideCaption) {\r
+ ?><span class="hp_caption"><?php echo $caption[$key]->caption; ?></span>:<?php }\r
+ ?><span class="hp_price"><?php echo $caption[$key]->prefix_text.$hp_currency." ".number_format($value, $hp_dec_point, $hp_dec_string, ($hp_thousand_sep) ? $hp_thousand_string:'').$caption[$key]->append_text; ?></span><br /> <?php\r
+ # Show Featured as Yes/No instead of 1/0\r
+ } elseif ($key == "featured") {\r
+ if (!$caption[$key]->hideCaption) {\r
+ echo '<span class="hp_caption">'.$caption[$key]->caption."</span>: ";\r
+ }\r
+ echo $caption[$key]->prefix_text\r
+ . ( ($value == '1') ? _CMN_YES : _CMN_NO )\r
+ . $caption[$key]->append_text\r
+ . "<br />";\r
+ # Else, show normal 'caption: value'\r
+ } else {\r
+ if (!$caption[$key]->hideCaption) {\r
+ echo '<span class="hp_caption">'.$caption[$key]->caption."</span>: ";\r
+ }\r
+ echo $caption[$key]->prefix_text\r
+ . ( ($key=="price") ? $hp_currency." " : "" )\r
+ . $value\r
+ . $caption[$key]->append_text\r
+ . "<br />";\r
+ }\r
+ }\r
+ }\r
+ }*/\r
+\r
+ ?>\r
+ </div>\r
+ </div>\r
+\r
+ </div>\r
+ <?php\r
+ } // End Foreach\r
+ } // End If\r
+ }\r
+\r
+ function seleccion_fecha ( $name ) {\r
+ ?>\r
+ <?php\r
+ if ($name == "desde")\r
+ {\r
+ echo "<div class=\"titulo_fecha\">"._HPAVL_DESDE." </div>";\r
+ }\r
+ else\r
+ {\r
+ echo "<div class=\"titulo_fecha\">"._HPAVL_HASTA." </div>";\r
+ }\r
+ ?>\r
+ <!-- Día -->\r
+ <select size="1" name="<?php echo $name."_dia"; ?>" class="campo_fecha inputbox">\r
+ <?php\r
+ for ($i=1; $i<=31; $i++)\r
+ echo "<option value='".$i."'>".$i."</option>";\r
+ ?>\r
+ </select>\r
+\r
+ <!-- Mes -->\r
+ <select size="1" name="<?php echo $name."_mes"; ?>" class="campo_fecha inputbox">\r
+ <?php\r
+ for ($i=1; $i<=12; $i++)\r
+ echo "<option value='".$i."'>".$i."</option>";\r
+ ?>\r
+ </select>\r
+ <!-- Año -->\r
+ <select size="1" name="<?php echo $name."_año"; ?>" class="campo_fecha inputbox">\r
+ <?php\r
+ $hoy=getdate();\r
+ for ($i=$hoy['year']; $i<=2080; $i++)\r
+ echo "<option value='".$i."'>".$i."</option>";\r
+ ?>\r
+ </select>\r
+ <br class="clearboth"/>\r
+ <?php\r
+ }\r
+\r
+\r
+ function show_ResumenTipos() {\r
+ global $database;\r
+\r
+ # Select published types\r
+ $database->setQuery( "SELECT * FROM #__hp_prop_types AS t"\r
+ . "\nWHERE t.published='1'"\r
+ . "\nORDER BY t.ordering ASC");\r
+ $types = $database->loadObjectList();\r
+\r
+ foreach($types AS $t) { ?>\r
+ <a href="<?php echo sefRelToAbs('index.php?option=com_hotproperty&task=viewtype&id='.$t->id.'&Itemid='.$Itemid); ?>"><?= $t->name ?> ( <?= getNumOfertas($t->id) ?>)</a>\r
+ <?php }\r
+ }\r
+\r
+ function getNumOfertas($type_id) {\r
+ $database->setQuery( "SELECT id FROM #__hp_properties AS p"\r
+ . "\nWHERE p.type=".$type_id);\r
+ return $database->getNumRows();\r
+ }\r
+}\r
+\r
+\r
+?>\r
--- /dev/null
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title></title>
+ </head>
+ <body>
+© <??>
+ </body>
+</html>
--- /dev/null
+<?php
+/**
+ * @file doxysample.php
+ * @author Zoltán Nagy <abesto0@gmail.com>
+ * @date Fri May 29 15:28:06 2009
+ *
+ * @brief Example file commented with Doxygen (via doxymacs)
+ *
+ * Longer description of what this file is
+ * Possibly multiline
+ */
+
+
+/**
+ * Echos the parameter
+ *
+ * @param text Text to echo
+ *
+ * @return EOL message
+ */
+function say($text)
+{
+ echo $text;
+ return "I spoketh.";
+}
+?>
+
+<div>
+This is HTML, so the following has no special meaning:
+/**
+ * Fake comment
+ *
+ * @param whatever Foo
+ *
+ * @return bar
+ */
+</div>
--- /dev/null
+;; Setup
+(defvar word-wrap2 nil)
+(make-variable-buffer-local 'word-wrap2)
+(set-default 'word-wrap2 nil)
+
+(defcustom word-wrap3 nil
+ "doc 3"
+ :type 'boolean)
+(make-variable-buffer-local 'word-wrap3)
+(set-default 'word-wrap3 nil)
+
+(set-default 'word-wrap nil)
+(set-default 'truncate-lines nil)
+
+(put 'truncate-lines 'permanent-local t)
+(put 'word-wrap 'permanent-local t)
+(put 'word-wrap2 'permanent-local t)
+(put 'word-wrap3 'permanent-local t)
+
+(setq truncate-lines t)
+(setq word-wrap t)
+(setq word-wrap2 t)
+(setq word-wrap3 t)
+
+(kill-all-local-variables)
+
+;; Test
+(ert-should (eq (default-value 'word-wrap3) nil))
+(ert-should (eq word-wrap3 t))
+(ert-should (eq (default-value 'word-wrap2) nil))
+(ert-should (eq word-wrap2 t))
+(ert-should (eq (default-value 'truncate-lines) nil))
+(ert-should (eq truncate-lines t))
+(ert-should (eq (default-value 'word-wrap) nil))
+(ert-should (eq word-wrap t))
--- /dev/null
+;;; mumamo-test.el --- Test routines for mumamo
+;;
+;; Author: Lennart Borgman
+;; Created: Sat Mar 31 03:59:26 2007
+;; Version: 0.1
+;; Last-Updated:
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This file defines some test for mumamo.el and a the minor mode
+;; `mumamu-test-mode' to bind the test functions to some keys for
+;; convenient use. This will define F3 to run
+;; `mumamo-test-create-chunk-at' and Shift-F3 to
+;; `mumamo-test-create-chunks-at-all-points'.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;(eval-when-compile (require 'mumamo))
+(eval-when-compile (require 'mumamo))
+(require 'whelp)
+
+;;;;;;; TESTS, run in fundamental-mode buffer
+
+(defvar mumamo-test-mode-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [f11] 'goto-char)
+ (define-key map [(meta f3)] 'mumamo-test-fontify-region)
+ (define-key map [(shift f3)] 'mumamo-test-create-chunks-at-all-points)
+ (define-key map [f3] 'mumamo-test-create-chunk-at-point)
+ map))
+
+(defvar mumamo-test-current-chunk-family nil)
+(make-variable-buffer-local 'mumamo-test-current-chunk-family)
+
+(define-minor-mode mumamo-test-mode
+ "For testing creating mumamo-mode chunks.
+When this mode is on the following keys are defined:
+
+ \\{mumamo-test-mode-keymap}
+
+"
+ nil
+ " MuMaMo-TEST"
+ :keymap mumamo-test-mode-keymap
+ (if mumamo-test-mode
+ (progn
+ (setq mumamo-test-current-chunk-family mumamo-current-chunk-family)
+ (setq mumamo-use-condition-case nil)
+ (setq mumamo-debugger nil)
+ (run-with-idle-timer 0 nil 'mumamo-test-tell-bindings))
+ (setq mumamo-use-condition-case t)
+ (setq mumamo-debugger (default-value 'mumamo-debugger)))
+ )
+
+(defun mumamo-test-tell-bindings ()
+ (save-match-data ;; runs in timer
+ (let ((s "mumamo-test-mode is on, use F3/shift-F3 for simple testing"))
+ (put-text-property 0 (length s)
+ 'face 'font-lock-warning-face
+ s)
+ (message "%s" s))))
+
+;;(mumamo-test-mode 1)
+
+
+;; (defun mumamo-test-fontify-buffer ()
+;; (interactive)
+;; (unless mumamo-current-chunk-family
+;; (mumamo-select-chunk-family))
+;; ;;(when mumamo-mode (mumamo-mode 0))
+;; (when mumamo-multi-major-mode (mumamo-turn-off-actions))
+;; (save-excursion
+;; (mumamo-remove-all-chunk-overlays)
+;; (mumamo-save-buffer-state nil
+;; (put-text-property (point-min) (point-max) 'face nil))
+;; (mumamo-fontify-buffer)))
+
+(defun mumamo-test-create-chunk-at-point ()
+ (interactive)
+ (remove-hook 'post-command-hook 'mumamo-post-command t)
+ (font-lock-mode -1)
+ (setq fontification-functions nil)
+ (save-excursion
+ (mumamo-remove-all-chunk-overlays)
+ (mumamo-save-buffer-state nil
+ (remove-text-properties (point-min) (point-max) '(face nil syntax-table nil)))
+ (let* ((mumamo-current-chunk-family mumamo-test-current-chunk-family)
+ (here (point))
+ chunk
+ chunk2)
+ (mumamo-save-buffer-state nil
+ ;;(setq chunk (mumamo-create-chunk-at here)))
+ (setq chunk (mumamo-find-chunks here "test1")))
+ ;;(setq chunk2 (mumamo-get-chunk-at here))
+ (setq chunk2 (mumamo-find-chunks here "set chunk2"))
+ ;;(message "mumamo-test-create-chunk-at-point.chunk 1=%s" chunk)
+ ;;(lwarn 'test-create-chunk-at :warning "chunk=%s, chunk2=%s" chunk chunk2)
+ ;;(when (overlay-buffer chunk)
+ (assert (eq chunk chunk2))
+ ;;)
+ ;;(message "mumamo-test-create-chunk-at-point.chunk 2=%s" chunk)
+ ;;(syntax-ppss-flush-cache (1- (overlay-start chunk)))
+ (syntax-ppss-flush-cache (overlay-start chunk))
+ (let ((start (overlay-start chunk))
+ (end (overlay-end chunk)))
+ ;;(setq syntax-ppss-last (cons 319 (parse-partial-sexp 1 1)))
+ ;;(message "mumamo-test-create-chunk-at-point.chunk 2a=%s" chunk)
+ (mumamo-save-buffer-state nil
+ (mumamo-fontify-region-1 start end nil)))
+ ;;(message "mumamo-test-create-chunk-at-point.chunk 3=%s" chunk)
+ (unless mumamo-test-mode (mumamo-test-mode 1))
+ ;;(message "mumamo-test-create-chunk-at-point.chunk 4=%s" chunk)
+ chunk
+ ;;(message "test 2.debugger=%s" debugger)
+ ;;(mumamo-get-chunk-at here)
+ (mumamo-find-chunks here "return value")
+ )))
+
+(defun mumamo-test-create-chunks-at-all-points ()
+ (interactive)
+ ;;(goto-char (point-min))
+ (let (last-ovl
+ this-ovl)
+ (while (< (point) (point-max))
+ ;;(setq this-ovl (mumamo-test-create-chunk-at-point))
+ (setq this-ovl (mumamo-find-chunks (point) "test loop"))
+ ;;(message "this-ovl=%s" this-ovl)
+ (sit-for 0.005)
+ ;;(sit-for 0)
+ (when last-ovl
+ (if (= (point) (overlay-end last-ovl))
+ (assert (= (overlay-end last-ovl) (overlay-start this-ovl)))
+ (assert (= (overlay-start last-ovl) (overlay-start this-ovl)))
+ (assert (= (overlay-end last-ovl) (overlay-end this-ovl)))
+ ))
+ (if last-ovl
+ (move-overlay last-ovl (overlay-start this-ovl) (overlay-end this-ovl))
+ (setq last-ovl (make-overlay (overlay-start this-ovl) (overlay-end this-ovl))))
+ (forward-char 1)
+ )
+ (message "No problems found")))
+
+(defun mumamo-test-fontify-region ()
+ (interactive)
+ (let ((font-lock-mode t))
+ ;;(mumamo-fontify-region-with (point-min) (point-max) nil 'php-mode nil)
+ (mumamo-fontify-region (point-min) (point-max) t)))
+
+;; Fix-me: can't byte compile:
+;; (defun mumamo-test-easy-make ()
+;; (interactive)
+;; (let ((start-str "--Start Submode:")
+;; (end-str "--End Submode--")
+;; (start-reg nil))
+;; (setq start-reg
+;; ;; (rx
+;; ;; (eval start-str)
+;; ;; (0+ space)
+;; ;; (submatch
+;; ;; (0+ (any "a-z-")))
+;; ;; (0+ space)
+;; ;; "--"
+;; ;; )
+;; (rx-to-string
+;; `(and
+;; ,start-str
+;; (0+ space)
+;; (submatch
+;; (0+ (any "a-z-")))
+;; (0+ space)
+;; "--"
+;; ))
+;; )
+;; (mumamo-easy-make-chunk-fun testchunk
+;; start-str
+;; start-reg
+;; end-str))
+;; (setq mumamo-current-chunk-family
+;; (list "testing"
+;; 'text-mode
+;; (list
+;; 'testchunk
+;; ))))
+
+;; (defun mumamo-test-emb-perl ()
+;; (interactive)
+;; (let ((start-str "[-")
+;; (end-str "-]")
+;; (start-reg nil))
+;; (mumamo-easy-make-chunk-fun testchunk-ep
+;; start-str
+;; start-reg
+;; end-str))
+;; (setq mumamo-current-chunk-family
+;; (list "emb perl test"
+;; 'perl-mode
+;; (list
+;; 'testchunk-ep
+;; ))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; These are for testing bad initialization in mumamo. They can be
+;; used for example with php-mode. (They are mainly for development
+;; purposes.)
+;;
+;; (mumamo-bad-c-init)
+(defun mumamo-bad-c-init() (/ 1 0))
+(defun mumamo-setup-bad-c-init ()
+ (interactive)
+ (add-hook 'c-mode-common-hook 'mumamo-bad-c-init))
+(defun mumamo-teardown-bad-c-init ()
+ (interactive)
+ (remove-hook 'c-mode-common-hook 'mumamo-bad-c-init))
+
+
+;; (defmacro mumamo-get-backtrace (bodyform)
+;; "Evaluate BODYFORM, return backtrace as a string.
+;; If there is an error in BODYFORM then return the backtrace as a
+;; string, otherwise return nil."
+;; `(let* ((debugger-ret nil)
+;; (debugger (lambda (&rest debugger-args)
+;; (message "DEBUGGER CALLED BEFORE")
+;; (setq debugger-ret (with-output-to-string (backtrace)))
+;; (message "DEBUGGER CALLED AFTER, debugger-ret=%s" debugger-ret)
+;; ))
+;; (debug-on-error t)
+;; (debug-on-signal t)
+;; )
+;; (condition-case err
+;; (progn
+;; ,bodyform
+;; nil)
+;; (error
+;; (message "err=%S" err)
+;; (message "debugger-ret=%S\n\n\n" debugger-ret)
+;; (let* ((errmsg (error-message-string err))
+;; (debugger-lines (split-string debugger-ret "\n"))
+;; (dbg-ret (mapconcat 'identity (nthcdr 6 debugger-lines) "\n")))
+;; (concat errmsg "\n" dbg-ret))))))
+
+;; (defun mumamo-test3-debug()
+;; (interactive)
+;; (message "%s"
+;; (mumamo-get-backtrace
+;; (mumamo-test-major-mode-init 'php-mode))))
+
+;; (defun mumamo-test2-debug()
+;; (interactive)
+;; (mumamo-condition-case var
+;; (mumamo-test-major-mode-init 'php-mode)
+;; handlers))
+
+(defun mumamo-test-debug()
+ (interactive)
+ (condition-case err
+ (let ((debugger 'mumamo-debug)
+ (debug-on-error t)
+ (debug-on-signal t))
+ ;;(message "here d")(sit-for 1)
+ (mumamo-test-major-mode-init 'php-mode))
+ (error (message "here 2 err=%S" err))))
+
+(defun mumamo-debug (&rest debugger-args)
+ (let ((s (with-output-to-string (backtrace))))
+ (message "mumamo-debug: %s" s)))
+
+;; (defun mumamo-bt-to-msg (msg)
+;; (mumamo-msgfntfy "%s: %s" msg
+;; (with-output-to-string
+;; (backtrace))))
+
+(defun mumamo-test-major-mode-init (major)
+ "Turn on major mode MAJOR in a temp buffer.
+This function should be used after getting errors during
+fontification where the message in the *Message* buffer tells
+that you should call it to get a traceback.
+
+Send the traceback you get, if any, together with the message in
+the message buffer when reporting the error."
+ (interactive "CMajor mode: ")
+ (with-temp-buffer
+ ;;(setq mumamo-explicitly-turned-on-off t)
+ (setq debug-on-error t)
+ (funcall major)))
+
+(provide 'mumamo-test)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; mumamo-test.el ends here
--- /dev/null
+;;; test-Q.el --- Run test from a fresh Emacs
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-07-08T23:05:40+0200 Tue
+;; Version: 0.1
+;; Last-Updated: 2008-07-09T00:17:26+0200 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; Required feature `test-Q' was not provided.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Defines `nxhtmltest-Q'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'ourcomments-util))
+
+(eval-and-compile
+ (defvar nxhtmltest-bin-Q
+ (file-name-directory (or load-file-name
+ (when 'bytecomp-filename bytecomp-filename)
+ buffer-file-name)))
+
+ (add-to-list 'load-path nxhtmltest-bin-Q)
+ (require 'nxhtmltest-helpers))
+
+;;;###autoload
+(defun nxhtmltest-run-Q ()
+ "Run all tests defined for nXhtml in fresh Emacs.
+See `nxhtmltest-run' for more information about the tests."
+ (interactive)
+ (let* ((test-el (expand-file-name "nxhtmltest-suites.el" nxhtmltest-bin-Q))
+ (nxhtml-auto-start (expand-file-name "../autostart.el" nxhtmltest-bin-Q))
+ (temp-eval-file (expand-file-name "temp-test.el" nxhtmltest-bin-Q))
+ (temp-eval-buf (find-file-noselect temp-eval-file))
+ (load-path load-path))
+ ;;(load (expand-file-name "nxhtmltest-helpers" nxhtmltest-bin-Q))
+ (add-to-list 'load-path nxhtmltest-bin-Q)
+ (require 'nxhtmltest-helpers)
+ (nxhtmltest-get-fontification-method)
+ (with-current-buffer temp-eval-buf
+ (erase-buffer)
+ (insert "(setq debug-on-error t)\n"
+ "(eval-when-compile (require 'cl))\n"
+ "(delete-other-windows)\n"
+ "(eval-after-load 'nxhtml '(setq nxhtml-skip-welcome t))\n"
+ (format "(setq nxhtmltest-default-fontification-method '%s)\n"
+ nxhtmltest-default-fontification-method)
+ ))
+ (when (featurep 'ruby-mode)
+ (with-current-buffer temp-eval-buf
+ (insert "(pushnew \""
+ (file-name-directory (locate-library "ruby-mode"))
+ "\" load-path)")))
+ (with-current-buffer temp-eval-buf
+ (save-buffer))
+ (kill-buffer temp-eval-buf)
+ (unless (file-exists-p nxhtmltest-bin-Q)
+ (error "Can't find directory %s" nxhtmltest-bin-Q))
+ (setq nxhtmltest-bin-Q (file-name-sans-extension nxhtmltest-bin-Q))
+ (unless (file-exists-p test-el)
+ (error "Can't find file %s" test-el))
+ (setq test-el (file-name-sans-extension test-el))
+ (unless (file-exists-p nxhtml-auto-start)
+ (error "Can't find file %s" nxhtml-auto-start))
+ (setq nxhtml-auto-start (file-name-sans-extension nxhtml-auto-start))
+ (message "nxhtmltest-bin-Q=%s" nxhtmltest-bin-Q)
+ (message "nxhtml-auto-start=%s" nxhtml-auto-start)
+ (setenv "nxhtmltest-run-Q" "run")
+ (message "After setenv nxhtmltest-run-Q=%s" (getenv "nxhtmltest-run-Q"))
+ (message "(ourcomments-find-emacs) => %s" (ourcomments-find-emacs))
+ (call-process (ourcomments-find-emacs) nil 0 nil "-Q"
+ "-l" temp-eval-file
+ "-l" nxhtml-auto-start
+ "-l" test-el)
+ (message "After call-process")
+ (setenv "nxhtmltest-run-Q")
+ (message "Starting new Emacs instance for test - it will be ready soon ...")))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtmltest-Q.el ends here
--- /dev/null
+;;; nxhtmltest-helpers.el --- Helper functions for testing
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-07-08T19:10:54+0200 Tue
+;; Version: 0.2
+;; Last-Updated: 2008-09-01T01:13:15+0200 Sun
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `button', `help-fns', `help-mode', `view'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ert2)
+
+(defun nxhtmltest-goto-line (line)
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))))
+
+(defun nxhtmltest-mumamo-error-messages ()
+ (ert-get-messages "^MU:MuMaMo error"))
+
+(defun nxhtmltest-should-no-mumamo-errors ()
+ (ert-should (not (nxhtmltest-mumamo-error-messages))))
+
+(defun nxhtmltest-should-no-nxml-errors ()
+ (ert-should (not (ert-get-messages "Internal nXML mode error"))))
+
+(defun nxhtmltest-be-really-idle (seconds &optional prompt-mark)
+ (unless prompt-mark (setq prompt-mark ""))
+ (with-timeout (4 (message "<<<< %s - not really idle any more at %s"
+ prompt-mark
+ (format-time-string "%H:%M:%S")))
+ (let ((prompt (format
+ ">>>> %s Starting beeing really idle %s seconds at %s"
+ prompt-mark
+ seconds
+ (format-time-string "%H:%M:%S ..."))))
+ (message "%s" prompt)
+ (read-minibuffer prompt)
+ (redisplay))))
+
+;;(nxhtmltest-be-really-idle 4 "HERE I AM!!")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Fontification methods
+
+(defvar nxhtmltest-default-fontification-method nil)
+
+(defun nxhtmltest-get-fontification-method ()
+ "Ask user for default fontification method."
+ (let* ((collection
+ '(
+ ("Fontify as usual (wait)" fontify-as-usual)
+ ("Fontify by calling timer handlers" fontify-w-timer-handlers)
+ ("Fontify ps print " fontify-as-ps-print)
+ ("Call fontify-buffer" fontify-buffer)
+ ))
+ (hist (mapcar (lambda (rec)
+ (car rec))
+ collection))
+ (method-name (or t
+ (completing-read "Default fontification method: "
+ collection nil t
+ (car (nth 1 collection))
+ 'hist))))
+ (setq nxhtmltest-default-fontification-method
+ ;;(nth 1 (assoc method-name collection))
+ ;;'fontify-w-timer-handlers
+ 'fontify-as-ps-print
+ )))
+
+(defun nxhtmltest-fontify-as-usual (seconds prompt-mark)
+ (font-lock-mode 1)
+ ;; This does not work now since I deleted the function below:
+ (error "font-lock-wait not defined")
+ ;;(font-lock-wait (nxhtmltest-be-really-idle seconds prompt-mark))
+ )
+
+(defun nxhtmltest-fontify-w-timers-handlers ()
+ ;;(dolist (timer (copy-list timer-idle-list))
+ (dolist (timer (copy-sequence timer-idle-list))
+ (timer-event-handler timer))
+ (redisplay t))
+
+(declare-function jit-lock-fontify-now "jit-lock" (&optional start end))
+(declare-function lazy-lock-fontify-region "lazy-lock" (beg end))
+
+;; to avoid compilation gripes
+;;(defun ps-print-ensure-fontified (start end)
+(defun nxhtmltest-fontify-as-ps-print()
+ (save-restriction
+ (widen)
+ (let ((start (point-min))
+ (end (point-max)))
+ (cond ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
+ (jit-lock-fontify-now start end))
+ ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
+ (lazy-lock-fontify-region start end))))))
+
+(defun nxhtmltest-fontify-buffer ()
+ (font-lock-fontify-buffer)
+ (redisplay t))
+
+(defun nxhtmltest-fontify-default-way (seconds &optional pmark)
+ ;;(assert (not font-lock-mode))
+ (case nxhtmltest-default-fontification-method
+ (fontify-as-usual (nxhtmltest-fontify-as-usual seconds pmark))
+ (fontify-w-timer-handlers (nxhtmltest-fontify-w-timers-handlers))
+ (fontify-as-ps-print (nxhtmltest-fontify-as-ps-print))
+ (fontify-buffer (nxhtmltest-fontify-buffer))
+ (t (error "Unrecognized default fontification method: %s"
+ nxhtmltest-default-fontification-method))))
+
+
+
+(provide 'nxhtmltest-helpers)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtmltest-helpers.el ends here
--- /dev/null
+;;; nxhtmltest-suites.el --- Test suites for mumamo / nXhtml
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-07-08T20:17:36+0200 Tue
+;; Version: 0.12
+;; Last-Updated: 2008-09-01T01:13:28+0200 Sun
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Defines `nxhtmltest-run'. When (getenv "nxhtmltest-run-Q")
+;; returns non-nil also runs this function.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; Added code from Christian Ohler for writing ert tests.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'rng-valid))
+(eval-when-compile (require 'rngalt))
+(require 'mumamo)
+(require 'mumamo-fun)
+(require 'nxhtml)
+(require 'nxhtml-mumamo)
+(when (fboundp 'nxml-mode)
+ (require 'rng-valid)
+ (require 'rngalt))
+
+(setq debug-on-error t)
+
+(defvar nxhtmltest-ert-default-selector "nxhtml-ert-"
+ "Set this to run a single test with `nxhtmltest-run-Q'.")
+
+(defvar nxhtmltest-bin
+ (file-name-directory (if load-file-name load-file-name buffer-file-name)))
+
+(pushnew nxhtmltest-bin load-path)
+(require 'nxhtmltest-helpers)
+;;(require 'ert)
+
+(defvar nxhtmltest-files-root
+ (let* ((this-dir nxhtmltest-bin)
+ (root (expand-file-name "in/" this-dir)))
+ (unless (file-accessible-directory-p root)
+ (error (if (file-exists-p root)
+ "Can't read files in test directory %s"
+ "Can't find test directory %s")
+ root))
+ root))
+
+(let ((distr-in "c:/EmacsW32/nxhtml/tests/in/"))
+ (when (file-directory-p distr-in)
+ (setq nxhtmltest-files-root distr-in)))
+
+;; (setq nxhtmltest-update-method
+;; ;;'font-lock-wait
+;; 'font-lock-run-timers
+;; ;;'font-lock-fontify-buffer
+;; )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Define tests using ert.el
+
+(ert-deftest nxhtml-ert-bug531328 ()
+ "Test of eRuby chunks with nothing between."
+ (ert-with-temp-buffer-include-file "bug531328.rhtml"
+ (add-hook 'ert-simulate-command-post-hook
+ 'nxhtmltest-should-no-mumamo-errors
+ nil t)
+ (ert-simulate-command '(eruby-html-mumamo-mode) t)
+ (nxhtmltest-get-fontification-method)
+ (nxhtmltest-fontify-default-way 2 "trans")
+ (ert-simulate-command '(goto-char 12) t)
+ (ert-should (eq major-mode 'ruby-mode))
+ ))
+
+(ert-deftest nxhtml-ert-indent-bug-johan-2010-02-17()
+ "Test of eRuby indentation.
+Got a bug report by mail on the emacs-on-rails list."
+ (ert-with-temp-buffer-include-file "bug-johan-2010-02-17.erb"
+ (add-hook 'ert-simulate-command-post-hook
+ 'nxhtmltest-should-no-mumamo-errors
+ nil t)
+ (ert-simulate-command '(eruby-html-mumamo-mode) t)
+ (nxhtmltest-fontify-default-way 2 "trans")
+ (ert-simulate-command '(mark-whole-buffer) t)
+ (ert-simulate-command '(indent-for-tab-command) t)
+ (nxhtmltest-goto-line 1) (ert-should (= 0 (current-indentation)))
+ (nxhtmltest-goto-line 2) (ert-should (= 2 (current-indentation)))
+ (nxhtmltest-goto-line 3) (ert-should (= 0 (current-indentation)))
+ ))
+
+(ert-deftest nxhtml-ert-indent-bug-johan-2010-02-12()
+ "Test of eRuby indentation.
+Got a bug report by mail on the emacs-on-rails list."
+ (ert-with-temp-buffer-include-file "bug-johan-2010-02-12.rhtml"
+ (add-hook 'ert-simulate-command-post-hook
+ 'nxhtmltest-should-no-mumamo-errors
+ nil t)
+ (ert-simulate-command '(eruby-html-mumamo-mode) t)
+ (nxhtmltest-fontify-default-way 2 "trans")
+ (ert-simulate-command '(mark-whole-buffer) t)
+ (ert-simulate-command '(indent-for-tab-command) t)
+ (nxhtmltest-goto-line 12) (ert-should (= 2 (current-indentation)))
+ ))
+
+;;(setq nxhtmltest-ert-default-selector "nxhtml-ert-indent-rr-min8")
+(ert-deftest nxhtml-ert-indent-rr-min8 ()
+ "Test of indentation bug.
+As per Richard Riley's bug report 2009-10-08. Last line gave an
+error."
+ (ert-with-temp-buffer-include-file "rr-min8.php"
+ (add-hook 'ert-simulate-command-post-hook
+ 'nxhtmltest-should-no-mumamo-errors
+ nil t)
+ (ert-simulate-command '(nxhtml-mumamo-mode) t)
+ (nxhtmltest-fontify-default-way 2 "trans")
+ (ert-simulate-command '(mark-whole-buffer) t)
+ (ert-simulate-command '(indent-for-tab-command) t)))
+
+;;(setq nxhtmltest-ert-default-selector "nxhtml-ert-bug-400415")
+(ert-deftest nxhtml-ert-bug-400415-foo2 ()
+ "Test for changes before in-here-doc using 400415.
+See URL `https://bugs.launchpad.net/nxhtml/+bug/400415'. This is
+not the bug reported there however."
+ (ert-with-temp-buffer-include-file "bug400415-foo2.php"
+ (add-hook 'ert-simulate-command-post-hook
+ 'nxhtmltest-should-no-mumamo-errors
+ nil t)
+ (ert-simulate-command '(nxhtml-mumamo-mode) t)
+ (nxhtmltest-fontify-default-way 2 "trans")
+ (ert-simulate-command '(goto-char 74) t)
+ (ert-should (eq major-mode 'sql-mode))
+ (ert-simulate-command '(goto-char 23) t)
+ (ert-simulate-command '(backward-delete-char-untabify 1) t)
+ (ert-simulate-command '(goto-char 74) t)
+ (ert-should (eq major-mode 'sql-mode))
+ ))
+
+(ert-deftest nxhtml-ert-bug-300946-index ()
+ "Test for bug 300946 in Launchpad.
+See URL `https://bugs.launchpad.net/nxhtml/+bug/300946'. This is
+a test for the file attached by Chris on 2008-12-02."
+ (ert-with-temp-buffer-include-file "bug-300946-index.html"
+ (add-hook 'ert-simulate-command-post-hook
+ 'nxhtmltest-should-no-mumamo-errors
+ nil t)
+ (ert-simulate-command '(nxhtml-mumamo-mode) t)
+ (font-lock-mode 1)
+ ))
+
+(ert-deftest nxhtml-ert-indent-bug290364 ()
+ "Test for bug 290364 in Launchpad.
+See URL `https://bugs.launchpad.net/nxhtml/+bug/290364'.
+
+Note: If this test fails Emacs loops. Therefore the whole test
+is included in a when clause so you can avoid it easily."
+ ;;(when t
+ (ert-with-temp-buffer-include-file "bug-290364.php"
+ (add-hook 'ert-simulate-command-post-hook
+ 'nxhtmltest-should-no-mumamo-errors
+ nil t)
+ (ert-simulate-command '(nxhtml-mumamo-mode) t)
+ (font-lock-mode 1)
+ ))
+;)
+
+(ert-deftest nxhtml-ert-indent-bug271497 ()
+ "Test for bug 271497 in Launchpad.
+This is a bug in Emacs 22. It should work in Emacs 23 though.
+See URL `https://bugs.launchpad.net/nxhtml/+bug/271497'."
+ (ert-with-temp-buffer-include-file "bug271497.txt"
+ (add-hook 'ert-simulate-command-post-hook
+ 'nxhtmltest-should-no-mumamo-errors
+ nil t)
+ (load-file (ert-get-test-file-name "bug271497.el"))
+ (ert-simulate-command '(bug271497-mumamo) t)
+ ;;(font-lock-mode 1)
+ (nxhtmltest-fontify-default-way 2 "trans")
+ (ert-simulate-command '(goto-char 42) t)
+ (message "after goto-char 42")
+ (let ((ac42 after-change-functions)
+ ac88)
+ (ert-simulate-command '(goto-char 88) t)
+ (message "after goto-char 88")
+ (setq ac88 after-change-functions)
+ (ert-should (not (equal ac88 ac42))))))
+
+(ert-deftest nxhtml-ert-indent-question43320 ()
+ "Test for question 43320 in Launchpad.
+See URL `https://answers.launchpad.net/nxhtml/+question/43320'.
+
+Note: This fails in Emacs 22, but should work in Emacs 23."
+;; I did see some problem here:
+
+;; - nXhtml 081222 + unpatched Emacs 081219 => ok
+;; - nXhtml 081222 + unpatched Emacs 081124 => ok
+;; - nXhtml 081222 + patched Emacs 081219 => ok
+
+;; - nXhtml 081222 + patched Emacs 081124 => ok, but it fails if I
+;; use `nxhtmltest-run-Q'! I e, it fails if the autostart.el from
+;; the nxhtml dir in 081222 is used - but not if the copy in
+;; c:/EmacsW32 is used??? Which turned out to be if the old
+;; php-mode was used ...
+
+ (ert-with-temp-buffer-include-file "question43320.html"
+ (add-hook 'ert-simulate-command-post-hook
+ 'nxhtmltest-should-no-mumamo-errors
+ nil t)
+ (ert-simulate-command '(nxhtml-mumamo-mode) t)
+ (font-lock-mode 1)
+ (nxhtmltest-goto-line 25) (ert-should (/= 14 (current-indentation)))
+ (put 'mumamo-submode-indent-offset-0 'permanent-local t)
+ (put 'mumamo-submode-indent-offset 'permanent-local t)
+ ;;
+ ;;(set (make-local-variable 'mumamo-submode-indent-offset-0) nil)
+ (set (make-local-variable 'mumamo-submode-indent-offset-0) 0)
+ (set (make-local-variable 'mumamo-submode-indent-offset) nil)
+ ;;(set (make-local-variable 'mumamo-submode-indent-offset) 2)
+ (ert-simulate-command '(mark-whole-buffer) t)
+ (ert-simulate-command '(indent-for-tab-command) t)
+ (nxhtmltest-goto-line 8) (ert-should (= 8 (current-indentation)))
+ (nxhtmltest-goto-line 9) (ert-should (= 0 (current-indentation)))
+ (nxhtmltest-goto-line 15) (ert-should (= 8 (current-indentation)))
+ (nxhtmltest-goto-line 16) (ert-should (= 8 (current-indentation)))
+ (nxhtmltest-goto-line 22) (ert-should (= 6 (current-indentation)))
+ (nxhtmltest-goto-line 25) (ert-should (= 4 (current-indentation)))
+ (nxhtmltest-goto-line 8) (indent-line-to 0)
+ ;;(message "before indent-for-tab-command")
+ (ert-simulate-command '(indent-for-tab-command) t)
+ ;;(message "after indent-for-tab-command")
+ (ert-should (= 8 (current-indentation)))
+ ;;
+ (set (make-local-variable 'mumamo-submode-indent-offset-0) 0)
+ (set (make-local-variable 'mumamo-submode-indent-offset) 2)
+ (ert-simulate-command '(mark-whole-buffer) t)
+ (ert-simulate-command '(indent-for-tab-command) t)
+ (nxhtmltest-goto-line 8) (ert-should (= 8 (current-indentation)))
+ (nxhtmltest-goto-line 9) (ert-should (= 10 (current-indentation)))
+ (nxhtmltest-goto-line 15) (ert-should (= 8 (current-indentation)))
+ (nxhtmltest-goto-line 16) (ert-should (= 8 (current-indentation)))
+ (nxhtmltest-goto-line 22) (ert-should (= 16 (current-indentation)))
+ (nxhtmltest-goto-line 25) (ert-should (= 14 (current-indentation)))
+ ))
+
+(ert-deftest nxhtml-ert-only-php-no-end ()
+ "Check for nXml error."
+ (ert-with-temp-buffer-include-file "no-php-end-4.php"
+ (nxhtml-mumamo-mode)
+ (run-hooks 'after-change-major-mode-hook)
+ (run-hooks 'post-command-hook)
+ (nxhtmltest-fontify-default-way 2 "trans")
+ (rng-validate-mode 1)
+ ;;(rngalt-validate)
+ (ert-should (eq rng-validate-mode t))
+ (nxhtmltest-should-no-mumamo-errors)
+ (nxhtmltest-should-no-nxml-errors)
+ (goto-char 324)
+ (message "before insert, after-change-functions local=%s" after-change-functions)
+ (insert "\n")
+ (nxhtmltest-should-no-mumamo-errors)
+ (nxhtmltest-should-no-nxml-errors)))
+
+(ert-deftest nxhtml-ert-xhtml-1.0-transitional ()
+ "Test XHTML 1.0 Transitional with `nxhtml-mumamo-mode'.
+NOTICE: This test SHOULD FAIL because there is currently no rng
+schema for transitional. The schema for strict is used instead
+and the file is invalid then."
+ (ert-with-temp-buffer-include-file "lg-080813-label.html"
+ (nxhtml-mumamo-mode)
+ (nxhtmltest-fontify-default-way 2 "trans")
+ (rng-validate-mode 1)
+ (rngalt-validate)
+ (ert-should (eq rng-validate-mode t))
+ (nxhtmltest-should-no-mumamo-errors)
+;;; (ert-should
+;;; (not (eq (get-char-property 398 'category)
+;;; 'rng-error)))
+ (ert-should
+ (eq (get-text-property 398 'face)
+ 'font-lock-function-name-face))
+ (ert-should-not
+ (= 0 rng-error-count))
+ ))
+
+(ert-deftest nxhtml-ert-genshi-valid-in-genshi ()
+ (ert-with-temp-buffer-include-file "genshi-auto-mode.html"
+ (message "\n")
+ (genshi-nxhtml-mumamo-mode)
+ (font-lock-mode 1)
+ (mumamo-post-command)
+ (ert-should (eq font-lock-mode t))
+ (ert-should (eq major-mode 'nxhtml-genshi-mode))
+ (ert-should
+ (memq mumamo-multi-major-mode '(genshi-nxhtml-mumamo-mode
+ genshi-html-mumamo-mode)))
+ (nxhtmltest-fontify-default-way 2 "sheit")
+ (rng-validate-mode 1)
+ (rngalt-validate)
+ (ert-should (eq rng-validate-mode t))
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should
+ (= 0 rng-error-count))))
+
+(ert-deftest nxhtml-ert-genshi-invalid-in-nxhtml ()
+ (ert-with-temp-buffer-include-file "genshi-auto-mode.html"
+ (message "\n")
+ (nxhtml-mumamo-mode)
+ (nxhtmltest-fontify-default-way 2 "sheit")
+ (font-lock-mode 1)
+ (mumamo-post-command)
+ (rng-validate-mode 1)
+ (rngalt-validate)
+ (ert-should (eq rng-validate-mode t))
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should
+ (= 2 rng-error-count))))
+
+(ert-deftest nxhtml-ert-genshi-magic-mode ()
+ "Test if genshi file is recognized."
+ (let ((file1 (ert-get-test-file-name "genshi-auto-mode.html"))
+ buf1)
+ ;; Ensure we open the files
+ (setq buf1 (find-buffer-visiting file1))
+ (when buf1 (kill-buffer buf1))
+ ;; Open file 1
+ (setq buf1 (find-file file1))
+ (nxhtmltest-fontify-default-way 2 "mod")
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should
+ (with-current-buffer buf1
+ (memq mumamo-multi-major-mode '(genshi-nxhtml-mumamo-mode
+ genshi-html-mumamo-mode))))
+ (kill-buffer buf1)))
+
+(ert-deftest nxhtml-ert-genshi-auto-mode ()
+ "Test if file extension .ghtml is recognized."
+ (let ((file1 (ert-get-test-file-name "genshi-HelloWorldPage.ghtml"))
+ buf1)
+ ;; Ensure we open the files
+ (setq buf1 (find-buffer-visiting file1))
+ (when buf1 (kill-buffer buf1))
+ ;; Open file 1
+ (setq buf1 (find-file file1))
+ (nxhtmltest-fontify-default-way 2 "mod")
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should
+ (with-current-buffer buf1
+ (memq mumamo-multi-major-mode '(genshi-nxhtml-mumamo-mode
+ genshi-html-mumamo-mode))))
+ (kill-buffer buf1)))
+
+(ert-deftest nxhtml-ert-opened-modified ()
+ "Test if buffer get modified when opening a file."
+ (let ((file1 (ert-get-test-file-name "cvd-080805-ac.php"))
+ (file2 (ert-get-test-file-name "cvd-080805-cc.php"))
+ buf1
+ buf2)
+ ;; Ensure we open the files
+ (setq buf1 (find-buffer-visiting file1))
+ (when buf1 (kill-buffer buf1))
+ (setq buf2 (find-buffer-visiting file2))
+ (when buf2 (kill-buffer buf2))
+ ;; Open file 1
+ (setq buf1 (find-file file1))
+ (nxhtmltest-fontify-default-way 2 "mod")
+ (nxhtmltest-should-no-mumamo-errors)
+ ;; Open file 2
+ (setq buf2 (find-file file2))
+ (nxhtmltest-fontify-default-way 2 "mod")
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should
+ (not (or (buffer-modified-p buf1)
+ (buffer-modified-p buf2))))
+ (kill-buffer buf1)
+ (kill-buffer buf2)))
+
+(ert-deftest nxhtml-ert-wiki-strange-hili-080629 ()
+ "From a report on EmacsWiki."
+ (ert-with-temp-buffer-include-file "wiki-strange-hili-080629.html"
+ ;;(ert-should (not font-lock-mode))
+ (nxhtml-mumamo-mode)
+ ;;(ert-should (not font-lock-mode))
+ (nxhtmltest-fontify-default-way 2 "hili")
+ (goto-char 44)
+ (nxhtmltest-should-no-mumamo-errors)
+ (message "face at 44=%s" (get-text-property 44 'face))
+ (ert-should
+ (eq (get-text-property 44 'face)
+ 'font-lock-function-name-face))))
+
+(ert-deftest nxhtml-ert-indent-wiki-080708-ind-problem ()
+ (ert-with-temp-buffer-include-file "wiki-080708-ind-problem.rhtml"
+ (require 'ruby-mode nil t)
+ (if (not (featurep 'ruby-mode))
+ ;; Fix-me: ert should maybe have some way to just display
+ ;; informational messages?
+ (error "ruby-mode not available, skipping test")
+ ;;(ert-should (not font-lock-mode))
+ (eruby-nxhtml-mumamo-mode)
+ ;;(ert-should (not font-lock-mode))
+ (nxhtmltest-fontify-default-way 2 "ind")
+ (mark-whole-buffer)
+ (indent-for-tab-command)
+ (nxhtmltest-goto-line 3)
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should (= (current-indentation) 0)))))
+
+(ert-deftest nxhtml-ert-indent-wiki-080708-ind-problem-a ()
+ "From a report on EmacsWiki.
+NOTICE: This SHOULD FAIL. There is currently no support for the
+kind of indentation needed here.
+
+Notice 2: For some reason I sometimes get the error overlayp, nil
+here."
+ (ert-with-temp-buffer-include-file "wiki-080708-ind-problem.rhtml"
+ (require 'ruby-mode nil t)
+ (if (not (featurep 'ruby-mode))
+ (error "ruby-mode not available, skipping test")
+ ;;(ert-should (not font-lock-mode))
+ (eruby-nxhtml-mumamo-mode)
+ ;;(ert-should (not font-lock-mode))
+ (nxhtmltest-fontify-default-way 2 "ind")
+ (insert " ")
+ (mark-whole-buffer)
+ (indent-for-tab-command)
+ (nxhtmltest-goto-line 3)
+ ;; Test
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should-not (= (current-indentation) 2)))))
+
+(ert-deftest nxhtml-ert-sheit-2007-12-26 ()
+ (ert-with-temp-buffer-include-file "sheit-2007-12-26.php"
+ ;;(ert-should (not font-lock-mode))
+ (nxhtml-mumamo-mode)
+ ;;(ert-should (not font-lock-mode))
+ (nxhtmltest-fontify-default-way 2 "sheit")
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should
+ (and
+ (eq (get-text-property 21 'face)
+ 'font-lock-comment-face)
+ (eq (get-text-property 22 'face)
+ 'font-lock-comment-face)
+ (eq (get-text-property 35 'face)
+ 'font-lock-comment-face)))))
+
+
+;; Now some tests with a big file. Jumping backwards can fail.
+
+(defun nxhtml-ert-nxhtml-changes-jump-back-2 (pos)
+ ;;(ert-should (not font-lock-mode))
+ (nxhtml-mumamo-mode)
+ (run-hooks 'post-command-hook)
+ ;;(ert-should (not font-lock-mode))
+ (goto-char (- (point-max) (- 64036 63869)))
+ (nxhtmltest-fontify-default-way 2)
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should
+ (eq (get-text-property (point) 'face)
+ 'font-lock-variable-name-face))
+ (message "here 1")
+ (goto-char pos)
+ (nxhtmltest-fontify-default-way 2)
+ (nxhtmltest-should-no-mumamo-errors)
+ (message "here 2")
+ (ert-should
+ (eq (get-text-property (point) 'face)
+ 'font-lock-function-name-face)))
+
+;; Fix-me: forgot to copy nxhtml-changes.html. I can't find any
+;; similar error now.
+;;
+;; (ert-deftest nxhtml-ert-nxhtml-changes-jump-back-7014-2 ()
+;; "this is a docstring.
+;; wonder how that works now ..."
+;; (ert-with-temp-buffer-include-file "../../nxhtml/doc/nxhtml-changes.html"
+;; (nxhtml-ert-nxhtml-changes-jump-back-2 7014)))
+
+;; (ert-deftest nxhtml-ert-nxhtml-changes-jump-back-10488-2 ()
+;; (ert-with-temp-buffer-include-file "../../nxhtml/doc/nxhtml-changes.html"
+;; (nxhtml-ert-nxhtml-changes-jump-back-2 10488)))
+
+;; (ert-deftest nxhtml-ert-nxhtml-changes-jump-2 ()
+;; (ert-with-temp-buffer-include-file "../../nxhtml/doc/nxhtml-changes.html"
+;; ;;(ert-should (not font-lock-mode))
+;; (nxhtml-mumamo-mode)
+;; ;;(ert-should (not font-lock-mode))
+;; (goto-char 10420)
+;; (nxhtmltest-fontify-default-way 2 "jump-2")
+;; (nxhtmltest-should-no-mumamo-errors)
+;; (ert-should
+;; (eq (get-text-property (point) 'face)
+;; 'font-lock-variable-name-face))))
+
+;;; Indentation tests
+
+(ert-deftest nxhtml-ert-php-indent-bug-1 ()
+ "Test indentation in php only file.
+The indentation on line 7 should be 0."
+ (ert-with-temp-buffer-include-file "only-php.php"
+ (nxhtml-mumamo-mode)
+ ;; No fontification needed for indentation.
+ (nxhtmltest-goto-line 7)
+ (indent-for-tab-command)
+ (nxhtmltest-should-no-mumamo-errors)
+ (ert-should
+ (= 0
+ (current-indentation)))))
+
+;;; Scroll tests
+
+;; (ert-deftest nxhtml-ert-scroll-jump-test ()
+;; "Test if `scroll-conservatively' eq 1 works."
+;; (ert-with-temp-buffer-include-file "../../nxhtml/doc/nxhtml-changes.html"
+;; (ert-should (not font-lock-mode))
+;; (nxhtml-mumamo-mode)
+;; (ert-should (not font-lock-mode))
+;; (nxhtmltest-fontify-default-way 2 "jump-2")
+;; (let ((scroll-conservatively 1)
+;; (ws (list (window-start)))
+;; (xi (loop for ii from 1 to 100 by 1
+;; do
+;; (next-line)
+;; (sit-for 0.01)
+;; collect (list (window-start)
+;; (let ((here (point)))
+;; (goto-char (window-start))
+;; (prog1 (line-end-position)
+;; (goto-char here)))
+;; (point))
+;; ))
+;; (jumps 0)
+;; prev-win-start
+;; prev-win-start-le
+;; )
+;; (loop for xx in xi
+;; do
+;; (message "xx=%s" xx)
+;; (let ((win-start (nth 0 xx))
+;; (win-start-le (nth 1 xx))
+;; (cur-point (nth 2 xx)))
+;; (unless (or (not prev-win-start)
+;; (= prev-win-start win-start)
+;; (= (1+ prev-win-start-le) win-start))
+;; (setq jumps (1+ jumps)))
+;; (setq prev-win-start win-start)
+;; (setq prev-win-start-le win-start-le)
+;; )
+;; )
+;; (ert-should (= 0 jumps))
+;; )))
+
+;;(defvar ert-error-on-test-redefinition nil)
+
+;;; End of test definitions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun nxhtmltest-run-ert (selector)
+ "Run test with ert library."
+ (unless selector (setq selector nxhtmltest-ert-default-selector))
+ (setq ert-test-files-root nxhtmltest-files-root)
+ (if noninteractive
+ (ert-run-tests-batch selector)
+ (ert-kill-temp-test-buffers)
+ (ert-run-tests-interactively selector)
+ (other-window 1)
+ (ert-list-temp-test-buffers)))
+
+;;;###autoload
+(defun nxhtmltest-run-indent ()
+ "Run indentation tests."
+ (interactive)
+ (setq ert-test-files-root nxhtmltest-files-root)
+ (let ((selector "nxhtml-ert-indent-"))
+ (ert-kill-temp-test-buffers)
+ (nxhtmltest-get-fontification-method)
+ (ert-run-tests-interactively selector))
+ (other-window 1)
+ (ert-list-temp-test-buffers))
+
+;;;###autoload
+(defun nxhtmltest-run ()
+ "Run all tests defined for nXhtml.
+Currently there are only tests using ert.el defined.
+
+Note that it is currently expected that the following tests will
+fail (they corresponds to known errors in nXhtml/Emacs):
+
+ `nxhtml-ert-nxhtml-changes-jump-back-10549'
+ `nxhtml-ert-nxhtml-changes-jump-back-7014'
+"
+ (interactive)
+ (setq message-log-max t)
+ (when (called-interactively-p)
+ (nxhtmltest-get-fontification-method))
+ (nxhtmltest-run-ert nil))
+
+(when (getenv "nxhtmltest-run-Q")
+ (nxhtmltest-run))
+
+(provide 'nxhtmltest-suites)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; nxhtmltest-suites.el ends here
--- /dev/null
+;;; anchored-transpose.el --- Transposes a phrase around an anchor phrase
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; Author: Rick Bielawski <rbielaws@i1.net>
+;; Keywords: tools convenience
+
+;; This file is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+
+;; This file is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+;; more details.
+
+;;; Commentary:
+
+;; `anchored-transpose' is an interactive autoload function to transpose
+;; portions of a region around an anchor phrase. In other words it swaps
+;; two regions.
+;;
+;; See C-h f anchored-transpose <ret> for a complete description.
+
+;;; Installing:
+
+;; 1) Put anchored-transpose.el on your load path.
+;; 2) Put the following 2 lines in your .emacs
+;; (global-set-key [?\C-x ?t] 'anchored-transpose) ;; Just a suggestion...
+;; (autoload 'anchored-transpose "anchored-transpose" nil t)
+
+;;; History:
+
+;; 2004-09-24 RGB Seems useable enough to release.
+;; 2004-10-15 RGB Only comments and doc strings were updated.
+;; 2004-10-22 RGB Added support for 2 phrase selection.
+;; 2004-12-01 RGB Added secondary selection support.
+;; 2005-07-21 RGB Updated help text and comments.
+;; Added support for A C B D and C A D B selection.
+;; Fixed bug affecting multi line selections.
+;; 2005-09-28 RGB Allow swapping regions with no anchor text between.
+
+;; Changes by Lennart Borgman
+;; 2009-11-25 LB Set and clear secondary selection from keyboard.
+;; Always use secondary selection.
+;; Keep selections right after swapping.
+;; Clear them if not used again.
+;; Swap between buffers.
+;; Check for read-only.
+;; Probably broke something... ;-)
+
+;;; Code:
+
+(defvar anchored-transpose-anchor ()
+ "begin/end when `anchored-transpose' is in progress else nil")
+
+;;;###autoload
+(defun anchored-transpose (beg1 end1 flg1 &optional beg2 end2 flg2 win2)
+ "Transpose portions of the region around an anchor phrase.
+
+`this phrase but not that word' can be transposed into
+`that word but not this phrase'
+
+I want this phrase but not that word.
+ |----------------------------|. .This is the entire phrase.
+ |-------|. . . . . . .This is the anchor phrase.
+
+First select the entire phrase and type \\[anchored-transpose].
+This set the secondary selection.
+
+Then select the anchor phrase and type \\[anchored-transpose]
+again. Alternatively you can do the selections like this:
+
+I want this phrase but not that word.
+ |----------| |---------| Separate phrase selection.
+
+By default the anchor phrase will automatically include
+any surrounding whitespace even if you don't explicitly select
+it. Also, it won't include certain trailing punctuation. See
+`anchored-transpose-do-fuzzy' for details. A prefix arg prior to
+either selection means `no fuzzy logic, use selections
+literally'.
+
+You can select the regions to be swapped separately in any
+order.
+
+After swapping both primary and secondary selection are still
+active. They will be canceled after second next command if you
+do not swap regions again. \(Second because this allow you to
+adjust the regions and try again.)
+
+You can also swap text between different buffers this way.
+
+Typing \\[anchored-transpose] with nothing selected clears any
+prior selection, ie secondary selection."
+ (interactive `(,(region-beginning) ,(region-end)
+ ,current-prefix-arg
+ ,@anchored-transpose-anchor))
+ (setq anchored-transpose-anchor nil)
+ (when (and mouse-secondary-overlay
+ mark-active
+ (overlay-buffer mouse-secondary-overlay)
+ (/= (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay)))
+ (if (eq (overlay-buffer mouse-secondary-overlay) (current-buffer))
+ (progn
+ (setq beg2 (overlay-start mouse-secondary-overlay))
+ (setq end2 (overlay-end mouse-secondary-overlay))
+ (setq flg2 flg1)
+ (delete-overlay mouse-secondary-overlay))
+ (let* ((sec-buf (overlay-buffer mouse-secondary-overlay))
+ (sec-win (get-buffer-window sec-buf))
+ (sec-new nil))
+ (unless sec-win
+ (setq sec-new t)
+ (setq sec-win (split-window)))
+ (with-selected-window sec-win
+ (set-window-buffer (selected-window) sec-buf)
+ (goto-char (overlay-start mouse-secondary-overlay)))
+ (if (not (y-or-n-p "Swap between buffers "))
+ (when sec-new (delete-window sec-win))
+ (setq beg2 (overlay-start mouse-secondary-overlay))
+ (setq end2 (overlay-end mouse-secondary-overlay))
+ (setq flg2 flg1)
+ (setq win2 sec-win)))))
+ (setq win2 (or win2 (selected-window)))
+ (if mark-active
+ (if end2 ; then both regions are marked. swap them.
+ (if (not (eq win2 (selected-window)))
+ (anchored-transpose-swap beg1 end1 beg2 end2 win2)
+ (if (and (< beg1 beg2) ;A C B D
+ (< end1 end2)
+ (> end1 beg2))
+ (apply 'anchored-transpose-swap
+ (anchored-transpose-do-fuzzy
+ beg1 beg2 end1 end2 flg1 flg2 flg1 flg2))
+ (if (and (> beg1 beg2) ;C A D B
+ (> end1 end2)
+ (> end2 beg1))
+ (apply 'anchored-transpose-swap
+ (anchored-transpose-do-fuzzy
+ beg2 beg1 end2 end1 flg2 flg1 flg2 flg1))
+ (if (and (< beg1 beg2) ;A C D B
+ (> end1 end2))
+ (apply 'anchored-transpose-swap
+ (anchored-transpose-do-fuzzy
+ beg1 beg2 end2 end1 flg1 flg2 flg2 flg1))
+ (if (and (> beg1 beg2) ;C A B D
+ (< end1 end2))
+ (apply 'anchored-transpose-swap
+ (anchored-transpose-do-fuzzy
+ beg2 beg1 end1 end2 flg2 flg1 flg1 flg2))
+ (if (<= end1 beg2) ;A B C D
+ (apply 'anchored-transpose-swap
+ (anchored-transpose-do-fuzzy
+ beg1 end1 beg2 end2 flg1 flg1 flg2 flg2))
+ (if (<= end2 beg1) ;C D A B
+ (apply 'anchored-transpose-swap
+ (anchored-transpose-do-fuzzy
+ beg2 end2 beg1 end1 flg2 flg2 flg1 flg1))
+ (error "Regions have invalid overlap"))))))))
+ ;; 1st of 2 regions. Save it and wait for the other.
+ ;;(setq anchored-transpose-anchor (list beg1 end1 flg1))
+ (if (or buffer-read-only
+ (get-char-property beg1 'read-only)
+ (get-char-property end1 'read-only))
+ ;; Fix-me: move test, clean up a bit.
+ (message "Buffer text is readonly")
+ (set-secondary-selection beg1 end1)
+ (setq deactivate-mark t)
+ (message "%s" (this-command-keys))
+ (message (propertize "Transpose: Select second region and call again - (without selection to cancel)"
+ 'face 'secondary-selection))))
+ (if (and mouse-secondary-overlay
+ (overlay-buffer mouse-secondary-overlay))
+ (progn
+ (cancel-secondary-selection)
+ (message (propertize "Canceled secondary selection" 'face
+ 'highlight)))
+ (message (propertize "Command requires a marked region" 'face
+ 'highlight)))))
+
+;;;###autoload
+(defun set-secondary-selection (beg end)
+ "Set the secondary selection to the current region.
+This must be bound to a mouse drag event."
+ (interactive "r")
+ (move-overlay mouse-secondary-overlay beg end (current-buffer))
+ (when (called-interactively-p 'interactive)
+ ;;(deactivate-mark)
+ )
+ (x-set-selection
+ 'SECONDARY
+ (buffer-substring (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay))))
+
+;;;###autoload
+(defun cancel-secondary-selection ()
+ (interactive)
+ (delete-overlay mouse-secondary-overlay)
+ (x-set-selection 'SECONDARY nil))
+
+(defun anchored-transpose-do-fuzzy (r1beg r1end r2beg r2end
+ lit1 lit2 lit3 lit4)
+ "Returns the first 4 arguments after adjusting their value if necessary.
+
+I want this phrase but not that word.
+ |----------------------------|. .This is the entire phrase.
+ |-------|. . . . . . .This is the anchor phrase.
+ R1BEG R1END R2BEG R2END
+
+R1BEG and R1END define the first region and R2BEG and R2END the second.
+
+The flags, LIT1 thru LIT4 indicate if fuzzy logic should be applied to the
+beginning of R1BEG, the end of R1END, the beginning of R2BEG, the end of R2END
+respectively. If any flag is nil then fuzzy logic will be applied. Otherwise
+the value passed should be returned LITerally (that is, unchanged).
+
+See `anchored-transpose-fuzzy-begin' and `anchored-transpose-fuzzy-end' for
+specifics on what adjustments these routines will make when LITx is nil."
+ (list
+ (if lit1 r1beg
+ (anchored-transpose-fuzzy-begin r1beg r1end "[\t ]+"))
+ (if lit2 r1end
+ (anchored-transpose-fuzzy-end r1beg r1end "\\s +"))
+ (if lit3 r2beg
+ (anchored-transpose-fuzzy-begin r2beg r2end "[\t ]+"))
+ (if lit4 r2end
+ (anchored-transpose-fuzzy-end r2beg r2end "\\s *[.!?]"))
+ nil))
+
+(defun anchored-transpose-fuzzy-end (beg end what)
+ "Returns END or new value for END based on the regexp WHAT.
+BEG and END are buffer positions defining a region. If that region ends
+with WHAT then the value for END is adjusted to exclude that matching text.
+
+NOTE: The regexp is applied differently than `looking-back' applies a regexp.
+
+Example: if (buffer-string beg end) contains `1234' the regexp `432' matches
+it, not `234' as `looking-back' would. Also, your regexp never sees the char
+at BEG so the match will always leave at least 1 character to transpose.
+The reason for not using looking-back is that it's not greedy enough.
+\(looking-back \" +\") will only match one space no matter how many exist."
+ (let ((str (concat
+ (reverse (append (buffer-substring (1+ beg) end) nil)))))
+ (if (string-match (concat "`" what) str)
+ (- end (length (match-string 0 str)))
+ end)))
+
+(defun anchored-transpose-fuzzy-begin (beg end what)
+ "Returns BEG or a new value for BEG based on the regexp WHAT.
+BEG and END are buffer positions defining a region. If the region begins
+with WHAT then BEG is adjusted to exclude the matching text.
+
+NOTE: Your regexp never sees the last char defined by beg/end. This insures
+at least 1 char is always left to transpose."
+ (let ((str (buffer-substring beg (1- end))))
+ (if (string-match (concat "`" what) str)
+ (+ beg (length (match-string 0 str)))
+ beg)))
+
+(defun anchored-transpose-swap (r1beg r1end r2beg r2end win2)
+ "Swaps region r1beg/r1end with r2beg/r2end. Flags are currently ignored.
+Point is left at r1end."
+ (let ((reg1 (buffer-substring r1beg r1end))
+ (reg2 nil)
+ (old-buffer (current-buffer)))
+ (when win2
+ (unless (eq (selected-window) win2)
+ (select-window win2)
+ (set-buffer (window-buffer (selected-window)))))
+ (setq reg2 (delete-and-extract-region r2beg r2end))
+ (goto-char r2beg)
+ (let ((new-mark (point)))
+ (insert reg1)
+ (push-mark new-mark))
+ ;; I want to leave point at the end of phrase 2 in current buffer.
+ (save-excursion
+ (with-current-buffer old-buffer
+ (goto-char r1beg)
+ (delete-region r1beg r1end)
+ (let ((here (point)))
+ (insert reg2)
+ (set-secondary-selection here (point)))))
+ (setq deactivate-mark nil)
+ (when (eq old-buffer (current-buffer))
+ (add-hook 'post-command-hook 'anchored-swap-post-command t t))))
+
+(defun anchored-swap-post-command ()
+ (condition-case err
+ (unless mark-active
+ (cancel-secondary-selection)
+ (remove-hook 'post-command-hook 'anchored-swap-post-command t))
+ (error (message "anchored-swap-post-command: %s" err))))
+
+(provide 'anchored-transpose)
+
+;; Because I like it this way. So there!
+;;; fill-column:78 ***
+;;; emacs-lisp-docstring-fill-column:78 ***
+;;;
+;;; Local Variables: ***
+;;; End: ***
+;;; anchored-transpose.el ends here.
--- /dev/null
+;;; appmenu-fold.el --- Support form fold-dwim in AppMenu
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Wed Jan 11 21:48:02 2006
+(defconst appmenu-fold:version "0.51") ;; Version:
+;; Last-Updated: Mon Jan 15 03:10:59 2007 (3600 +0100)
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'fold-dwim nil t)
+(eval-when-compile (require 'appmenu))
+
+(when (featurep 'fold-dwim)
+
+ (defun appmenu-fold-no-hs-minor-mode ()
+ t)
+ (defun appmenu-fold-no-outline-minor-mode ()
+ t)
+ (defun appmenu-fold-setup ()
+ "Adds some tweaks for using fold-dwim in AppMenu."
+ (let ((fd-map (make-sparse-keymap)))
+ (define-key fd-map [fold-dwim-toggle]
+ (list 'menu-item "Fold Dwin Toggle" 'fold-dwim-toggle))
+ (define-key fd-map [fold-dwim-hide-all]
+ (list 'menu-item "Fold Dwin Hide All" 'fold-dwim-hide-all))
+ (define-key fd-map [fold-dwim-show-all]
+ (list 'menu-item "Fold Dwin Show All" 'fold-dwim-show-all))
+ ;;(add-to-list 'appmenu-alist (cons t (cons "Folding" fd-map)))
+ (appmenu-add 'appmenu-fold nil t "Folding" fd-map)
+ )
+;;; (add-to-list 'appmenu-minor-modes-exclude
+;;; '(hs-minor-mode appmenu-fold-no-hs-minor-mode))
+;;; (add-to-list 'appmenu-minor-modes-exclude
+;;; '(outline-minor-mode appmenu-fold-no-outline-minor-mode)))
+ )
+ )
+
+(provide 'appmenu-fold)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; appmenu-fold.el ends here
--- /dev/null
+;;; appmenu.el --- A framework for [apps] popup menus.
+
+;; Copyright (C) 2008 by Lennart Borgman
+
+;; Author: Lennart Borgman <lennart DOT borgman AT gmail DOT com>
+;; Created: Thu Jan 05 14:00:26 2006
+(defconst appmenu:version "0.63") ;; Version:
+;; Last-Updated: 2010-01-04 Mon
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; appmenu.el is a framework for creating cooperative context
+;; sensitive popup menus with commands from different major and minor
+;; modes. For more information see `appmenu-mode'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; Version 0.61:
+;; - Remove support for minor and major menus.
+;; - Add support for text and overlay keymaps.
+;; - Add customization options.
+;;
+;; Version 0.62:
+;; - Fix problem with keymap at point.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'flyspell))
+(eval-when-compile (require 'help-mode))
+(eval-when-compile (require 'ourcomments-util nil t))
+(eval-when-compile (require 'mumamo nil t))
+;;(eval-when-compile (require 'mlinks nil t))
+
+;;;###autoload
+(defgroup appmenu nil
+ "Customization group for `appmenu-mode'."
+ :group 'convenience)
+
+(defcustom appmenu-show-help nil
+ "Non-nil means show AppMenu help on AppMenu popup."
+ :type 'boolean
+ :group 'appmenu)
+
+(defcustom appmenu-show-point-menu t
+ "If non-nil show entries fetched from keymaps at point."
+ :type 'boolean
+ :group 'appmenu)
+
+(defvar appmenu-alist nil
+ "List of additional menu keymaps.
+To change this list use `appmenu-add' and `appmenu-remove'.
+
+The entries in this list are lists:
+
+ \(ID PRIORITY TEST TITLE DEFINITION)
+
+ID is a unique identity.
+
+PRIORITY is a number or a variable whose value is a number
+telling where to put this entry when showing the menu.
+
+TEST should be a form to evaluate. The entry is used if \(eval
+TEST) returns non-nil.
+
+DEFINITION should be either a keymap or a function that returns a
+keymap.
+
+The function must take no argument and return a keymap. If the
+function returns nil then the entry is not shown in the popup
+menu. Using this you can make context sensitive popup menus.
+
+For an example of use see mlinks.el.")
+
+(defun appmenu-sort-by-priority ()
+ "Sort `appmenu-alist' entries by priority."
+ (setq appmenu-alist
+ (sort appmenu-alist
+ (lambda (recA recB)
+ (let ((priA (nth 1 recA))
+ (priB (nth 1 recB)))
+ (when (symbolp priA) (setq priA (symbol-value priA)))
+ (when (symbolp priB) (setq priB (symbol-value priB)))
+ (< priA priB))))))
+
+;;;###autoload
+(defun appmenu-add (id priority test title definition)
+ "Add entry to `appmenu-alist'.
+Add an entry to this list with ID, PRIORITY, TEST, TITLE and
+DEFINITION as explained there."
+ (assert (symbolp id))
+ (unless priority (setq priority 100))
+ (assert (numberp priority))
+ (assert (stringp title))
+ (let ((rec (list id priority test title definition)))
+ (appmenu-remove id)
+ (add-to-list 'appmenu-alist rec)))
+
+(defun appmenu-remove (id)
+ "Remove entry with id ID from `appmenu-alist'."
+ (setq appmenu-alist (assq-delete-all id appmenu-alist)))
+
+(defun appmenu-help ()
+ "Show help for minor mode function `appmenu-mode'."
+ (interactive)
+ (describe-function 'appmenu-mode))
+
+(defun appmenu-keymap-len (map)
+ "Return length of keymap MAP."
+ (let ((ml 0))
+ (map-keymap (lambda (e f) (setq ml (1+ ml))) map)
+ ml))
+
+(defvar appmenu-mouse-only
+ '((flyspell-correct-word appmenu-flyspell-correct-word-before-point)))
+
+(defun appmenu-flyspell-correct-word-before-point ()
+ "Pop up a menu of possible corrections for misspelled word before point.
+Special version for AppMenu."
+ (interactive)
+ (flyspell-correct-word-before-point))
+
+(defcustom appmenu-at-any-point '(ispell-word)
+ "Commands that may work at any point in a buffer.
+Some important but not too often used commands that may be useful
+for most points in a buffer."
+ :group 'appmenu)
+
+(defvar appmenu-map-fun) ;; dyn var, silence compiler
+
+(defun appmenu-make-menu-for-point (this-point)
+ "Construct a menu based on point THIS-POINT.
+This includes some known commands for point and keymap at
+point."
+ (let ((point-map (get-char-property this-point 'keymap))
+ (funs appmenu-at-any-point)
+ (map (make-sparse-keymap "At point"))
+ (num 0)
+ last-prefix
+ this-prefix)
+ ;; Known for any point
+ (when point-map
+ (let ((appmenu-map-fun
+ (lambda (key fun)
+ (if (keymapp fun)
+ (map-keymap appmenu-map-fun fun)
+ (when (and (symbolp fun)
+ (fboundp fun))
+ (let ((mouse-only (assq fun appmenu-mouse-only)))
+ (when mouse-only
+ (setq fun (cadr mouse-only)))
+ (add-to-list 'funs fun)))))))
+ (map-keymap appmenu-map-fun point-map)))
+ (dolist (fun funs)
+ (let ((desc (when fun (documentation fun))))
+ (when desc
+ (setq desc (car (split-string desc "[\n]")))
+ ;;(lwarn t :warning "pk: %s, %s" fun desc)
+ (setq this-prefix
+ (car (split-string (symbol-name fun) "[-]")))
+ (when (and last-prefix
+ (not (string= last-prefix this-prefix)))
+ (define-key map
+ (vector (intern (format "appmenu-point-div-%s" num)))
+ (list 'menu-item "--")))
+ (setq last-prefix this-prefix)
+ (setq num (1+ num))
+ (define-key map
+ (vector (intern (format "appmenu-point-%s" num)))
+ (list 'menu-item desc fun)))))
+ (when (> num 0) map)))
+
+(defvar appmenu-level) ;; dyn var
+(defvar appmenu-funs) ;; dyn var
+(defvar appmenu-events) ;; dyn var
+(defvar appmenu-this-point) ;; dyn var
+
+(defun appmenu-keymap-map-fun (ev def)
+ (if (keymapp def)
+ (progn
+ (add-to-list 'appmenu-funs (list appmenu-level ev))
+ (setq appmenu-events (cons ev appmenu-events))
+ (setq appmenu-level (1+ appmenu-level))
+
+ (map-keymap 'appmenu-keymap-map-fun def)
+
+ (setq appmenu-events (cdr appmenu-events))
+ (setq appmenu-level (1- appmenu-level)))
+ (when (and (symbolp def)
+ (fboundp def))
+ (let* ((mouse-only (assq def appmenu-mouse-only))
+ (fun (if mouse-only (cadr mouse-only) def))
+ (doc (when fun
+ (if (not (eq fun 'push-button))
+ (documentation fun)
+ (concat
+ "Button: "
+ (with-current-buffer (marker-buffer appmenu-this-point)
+ (or (get-char-property appmenu-this-point 'help-echo)
+ (let ((action-fun (get-char-property appmenu-this-point 'action)))
+ (if action-fun
+ (documentation action-fun)
+ "No action, ignored"))
+ "No documentation available")))))))
+ (add-to-list 'appmenu-funs (list appmenu-level (cons ev appmenu-events) def doc))))))
+
+;;(appmenu-as-help (point))
+(defun appmenu-as-help (this-point)
+ "Show keybindings specific done current point in buffer.
+This shows the binding in the help buffer.
+
+Tip: This may be helpful if you are using `css-color-mode'."
+ (interactive (list (copy-marker (point))))
+ ;; Split this for debugging
+ (let ((menu-here
+ (with-current-buffer (or (and (markerp this-point)
+ (marker-buffer this-point))
+ (current-buffer))
+ (unless (markerp this-point) (setq this-point (copy-marker this-point)))
+ (get-char-property this-point 'keymap))))
+ ;;(describe-variable 'menu-here)
+ (appmenu-as-help-1 menu-here this-point)))
+
+(defun appmenu-as-help-1 (menu-here this-point)
+ (let ((appmenu-level 0)
+ (appmenu-funs nil)
+ (appmenu-events nil)
+ (appmenu-this-point this-point))
+ (when menu-here
+ (map-keymap 'appmenu-keymap-map-fun menu-here))
+ ;;(describe-variable 'appmenu-funs)
+ ;; Fix-me: collect info first in case we are in help-buffer!
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'appmenu-as-help this-point) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (let ((fmt " %s%15s %-30s\n"))
+ (insert (propertize
+ ;;"AppMenu: Keys found at point in buffer\n\n"
+ (format "Appmenu: Key bindings specific to point %s in buffer %S\n\n"
+ (+ 0 this-point)
+ (when (markerp this-point)
+ (buffer-name (marker-buffer this-point))))
+ 'face 'font-lock-comment-face))
+ (if (not menu-here)
+ (insert "\n\nThere are no point specific key bindings there now.")
+ (insert (propertize (format fmt "" "Key" "Function") 'face 'font-lock-function-name-face))
+ (insert (propertize (format fmt "" "---" "--------") 'face 'font-lock-function-name-face))
+ (dolist (rec appmenu-funs)
+ (let* ((lev (nth 0 rec))
+ (ev (nth 1 rec))
+ (fun (nth 2 rec))
+ (doc (nth 3 rec))
+ (d1 (when doc (car (split-string doc "[\n]")))))
+ (if fun
+ (insert (format fmt
+ "" ;;(concat "*" (make-string (* 4 lev) ?\ ))
+ (key-description (reverse ev))
+ d1)
+ (if nil (format "(%s)" fun) ""))
+ ;;(insert (format "something else=%S\n" rec))
+ )))))))))
+
+
+(defun appmenu-map ()
+ "Return menu keymap to use for popup menu."
+ (let* ((map (make-sparse-keymap
+ "AppMenu"
+ ))
+ (map-len (appmenu-keymap-len map))
+ (map-init-len map-len)
+ (num-minor 0)
+ (id 0)
+ (point-menu (when appmenu-show-point-menu
+ (appmenu-make-menu-for-point (point)))))
+ ;; AppMenu itself
+ (when appmenu-show-help
+ (define-key map [appmenu-customize]
+ (list 'menu-item "Customize AppMenu"
+ (lambda () (interactive) (customize-group 'appmenu))
+ :help "Customize AppMenu"
+ :visible 'appmenu-show-help))
+ (define-key map [appmenu-help]
+ (list 'menu-item "Help for AppMenu" 'appmenu-help
+ :help "Help for how to use AppMenu"
+ :visible 'appmenu-show-help))
+ (define-key map [appmenu-separator-1]
+ (list 'menu-item "--")))
+ (setq map-len (appmenu-keymap-len map))
+ (appmenu-sort-by-priority)
+ (dolist (rec appmenu-alist)
+ (let* ((test (nth 2 rec))
+ (title (nth 3 rec))
+ (mapdef (nth 4 rec))
+ (usedef (if (symbolp mapdef)
+ (funcall mapdef)
+ mapdef)))
+ (when (and usedef
+ (eval test))
+ (setq id (1+ id))
+ (define-key map
+ (vector (intern (format "appmenu-%s" id)))
+ (list 'menu-item title usedef)))
+ ))
+ (when point-menu
+ (setq map-len (appmenu-keymap-len map))
+ (when (> map-len map-init-len)
+ (define-key map [appmenu-at-point-div]
+ (list 'menu-item "--")))
+ (define-key map [appmenu-at-point]
+ (list 'menu-item "Bound To Point"
+ point-menu)))
+ (setq map-len (appmenu-keymap-len map))
+ (when (> map-len map-init-len)
+ map)))
+
+;; (defun appmenu-get-submenu (menu-command)
+;; (let (subtitle submenumap)
+;; (if (eq 'menu-item (car menu-command))
+;; (progn (setq subtitle (cadr menu-command))
+;; (setq submenumap (caddr menu-command)))
+;; (setq subtitle (car menu-command))
+;; (setq submenumap (cdr menu-command)))
+;; (unless (keymapp submenumap) (error "Submenu not a keymap=%s" submenumap))
+;; (cons subtitle submenumap)))
+
+(defun appmenu-popup ()
+ "Pops up the AppMenu menu."
+ (interactive)
+ (let* ((mod (event-modifiers last-input-event))
+ (is-mouse (or (memq 'click mod)
+ (memq 'down mod)
+ (memq 'drag mod))))
+ (when is-mouse
+ (goto-char (posn-point (event-start last-input-event)))
+ (sit-for 0.01))
+ (let ((menu (appmenu-map)))
+ (if menu
+ (popup-menu-at-point menu)
+ (message "Appmenu is empty")))))
+
+(defvar appmenu-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [apps] 'appmenu-popup)
+ (define-key map [mouse-3] 'appmenu-popup)
+ (define-key map [(control apps)] 'appmenu-as-help)
+ map))
+
+
+;;(setq appmenu-auto-help 4)
+(defcustom appmenu-auto-help 2
+ "Automatically show help on keymap at current point.
+This shows up after the number of seconds in this variable.
+If it it nil this feature is off.
+
+This feature is only on in `appmenu-mode'."
+ :type '(choice (number :tag "Number of seconds to wait")
+ (const :tag "Turned off" nil))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (if val
+ (add-hook 'post-command-hook 'appmenu-auto-help-post-command nil t)
+ (remove-hook 'post-command-hook 'appmenu-auto-help-post-command t)))
+ :group 'appmenu)
+
+(defcustom appmenu-auto-match-keymaps
+ '(css-color)
+ "Keymaps listed here can be avoided."
+ :type '(set (const unknown)
+ (const mlink)
+ (const css-color))
+ :group 'appmenu)
+
+(defvar appmenu-auto-help-timer nil)
+
+(defun appmenu-dump-keymap (km)
+ (let ((fun (lambda (ev def)
+ (message "ev=%S def=%S" ev def)
+ (when (keymapp def)
+ (map-keymap fun def)))))
+ (map-keymap fun km)))
+
+(defun appmenu-on-keymap (where)
+ (setq where (or where (point)))
+ (let* ((rec (get-char-property-and-overlay where 'keymap))
+ (kmp (car rec))
+ (ovl (cdr rec)))
+ (when kmp
+ (or (memq 'unknown appmenu-auto-match-keymaps)
+ (and (memq 'css-color appmenu-auto-match-keymaps)
+ (get-text-property where 'css-color-type))
+ (and (memq 'mlinks appmenu-auto-match-keymaps)
+ (boundp 'mlinks-point-hilighter-overlay)
+ (eq ovl mlinks-point-hilighter-overlay))
+ ))))
+
+(defsubst appmenu-auto-help-add-wcfg (at-point wcfg)
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (add-text-properties at-point (1+ at-point)
+ (list 'point-left 'appmenu-auto-help-maybe-remove
+ 'appmenu-auto-help-wcfg wcfg))))
+
+(defsubst appmenu-auto-help-remove-wcfg (at-point)
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (remove-list-of-text-properties at-point (1+ at-point)
+ '(appmenu-auto-help-wcfg point-left))))
+
+(defun appmenu-auto-help-maybe-remove (at-point new-point)
+ "Run in 'point-left property.
+Restores window configuration."
+ (let ((old-wcfg (get-text-property at-point 'appmenu-auto-help-wcfg)))
+ (appmenu-auto-help-remove-wcfg at-point)
+ (if (appmenu-on-keymap new-point)
+ (appmenu-auto-help-add-wcfg new-point old-wcfg)
+ (if old-wcfg
+ (set-window-configuration old-wcfg)
+ (help-xref-go-back (help-buffer))))))
+
+(defun appmenu-as-help-in-timer (win buf)
+ (condition-case err
+ (when (and (eq (selected-window) win)
+ (eq (current-buffer) buf)
+ appmenu-auto-help
+ (appmenu-on-keymap (point)))
+ (let* ((old-help-win (get-buffer-window (help-buffer)))
+ (wcfg (unless old-help-win
+ (current-window-configuration))))
+ (unless old-help-win
+ (display-buffer (help-buffer)))
+ (appmenu-auto-help-add-wcfg (point) wcfg)
+ (appmenu-as-help (copy-marker (point)))))
+ (error (message "appmenu-as-help-in-timer: %s" (error-message-string err)))))
+
+(defun appmenu-auto-help-cancel-timer ()
+ (when (timerp appmenu-auto-help-timer)
+ (cancel-timer appmenu-auto-help-timer))
+ (setq appmenu-auto-help-timer nil))
+
+(defun appmenu-auto-help-post-command ()
+ (when (fboundp 'appmenu-as-help)
+ (condition-case err
+ (appmenu-auto-help-post-command-1)
+ (error (message "css-color-post-command: %s" (error-message-string err))))))
+
+;; #fff #c9ff33
+(defun appmenu-auto-help-post-command-1 ()
+ (appmenu-auto-help-cancel-timer)
+ (and appmenu-auto-help
+ (appmenu-on-keymap (point))
+ (not (get-text-property (point) 'appmenu-auto-help-wcfg))
+ (setq appmenu-auto-help-timer
+ (run-with-idle-timer appmenu-auto-help nil 'appmenu-as-help-in-timer
+ (selected-window)
+ (current-buffer)))))
+
+
+;;;###autoload
+(define-minor-mode appmenu-mode
+ "Use a context sensitive popup menu.
+AppMenu (appmenu.el) is a framework for creating cooperative
+context sensitive popup menus with commands from different major
+and minor modes. Using this different modes may cooperate about
+the use of popup menus.
+
+There is also the command `appmenu-as-help' that shows the key
+bindings at current point in the help buffer.
+
+The popup menu and the help buffer version are on these keys:
+
+\\{appmenu-mode-map}
+
+The variable `appmenu-alist' is where the popup menu entries
+comes from.
+
+If there is a `keymap' property at point then relevant bindings
+from this is also shown in the popup menu.
+
+You can write functions that use whatever information you want in
+Emacs to construct these entries. Since this information is only
+collected when the popup menu is shown you do not have to care as
+much about computation time as for entries in the menu bar."
+ :global t
+ :keymap appmenu-mode-map
+ :group 'appmenu
+ (if appmenu-mode
+ (add-hook 'post-command-hook 'appmenu-auto-help-post-command)
+ (remove-hook 'post-command-hook 'appmenu-auto-help-post-command)))
+
+(when (and appmenu-mode
+ (not (boundp 'define-globa-minor-mode-bug)))
+ (appmenu-mode 1))
+
+(provide 'appmenu)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; appmenu.el ends here
--- /dev/null
+;;; as-external.el --- Emacs as an external editor to other apps
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Mon Jun 25 19:02:49 2007
+(defconst as-external:version "0.6") ;;Version:
+;; Last-Updated: 2009-08-04 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This little library should make it easier to use Emacs as an
+;; external editor in certain cases. One such case is when want to
+;; use Emacs as the external editor with the Firefox add-on "It's All
+;; Text".
+;;
+;; See variable `as-external-mode' for more information.
+;;
+;;
+;;; A note on the implementation:
+;;
+;; You may wonder why this does not use `auto-mode-alist' since it
+;; checks the file name in nearly the same way? It is perhaps possible
+;; to use that, but there are two things to be aware of:
+;;
+;; 1. The choice made must override other possible choices.
+;;
+;; 2. Beside the file name the implementation here also checks if the
+;; buffer has clients waiting. That makes the check more reliable.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'html-write nil t))
+(eval-when-compile (require 'mlinks nil t))
+(eval-when-compile (require 'mumamo nil t))
+(eval-when-compile (require 'nxhtml-mode nil t))
+(eval-when-compile (require 'ourcomments-util nil t))
+(eval-when-compile (require 'pause nil t))
+(eval-when-compile (require 'server))
+(eval-when-compile (require 'wikipedia-mode nil t))
+(eval-and-compile (require 'wrap-to-fill nil t))
+
+;;;###autoload
+(defgroup as-external nil
+ "Settings related to Emacs as external editor."
+ :group 'nxhtml
+ :group 'external)
+
+(defcustom as-external-its-all-text-regexp "/itsalltext/"
+ "Regular expression matching It's All Text buffer's file."
+ :type 'regexp
+ :group 'as-external)
+
+(defcustom as-external-alist
+ '(
+ ("/itsalltext/.*wiki" as-external-for-wiki)
+ ("/itsalltext/.*mail" as-external-for-mail-mode)
+ ("/itsalltext/" as-external-for-xhtml)
+ )
+ "List to determine setup if Emacs is used as an external Editor.
+Element in this list should have the form
+
+ \(FILE-REGEXP BUFFER-SETUP)
+
+where FILE-REGEXP should be a regular expression to match
+`buffer-file-name'. If it matches then BUFFER-SETUP should be
+called in the buffer.
+
+* Tip when using Firefox's add-on It's All Text: It looks like
+ the file name used will be constructed from the host url. For
+ example if your are editing something on
+ http://www.emacswiki.org/ the file name may be something like
+ 'www.emacswiki.org.283b1y212e.html'.
+
+
+The list is processed by `as-external-setup'. Note that the first
+match is used!
+
+The default entries in this list supports for Firefox addon It's
+All Text:
+
+- `as-external-for-xhtml'. For text areas on web pages where you
+ can enter some XHTML code, for example blog comment fields.
+
+- `as-external-for-mail-mode', for editing web mail messages.
+
+- `as-external-for-wiki', for mediawiki.
+
+See also `as-external-mode'."
+ :type '(repeat
+ (list (choice (variable :tag "Regexp variable")
+ regexp)
+ command))
+ :group 'as-external)
+
+(defcustom as-external-its-all-text-coding 'utf-8
+ "Coding system to use for It's All Text buffers.
+See also `as-external-for-xhtml'."
+ :type '(choice (const :tag "No special coding system" nil)
+ coding-system)
+ :group 'as-external)
+
+(defun as-external-fall-back (msg)
+ "Fallback to text-mode if necessary."
+ (text-mode)
+ (lwarn t :warning "%s. Using text-mode" msg))
+
+;;;###autoload
+(defun as-external-for-xhtml ()
+ "Setup for Firefox addon It's All Text to edit XHTML.
+It's All Text is a Firefox add-on for editing textareas with an
+external editor.
+See URL `https://addons.mozilla.org/en-US/firefox/addon/4125'.
+
+In this case Emacs is used to edit textarea fields on a web page.
+The text will most often be part of a web page later, like on a
+blog. Therefore turn on these:
+
+- `nxhtml-mode' since some XHTML tags may be allowed.
+- `nxhtml-validation-header-mode' since it is not a full page.
+- `wrap-to-fill-column-mode' to see what you are writing.
+- `html-write-mode' to see it even better.
+
+Also bypass the question for line end conversion when using
+emacsw32-eol."
+ (interactive)
+ (if (not (fboundp 'nxhtml-mode))
+ (as-external-fall-back "Can't find nXhtml")
+ (nxhtml-mode)
+ (nxhtml-validation-header-mode 1)
+ (set (make-local-variable 'wrap-to-fill-left-marg-modes)
+ '(nxhtml-mode fundamental-mode))
+ (wrap-to-fill-column-mode 1)
+ ;;(visible-point-mode 1)
+ (when (fboundp 'html-write-mode) (html-write-mode 1))
+ (when (boundp 'emacsw32-eol-ask-before-save)
+ (make-local-variable 'emacsw32-eol-ask-before-save)
+ (setq emacsw32-eol-ask-before-save nil))))
+
+
+(defvar as-external-mail-mode-comment-pattern "^>.*$"
+ "Regular expression for a comment line.")
+
+(defvar as-external-mail-mode-email-pattern
+ (concat "[a-z0-9$%(*-=?[_][^<>\")!;:,{}]*"
+ "\@"
+ "\\(?:[a-z0-9\-]+\.\\)+[a-z0-9]\\{2,4\\}")
+ "Regular expression for a mail address.")
+
+(defvar as-external-mail-mode-font-lock-keywords
+ (list
+ (list as-external-mail-mode-comment-pattern
+ '(0 font-lock-comment-face))
+ ;; (list as-external-mail-mode-email-pattern
+ ;; '(0 font-lock-keyword-face))
+ ))
+
+;;;###autoload
+(define-derived-mode as-external-for-mail-mode text-mode "ExtMail "
+ "Setup for Firefox addon It's All Text to edit mail.
+Set normal mail comment markers in column 1 (ie >).
+
+Set `fill-column' to 90 and enable `wrap-to-fill-column-mode' so
+that it will look similar to how it will look in the sent plain
+text mail.
+
+See also `as-external-mode'."
+ ;; To-do: Look at http://globs.org/articles.php?lng=en&pg=2
+ (set (make-local-variable 'comment-column) 0)
+ (set (make-local-variable 'comment-start) ">")
+ (set (make-local-variable 'comment-end) "")
+ (set (make-local-variable 'font-lock-defaults)
+ '((as-external-mail-mode-font-lock-keywords) nil))
+ (setq fill-column 90)
+ (mlinks-mode 1)
+ (wrap-to-fill-column-mode 1))
+
+;;;###autoload
+(defun as-external-for-wiki ()
+ "Setup for Firefox addon It's All Text to edit MediaWikis."
+ (interactive)
+ (require 'wikipedia-mode nil t)
+ (if (not (featurep 'wikipedia-mode))
+ (as-external-fall-back "Can't find file wikipedia-mode.el")
+ (wikipedia-mode)))
+
+
+;;;###autoload
+(define-minor-mode as-external-mode
+ "If non-nil check if Emacs is called as external editor.
+When Emacs is called as an external editor for example to edit
+text areas on a web page viewed with Firefox this library tries
+to help to setup the buffer in a useful way. It may for example
+set major and minor modes for the buffer.
+
+This can for example be useful when blogging or writing comments
+on blogs.
+
+See `as-external-alist' for more information."
+ :global t
+ :group 'as-external
+ ;;(modify-coding-system-alist 'file "/itsalltext/" as-external-its-all-text-coding)
+ (let ((coding-entry
+ (cons
+ as-external-its-all-text-regexp
+ (cons as-external-its-all-text-coding
+ as-external-its-all-text-coding))))
+ ;;(message "as-external-mode=%s" as-external-mode)
+ (if as-external-mode
+ (progn
+ (add-to-list 'file-coding-system-alist coding-entry)
+ (add-hook 'server-visit-hook 'as-external-setup t))
+ (setq file-coding-system-alist
+ (delq coding-entry file-coding-system-alist))
+ (remove-hook 'server-visit-hook 'as-external-setup))))
+
+(defun as-external-setup ()
+ "Check if Emacs is used as an external editor.
+If so then turn on useful major and minor modes.
+This is done by checking `as-external-alist'."
+ (condition-case err
+ (as-external-setup-1)
+ (error (message "as-external-setup error: %s" err))))
+
+(defvar as-external-my-frame nil)
+(make-variable-buffer-local 'as-external-my-frame)
+
+(defvar as-external-last-buffer nil)
+
+(defun as-external-server-window-fix-frames ()
+ (condition-case err
+ (with-current-buffer as-external-last-buffer
+ (unless (buffer-live-p pause-buffer)
+ (remove-hook 'pause-break-exit-hook 'as-external-server-window-fix-frames)
+ (setq as-external-my-frame (or as-external-my-frame
+ (make-frame)))
+ (dolist (f (frame-list))
+ (unless (eq f as-external-my-frame)
+ (lower-frame f)))
+ (raise-frame as-external-my-frame)))
+ (error (message "%s" (error-message-string err)))))
+
+(defun as-external-server-window (buffer)
+ (setq server-window nil)
+ (with-current-buffer buffer
+ (setq as-external-last-buffer (current-buffer))
+ (run-with-idle-timer 2 nil 'as-external-server-window-fix-frames)
+ (add-hook 'pause-break-exit-hook 'as-external-server-window-fix-frames)
+ (add-hook 'kill-buffer-hook 'as-external-delete-my-frame nil t)))
+
+(defun as-external-delete-my-frame ()
+ (let ((win (and (frame-live-p as-external-my-frame)
+ (get-buffer-window nil as-external-my-frame))))
+ (when (and win
+ (= 1 (length (window-list as-external-my-frame 'no-mini))))
+ (delete-frame as-external-my-frame)
+ (lower-frame))))
+
+(defun as-external-setup-1 ()
+ ;; Fix-me: How does one know if the file names are case sensitive?
+ (unless (when (boundp 'nowait) nowait) ;; dynamically bound in `server-visit-files'
+ (unless server-window
+ ;; `server-goto-toplevel' has been done here.
+ ;; Setup to use a new frame
+ (setq server-window 'as-external-server-window))
+ (catch 'done
+ (dolist (rec as-external-alist)
+ (let ((file-regexp (car rec))
+ (setup-fun (cadr rec)))
+ (when (symbolp file-regexp)
+ (setq file-regexp (symbol-value file-regexp)))
+ (when (string-match file-regexp (buffer-file-name))
+ (funcall setup-fun)
+ (throw 'done t)))))))
+
+(provide 'as-external)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; as-external.el ends here
--- /dev/null
+;;; buffer-bg.el --- Changing background color of windows
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-05-22T19:06:23+0200 Thu
+;; Version: 0.5
+;; Last-Updated: 2008-05-22T23:19:55+0200 Thu
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/buffer-bg.el
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; There is currently no way to change background colors of Emacs
+;; windows. This library implements a workaround using overlays.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defvar buffer-bg-overlay nil)
+(put 'buffer-bg-overlay 'permanent-local t)
+
+;;;###autoload
+(defun buffer-bg-set-color (color buffer)
+ "Add an overlay with background color COLOR to buffer BUFFER.
+If COLOR is nil remove previously added overlay."
+ (interactive
+ (let* ((prompt (if buffer-bg-overlay
+ "Background color (empty string to remove): "
+ "Background color: "))
+ (color (read-color prompt nil t)))
+ (when (= 0 (length color))
+ (setq color nil))
+ (list color (current-buffer))
+ ))
+ (if (not color)
+ (when buffer-bg-overlay
+ (delete-overlay buffer-bg-overlay)
+ (setq buffer-bg-overlay nil))
+ (save-restriction
+ (widen)
+ (setq buffer-bg-overlay
+ (make-overlay (point-min) (point-max) nil nil t))
+ ;; Fix-me: Let the overlay have priority 0 which is the
+ ;; lowest. Change this to below char properties if this is ever
+ ;; allowed in Emacs.
+ (overlay-put buffer-bg-overlay 'priority 0)
+ (let* ((bg-face (list :background color))
+ (bg-after (propertize (make-string 10 ?\n)
+ 'face bg-face
+ 'intangible t)))
+ (overlay-put buffer-bg-overlay 'face bg-face)
+ ;; This is just confusing, don't use it:
+ ;;(overlay-put buffer-bg-overlay 'after-string bg-after)
+ )
+ )))
+
+
+(provide 'buffer-bg)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; buffer-bg.el ends here
--- /dev/null
+;;; chartg.el --- Google charts (and maybe other)
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-04-06 Sun
+(defconst chart:version "0.2") ;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defconst chartg-types
+ '((line-chartg-x lc)
+ (line-chartg-xy lxy)
+ (line-chart ls)
+
+ (bar-chartg-horizontal bhs)
+ (bar-chartg-vertical bvs)
+ (bar-chartg-horizontal-grouped bhg)
+ (bar-chartg-vertical-grouped bvg)
+
+ (pie-2-dimensional p)
+ (pie-3-dimensional p3)
+
+ (venn-diagram v)
+ (scatter-plot s)
+
+ (radar-chart r)
+ (radar-chartg-w-splines rs)
+
+ (geographical-map t)
+ (meter gom)))
+
+(defconst chartg-types-keywords
+ (mapcar (lambda (rec)
+ (symbol-name (car rec)))
+ chartg-types))
+
+(defvar chartg-mode-keywords-and-states
+ '(("Output-file:" (accept file-name))
+ ("Size:" (accept number))
+ ("Data:" (accept number))
+ ("Type:" (accept chartg-type))
+ ))
+
+(defvar chartg-mode-keywords
+ (mapcar (lambda (rec)
+ (car rec))
+ chartg-mode-keywords-and-states))
+
+;; Fix-me: I started to implement a parser, but I think I will drop it
+;; and wait for Semantic to be easily available instead. Or just use
+;; Calc/Org Tables.
+
+(defvar chartg-intermediate-states
+ '((end-or-label (or end-of-file label))
+ ))
+
+(defvar chartg-extra-keywords-and-states
+ '(
+ ;;("Provider:")
+ ("Colors:")
+ ("Solid-fill:")
+ ("Linear-gradient:")
+ ("Linear-stripes:")
+ ("Chartg-title:" (and string end-or-label))
+ ("Legends:" (accept string))
+ ("Axis-types:")
+ ("Axis-labels:")
+ ("Axis-ranges:")
+ ("Axis-styles:")
+ ("Bar-thickness:")
+ ("Bar-chartg-zero-line:")
+ ("Bar-chartg-zero-line-2:")
+ ("Line-styles-1:")
+ ("Line-styles-2:")
+ ("Grid-lines:")
+ ("Shape-markers:")
+ ("Range-markers:")
+ ))
+
+(defvar chartg-extra-keywords
+ (mapcar (lambda (rec)
+ (car rec))
+ chartg-extra-keywords-and-states))
+
+(defvar chartg-raw-keywords-and-states
+ '(
+ ("Google-chartg-raw:" (accept string))
+ ))
+
+(defvar chartg-raw-keywords
+ (mapcar (lambda (rec)
+ (car rec))
+ chartg-raw-keywords-and-states))
+
+(defvar chartg-mode-keywords-re (regexp-opt chartg-mode-keywords))
+(defvar chartg-extra-keywords-re (regexp-opt chartg-extra-keywords))
+(defvar chartg-types-keywords-re (regexp-opt chartg-types-keywords))
+(defvar chartg-raw-keywords-re (regexp-opt chartg-raw-keywords))
+
+(defvar chartg-font-lock-keywords
+ `((,chartg-mode-keywords-re . font-lock-keyword-face)
+ (,chartg-extra-keywords-re . font-lock-variable-name-face)
+ (,chartg-types-keywords-re . font-lock-function-name-face)
+ (,chartg-raw-keywords-re . font-lock-preprocessor-face)
+ ))
+
+(defvar chartg-font-lock-defaults
+ '(chartg-font-lock-keywords nil t))
+
+(defvar chartg-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\n "> " table)
+ (modify-syntax-entry ?\; "< " table)
+ table))
+
+(defun chartg-create (provider out-file size data type
+ title legends &optional extras)
+ "Create a chart image.
+PROVIDER is what to use for creating the chart. Currently only
+`google' for Google's chart API is supported.
+
+OUT-FILE is where the image goes.
+
+SIZE is a cons cell with pixel width and height.
+
+DATA is the data to draw the chart from. It is a list of data
+sets where each data set has the form:
+
+ (list (list NUMBERS ...) (MIN . MAX)))
+
+TYPE can be the following:
+
+* Line charts
+
+ - lc: Line chart with only y values. Each dataset is a new
+ line.
+
+ - lxy: Line chart with both x and y values. For each line there
+ should be a pair of datasets, the first for x and the second
+ for y. If the x dataset just contains a single -1 then values
+ are evenly spaced along the x-axis.
+
+ - ls: Like above, but axis are not drawn.
+
+* Bar charts:
+
+ - bhs: horizontal bars.
+ - bvs: vertical bars.
+ - bhg, bvg: dito grouped.
+
+* Pie charts:
+
+ - cht=p: one dimensional
+ - cht=p3: three dimensional
+
+* Venn diagrams
+
+ - cht=v: data should be specified as
+ * the first three values specify the relative sizes of three
+ circles, A, B, and C
+ * the fourth value specifies the area of A intersecting B
+ * the fifth value specifies the area of A intersecting C
+ * the sixth value specifies the area of B intersecting C
+ * the seventh value specifies the area of A intersecting B
+ intersecting C
+
+* Scatter plots
+
+ - cht=s: Supply a pair of datasets, first for x and second for
+ y coordinates.
+
+* Radar charts
+
+ - cht=r: straight lines.
+ - cht=rs: splines.
+
+ You will have to find out the format of the datasets
+ yourself, I don't understand it ;-)
+
+ Or perhaps mail google?
+
+* Maps
+
+ - cht=t
+
+ together with
+
+ - chtm=AREA: AREA for provider `google' is currently one of
+ * africa
+ * asia
+ * europe
+ * middle_east
+ * south_america
+ * usa
+ * world
+
+* Meter
+
+ - cht=gom: A speed meter type meter. Takes a single value.
+
+TITLE is a string to use as title.
+
+LEGENDS is a list of labels to put on the data.
+
+EXTRAS is a list of extra arguments with the form
+
+ (EXTRA-TYPE EXTRA-VALUE)
+
+Where EXTRA-TYPE is the extra argument type and EXTRA-VALUE the
+value. The following EXTRA-TYPEs are supported:
+
+* COLORS: value is a list of colors corresponding to the list of
+ DATA. Each color have the format RRGGBB or RRGGBBTT where the
+ first form is the normal way to specify colors in rgb-format
+ and the second has an additional TT for transparence. TT=00
+ means completely transparent and TT=FF means completely opaque.
+
+FILL-AREA are fill colors for data sets in line charts. It should
+be a list
+
+ (list COLOR START-INDEX END-INDEX)
+
+"
+ (message "(chartg-create %s %s %s %s %s %s %s" provider out-file size data type
+ title legends)
+ (unless (symbolp type)
+ (error "Argument TYPE should be a symbol"))
+ (unless (assoc type chartg-types)
+ (error "Unknown chart type: %s" type))
+ (cond
+ ((eq provider 'google)
+ (let* ((g-type (nth 1 (assoc type chartg-types)))
+ (width (car size))
+ (height (cdr size))
+ ;;(size-par (format "&chs=%sx%s" width height))
+ ;;
+ numbers
+ scales
+ colors-par
+ ;;
+ url
+ content
+ )
+ (setq url
+ (format
+ "http://chart.apis.google.com/chart?cht=%s&chs=%dx%d" g-type width height))
+ ;;(setq url (concat url size-par))
+ ;; Data and scales
+ (unless data
+ (error "No data"))
+ (dolist (rec data)
+ (let* ((rec-numbers (car rec))
+ (number-str
+ (let (str)
+ (dolist (num rec-numbers)
+ (setq str
+ (if (not str)
+ (number-to-string num)
+ (concat str "," (number-to-string num)))))
+ str))
+ (rec-scale (cadr rec))
+ (rec-min (car rec-scale))
+ (rec-max (cdr rec-scale))
+ (scale-str (when rec-scale (format "%s,%s" rec-min rec-max)))
+ )
+ (if (not numbers)
+ (progn
+ (setq numbers (concat "&chd=t:" number-str))
+ (when (or scale-str
+ (memq g-type '(p p3 gom)))
+ (setq scales (concat "&chds=" scale-str))))
+ (setq numbers (concat numbers "|" number-str))
+ (when scale-str
+ (setq scales (concat scales "," scale-str))))))
+ (setq url (concat url numbers))
+ (when scales (setq url (concat url scales)))
+ ;; fix-me: encode the url
+ (when title (setq url (concat url "&chtt=" (url-hexify-string title))))
+ (when legends
+ (let ((url-legends (mapconcat 'url-hexify-string legends "|"))
+ (arg (if (memq g-type '(p p3 gom))
+ "&chl="
+ "&chdl=")))
+ (setq url (concat url arg url-legends))))
+ (dolist (extra extras)
+ (let ((extra-type (car extra))
+ (extra-value (cdr extra)))
+ (cond
+ ((eq extra-type 'GOOGLE-RAW)
+ (setq url (concat url extra-value)))
+ ((eq extra-type 'colors)
+ ;; Colors
+ (dolist (color extra-value)
+ (if (not colors-par)
+ (setq colors-par (concat "&chco=" color))
+ (setq colors-par (concat colors-par "," color))))
+ (when colors-par (setq url (concat url colors-par))))
+ (t (error "Unsupported extra type: %s" extra-type)))))
+
+ ;;(lwarn t :warning "url=%s" url)(top-level)
+ ;;(setq url (concat url "&chxt=y"))
+ (message "Sending %s" url)
+ (setq content
+ (with-current-buffer (url-retrieve-synchronously url)
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (buffer-substring-no-properties (point) (point-max))
+ (view-buffer-other-window (current-buffer))
+ (error "Bad content"))))
+ (let* ((is-html (string-match-p "</body></html>" content))
+ (fname (progn
+ (when is-html
+ (setq out-file (concat (file-name-sans-extension out-file) ".html")))
+ (expand-file-name out-file)
+ ))
+ (do-it (or (not (file-exists-p fname))
+ (y-or-n-p
+ (concat "File " fname " exists. Replace it? "))))
+ (buf (find-buffer-visiting fname))
+ (this-window (selected-window)))
+ (when do-it
+ (when buf (kill-buffer buf))
+ (with-temp-file fname
+ (insert content))
+ (if (not is-html)
+ (view-file-other-window fname)
+ (chartg-show-last-error-file fname))
+ (select-window this-window)))))
+ (t (error "Unknown provider: %s" provider)))
+ )
+
+(defun chartg-show-last-error-file (fname)
+ (interactive)
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'chartg-show-last-error-file fname) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert "Error, see ")
+ (insert-text-button "result error page"
+ 'action
+ `(lambda (btn)
+ (browse-url ,fname))))))
+
+(defvar chartg-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(meta tab)] 'chartg-complete)
+ (define-key map [(control ?c) (control ?c)] 'chartg-make-chart)
+ map))
+
+(defun chartg-missing-keywords ()
+ (let ((collection (copy-sequence chartg-mode-keywords)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward chartg-mode-keywords-re nil t)
+ (setq collection
+ (delete (match-string-no-properties 0)
+ collection)))))
+ collection))
+
+;;;###autoload
+(defun chartg-complete ()
+ (interactive)
+ (let* ((here (point))
+ (partial (when (looking-back (rx word-start
+ (optional ?\")
+ (0+ (any "[a-z]"))))
+ (match-string-no-properties 0)))
+ (part-pos (if partial
+ (match-beginning 0)
+ (setq partial "")
+ (point)))
+ (state (catch 'pos-state (chartg-get-state (point))))
+ (msg "No completions")
+ collection
+ all
+ prompt
+ res)
+ (when state
+ (cond
+ ((or (= (current-column) 0)
+ (equal state 'need-label))
+ (setq collection (append (chartg-missing-keywords)
+ chartg-extra-keywords
+ chartg-raw-keywords
+ nil))
+ (setq prompt "Label: "))
+ ((equal state '(accept number))
+ (setq res nil)
+ (setq msg (propertize "Needs a number here!"
+ 'face 'secondary-selection)))
+ ((equal state '(accept chartg-type))
+ (setq collection chartg-types-keywords)
+ (setq prompt "Chart type: "))
+ ((equal state '(accept file-name))
+ (setq res
+ (concat "\"" (read-file-name "Output-file: "
+ nil
+ ;; fix-me: handle partial
+ partial)
+ "\""))))
+ (when collection
+ (let ((all (if partial
+ (all-completions partial collection)
+ collection)))
+ (setq res (when all
+ (if (= (length all) 1)
+ (car all)
+ (completing-read prompt collection nil t partial)))))))
+ (if (not res)
+ (message "%s" msg)
+ (insert (substring res (length partial))))))
+
+
+(defun chartg-get-state (want-pos-state)
+ (let* (par-output-file
+ par-provider
+ par-size
+ par-data par-data-temp
+ par-data-min par-data-max
+ par-type
+ par-title
+ par-legends
+ par-google-raw
+ (here (point))
+ token-before-pos
+ pos-state
+ (state 'need-label)
+ (problems
+ (catch 'problems
+ (save-restriction
+ ;;(widen)
+ (if want-pos-state
+ (unless (re-search-backward chartg-mode-keywords-re nil t)
+ (goto-char (point-min)))
+ (goto-char (point-min)))
+ (let (this-keyword
+ this-start
+ this-end
+ params
+ token
+ token-pos
+ next-token
+ found-labels
+ current-label)
+ (while (or token
+ (progn
+ (setq pos-state state)
+ (setq token-before-pos (point))
+ (condition-case err
+ (setq token (read (current-buffer)))
+ (error
+ (if (eq (car err) 'end-of-file)
+ (unless (or (eq state 'need-label)
+ (member '(quote |) state))
+ (throw 'problems (format "Unexpected end, state=%s" state)))
+ (throw 'problems
+ (error-message-string err)))))))
+ (message "token=%s, label=%s, state=%s" token current-label state)
+ (when (and want-pos-state
+ (>= (point) want-pos-state))
+ (when (= (point) want-pos-state)
+ ;; right after item
+ (setq pos-state nil))
+ (goto-char here)
+ (throw 'pos-state pos-state))
+ (when (and (listp state) (memq 'number state))
+ (unless (numberp token)
+ (save-match-data
+ (let ((token-str (format "%s" token)))
+ (setq token-str (replace-regexp-in-string "\\([0-9]\\),\\([0-9]\\)" "\\1\\2" token-str))
+ (when (string-match-p "^[0-9]+$" token-str)
+ (setq token (string-to-number token-str)))))))
+ (cond ;; state
+ ;; Label
+ ((eq state 'need-label)
+ (unless (symbolp token)
+ (throw 'problems (format "Expected label, got %s" token)))
+ (unless (member (symbol-name token)
+ (append chartg-mode-keywords
+ chartg-extra-keywords
+ chartg-raw-keywords
+ nil))
+ (throw 'problems (format "Unknown label %s" token)))
+ (when (member (symbol-name token) found-labels)
+ (throw 'problems (format "Label %s defined twice" token)))
+ (setq current-label token)
+ (setq found-labels (cons current-label found-labels))
+ (setq token nil)
+ ;;(setq state 'need-value)
+ (case current-label
+ ('Output-file:
+ (setq state '(accept file-name)))
+ ('Size:
+ (setq state '(accept number)))
+ ('Data:
+ (setq state '(accept number)))
+ ('Type:
+ (setq state '(accept chartg-type)))
+ ('Chartg-title:
+ (setq state '(accept string)))
+ ('Legends:
+ (setq state '(accept string)))
+ ('Google-chartg-raw:
+ (setq state '(accept string)))
+ ))
+ ;;;; Values
+ ;; Alt
+ ((equal state '(accept '| symbol))
+ (if (eq '| token)
+ (case current-label
+ ('Legends:
+ (setq token nil)
+ (setq state '(accept string)))
+ (t (error "internal error, current-label=%s, state=%s" current-label state)))
+ (if (symbolp token)
+ (progn
+ ;;(setq token nil)
+ (setq state 'need-label))
+ (throw 'problems (format "Expected | or label, got %s" token)))))
+ ;; Strings
+ ((equal state '(accept string))
+ (unless (stringp token)
+ (throw 'problems "Expected string"))
+ (case current-label
+ ('Chartg-title:
+ (setq par-title token)
+ (setq token nil)
+ (setq state 'need-label))
+ ('Legends:
+ (setq par-legends (cons token par-legends))
+ (setq token nil)
+ (setq state '(accept '| symbol)))
+ ('Google-chartg-raw:
+ (setq par-google-raw token)
+ (setq token nil)
+ (setq state 'need-label))
+ (t (error "internal error, current-label=%s, state=%s" current-label state))))
+ ;; Output file
+ ((equal state '(accept file-name))
+ (unless (stringp token)
+ (throw 'problems "Expected file name string"))
+ (assert (eq current-label 'Output-file:))
+ (setq par-output-file token)
+ (setq token nil)
+ (setq state 'need-label))
+ ;; Numbers
+ ((equal state '(accept number))
+ (unless (numberp token)
+ (throw 'problems "Expected number"))
+ (case current-label
+ ('Size:
+ (if (not par-size)
+ (progn
+ (setq par-size token)
+ (setq token nil)
+ (setq state '(accept number 'x 'X)))
+ (setq par-size (cons par-size token))
+ (setq token nil)
+ (setq state 'need-label)))
+ ('Data:
+ ;;(assert (not par-data-temp))
+ (setq par-data-temp (cons token par-data-temp))
+ (setq par-data-min token)
+ (setq par-data-max token)
+ (setq token nil)
+ (setq state '(accept number ', '| symbol))
+ )
+ (t (error "internal error, state=%s, current-label=%s" state current-label)))
+ )
+ ;; Numbers or |
+ ((equal state '(accept number ', '| symbol))
+ (if (numberp token)
+ (progn
+ (setq par-data-min (if par-data-min (min par-data-min token) token))
+ (setq par-data-max (if par-data-max (max par-data-max token) token))
+ (setq par-data-temp (cons token par-data-temp))
+ (message "par-data-min/max=%s/%s, token=%s -- %s" par-data-min par-data-max token par-data-temp)
+ (setq token nil))
+ (if (eq ', token)
+ (setq token nil)
+ (if (or (eq '| token)
+ (symbolp token))
+ (progn
+ (unless par-data-temp
+ (throw 'problems "Empty data set"))
+ (setq par-data (cons (list (reverse par-data-temp) (cons par-data-min par-data-max)) par-data))
+ (setq par-data-temp nil)
+ (setq par-data-min nil)
+ (setq par-data-max nil)
+ (if (not (eq '| token))
+ (setq state 'need-label)
+ (setq state '(accept number))
+ (setq token nil)))
+ (throw 'problems "Expected | or EOF")
+ ))))
+ ;; Numbers or x/X
+ ((equal state '(accept number 'x 'X))
+ (assert (eq current-label 'Size:))
+ (let ((is-n (numberp token))
+ (is-x (memq token '(x X))))
+ (unless (or is-n is-x)
+ (throw 'problems "Expected X or number"))
+ (if is-x
+ (progn
+ (setq token nil)
+ (setq state '(accept number)))
+ (setq par-size (cons par-size token))
+ (setq token nil)
+ (setq state 'need-label))))
+ ;; Chart type
+ ((equal state '(accept chartg-type))
+ (setq par-type token)
+ (unless (assoc par-type chartg-types)
+ (throw 'problems (format "Unknown chart type: %s" par-type)))
+ (setq token nil)
+ (setq state 'need-label))
+ (t (error "internal error, state=%s" state))))))
+ ;; fix-me here
+
+ nil)))
+ (when want-pos-state
+ (goto-char here)
+ (throw 'pos-state state))
+ (unless problems
+ (let ((missing-lab (chartg-missing-keywords)))
+ (when missing-lab
+ (setq problems (format "Missing required labels: %s" missing-lab)))))
+ (if problems
+ (let ((msg (if (listp problems)
+ (nth 1 problems)
+ problems))
+ (where (if (listp problems)
+ (nth 0 problems)
+ token-before-pos)))
+ (goto-char where)
+ (skip-chars-forward " \t")
+ (error msg))
+ (goto-char here)
+ ;;(defun chartg-create (out-file provider size data type &rest extras)
+ (setq par-provider 'google)
+ (setq par-legends (nreverse par-legends))
+ (let ((extras nil))
+ (when par-google-raw
+ (setq extras (cons (cons 'GOOGLE-RAW par-google-raw) extras)))
+ (chartg-create par-provider par-output-file par-size
+ par-data par-type par-title par-legends extras))
+ nil)))
+
+;;;###autoload
+(defun chartg-make-chart ()
+ "Try to make a new chart.
+If region is active then make a new chart from data in the
+selected region.
+
+Else if current buffer is in `chartg-mode' then do it from the
+chart specifications in this buffer. Otherwise create a new
+buffer and initialize it with `chartg-mode'.
+
+If the chart specifications are complete enough to make a chart
+then do it and show the resulting chart image. If not then tell
+user what is missing.
+
+NOTE: This is beta, no alpha code. It is not ready.
+
+Below are some examples. To test them mark an example and do
+
+ M-x chartg-make-chart
+
+* Example, simple x-y chart:
+
+ Output-file: \"~/temp-chart.png\"
+ Size: 200 200
+ Data: 3 8 5 | 10 20 30
+ Type: line-chartg-xy
+
+* Example, pie:
+
+ Output-file: \"~/temp-depression.png\"
+ Size: 400 200
+ Data:
+ 2,160,000
+ 3,110,000
+ 1,510,000
+ 73,600
+ 775,000
+ 726,000
+ 8,180,000
+ 419,000
+ Type: pie-3-dimensional
+ Chartg-title: \"Depression hits on Google\"
+ Legends:
+ \"SSRI\"
+ | \"Psychotherapy\"
+ | \"CBT\"
+ | \"IPT\"
+ | \"Psychoanalysis\"
+ | \"Mindfulness\"
+ | \"Meditation\"
+ | \"Exercise\"
+
+
+* Example, pie:
+
+ Output-file: \"~/temp-panic.png\"
+ Size: 400 200
+ Data:
+ 979,000
+ 969,000
+ 500,000
+ 71,900
+ 193,000
+ 154,000
+ 2,500,000
+ 9,310,000
+ Type: pie-3-dimensional
+ Chartg-title: \"Depression hits on Google\"
+ Legends:
+ \"SSRI\"
+ | \"Psychotherapy\"
+ | \"CBT\"
+ | \"IPT\"
+ | \"Psychoanalysis\"
+ | \"Mindfulness\"
+ | \"Meditation\"
+ | \"Exercise\"
+
+
+* Example using raw:
+
+ Output-file: \"~/temp-chartg-slipsen-kostar.png\"
+ Size: 400 130
+ Data: 300 1000 30000
+ Type: bar-chartg-horizontal
+ Chartg-title: \"Vad killen i slips tjänar jämfört med dig och mig\"
+ Google-chartg-raw: \"&chds=0,30000&chco=00cd00|ff4500|483d8b&chxt=y,x&chxl=0:|Killen+i+slips|Partiledarna|Du+och+jag&chf=bg,s,ffd700\"
+
+
+"
+ (interactive)
+ (if mark-active
+ (let* ((rb (region-beginning))
+ (re (region-end))
+ (data (buffer-substring-no-properties rb re))
+ (buf (generate-new-buffer "*Chart from region*")))
+ (switch-to-buffer buf)
+ (insert data)
+ (chartg-mode))
+ (unless (eq major-mode 'chartg-mode)
+ (switch-to-buffer (generate-new-buffer "*Chart*"))
+ (chartg-mode)))
+ (chartg-get-state nil))
+
+;; (defun chartg-from-region (min max)
+;; "Try to make a new chart from data in selected region.
+;; See `chartg-mode' for examples you can test with this function."
+;; (interactive "r")
+;; (unless mark-active (error "No region selected"))
+;; (let* ((rb (region-beginning))
+;; (re (region-end))
+;; (data (buffer-substring-no-properties rb re))
+;; (buf (generate-new-buffer "*Chart from region*")))
+;; (switch-to-buffer buf)
+;; (insert data)
+;; (chartg-mode)
+;; (chartg-get-state nil)))
+
+(define-derived-mode chartg-mode fundamental-mode "Chart"
+ "Mode for specifying charts.
+\\{chartg-mode-map}
+
+To make a chart see `chartg-make-chart'.
+
+"
+ (set (make-local-variable 'font-lock-defaults) chartg-font-lock-defaults)
+ (set (make-local-variable 'comment-start) ";")
+ ;; Look within the line for a ; following an even number of backslashes
+ ;; after either a non-backslash or the line beginning.
+ (set (make-local-variable 'comment-start-skip)
+ "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ ;; Font lock mode uses this only when it KNOWS a comment is starting.
+ (set (make-local-variable 'font-lock-comment-start-skip) ";+ *")
+ (set (make-local-variable 'comment-add) 1) ;default to `;;' in comment-region
+ (set (make-local-variable 'comment-column) 40)
+ ;; Don't get confused by `;' in doc strings when paragraph-filling.
+ (set (make-local-variable 'comment-use-global-state) t)
+ (set-syntax-table chartg-mode-syntax-table)
+ (when (looking-at (rx buffer-start (0+ whitespace) buffer-end))
+ (insert ";; Type C-c C-c to make a chart, M-Tab to complete\n"))
+ (let ((missing (chartg-missing-keywords)))
+ (when missing
+ (save-excursion
+ (goto-char (point-max))
+ (dolist (miss missing)
+ (insert "\n" miss " "))))))
+
+;; Tests
+;;(chartg-create 'google "temp.png" '(200 . 150) '(((90 70) . nil)) 'pie-3-dimensional "test title" nil '((colors "FFFFFF" "00FF00")))
+
+;; Fix-me
+(add-to-list 'auto-mode-alist '("\\.mx-chart\\'" . chartg-mode))
+
+(provide 'chartg)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; chartg.el ends here
--- /dev/null
+;;; css-color.el --- Highlight and edit CSS colors
+
+(defconst css-color:version "0.03")
+;; Copyright (C) 2008 Niels Giesen
+
+;; Author: Niels Giesen
+;; Keywords: processes, css, extensions, tools
+;; Some smaller changes made by Lennart Borgman
+
+;; Last-Updated: 2009-10-19 Mon
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Edit css-colors in hex, rgb or hsl notation in-place, with
+;; immediate feedback by font-locking. Cycle between color-spaces.
+
+;; Usage:
+
+;; (autoload 'css-color-mode "css-color" "" t)
+;; (add-hook 'css-mode-hook 'css-color-mode-turn-on)
+
+;; Css-Css-color.el propertizes colours in a CSS stylesheet found by
+;; font-locking code with a keymap. From that keymap, you can easily
+;; adjust values such as red green and blue, hue, saturation and
+;; value, or switch between different color (space) notations.
+
+;; It supports all 'css-colors', so hex, rgb(), hsl() and even HTML
+;; color names (although I wouldn't use them myself, it is nice to be
+;; able to quickly convert those), can be used and switched between.
+
+;; The rgb() notation can be expressed either in percentages or in
+;; values between 0-255.
+
+;; You can cycle between the different formats (with SPACE), so that
+;; it is possible to edit the color in hsl mode (which is more
+;; intuitive than hsv, although hsv has its merits too), and switch
+;; back to rgb or hex if so desired.
+
+;; With point on a color, the keys - and = to are bound to the down
+;; and up functions for channels (or 'fields'). Toggling percentage
+;; in rgb() is done with the % key (not sure if that is wise
+;; though). The TAB key is bound to go to the next channel, cycling
+;; when at the end. color.el propertizes the longhand hexcolours
+;; found by the
+
+;; Caveats:
+
+;; Notation cycling can often introduce small errors inherent to
+;; switching color spaces. Currently there is no check nor a warning
+;; for that.
+
+;; ToDo:
+
+;; Try and fix those conversion inaccuracies. This cannot be done
+;; completely I guess. But maybe we can check whether this has
+;; occured, and then warn.
+
+;;; Change log:
+
+;; 2009-01-11 Lennart Borgman
+;; - Minor code clean up.
+;; 2009-05-23 Lennart Borgman
+;; - Let bound m1 and m2.
+
+;;; Code:
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'mumamo nil t))
+
+;;;###autoload
+(defgroup css-color ()
+ "Customization group for library `css-color'."
+ :group 'css
+ :group 'nxhtml)
+
+(defconst css-color-hex-chars "0123456789abcdefABCDEF"
+ "Composing chars in hexadecimal notation, save for the hash (#) sign.")
+
+(defconst css-color-hex-re
+ "#\\([a-fA-F[:digit:]]\\{6\\}\\|[a-fA-F[:digit:]]\\{3\\}\\)")
+
+(defconst css-color-hsl-re
+ "hsla?(\\([[:digit:]]\\{1,3\\}\\),[[:space:]]*\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*\\)\\)%,[[:space:]]*\\([[:digit:]]\\{1,3\\}\\)\\(?:\.?[[:digit:]]*\\)%)")
+
+(defconst css-color-rgb-re
+ "rgba?(\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*%\\)?\\),[[:space:]]*\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*%\\)?\\),[[:space:]]*\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*%\\)?\\)\\(:?,[[:space:]]*\\(0\.[0-9]+\\|1\\)\\)?)")
+
+(defconst css-color-html-colors
+ '(("AliceBlue" "#F0F8FF")
+ ("AntiqueWhite" "#FAEBD7")
+ ("Aqua" "#00FFFF")
+ ("Aquamarine" "#7FFFD4")
+ ("Azure" "#F0FFFF")
+ ("Beige" "#F5F5DC")
+ ("Bisque" "#FFE4C4")
+ ("Black" "#000000")
+ ("BlanchedAlmond" "#FFEBCD")
+ ("Blue" "#0000FF")
+ ("BlueViolet" "#8A2BE2")
+ ("Brown" "#A52A2A")
+ ("BurlyWood" "#DEB887")
+ ("CadetBlue" "#5F9EA0")
+ ("Chartreuse" "#7FFF00")
+ ("Chocolate" "#D2691E")
+ ("Coral" "#FF7F50")
+ ("CornflowerBlue" "#6495ED")
+ ("Cornsilk" "#FFF8DC")
+ ("Crimson" "#DC143C")
+ ("Cyan" "#00FFFF")
+ ("DarkBlue" "#00008B")
+ ("DarkCyan" "#008B8B")
+ ("DarkGoldenRod" "#B8860B")
+ ("DarkGray" "#A9A9A9")
+ ("DarkGrey" "#A9A9A9")
+ ("DarkGreen" "#006400")
+ ("DarkKhaki" "#BDB76B")
+ ("DarkMagenta" "#8B008B")
+ ("DarkOliveGreen" "#556B2F")
+ ("Darkorange" "#FF8C00")
+ ("DarkOrchid" "#9932CC")
+ ("DarkRed" "#8B0000")
+ ("DarkSalmon" "#E9967A")
+ ("DarkSeaGreen" "#8FBC8F")
+ ("DarkSlateBlue" "#483D8B")
+ ("DarkSlateGray" "#2F4F4F")
+ ("DarkSlateGrey" "#2F4F4F")
+ ("DarkTurquoise" "#00CED1")
+ ("DarkViolet" "#9400D3")
+ ("DeepPink" "#FF1493")
+ ("DeepSkyBlue" "#00BFFF")
+ ("DimGray" "#696969")
+ ("DimGrey" "#696969")
+ ("DodgerBlue" "#1E90FF")
+ ("FireBrick" "#B22222")
+ ("FloralWhite" "#FFFAF0")
+ ("ForestGreen" "#228B22")
+ ("Fuchsia" "#FF00FF")
+ ("Gainsboro" "#DCDCDC")
+ ("GhostWhite" "#F8F8FF")
+ ("Gold" "#FFD700")
+ ("GoldenRod" "#DAA520")
+ ("Gray" "#808080")
+ ("Grey" "#808080")
+ ("Green" "#008000")
+ ("GreenYellow" "#ADFF2F")
+ ("HoneyDew" "#F0FFF0")
+ ("HotPink" "#FF69B4")
+ ("IndianRed" "#CD5C5C")
+ ("Indigo" "#4B0082")
+ ("Ivory" "#FFFFF0")
+ ("Khaki" "#F0E68C")
+ ("Lavender" "#E6E6FA")
+ ("LavenderBlush" "#FFF0F5")
+ ("LawnGreen" "#7CFC00")
+ ("LemonChiffon" "#FFFACD")
+ ("LightBlue" "#ADD8E6")
+ ("LightCoral" "#F08080")
+ ("LightCyan" "#E0FFFF")
+ ("LightGoldenRodYellow" "#FAFAD2")
+ ("LightGray" "#D3D3D3")
+ ("LightGrey" "#D3D3D3")
+ ("LightGreen" "#90EE90")
+ ("LightPink" "#FFB6C1")
+ ("LightSalmon" "#FFA07A")
+ ("LightSeaGreen" "#20B2AA")
+ ("LightSkyBlue" "#87CEFA")
+ ("LightSlateGray" "#778899")
+ ("LightSlateGrey" "#778899")
+ ("LightSteelBlue" "#B0C4DE")
+ ("LightYellow" "#FFFFE0")
+ ("Lime" "#00FF00")
+ ("LimeGreen" "#32CD32")
+ ("Linen" "#FAF0E6")
+ ("Magenta" "#FF00FF")
+ ("Maroon" "#800000")
+ ("MediumAquaMarine" "#66CDAA")
+ ("MediumBlue" "#0000CD")
+ ("MediumOrchid" "#BA55D3")
+ ("MediumPurple" "#9370D8")
+ ("MediumSeaGreen" "#3CB371")
+ ("MediumSlateBlue" "#7B68EE")
+ ("MediumSpringGreen" "#00FA9A")
+ ("MediumTurquoise" "#48D1CC")
+ ("MediumVioletRed" "#C71585")
+ ("MidnightBlue" "#191970")
+ ("MintCream" "#F5FFFA")
+ ("MistyRose" "#FFE4E1")
+ ("Moccasin" "#FFE4B5")
+ ("NavajoWhite" "#FFDEAD")
+ ("Navy" "#000080")
+ ("OldLace" "#FDF5E6")
+ ("Olive" "#808000")
+ ("OliveDrab" "#6B8E23")
+ ("Orange" "#FFA500")
+ ("OrangeRed" "#FF4500")
+ ("Orchid" "#DA70D6")
+ ("PaleGoldenRod" "#EEE8AA")
+ ("PaleGreen" "#98FB98")
+ ("PaleTurquoise" "#AFEEEE")
+ ("PaleVioletRed" "#D87093")
+ ("PapayaWhip" "#FFEFD5")
+ ("PeachPuff" "#FFDAB9")
+ ("Peru" "#CD853F")
+ ("Pink" "#FFC0CB")
+ ("Plum" "#DDA0DD")
+ ("PowderBlue" "#B0E0E6")
+ ("Purple" "#800080")
+ ("Red" "#FF0000")
+ ("RosyBrown" "#BC8F8F")
+ ("RoyalBlue" "#4169E1")
+ ("SaddleBrown" "#8B4513")
+ ("Salmon" "#FA8072")
+ ("SandyBrown" "#F4A460")
+ ("SeaGreen" "#2E8B57")
+ ("SeaShell" "#FFF5EE")
+ ("Sienna" "#A0522D")
+ ("Silver" "#C0C0C0")
+ ("SkyBlue" "#87CEEB")
+ ("SlateBlue" "#6A5ACD")
+ ("SlateGray" "#708090")
+ ("SlateGrey" "#708090")
+ ("Snow" "#FFFAFA")
+ ("SpringGreen" "#00FF7F")
+ ("SteelBlue" "#4682B4")
+ ("Tan" "#D2B48C")
+ ("Teal" "#008080")
+ ("Thistle" "#D8BFD8")
+ ("Tomato" "#FF6347")
+ ("Turquoise" "#40E0D0")
+ ("Violet" "#EE82EE")
+ ("Wheat" "#F5DEB3")
+ ("White" "#FFFFFF")
+ ("WhiteSmoke" "#F5F5F5")
+ ("Yellow" "#FFFF00")
+ ("YellowGreen" "#9ACD32")))
+
+(defvar css-color-html-re
+ (concat "\\<\\("
+ (funcall 'regexp-opt
+ (mapcar 'car css-color-html-colors))
+ "\\)\\>"))
+
+(defconst
+ css-color-color-re
+ "\\(?:#\\(?:[a-fA-F[:digit:]]\\{6\\}\\|[a-fA-F[:digit:]]\\{3\\}\\)\\|hsl(\\(?:[[:digit:]]\\{1,3\\}\\),[[:space:]]*\\(?:[[:digit:]]\\{1,3\\}\\)%,[[:space:]]*\\(?:[[:digit:]]\\{1,3\\}\\)%)\\|rgba?(\\(?:[[:digit:]]\\{1,3\\}%?\\),[[:space:]]*\\(?:[[:digit:]]\\{1,3\\}%?\\),[[:space:]]*\\(?:[[:digit:]]\\{1,3\\}%?\\)\\(?:,[[:space:]]*\\(?:0.[0-9]+\\|1\\)\\)?)\\)"
+ "Regular expression containing only shy groups matching any type of CSS color")
+
+;; (defconst css-color-color-re
+;; (concat "\\(?1:"
+;; (mapconcat
+;; 'identity
+;; (list css-color-hex-re
+;; css-color-hsl-re
+;; css-color-rgb-re) "\\|")
+;; "\\)"))
+
+(defvar css-color-keywords
+ `((,css-color-hex-re
+ (0
+ (progn
+ (when (= 7 (- (match-end 0)
+ (match-beginning 0)))
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'keymap css-color-map))
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'css-color-type 'hex)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'rear-nonsticky t)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'face (list :background
+ (match-string-no-properties 0)
+ :foreground
+ (css-color-foreground-color
+ (match-string-no-properties 0)))))))
+ (,css-color-html-re
+ (0
+ (let ((color
+ (css-color-string-name-to-hex (match-string-no-properties 0))))
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'keymap css-color-generic-map)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'css-color-type 'name)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'rear-nonsticky t)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'face (list :background
+ color
+ :foreground
+ (css-color-foreground-color
+ color))))))
+ (,css-color-hsl-re
+ (0
+ (let ((color (concat "#" (apply 'css-color-hsl-to-hex
+ (mapcar 'string-to-number
+ (list
+ (match-string-no-properties 1)
+ (match-string-no-properties 2)
+ (match-string-no-properties 3)))))))
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'keymap css-color-generic-map)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'css-color-type 'hsl)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'rear-nonsticky t)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'face (list :background
+ color
+ :foreground
+ (css-color-foreground-color
+ color))))))
+ (,css-color-rgb-re
+ (0
+ (let ((color (css-color-string-rgb-to-hex (match-string-no-properties 0))))
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'keymap css-color-generic-map)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'css-color-type 'rgb)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'rear-nonsticky t)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'face (list :background
+ color
+ :foreground
+ (css-color-foreground-color
+ color))))))))
+
+
+;;;###autoload
+(define-minor-mode css-color-mode
+ "Show hex color literals with the given color as background.
+In this mode hexadecimal colour specifications like #6600ff are
+displayed with the specified colour as background.
+
+Certain keys are bound to special colour editing commands when
+point is at a hexadecimal colour:
+
+\\{css-color-map}"
+ :initial-value nil
+ :group 'css-color
+ (unless font-lock-defaults
+ (error "Can't use css-color-mode for this major mode"))
+ (if css-color-mode
+ (progn
+ (unless font-lock-mode (font-lock-mode 1))
+ (css-color-font-lock-hook-fun)
+ (add-hook 'font-lock-mode-hook 'css-color-font-lock-hook-fun nil t))
+ (remove-hook 'font-lock-mode-hook 'css-color-font-lock-hook-fun t)
+ (font-lock-remove-keywords nil css-color-keywords))
+ ;;(font-lock-fontify-buffer)
+ (save-restriction
+ (widen)
+ (mumamo-mark-for-refontification (point-min) (point-max))))
+
+(put 'css-color-mode 'permanent-local t)
+
+(defun css-color-turn-on-in-buffer ()
+ "Turn on `css-color-mode' in `css-mode'."
+ (when (derived-mode-p 'css-mode)
+ (css-color-mode 1)))
+
+;;;###autoload
+(define-globalized-minor-mode css-color-global-mode css-color-mode
+ css-color-turn-on-in-buffer
+ :group 'css-color)
+
+(defun css-color-font-lock-hook-fun ()
+ "Add css-color pattern to font-lock's."
+ (if font-lock-mode
+ (font-lock-add-keywords nil css-color-keywords t)
+ (css-color-mode -1)))
+
+(defvar css-color-map
+ (let ((m (make-sparse-keymap "css-color")))
+ (define-key m "=" 'css-color-up)
+ (define-key m "-" 'css-color-down)
+ (define-key m "h" 'css-color-hue-up)
+ (define-key m "H" 'css-color-hue-down)
+ (define-key m "s" 'css-color-saturation-up)
+ (define-key m "S" 'css-color-saturation-down)
+ (define-key m "v" 'css-color-value-up)
+ (define-key m "V" 'css-color-value-down)
+ (define-key m "\t" 'css-color-next-channel)
+ (define-key m " " 'css-color-cycle-type)
+ m)
+ "Mode map for `css-color-minor-mode'")
+
+(defvar css-color-generic-map
+ (let ((m (make-sparse-keymap "css-color")))
+ (define-key m "=" 'css-color-num-up)
+ (define-key m "-" 'css-color-num-down)
+ (define-key m " " 'css-color-cycle-type)
+ (define-key m "%" 'css-color-toggle-percentage)
+ (define-key m "\t" 'css-color-next-channel)
+ m)
+ "Mode map for simple numbers in `css-color-minor-mode'")
+
+(defun css-color-pal-lumsig (r g b)
+ "Return PAL luminance signal, but in range 0-255."
+ (+
+ (* 0.3 r)
+ (* 0.59 g)
+ (* 0.11 b)))
+
+(defun css-color-foreground-color (hex-color)
+ (multiple-value-bind (r g b) (css-color-hex-to-rgb hex-color)
+ (if (< (css-color-pal-lumsig r g b) 128)
+ "#fff"
+ "#000")))
+
+;; Normalizing funs
+(defun css-color-normalize-hue (h)
+ (mod (+ (mod h 360) 360) 360))
+
+(defun css-color-within-bounds (num min max)
+ (min (max min num) max))
+
+;; Source: hex
+(defun css-color-hex-to-rgb (str)
+ (cond
+ ((not (string-match "^#?[a-fA-F[:digit:]]*$" str))
+ (error "No valid hexadecimal: %s" str))
+ ((= 0 (length str))
+ nil)
+ ((= (aref str 0) 35)
+ (css-color-hex-to-rgb (substring str 1)))
+ (;;(oddp (length str))
+ (= (mod (length str) 2) 1)
+ (css-color-hex-to-rgb (mapconcat (lambda (c)
+ (make-string 2 c))
+ (string-to-list str) "")))
+ (t (cons (string-to-number (substring str 0 2) 16)
+ (css-color-hex-to-rgb (substring str 2))))))
+
+(defun css-color-hex-to-hsv (hex)
+ (multiple-value-bind (r g b) (css-color-hex-to-rgb hex)
+ (css-color-rgb-to-hsv r g b)))
+
+;; Source: rgb
+(defun css-color-rgb-to-hex (r g b)
+ "Return r g b as #rrggbb in hexadecimal, propertized to have
+the keymap `css-color-map'"
+ (format "%02x%02x%02x" r g b)) ;val
+
+(defun css-color-rgb-to-hsv (r g b)
+ "Return list of (hue saturation value).
+Arguments are: R = red; G = green; B = blue.
+Measure saturation and value on a scale from 0 - 100.
+GIMP-style, that is."
+ (let* ((r (float r))
+ (g (float g))
+ (b (float b))
+ (max (max r g b))
+ (min (min r g b)))
+ (values
+ (round
+ (cond ((and (= r g) (= g b)) 0)
+ ((and (= r max)
+ (>= g b))
+ (* 60 (/ (- g b) (- max min))))
+ ((and (= r max)
+ (< g b))
+ (+ 360 (* 60 (/ (- g b) (- max min)))))
+ ((= max g)
+ (+ 120 (* 60 (/ (- b r) (- max min)))))
+ ((= max b)
+ (+ 240 (* 60 (/ (- r g) (- max min))))))) ;hue
+ (round (* 100 (if (= max 0) 0 (- 1 (/ min max))))) ;sat
+ (round (/ max 2.55)))))
+
+(defun css-color-rgb-to-hsl (r g b)
+ "Return R G B (in range 0-255) converted to HSL (0-360 for hue, rest in %)"
+ (let* ((r (/ r 255.0))
+ (g (/ g 255.0))
+ (b (/ b 255.0))
+ (h 0)
+ (s 0)
+ (l 0)
+ (v (max r g b))
+ (m (min r g b))
+ (l (/ (+ m v) 2.0))
+ (vm 0)
+ (r2 0)
+ (g2 0)
+ (b2 0))
+ (multiple-value-bind (h s v)
+ (if (<= l 0)
+ (values h s l)
+ (setq vm (- v m)
+ s vm)
+ (if (>= 0 s)
+ (values h s l)
+ (setq s (/ s (if (<= l 0.5)
+ (+ v m)
+ (- 2.0 v m))))
+ (if (not (= 0 vm))
+ (setq r2 (/ (- v r) vm)
+ g2 (/ (- v g) vm)
+ b2 (/ (- v b) vm)))
+ (cond ((= r v)
+ (setq h (if (= g m)
+ (+ 5.0 b2)
+ (- 1.0 g2))))
+ ((= g v)
+ (setq h (if (= b m)
+ (+ 1.0 r2)
+ (- 3.0 b2))))
+ (t
+ (setq h (if (= r m)
+ (+ 3.0 g2)
+ (- 5.0 r2)))))
+ (values (/ h 6.0) s l)))
+ (list (round(* 360 h))
+ (* 100 s)
+ (* 100 l)))))
+
+;; Source: hsv
+(defun css-color-hsv-to-hsl (h s v)
+ (multiple-value-bind (r g b) (css-color-hsv-to-rgb h s v)
+ (css-color-rgb-to-hsl r g b)))
+
+(defun css-color-hsv-to-hex (h s v)
+ (apply 'css-color-rgb-to-hex (css-color-hsv-to-rgb h s v)))
+
+(defun css-color-hsv-to-rgb (h s v)
+ "Convert a point in the Hue, Saturation, Value (aka Brightness)
+color space to list of normalized Red, Green, Blue values.
+
+HUE is an angle in the range of 0 degrees inclusive to 360
+exclusive. The remainder of division by 360 is used for
+out-of-range values.
+SATURATION is in the range of 0 to 100.
+VALUE is in the range of 0 to 100.
+Returns a list of values in the range of 0 to 255.
+"
+ ;; Coerce to float and get hue into range.
+ (setq h (mod h 360.0)
+ s (/ (float s) 100)
+ v (/ (float v) 100))
+ (let* ((hi (floor h 60.0))
+ (f (- (/ h 60.0) hi))
+ (p (* v (- 1.0 s)))
+ (q (* v (- 1.0 (* f s))))
+ ;; cannot use variable t, obviously.
+ (u (* v (- 1.0 (* (- 1.0 f) s))))
+ r g b)
+ (case hi
+ (0 (setq r v g u b p))
+ (1 (setq r q g v b p))
+ (2 (setq r p g v b u))
+ (3 (setq r p g q b v))
+ (4 (setq r u g p b v))
+ (5 (setq r v g p b q)))
+ (mapcar (lambda (color) (round (* 255 color))) (list r g b))))
+
+(defun css-color-hsv-to-prop-hexstring (color-data)
+ (propertize
+ (apply 'css-color-hsv-to-hex color-data)
+ 'keymap css-color-map
+ 'css-color color-data))
+
+;; Source: hsl
+(defun css-color-hsl-to-rgb-fractions (h s l)
+ (let (m1 m2)
+ (if (<= l 0.5)
+ (setq m2 (* l (+ s 1)))
+ (setq m2 (- (+ l s) (* l s))))
+ (setq m1 (- (* l 2) m2))
+ (values (css-color-hue-to-rgb m1 m2 (+ h (/ 1 3.0)))
+ (css-color-hue-to-rgb m1 m2 h)
+ (css-color-hue-to-rgb m1 m2 (- h (/ 1 3.0))))))
+
+(defun css-color-hsl-to-rgb (h s l)
+ (multiple-value-bind (r g b)
+ (css-color-hsl-to-rgb-fractions
+ (/ h;; (css-color-normalize-hue h)
+ 360.0)
+ (/ s 100.0)
+ (/ l 100.0))
+ (values (css-color-within-bounds (* 256 r) 0 255)
+ (css-color-within-bounds (* 256 g) 0 255)
+ (css-color-within-bounds (* 256 b) 0 255))))
+
+(defun css-color-hsl-to-hex (h s l)
+ (apply 'css-color-rgb-to-hex
+ (css-color-hsl-to-rgb h s l)))
+
+(defun css-color-hue-to-rgb (x y h)
+ (when (< h 0) (incf h))
+ (when (> h 1) (decf h))
+ (cond ((< h (/ 1 6.0))
+ (+ x (* (- y x) h 6)))
+ ((< h 0.5) y)
+ ((< h (/ 2.0 3.0))
+ (+ x (* (- y x) (- (/ 2.0 3.0) h) 6)))
+ (t x)))
+
+(defun css-color-parse-hsl (str)
+ (string-match
+ css-color-hsl-re
+ str)
+ (mapcar 'string-to-number
+ (list
+ (match-string 1 str)
+ (match-string 2 str)
+ (match-string 3 str))))
+
+(defun css-color-inchue (color incr)
+ (multiple-value-bind (h s v) color
+ (css-color-hsv-to-prop-hexstring
+ (list (+ incr h) s v))))
+
+(defun css-color-incsat (color incr)
+ (multiple-value-bind (h s v) color
+ (css-color-hsv-to-prop-hexstring
+ (list h (css-color-within-bounds (+ incr s) 0 100) v))))
+
+(defun css-color-incval (color incr)
+ (multiple-value-bind (h s v) color
+ (css-color-hsv-to-prop-hexstring
+ (list h s (css-color-within-bounds (+ incr v) 0 100)))))
+
+(defun css-color-hexval-beginning ()
+ (skip-chars-backward css-color-hex-chars)
+ (if (= (char-after) 35)
+ (forward-char 1)))
+
+(defun css-color-replcolor-at-p (fun increment)
+ (let ((pos (point)))
+ (css-color-hexval-beginning)
+ (insert
+ (funcall fun
+ (css-color-get-color-at-point)
+ increment))
+ (delete-region (point) (+ (point) 6))
+ (goto-char pos)))
+
+(defun css-color-get-color-at-point ()
+ (save-excursion
+ (css-color-hexval-beginning)
+ (let ((saved-color (get-text-property (point) 'css-color)))
+ (or saved-color
+ (css-color-hex-to-hsv
+ (buffer-substring-no-properties (point) (+ (point) 6)))))))
+
+(defun css-color-adj-hue-at-p (increment)
+ (interactive "p")
+ (css-color-replcolor-at-p 'css-color-inchue increment))
+
+(defun css-color-adj-saturation-at-p (increment)
+ (interactive "p")
+ (css-color-replcolor-at-p 'css-color-incsat increment))
+
+(defun css-color-adj-value-at-p (increment)
+ (interactive "p")
+ (css-color-replcolor-at-p 'css-color-incval increment))
+
+(defun css-color-what-channel ()
+ (let ((pos (point)))
+ (prog1
+ (/ (skip-chars-backward css-color-hex-chars) -2)
+ (goto-char pos))))
+
+(defun css-color-adjust-hex-at-p (incr)
+ (interactive "p")
+ (let ((pos (point))
+ (channel (css-color-what-channel)))
+ (css-color-hexval-beginning)
+ (let ((rgb
+ (css-color-hex-to-rgb
+ (buffer-substring-no-properties (point)
+ (+ 6 (point))))))
+ (setf (nth channel rgb)
+ (css-color-within-bounds
+ (+ incr (nth channel rgb))
+ 0 255))
+ (delete-region (point) (+ 6 (point)))
+ (insert
+ (propertize
+ (apply 'format "%02x%02x%02x" rgb)
+ 'keymap css-color-map
+ 'css-color nil
+ 'rear-nonsticky t)))
+ (goto-char pos)))
+
+;; channels (r, g, b)
+(defun css-color-up (val)
+ "Adjust R/G/B up."
+ (interactive "p")
+ (css-color-adjust-hex-at-p val))
+
+(defun css-color-down (val)
+ "Adjust R/G/B down."
+ (interactive "p")
+ (css-color-adjust-hex-at-p (- val)))
+;; hue
+(defun css-color-hue-up (val)
+ "Adjust Hue up."
+ (interactive "p")
+ (css-color-adj-hue-at-p val))
+
+(defun css-color-hue-down (val)
+ "Adjust Hue down."
+ (interactive "p")
+ (css-color-adj-hue-at-p (- val)))
+;; saturation
+(defun css-color-saturation-up (val)
+ "Adjust Saturation up."
+ (interactive "p")
+ (css-color-adj-saturation-at-p val))
+
+(defun css-color-saturation-down (val)
+ "Adjust Saturation down."
+ (interactive "p")
+ (css-color-adj-saturation-at-p (- val)))
+;; value
+(defun css-color-value-up (val)
+ "Adjust Value up."
+ (interactive "p")
+ (css-color-adj-value-at-p val))
+
+(defun css-color-value-down (val)
+ "Adjust Value down."
+ (interactive "p")
+ (css-color-adj-value-at-p (- val)))
+
+(defun css-color-num-up (arg)
+ "Adjust HEX number up."
+ (interactive "p")
+ (save-excursion
+ (let ((digits "1234567890"))
+ (skip-chars-backward digits)
+ (when
+ (looking-at "[[:digit:]]+")
+ (replace-match
+ (propertize
+ (let ((num (+ (string-to-number (match-string 0)) arg)))
+ ;max = 100 when at percentage
+ (save-match-data
+ (cond ((looking-at "[[:digit:]]+%")
+ (setq num (min num 100)))
+ ((looking-back "hsla?(")
+ (setq num (css-color-normalize-hue num)))
+ ((memq 'css-color-type (text-properties-at (point)))
+ (setq num (min num 255)))))
+ (number-to-string num))
+ 'keymap
+ css-color-generic-map))))))
+
+(defun css-color-num-down (arg)
+ "Adjust HEX number down."
+ (interactive "p")
+ (save-excursion
+ (let ((digits "1234567890"))
+ (skip-chars-backward digits)
+ (when
+ (looking-at "[[:digit:]]+")
+ (replace-match
+ (propertize
+ (let ((num (- (string-to-number (match-string 0)) arg)))
+ ;max = 100 when at percentage
+ (save-match-data
+ (cond ((looking-back "hsla?(")
+ (setq num (css-color-normalize-hue num)))
+ (t (setq num (max 0 num)))))
+ (number-to-string num))
+ 'keymap css-color-generic-map))))))
+
+
+(defun css-color-beginning-of-color ()
+ "Skip to beginning of color.
+
+Return list of point and color-type."
+ (while (memq 'css-color-type (text-properties-at (point)))
+ (backward-char 1))
+ (forward-char 1)
+ (cons (point) (plist-get (text-properties-at (point)) 'css-color-type)))
+
+(defun css-color-end-of-color ()
+ "Skip to beginning of color.
+
+Return list of point and color-type."
+ (while (plist-get (text-properties-at (point)) 'css-color-type)
+ (forward-char 1))
+ (cons (point) (plist-get (text-properties-at (1- (point))) 'css-color-type)))
+
+(defun css-color-color-info ()
+ (destructuring-bind ((beg . type)
+ (end . type))
+ (list
+ (css-color-beginning-of-color)
+ (css-color-end-of-color))
+ (list beg end type (buffer-substring-no-properties beg end))))
+
+(defconst css-color-type-circle '#1=(hex hsl rgb name . #1#))
+
+(defun css-color-next-type (sym)
+ (cadr (member sym css-color-type-circle)))
+
+(defun css-color-cycle-type ()
+ "Cycle color type."
+ (interactive)
+ (destructuring-bind (beg end type color) (css-color-color-info)
+ (if (or (= 0 (length color)) (null type))
+ (error "Not at color"))
+ (delete-region beg end)
+ (insert
+ (propertize (funcall
+ (intern-soft (format "css-color-string-%s-to-%s"
+ type
+ (css-color-next-type type)))
+ color)
+ 'keymap (if (eq (css-color-next-type type) 'hex)
+ css-color-map
+ css-color-generic-map) 'rear-nonsticky t))
+ (goto-char beg)))
+
+(defun css-color-string-hex-to-hsl (str)
+ (multiple-value-bind (h s l)
+ (apply 'css-color-rgb-to-hsl
+ (css-color-hex-to-rgb str))
+ (format "hsl(%d,%d%%,%d%%)"
+ h s l)))
+
+(defun css-color-string-hsl-to-rgb (str)
+ (multiple-value-bind (h s l)
+ (css-color-parse-hsl str)
+ (apply 'format
+ "rgb(%d,%d,%d)"
+ (mapcar 'round (css-color-hsl-to-rgb h s l)))))
+
+(defun css-color-string-rgb-to-name (str)
+ (let ((color (css-color-string-rgb-to-hex str)))
+ (or (car (rassoc (list (upcase color)) css-color-html-colors)) ;if name ok
+ color))) ;else return hex
+
+(defun css-color-string-name-to-hex (str)
+ (let ((str (downcase str)))
+ (cadr (assoc-if
+ (lambda (a)
+ (string=
+ (downcase a)
+ str))
+ css-color-html-colors))))
+
+(defun css-color-string-rgb-to-hex (str)
+ (save-match-data
+ (string-match css-color-rgb-re str)
+ (concat "#"
+ (apply 'css-color-rgb-to-hex
+ (mapcar
+ ;;'string-to-number
+ (lambda (s)
+ (if (= (aref s (1- (length s))) ?\%)
+ (round (* (string-to-number s) 2.55))
+ (string-to-number s)))
+ (list
+ (match-string-no-properties 1 str)
+ (match-string-no-properties 2 str)
+ (match-string-no-properties 3 str)))))))
+
+(defun css-color-string-hsl-to-hex (str)
+ (concat "#" (apply 'css-color-hsl-to-hex (css-color-parse-hsl str))))
+
+(defun css-color-next-channel ()
+ "Cycle color channel."
+ (interactive)
+ (multiple-value-bind (beg end type color)
+ (save-excursion (css-color-color-info))
+ (case type
+ ((hsl rgb)
+ (if (not (re-search-forward ",\\|(" end t))
+ (goto-char (+ beg 4))))
+ (hex
+ (cond ((> (point) (- end 3))
+ (goto-char (+ 1 beg)))
+ ((= (char-after) 35)
+ (forward-char 1))
+ ((evenp (- (point) beg))
+ (forward-char 1))
+ (t (forward-char 2)))))))
+
+(defun css-color-hexify-anystring (str)
+ (cond ((string-match "^hsl" str)
+ (css-color-string-hsl-to-hex str))
+ ((string-match "^rgb" str)
+ (css-color-string-rgb-to-hex str))
+ (t str)))
+
+(defun css-color-toggle-percentage ()
+ "Toggle percent ??"
+ (interactive)
+ (let ((pos (point)))
+ (if (eq (nth 2 (save-excursion (css-color-color-info))) 'rgb)
+ (let ((chars "%1234567890."))
+ (skip-chars-backward chars)
+ (when
+ (looking-at "[[:digit:]]+\\(?:\.?[[:digit:]]*%\\)?%?")
+ (let ((s (match-string 0)))
+ (replace-match
+ (propertize
+ (if (= (aref s (1- (length s))) ?\%)
+ (number-to-string (round (* (string-to-number s) 2.55)))
+ (format "%d%%" (/ (string-to-number s) 2.55)))
+ 'keymap css-color-generic-map
+ 'rear-nonsticky t)))
+ ;;(goto-char pos)
+ ))
+ (message "No toggling at point."))))
+
+;; provide some backwards-compatibility to hexcolor.el:
+(defvar css-color-fg-history nil)
+(defvar css-color-bg-history nil)
+
+;;;###autoload
+(defun css-color-test (fg-color bg-color)
+ "Test colors interactively.
+The colors are displayed in the echo area. You can specify the
+colors as any viable css color. Example:
+
+ red
+ #f00
+ #0C0
+ #b0ff00
+ hsla(100, 50%, 25%)
+ rgb(255,100,120)"
+ (interactive (list (completing-read "Foreground color: "
+ css-color-html-colors
+ nil nil nil nil css-color-fg-history)
+ (completing-read "Background color: "
+ css-color-html-colors
+ nil nil nil nil css-color-bg-history)))
+ (let* ((s (concat " Foreground: " fg-color ", Background: " bg-color " ")))
+ (put-text-property 0 (length s)
+ 'face (list
+ :foreground (css-color-hexify-anystring fg-color)
+ :background (css-color-hexify-anystring bg-color))
+ s)
+ (message "Here are the colors: %s" s)))
+
+(defun css-color-run-tests ()
+ (interactive)
+ (unless
+ (progn
+ (assert
+ (string= (css-color-string-hex-to-hsl "#ffff00") "hsl(60,100%,50%)"))
+ (assert
+ (string= (css-color-string-rgb-to-hex "rgb(255, 50%, 0)")"#ff7f00"))
+ (assert
+ (string= (css-color-string-hsl-to-rgb "hsl(60, 100%, 50%)") "rgb(255,255,0)"))
+ (assert
+ (string= (css-color-string-hsl-to-hex "hsl(60, 100%, 50%)") "#ffff00")))
+ (message "All tests passed")))
+
+(provide 'css-color)
+;;; css-color.el ends here
--- /dev/null
+;;; css-palette.el
+
+(defconst css-palette:version "0.02")
+;; Copyright (C) 2008 Niels Giesen
+
+;; Author: Niels Giesen <nielsforkgiesen@gmailspooncom, but please
+;; replace the kitchen utensils with a dot before hitting "Send">
+;; Keywords: processes, css, multimedia, extensions, tools
+;; Homepage: http://niels.kicks-ass.org/
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; css-palette defines commands to have "palettes" inside a block
+;; comment to circumvent the absence of (color or other) variable
+;; definitions in the CSS specification. It can import and export GIMP
+;; color palettes. See the documentation of `css-palette-mode'
+;; for details of usage.
+
+;;; Installation:
+
+;; Something like:
+
+;; put it in your load-path.
+
+;; (autoload 'css-palette-mode "css-palette" "" t)
+;; (add-hook 'css-mode-hook
+;; (lambda ()
+;; (css-palette-mode t)))
+
+;; Notes:
+
+;; css-palette depends on css-color.el to do font-locking.
+
+;; ccs-palette is orthogonal to css-mode, so it could probably be used
+;; inside other language modes, provided they support multiline block
+;; comments.
+
+;;; Change log:
+
+;; 2009-01-11 Lennart Borgman
+;; - Minor code clean up.
+
+;;; Code:
+(require 'css-color)
+(eval-when-compile (require 'cl)) ;i'm a bad bad boy...
+
+(defconst css-palette-hex-chars "0123456789abcdefABCDEF"
+ "Composing chars in hexadecimal notation, save for the hash (#) sign.")
+
+(defvar css-palette-mode-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "\C-c\C-c" 'css-palette-update-all)
+ (define-key m "\C-c\C-i" 'css-palette-insert-reference)
+ (define-key m "\C-c\C-p" 'css-palette-import-from-GIMP)
+ (define-key m "\C-c\C-f" 'css-palette-insert-files)
+ m)
+ "Mode map for `css-palette-mode'")
+
+;;;###autoload
+(define-minor-mode css-palette-mode
+ "Minor mode for palettes in CSS.
+
+The mode `css-palette-mode' acts on the first COLORS declaration in your
+ file of the form:
+
+COLORS:
+\(
+c0 \"#6f5d25\" ;tainted sand
+c1 \"#000000\" ;Black
+c2 \"#cca42b\" ;goldenslumber
+c3 \"#6889cb\" ;far off sky
+c4 \"#fff\" ;strange aeons
+)
+
+Such declarations should appear inside a block comment, in order
+ to be parsed properly by the LISP reader.
+
+Type \\[css-palette-update-all], and any occurence of
+
+ color: #f55; /*[c3]*/
+
+will be updated with
+
+ color: #6899cb; /*[c3]*/
+
+The following commands are available to insert key-value pairs
+ and palette declarations:
+ \\{css-palette-mode-map}
+
+You can extend or redefine the types of palettes by defining a
+ new palette specification of the form (PATTERN REGEXP
+ REF-FOLLOWS-VALUE), named according to the naming scheme
+ css-palette:my-type, where
+
+PATTERN is a pattern containing two (%s) format directives which
+ will be filled in with the variable and its value,
+
+REGEXP is a regular expression to match a value - variable
+ pattern,
+
+and REF-FOLLOWS-VALUE defined whether or not the reference comes
+ after the value. This allows for more flexibility.
+
+Note that, although the w3c spec at URL
+ `http://www.w3.org/TR/CSS2/syndata.html#comments' says that
+ comments \" may occur anywhere between tokens, and their
+ contents have no influence on the rendering\", Internet
+ Explorer does not think so. Better keep all your comments after
+ a \"statement\", as per the default. This means `css-palette'
+ is ill-suited for use within shorthands.
+
+See variable `css-palette:colors' for an example of a palette
+ type.
+
+The extension mechanism means that palette types can be used to
+ contain arbitrary key-value mappings.
+
+Besides the colors palette, css-palette defines the palette
+ definition variables `css-palette:colors-outside' and
+ `css-palette:files', for colors with the reference outside and
+ for file url()'s respectively.
+
+You can fine-control which palette types css-palette should look
+ at via the variable `css-palette-types'.
+
+"
+ nil
+ "-palette"
+ css-palette-mode-map
+ (css-color-mode +1))
+
+;;;###autoload
+(defgroup css-palette nil
+ "Customization group for css-palette library.
+
+See function `css-palette-mode' for documentation"
+ :group 'css-color)
+
+(defcustom css-palette:colors
+ `("%s; /*[%s]*/ "
+ ,(concat "\\("
+ css-color-color-re
+;; (mapconcat
+;; 'identity
+;; (list css-color-hex-re
+;; css-color-hsl-re
+;; css-color-rgb-re) "\\|")
+ "\\)"
+ "[[:space:]]*;[[:space:]]*\/\\*\\[\\([^[:space:]]+\\)\\]\\*\/")
+ t)
+ "Color palette specification.
+
+See function `css-palette-mode' for documentation"
+ :group 'css-palette
+ :type '(list
+ (string :tag "Pattern")
+ (regexp :tag "Regexp")
+ (boolean :tag "Reversed")))
+
+(defcustom css-palette:files
+ '("url(%s); /*[%s]*/ "
+ "url(\\([^)]+\\))[[:space:]]*;[[:space:]]*\/\\*\\[\\([^[:space:]]+\\)\\]\\*\/"
+ t)
+ "File palette specification.
+
+See function `css-palette-mode' for documentation"
+ :group 'css-palette
+ :type '(list
+ (string :tag "Pattern")
+ (regexp :tag "Regexp")
+ (boolean :tag "Reversed")))
+
+(defcustom css-palette-types
+ '(colors)
+ "List of palette types to check for in buffer.
+
+See function `css-palette-mode' for documentation"
+ :group 'css-palette
+ :type '(repeat (symbol :tag "Palette type")))
+(make-variable-buffer-local 'css-palette-types)
+
+;; (defun css-palette-mode-turn-on ()
+;; "Turn on `css-palette-mode'."
+;; (css-palette-mode 1))
+
+;; ;;;###autoload
+;; (defcustom css-palette-mode-activate-p nil
+;; "Start `css-palette-mode' when `css-mode' is activated."
+;; :group 'css-palette
+;; :set (lambda (sym val)
+;; (set-default sym val)
+;; (if val
+;; (add-hook 'css-mode-hook 'css-palette-mode-turn-on)
+;; (remove-hook 'css-mode-hook 'css-palette-mode-turn-on)))
+;; :type 'boolean)
+
+(defun css-palette-turn-on-in-buffer ()
+ "Turn on `css-palette-mode' in `css-mode'."
+ (when (derived-mode-p 'css-mode)
+ (message "turn-on-in-b:before (css-palette-mode 1) cb=%s" (current-buffer))
+ (css-palette-mode 1)
+ (message "turn-on-in-b:after (css-palette-mode 1)")
+ ))
+
+;;;###autoload
+(define-globalized-minor-mode css-palette-global-mode css-palette-mode
+ css-palette-turn-on-in-buffer
+ :group 'css-color)
+
+(defun css-palette-get (key spec)
+ (plist-get
+ (css-palette-spec-to-plist
+ (symbol-value
+ (intern-soft
+ (format "css-palette:%s" spec)))) key))
+
+(defun css-palette-spec-to-plist (palette)
+ (destructuring-bind (pattern regexp ref-follows-value) palette
+ (list :regexp regexp
+ :pattern pattern
+ :ref-follows-value ref-follows-value)))
+
+(defun css-palette-choose-type ()
+ (intern-soft
+ (if (null (cdr css-palette-types))
+ (car css-palette-types)
+ (completing-read "Type: "
+ (mapcar 'symbol-name css-palette-types)))))
+
+(defun css-palette-get-declaration (type)
+ "Return `css-palette' declaration of TYPE in current buffer.
+
+If none is found, throw an error."
+ (let ((type (symbol-name type)))
+ (save-excursion
+ (goto-char (point-min))
+ (or (re-search-forward (format "%s:"
+ (upcase type)) nil t)
+ (error "No %s declaration found in buffer; check value of variable
+ `css-palette-types'" type))
+ (let ((palette (read (current-buffer))))
+ ;; Check (could be better..)
+ (if (not (and
+ (listp palette)
+ (= 0 (% (length palette) 2))))
+ (error "Invalid %s " type))
+ palette))))
+
+(defun css-palette-update (type)
+"Update buffer references for palette of TYPE."
+ (interactive (list
+ (css-palette-choose-type)))
+ (let ((palette (css-palette-get-declaration type))
+ (regexp (css-palette-get :regexp type))
+ (ref-follows-value (css-palette-get :ref-follows-value type)))
+ (flet ((getval (key palette)
+ (let ((value (plist-get palette (intern-soft key))))
+ (if (null value)
+ (error
+ "%S not specified in %S palette "
+ key
+ type
+ ;; (signal 'css-palette-not-found-error nil)
+ )
+ value))))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ regexp
+ (point-max) t)
+ (replace-match
+ (getval (match-string-no-properties (if ref-follows-value 2 1)) palette)
+ nil nil nil (if ref-follows-value 1 2))))))
+ (css-color-mode 1))
+
+(defun css-palette-update-all ()
+ "Update all references for palettes in `css-palette-types'"
+ (interactive)
+ (catch 'err
+ (mapc (lambda (type)
+ (condition-case err
+ (css-palette-update type)
+ (if (y-or-n-p (format "%s, skip? " err))
+ nil)))
+ css-palette-types)))
+
+;; Reference Insertion
+(defun css-palette-insert-reference (type)
+ "Insert `css-palette' reference of TYPE at point."
+ (interactive
+ (list (css-palette-choose-type)))
+ (let* ((palette (css-palette-get-declaration type))
+ (ref-follows-value (css-palette-get :ref-follows-value type))
+ (pattern (css-palette-get :pattern type))
+ (var
+ (completing-read (format "%s variable: "
+ (capitalize
+ (substring (symbol-name type)
+ 0 -1)))
+ (loop for i on
+ palette
+ by 'cddr
+ collect
+ (css-palette-colorify
+ (symbol-name (car i))
+ (cadr i)))))
+ (val (plist-get palette (read var))))
+ (insert (apply 'format
+ pattern
+ (if ref-follows-value
+ (list val var)
+ (list var val))))
+ (css-color-mode +1)))
+
+(defun css-palette-hex-color-p (str)
+ (string-match "#\\([a-fA-F[:digit:]]\\{6\\}\\|[a-fA-F[:digit:]]\\{3\\}\\)" str))
+
+(defun css-palette-colorify (string color)
+ (let ((color (if (css-palette-hex-color-p color)
+ color
+ "#000")))
+ (propertize string
+ 'font-lock-face
+ (list :background color
+ :foreground (css-color-foreground-color color)
+ string)
+ 'fontified t)))
+
+;; Imports
+(defun css-palette-from-existing-colors ()
+ (interactive)
+ (let ((palette)
+ (count -1))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "#[[:digit:]a-fA-F]\\{6\\}\\>" nil t)
+ (if (not (member (match-string-no-properties 0) palette))
+ (setq palette (append (list
+ (match-string-no-properties 0)
+ (intern(format "c%d" (incf count))))
+ palette)))
+ (save-match-data (re-search-forward ";" nil t))
+ (insert (format "/*[%S]*/" (cadr (member (match-string-no-properties 0) palette))))))
+ (insert (format "COLORS:\n%S" (nreverse palette)))
+ (forward-sexp -1)
+ (forward-char 1)
+ (while
+ (not (looking-at ")"))
+ (forward-sexp 2)
+ (newline)
+ (indent-for-tab-command))))
+
+(defun css-palette-newest-GIMP-dir ()
+ "Return newest (version-wise) ~/.gimp-n.n/palettes directory on disk.
+
+Return `nil' if none such directory is found."
+ (catch 'none
+ (concat
+ (or
+ (car
+ (last
+ (directory-files "~/" t "^.gimp-[[:digit:].]\\{3,\\}")))
+ (throw 'none ()))
+ "/palettes/")))
+
+(defun css-palette-import-from-GIMP ()
+ "Import GIMP palette file as a `css-palette' palette.
+
+GIMP palettes can be made with the GIMP or on-line tools such as
+found at URL `http://colourlovers.com'."
+ (interactive)
+ (let ((file (read-file-name "File: " (css-palette-newest-GIMP-dir)))
+ (this-buffer (current-buffer))
+ (count -1))
+ (insert "\nCOLORS:\n(\n")
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat
+ "^"
+ "[[:space:]]*\\([[:digit:]]+\\)" ;red
+ "[[:space:]]+\\([[:digit:]]+\\)" ;green
+ "[[:space:]]+\\([[:digit:]]+\\)" ;blue
+ "[[:space:]]+\\(.*\\)$") ;name (=> used as comment)
+ nil t)
+ (destructuring-bind (rb re gb ge bb be nb ne &rest ignore)
+ (cddr (match-data t))
+ (let ((color
+ (apply 'format "c%d \"#%02x%02x%02x\" ;%s\n"
+ (incf count)
+ (append
+ (mapcar 'string-to-number
+ (list
+ (buffer-substring-no-properties rb re)
+ (buffer-substring-no-properties gb ge)
+ (buffer-substring-no-properties bb be)))
+ (list (buffer-substring-no-properties nb ne))))))
+ (with-current-buffer this-buffer
+ (insert color))))))
+ (insert ")")
+ (message "C-c C-c to update colors")))
+
+(defun css-palette-insert-files (dir)
+ "Insert a `css-palette' declaration for all files in DIR.
+
+Filenames are relative.
+Main use-case: an image directory."
+ (interactive "DDirectory: ")
+ (save-excursion
+ (let ((image-count -1))
+ (insert "\nFILES:\n(\n")
+ (mapc
+ (lambda (f)
+ (insert
+ (format "file-%d %S\n"
+ (incf image-count)
+ (file-relative-name
+ f
+ (file-name-directory (buffer-file-name))))))
+ (directory-files dir t "...+"))
+ (insert ")\n\n"))))
+
+;; Exports
+(defun css-palette-export-to-GIMP (type name columns)
+ "Export the COLORS declaration to a GIMP (.gpl) palette.
+
+See also `gpl-mode' at URL
+`http://niels.kicks-ass.org/public/elisp/gpl.el'."
+ (interactive
+ (list
+ (css-palette-choose-type)
+ (read-string "Name: ")
+ (read-number "Number of columns: " 2)))
+ (let ((palette (css-palette-get-declaration type)))
+ (find-file
+ (concat (css-palette-newest-GIMP-dir)
+ name
+ ".gpl"))
+ (insert
+ (format "GIMP Palette
+Name: %s
+Columns: %d
+#
+" name columns))
+ (loop for i on palette
+ by 'cddr
+ do
+ (multiple-value-bind (r g b)(css-color-hex-to-rgb
+ (css-color-hexify-anystring (cadr i)))
+ (insert (format "%3d %3d %3d\t%s\n"
+ r g b
+ (car i))))))
+ (if (featurep 'gpl)
+ (gpl-mode)))
+
+(provide 'css-palette)
+;; css-palette.el ends here
--- /dev/null
+;;; css-simple-completion.el --- Partly context aware css completion
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-11-22 Sun
+;; Version:
+;; Last-Updated: 2009-11-22 Sun
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Simple partly context aware completion. Context is based on
+;; guessing mainly.
+;;
+;; This can be combined with with flymake-css.el that can check the
+;; syntax.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; Fix-me: bad structure, does not fit completion frameworks
+(defun css-simple-completing-w-pred (regexp matnum prompt collection)
+ (let (pre start len)
+ (when (looking-back regexp (line-beginning-position) t)
+ (setq pre (downcase (match-string matnum)))
+ (setq len (length pre))
+ (setq start (match-beginning matnum))
+ (unless (try-completion pre collection)
+ (throw 'result nil))
+ (throw 'result (list start
+ (completing-read prompt
+ collection
+ (lambda (alt)
+ (and (>= (length alt) len)
+ (string= pre
+ (substring alt 0 len))))
+ t
+ pre))))))
+
+(defun css-simple-complete ()
+ "Try to complete at current point.
+This tries to complete keywords, but no CSS values.
+
+This is of course a pity since the value syntax is a bit
+complicated. However you can at least check the syntax with
+flymake-css if you want to."
+ (interactive)
+ (let ((context (css-simple-guess-context))
+ result
+ cur
+ pre
+ start)
+ (setq result
+ (catch 'result
+
+ (case context
+
+ ( 'css-media-ids
+ (css-simple-completing-w-pred "\\<[a-z0-9-]*" 0 "Media type: " css-media-ids))
+
+ ( 'css-at-ids
+ (css-simple-completing-w-pred "@\\([a-z0-9-]*\\)" 1 "At rule: @" css-at-ids))
+
+ ( 'css-property-ids
+ (css-simple-completing-w-pred "\\<[a-z-]*" 0 "CSS property name: " css-property-ids))
+
+ ( 'css-simple-selectors
+
+ ;; Fix-me: Break out the first two
+ (when (looking-back "\\W#\\([a-z0-9-]*\\)")
+ (setq cur (match-string 1))
+ (setq start (match-beginning 1))
+ (throw 'result (list (point)
+ (read-string (concat "Html tag Id: " cur)))))
+ (when (looking-back "\\W\\.\\([a-z0-9-]*\\)")
+ (setq cur (match-string 1))
+ (setq start (match-beginning 1))
+ (throw 'result (list (point)
+ (read-string (concat "CSS class name: " cur)))))
+
+ (css-simple-completing-w-pred "[a-z0-9]:\\([a-z0-9-]*\\)" 1 "Pseudo id: " css-pseudo-ids)
+
+ (css-simple-completing-w-pred "[a-z0-9-]+" 0 "HTML tag: " (cddr css-simple-selectors))
+
+ (when (looking-back "\\<\\(?:#\\|\\.\\)")
+ (setq pre nil)
+ (while t
+ (setq pre (completing-read "HTML tag, id or CSS class: " css-simple-selectors nil nil pre))
+ (if (string= (substring pre 0 1) "#")
+ (if (or (= 1 (length pre))
+ (and (> (length pre) 2)
+ (string= (substring pre 0 3) "# (")))
+ (throw 'result (list (point) (concat "#" (read-string "Html tag id: #"))))
+ (throw 'result (list (point) pre)))
+ (if (string= (substring pre 0 1) ".")
+ (if (or (= 1 (length pre))
+ (and (> (length pre) 2)
+ (string= (substring pre 0 3) ". (")))
+ (throw 'result (list (point) (concat "." (read-string "CSS class name: ."))))
+ (throw 'result (list (point) pre)))
+ (when (member pre css-simple-selectors)
+ (throw 'result (list (point) pre)))))
+ ))))))
+ (message "result=%S" result)
+ (if result
+ (let ((str (cadr result))
+ (len (- (point) (car result))))
+ (insert (substring str len)))
+ (message "No matching alternatives"))))
+
+(defun css-simple-guess-context ()
+ "Try to find a context matching none constant.
+Return the symbol corresponding to the context or nil if none
+could be found.
+
+The symbols are the names of the defconst holding the possibly
+matching ids.
+
+* Note: This function assumes that comments are fontified before
+ point."
+ ;; Kind of hand-written backward parser ... ;-)
+ (let ((ignore-case t) ;; fix-me
+ (here (point))
+ (after-colon (and (not (bobp)) (eq (char-before) ?:)))
+ ret)
+ (prog1
+ (catch 'return
+ ;; No completion in comments.
+ (when (eq (get-text-property (point) 'face)
+ 'font-lock-comment-face)
+ (throw 'return nil))
+
+ ;; If we are not on whitespace then don't complete
+ (css-simple-skip-backwards-to-code)
+ (unless (or (eobp)
+ (= (char-syntax (char-after)) ?\ )
+ (< (point) here))
+ (throw 'return nil))
+
+ ;; Skip backwards to see if after first selector
+ (let ((here2 (1+ (point))))
+ (while (/= here2 (point))
+ (setq here2 (point))
+ (css-simple-skip-backwards-to-code)
+ (when (and (not (bobp))
+ (eq (char-before) ?,))
+ (backward-char))
+ (skip-chars-backward "#.:a-z0-9-")))
+ ;; Selector
+ (when (or (bobp)
+ (eq (char-before) ?}))
+ (throw 'return 'css-simple-selectors))
+
+ ;; Property names
+ (when (memq (char-before) '( ?{ ?\; ))
+ (throw 'return 'css-property-ids))
+
+ ;; If we are in the value we can't complete there yet.
+ (when (eq (char-before) ?:)
+ (throw 'return nil))
+
+
+ ;; @
+ (goto-char here)
+ (skip-chars-backward "a-z0-9-")
+ (when (eq (char-before) ?@)
+ (throw 'return 'css-at-ids))
+
+ ;; @media ids
+ (when (looking-back "@media\\W+")
+ (throw 'return 'css-media-ids))
+
+ )
+ (goto-char here))))
+;;; Fix-me: complete these ...
+;;css-descriptor-ids ;; Removed or?
+
+(defun css-simple-skip-backwards-to-code ()
+ "Skip backwards until we reach code.
+Requires that comments are fontified."
+ (let ((here (1+ (point))))
+ (while (/= here (point))
+ (setq here (point))
+ (skip-syntax-backward " ")
+ (unless (bobp)
+ (when (memq (get-text-property (1- (point)) 'face)
+ '(font-lock-comment-face font-lock-comment-delimiter-face))
+ (goto-char (or (previous-single-property-change (1- (point)) 'face)
+ (point-min))))))))
+
+(defconst css-simple-selectors
+ '(". (for class)"
+ "# (for id)"
+ ;; HTML 4.01 tags
+ "a" "abbr" "acronym" "address" "applet" "area" "b" "base" "basefont" "bdo" "big"
+ "blockquote" "body" "br" "button" "caption" "center" "cite" "code" "col"
+ "colgroup" "dd" "del" "dfn" "dir" "div" "dl" "dt" "em" "fieldset" "font" "form"
+ "frame" "frameset" "head" "h1" "h2" "h3" "h4" "h5" "h6" "hr" "html" "i" "iframe" "img"
+ "input" "ins" "kbd" "label" "legend" "li" "link" "map" "menu" "meta" "noframes"
+ "noscript" "object" "ol" "optgroup" "option" "p" "param" "pre" "q" "s" "samp"
+ "script" "select" "small" "span" "strike" "strong" "style" "sub" "sup" "table"
+ "tbody" "td" "textarea" "tfoot" "th" "thead" "title" "tr" "tt" "u" "ul" "var"
+ ))
+
+(provide 'css-simple-completion)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; css-simple-completion.el ends here
--- /dev/null
+;;; cus-new-user.el --- Customize some important options
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-07-10 Fri
+;; Version: 0.2
+;; Last-Updated: 2009-07-10 Fri
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Customize significant options for which different user
+;; environment expectations might dictate different defaults.
+;;
+;; After an idea of Scot Becker on Emacs Devel.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defvar cusnu-my-skin-widget nil)
+
+(defvar cusnu-insert-os-spec-fun nil)
+
+;;(customize-for-new-user)
+;;;###autoload
+(defun customize-for-new-user (&optional name)
+ "Show special customization page for new user.
+"
+ (interactive)
+ ;;(setq debug-on-error t)
+ ;;(setq buffer-read-only t)
+ (require 'cus-edit)
+ (let ((inhibit-read-only t)
+ fill-pos)
+ (pop-to-buffer (custom-get-fresh-buffer (or name "*Customizations for New Users*")))
+ (buffer-disable-undo)
+ (Custom-mode)
+ (erase-buffer)
+ (widget-insert (propertize "Easy Customization for New Users\n" 'face '(:weight bold :height 1.5)))
+ (setq fill-pos (point))
+ (widget-insert
+ "Below are some custom options that new users often may want to
+tweak since they may make Emacs a bit more like what they expect from
+using other software in their environment.
+
+After this, at the bottom of this page, is a tool for exporting your own specific options.
+You choose which to export, make a description and give the group of options a new and click a button.
+Then you just mail it or put it on the web for others to use.
+
+Since Emacs runs in many environment and an Emacs user may use
+several of them it is hard to decide by default what a user
+wants/expects. Therefor you are given the possibility to easily
+do those changes here.
+
+Note that this is just a collection of normal custom options.
+There are no new options here.
+
+
+")
+ (fill-region fill-pos (point))
+
+ ;; Normal custom buffer header
+ (let ((init-file (or custom-file user-init-file)))
+ ;; Insert verbose help at the top of the custom buffer.
+ (when custom-buffer-verbose-help
+ (widget-insert "Editing a setting changes only the text in this buffer."
+ (if init-file
+ "
+To apply your changes, use the Save or Set buttons.
+Saving a change normally works by editing your init file."
+ "
+Currently, these settings cannot be saved for future Emacs sessions,
+possibly because you started Emacs with `-q'.")
+ "\nFor details, see ")
+ (widget-create 'custom-manual
+ :tag "Saving Customizations"
+ "(emacs)Saving Customizations")
+ (widget-insert " in the ")
+ (widget-create 'custom-manual
+ :tag "Emacs manual"
+ :help-echo "Read the Emacs manual."
+ "(emacs)Top")
+ (widget-insert "."))
+ (widget-insert "\n")
+ ;; The custom command buttons are also in the toolbar, so for a
+ ;; time they were not inserted in the buffer if the toolbar was in use.
+ ;; But it can be a little confusing for the buffer layout to
+ ;; change according to whether or nor the toolbar is on, not to
+ ;; mention that a custom buffer can in theory be created in a
+ ;; frame with a toolbar, then later viewed in one without.
+ ;; So now the buttons are always inserted in the buffer. (Bug#1326)
+;;; (when (not (and (bound-and-true-p tool-bar-mode) (display-graphic-p)))
+ (if custom-buffer-verbose-help
+ (widget-insert "\n
+ Operate on all settings in this buffer that are not marked HIDDEN:\n"))
+ (let ((button (lambda (tag action active help icon)
+ (widget-insert " ")
+ (if (eval active)
+ (widget-create 'push-button :tag tag
+ :help-echo help :action action))))
+ (commands custom-commands))
+ (apply button (pop commands)) ; Set for current session
+ (apply button (pop commands)) ; Save for future sessions
+ (if custom-reset-button-menu
+ (progn
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Reset buffer"
+ :help-echo "Show a menu with reset operations."
+ :mouse-down-action 'ignore
+ :action 'custom-reset))
+ (widget-insert "\n")
+ (apply button (pop commands)) ; Undo edits
+ (apply button (pop commands)) ; Reset to saved
+ (apply button (pop commands)) ; Erase customization
+ (widget-insert " ")
+ (pop commands) ; Help (omitted)
+ (apply button (pop commands)))) ; Exit
+ (widget-insert "\n\n")
+
+ (widget-insert (propertize "\nThis part is for your own use\n" 'face '(:weight bold :height 1.5)))
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; Editor emulator level
+
+ (widget-insert "\n")
+ (setq fill-pos (point))
+ (widget-insert
+"Emacs can emulate some common editing behaviours (and some uncommon too).
+For the most common ones you can decide if you want to use them here:
+")
+ (fill-region fill-pos (point))
+ (cusnu-mark-part-desc fill-pos (point))
+
+ ;; CUA Mode
+ (cusnu-insert-options '((cua-mode custom-variable)))
+
+ ;; Viper Mode
+ (widget-insert "\n")
+ (widget-insert (propertize "Viper" 'face 'custom-variable-tag))
+ (widget-insert ":")
+ (setq fill-pos (point))
+ (widget-insert "
+ Viper is currently set up in a special way, please see the
+ command `viper-mode'. You can use custom to set up most of
+ it. However if you want to load Viper at startup you must
+ explicitly include \(require 'viper) in your .emacs.
+")
+ (fill-region fill-pos (point))
+
+ ;; Viper Mode
+ (backward-delete-char 1)
+ (cusnu-insert-options '((viper-mode custom-variable)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; OS specific
+
+ (widget-insert "\n")
+ (setq fill-pos (point))
+ (widget-insert (format "OS specific options (%s): \n" system-type))
+ (fill-region fill-pos (point))
+ (cusnu-mark-part-desc fill-pos (point))
+
+ (if cusnu-insert-os-spec-fun
+ (funcall cusnu-insert-os-spec-fun)
+ (widget-insert "No OS specific customizations.\n"))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; Disputed settings
+
+ (widget-insert "\n")
+ (setq fill-pos (point))
+ (widget-insert
+"Some old time Emacs users want to change the options below:
+")
+ (fill-region fill-pos (point))
+ (cusnu-mark-part-desc fill-pos (point))
+
+ (cusnu-insert-options '((global-visual-line-mode custom-variable)))
+ (cusnu-insert-options '((word-wrap custom-variable)))
+ (cusnu-insert-options '((blink-cursor-mode custom-variable)))
+ (cusnu-insert-options '((tool-bar-mode custom-variable)))
+ (cusnu-insert-options '((tooltip-mode custom-variable)))
+ ;;(cusnu-insert-options '((initial-scratch-message custom-variable)))
+
+ (widget-insert "\n")
+ (widget-insert (propertize "\n\nThis part is for exporting to others\n\n" 'face '(:weight bold :height 1.5)))
+ (setq fill-pos (point))
+ (widget-insert
+"My skin options - This is for exporting custom options to other users
+\(or maybe yourself on another computer).
+This works the following way:
+
+- You add a description of your options and the options you want to export below.
+Then you click on `Export my skin options'.
+This creates a file that you can send to other Emacs users.
+They simply open that file in Emacs and follow the instructions there to test your options
+and maybe save them for later use if they like them.
+\(You can follow the instructions yourself to see how it works.)
+
+Please change the group symbol name to something specific for you.
+")
+ (fill-region fill-pos (point))
+ (cusnu-mark-part-desc fill-pos (point))
+
+ (widget-insert "\n")
+ (set (make-local-variable 'cusnu-my-skin-widget)
+ (car
+ (cusnu-insert-options '((cusnu-my-skin-options custom-variable)))))
+ (widget-insert "\n")
+ (widget-create 'push-button
+ :tag "Export my skin options "
+ :action (lambda (&rest ignore)
+ (let ((use-dialog-box nil))
+ (call-interactively 'cusnu-export-my-skin-options))))
+ (widget-insert "\n")
+ (widget-create 'push-button
+ :tag "Customize my skin options "
+ :action (lambda (&rest ignore)
+ (let ((use-dialog-box nil))
+ (call-interactively 'cusnu-customize-my-skin-options))))
+ (widget-insert "\n")
+ (widget-create 'push-button
+ :tag "Reset those options to saved values"
+ :action (lambda (&rest ignore)
+ (let ((use-dialog-box nil))
+ (call-interactively 'cusnu-reset-my-skin-options))))
+
+ ;; Finish setup buffer
+ (mapc 'custom-magic-reset custom-options)
+ (cusnu-make-xrefs)
+ (widget-setup)
+ (buffer-enable-undo)
+ (goto-char (point-min)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Example on Emacs+Emacw32
+(eval-when-compile (require 'emacsw32 nil t))
+(when (fboundp 'emacsw32-version)
+ (defun cusnu-emacsw32-show-custstart (&rest args)
+ (emacsw32-show-custstart))
+ (setq cusnu-insert-os-spec-fun 'cusnu-insert-emacsw32-specific-part)
+ (defun cusnu-insert-emacsw32-specific-part ()
+ (cusnu-insert-options '((w32-meta-style custom-variable)))
+ (widget-insert "\n")
+ (widget-insert (propertize "EmacsW32" 'face 'custom-variable-tag))
+ (widget-insert "
+ Easy setup for Emacs+EmacsW32.")
+ (widget-insert "\n ")
+ (widget-create 'push-button :tag "Customize EmacsW32"
+ ;;:help-echo help
+ :action 'cusnu-emacsw32-show-custstart)
+ (widget-insert "\n")))
+;; End example
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun cusnu-mark-part-desc (beg end)
+ (let ((ovl (make-overlay beg end)))
+ (overlay-put ovl 'face 'highlight)))
+
+(defun cusnu-make-xrefs (&optional beg end)
+ (save-restriction
+ (when (or beg end)
+ (unless beg (setq beg (point-min)))
+ (unless end (setq end (point-max)))
+ (narrow-to-region beg end))
+ (let ((here (point)))
+ (goto-char (point-min))
+ (cusnu-help-insert-xrefs 'cusnu-help-xref-button)
+ (goto-char here))))
+
+(defun widget-info-link-action (widget &optional event)
+ "Open the info node specified by WIDGET."
+ (info-other-window (widget-value widget)))
+
+(defun widget-documentation-string-value-create (widget)
+ ;; Insert documentation string.
+ (let ((doc (widget-value widget))
+ (indent (widget-get widget :indent))
+ (shown (widget-get (widget-get widget :parent) :documentation-shown))
+ (start (point)))
+ (if (string-match "\n" doc)
+ (let ((before (substring doc 0 (match-beginning 0)))
+ (after (substring doc (match-beginning 0)))
+ button)
+ (when (and indent (not (zerop indent)))
+ (insert-char ?\s indent))
+ (insert before ?\s)
+ (widget-documentation-link-add widget start (point))
+ (setq button
+ (widget-create-child-and-convert
+ widget (widget-get widget :visibility-widget)
+ :help-echo "Show or hide rest of the documentation."
+ :on "Hide Rest"
+ :off "More"
+ :always-active t
+ :action 'widget-parent-action
+ shown))
+ (when shown
+ (setq start (point))
+ (when (and indent (not (zerop indent)))
+ (insert-char ?\s indent))
+ (insert after)
+ (widget-documentation-link-add widget start (point))
+ (cusnu-make-xrefs start (point))
+ )
+ (widget-put widget :buttons (list button)))
+ (when (and indent (not (zerop indent)))
+ (insert-char ?\s indent))
+ (insert doc)
+ (widget-documentation-link-add widget start (point))))
+ (insert ?\n))
+(defun cusnu-help-xref-button (match-number type what &rest args)
+ (let ((beg (match-beginning match-number))
+ (end (match-end match-number)))
+ (if nil
+ (let ((ovl (make-overlay beg end)))
+ (overlay-put ovl 'face 'highlight))
+ (let* ((tag (match-string match-number))
+ (value what)
+ (wid-type (cond
+ ((eq type 'help-variable)
+ 'variable-link)
+ ((eq type 'help-function)
+ 'function-link)
+ ((eq type 'help-info)
+ 'custom-manual)
+ (t nil)))
+ )
+ (when wid-type
+ (delete-region beg end)
+ (backward-char)
+ ;;(tag action active help icon)
+ (widget-create wid-type
+ ;;tag
+ :value value
+ :tag tag
+ :keymap custom-mode-link-map
+ :follow-link 'mouse-face
+ :button-face 'custom-link
+ :mouse-face 'highlight
+ :pressed-face 'highlight
+ ;;:help-echo help
+ )))))
+ )
+
+;; Override default ... ;-)
+(define-widget 'documentation-link 'link
+ "Link type used in documentation strings."
+ ;;:tab-order -1
+ :help-echo "Describe this symbol"
+ :button-face 'custom-link
+ :action 'widget-documentation-link-action)
+
+(defun cusnu-xref-niy (&rest ignore)
+ (message "Not implemented yet"))
+
+(defun cusnu-describe-function (wid &rest ignore)
+ (let ((fun (widget-get wid :what))
+ )
+ (describe-function fun)))
+
+(defun cusnu-help-insert-xrefs (help-xref-button)
+ ;; The following should probably be abstracted out.
+ (unwind-protect
+ (progn
+ ;; Info references
+ (save-excursion
+ (while (re-search-forward help-xref-info-regexp nil t)
+ (let ((data (match-string 2)))
+ (save-match-data
+ (unless (string-match "^([^)]+)" data)
+ (setq data (concat "(emacs)" data))))
+ (funcall help-xref-button 2 'help-info data))))
+ ;; URLs
+ (save-excursion
+ (while (re-search-forward help-xref-url-regexp nil t)
+ (let ((data (match-string 1)))
+ (funcall help-xref-button 1 'help-url data))))
+ ;; Mule related keywords. Do this before trying
+ ;; `help-xref-symbol-regexp' because some of Mule
+ ;; keywords have variable or function definitions.
+ (if help-xref-mule-regexp
+ (save-excursion
+ (while (re-search-forward help-xref-mule-regexp nil t)
+ (let* ((data (match-string 7))
+ (sym (intern-soft data)))
+ (cond
+ ((match-string 3) ; coding system
+ (and sym (coding-system-p sym)
+ (funcall help-xref-button 6 'help-coding-system sym)))
+ ((match-string 4) ; input method
+ (and (assoc data input-method-alist)
+ (funcall help-xref-button 7 'help-input-method data)))
+ ((or (match-string 5) (match-string 6)) ; charset
+ (and sym (charsetp sym)
+ (funcall help-xref-button 7 'help-character-set sym)))
+ ((assoc data input-method-alist)
+ (funcall help-xref-button 7 'help-character-set data))
+ ((and sym (coding-system-p sym))
+ (funcall help-xref-button 7 'help-coding-system sym))
+ ((and sym (charsetp sym))
+ (funcall help-xref-button 7 'help-character-set sym)))))))
+ ;; Quoted symbols
+ (save-excursion
+ (while (re-search-forward help-xref-symbol-regexp nil t)
+ (let* ((data (match-string 8))
+ (sym (intern-soft data)))
+ (if sym
+ (cond
+ ((match-string 3) ; `variable' &c
+ (and (or (boundp sym) ; `variable' doesn't ensure
+ ; it's actually bound
+ (get sym 'variable-documentation))
+ (funcall help-xref-button 8 'help-variable sym)))
+ ((match-string 4) ; `function' &c
+ (and (fboundp sym) ; similarly
+ (funcall help-xref-button 8 'help-function sym)))
+ ((match-string 5) ; `face'
+ (and (facep sym)
+ (funcall help-xref-button 8 'help-face sym)))
+ ((match-string 6)) ; nothing for `symbol'
+ ((match-string 7)
+;;; this used:
+;;; #'(lambda (arg)
+;;; (let ((location
+;;; (find-function-noselect arg)))
+;;; (pop-to-buffer (car location))
+;;; (goto-char (cdr location))))
+ (funcall help-xref-button 8 'help-function-def sym))
+ ((and
+ (facep sym)
+ (save-match-data (looking-at "[ \t\n]+face\\W")))
+ (funcall help-xref-button 8 'help-face sym))
+ ((and (or (boundp sym)
+ (get sym 'variable-documentation))
+ (fboundp sym))
+ ;; We can't intuit whether to use the
+ ;; variable or function doc -- supply both.
+ (funcall help-xref-button 8 'help-symbol sym))
+ ((and
+ (or (boundp sym)
+ (get sym 'variable-documentation))
+ (or
+ (documentation-property
+ sym 'variable-documentation)
+ (condition-case nil
+ (documentation-property
+ (indirect-variable sym)
+ 'variable-documentation)
+ (cyclic-variable-indirection nil))))
+ (funcall help-xref-button 8 'help-variable sym))
+ ((fboundp sym)
+ (funcall help-xref-button 8 'help-function sym)))))))
+ ;; An obvious case of a key substitution:
+ (save-excursion
+ (while (re-search-forward
+ ;; Assume command name is only word and symbol
+ ;; characters to get things like `use M-x foo->bar'.
+ ;; Command required to end with word constituent
+ ;; to avoid `.' at end of a sentence.
+ "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
+ (let ((sym (intern-soft (match-string 1))))
+ (if (fboundp sym)
+ (funcall help-xref-button 1 'help-function sym)))))
+ ;; Look for commands in whole keymap substitutions:
+ (save-excursion
+ ;; Make sure to find the first keymap.
+ (goto-char (point-min))
+ ;; Find a header and the column at which the command
+ ;; name will be found.
+
+ ;; If the keymap substitution isn't the last thing in
+ ;; the doc string, and if there is anything on the
+ ;; same line after it, this code won't recognize the end of it.
+ (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
+ nil t)
+ (let ((col (- (match-end 1) (match-beginning 1))))
+ (while
+ (and (not (eobp))
+ ;; Stop at a pair of blank lines.
+ (not (looking-at "\n\\s-*\n")))
+ ;; Skip a single blank line.
+ (and (eolp) (forward-line))
+ (end-of-line)
+ (skip-chars-backward "^ \t\n")
+ (if (and (>= (current-column) col)
+ (looking-at "\\(\\sw\\|\\s_\\)+$"))
+ (let ((sym (intern-soft (match-string 0))))
+ (if (fboundp sym)
+ (funcall help-xref-button 0 'help-function sym))))
+ (forward-line))))))
+ ;;(set-syntax-table stab)
+ ))
+
+(defun cusnu-insert-options (options)
+ (widget-insert "\n")
+ (setq custom-options
+ (append
+ (if (= (length options) 1)
+ (mapcar (lambda (entry)
+ (widget-create (nth 1 entry)
+ ;;:documentation-shown t
+ :custom-state 'unknown
+ :tag (custom-unlispify-tag-name
+ (nth 0 entry))
+ :value (nth 0 entry)))
+ options)
+ (let ((count 0)
+ (length (length options)))
+ (mapcar (lambda (entry)
+ (prog2
+ (message "Creating customization items ...%2d%%"
+ (/ (* 100.0 count) length))
+ (widget-create (nth 1 entry)
+ :tag (custom-unlispify-tag-name
+ (nth 0 entry))
+ :value (nth 0 entry))
+ (setq count (1+ count))
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))
+ (widget-insert "\n")))
+ options)))
+ custom-options))
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))
+ custom-options
+ )
+
+(defun cusnu-is-custom-obj (sym)
+ "Return non-nil if symbol SYM is customizable."
+ (or (get sym 'custom-type)
+ (get sym 'face)
+ (get sym 'custom-group)
+ ))
+
+(define-widget 'custom-symbol 'symbol
+ "A customizable symbol."
+ :prompt-match 'cusnu-is-custom-obj
+ :prompt-history 'widget-variable-prompt-value-history
+ :complete-function (lambda ()
+ (interactive)
+ (lisp-complete-symbol 'cusnu-is-custom-obj))
+ :tag "Custom option")
+
+(defun cusnu-set-my-skin-options (sym val)
+ (set-default sym val)
+ (let ((group (nth 0 val))
+ (doc (nth 1 val))
+ (members (nth 2 val)))
+ (custom-declare-group group nil doc)
+ (put group 'custom-group nil)
+ (dolist (opt members)
+ (let ((type (cusnu-get-opt-main-type opt)))
+ (when type
+ (custom-add-to-group group opt type))))))
+
+(defun cusnu-get-opt-main-type (opt)
+ (when opt
+ (cond ((get opt 'face) 'custom-face)
+ ((get opt 'custom-type) 'custom-variable)
+ ((get opt 'custom-group) 'custom-group))))
+
+(defgroup all-my-loaded-skin-groups nil
+ "All your loaded skin groups."
+ :group 'environment
+ :group 'convenience)
+
+(defun cusnu-custom-group-p (symbol)
+ (and (intern-soft symbol)
+ (or (and (get symbol 'custom-loads)
+ (not (get symbol 'custom-autoload)))
+ (get symbol 'custom-group))))
+
+(defcustom cusnu-my-skin-options '(my-skin-group "My skin group.\n\n\n\n\n" nil)
+ "Your custom skin-like options.
+The purpose of this variable is to provide for easy export a
+selection of variables you choose to set to other users.
+
+To send these values to other users you export them to a file
+with `cusnu-export-my-skin-options'."
+ :type '(list (symbol :tag "My custom group symbol name (should be specific to you)")
+ (string :tag "My custom group description")
+ (repeat :tag "Add your custom options below"
+ (custom-symbol :tag "My custom option")))
+ :set 'cusnu-set-my-skin-options
+ :group 'all-my-loaded-skin-groups)
+
+;;(cusnu-ring-bell "bell")
+(defun cusnu-ring-bell (format-string &rest args)
+ (message "%s" (propertize (apply
+ 'format format-string args) 'face 'secondary-selection))
+ (ding)
+ (throw 'bell nil))
+
+;;;###autoload
+(defun cusnu-export-my-skin-options (file)
+ "Export to file FILE custom options in `cusnu-my-skin-options'.
+The options is exported to elisp code that other users can run to
+set the options that you have added to `cusnu-my-skin-options'.
+
+For more information about this see `cusnu-export-cust-group'."
+ (interactive '(nil))
+ (catch 'bell
+ (let ((grp (nth 0 cusnu-my-skin-options))
+ buf)
+ (let ((state (plist-get (cdr cusnu-my-skin-widget) :custom-state)))
+ (case state
+ ((set saved) nil) ;;(error "test, state=%s" state))
+ (standard (cusnu-ring-bell "Please enter your options first"))
+ (t (cusnu-ring-bell "My Skin Options must be saved or set, use the State button, %s" state))))
+ (unless (nth 2 cusnu-my-skin-options)
+ (cusnu-ring-bell "You have not added any of your options"))
+ (unless file
+ (setq file (read-file-name "Save to file: ")))
+ (when (file-exists-p file)
+ (cusnu-ring-bell "File %s already exists, choose another file name" file))
+ (setq buf (find-file-other-window file))
+ (with-current-buffer buf
+ (unless (eq major-mode 'emacs-lisp-mode) (emacs-lisp-mode))
+ (unless (file-exists-p (buffer-file-name))
+ (erase-buffer)))
+ (cusnu-export-cust-group grp buf))))
+
+(defun cusnu-customize-my-skin-options ()
+ (interactive)
+ (customize-group-other-window (nth 0 cusnu-my-skin-options)))
+
+(defun cusnu-reset-my-skin-options ()
+ "Reset to my defaults for those options.
+"
+ (interactive)
+ (cusnu-reset-group-options-to-my-defaults (nth 0 cusnu-my-skin-options)))
+
+(defun cusnu-reset-group-options-to-my-defaults (group)
+ (dolist (sym-typ (get group 'custom-group))
+ (let ((symbol (nth 0 sym-typ))
+ ;;(type (cusnu-get-opt-main-type symbol))
+ (type (nth 1 sym-typ))
+ defval)
+ (cond
+ ((eq type 'custom-variable)
+ ;; First try reset to saved.
+ (let* ((set (or (get symbol 'custom-set) 'set-default))
+ (value (get symbol 'saved-value))
+ (comment (get symbol 'saved-variable-comment)))
+ (cond ((or comment value)
+ (put symbol 'variable-comment comment)
+ (custom-push-theme 'theme-value symbol 'user 'set (car-safe value))
+ (condition-case err
+ (funcall set symbol (eval (car value)))
+ (error (message "%s" err))))
+ ;; If symbol was not saved then reset to standard.
+ (t
+ (unless (get symbol 'standard-value)
+ (error "No standard setting known for %S" symbol))
+ (put symbol 'variable-comment nil)
+ (put symbol 'customized-value nil)
+ (put symbol 'customized-variable-comment nil)
+ (custom-push-theme 'theme-value symbol 'user 'reset)
+ (custom-theme-recalc-variable symbol)
+ (put symbol 'saved-value nil)
+ (put symbol 'saved-variable-comment nil)
+ ))))
+ ((eq type 'custom-face)
+ ;; First try reset to saved
+ (let* ((value (get symbol 'saved-face))
+ (comment (get symbol 'saved-face-comment)))
+ (cond ((or value comment)
+ (put symbol 'customized-face nil)
+ (put symbol 'customized-face-comment nil)
+ (custom-push-theme 'theme-face symbol 'user 'set value)
+ (face-spec-set symbol value t)
+ (put symbol 'face-comment comment))
+ ;; If symbol was not saved then reset to standard.
+ (t
+ (setq value (get symbol 'face-defface-spec))
+ (unless value
+ (error "No standard setting for this face"))
+ (put symbol 'customized-face nil)
+ (put symbol 'customized-face-comment nil)
+ (custom-push-theme 'theme-face symbol 'user 'reset)
+ (face-spec-set symbol value t)
+ (custom-theme-recalc-face symbol)
+ ;; Do this later.
+ (put symbol 'saved-face nil)
+ (put symbol 'saved-face-comment nil)
+ ))))
+ (t (error "not iy"))))))
+
+(defun cusnu-export-cust-group (group buf)
+ "Export custom group GROUP to end of buffer BUF.
+Only the options that has been customized will be exported.
+
+The group is exported as elisp code. Running the code will
+create a group with just those members. After this it opens a
+customization buffer with the new group.
+
+The code will also set the options to the customized values, but
+it will not save them in the users init file.
+
+See also the comment in the exported file."
+ (let (start
+ (doc (get group 'group-documentation))
+ groups options faces
+ (members (mapcar (lambda (rec)
+ (car rec))
+ (get group 'custom-group))))
+ (with-current-buffer buf
+ (insert (format-time-string ";; Here is my skin custom group %Y-%m-%d.\n"))
+ (font-lock-mode 1)
+ (insert (format ";;;;;; Customization group name: %s\n" group))
+ (insert ";;\n")
+ (let ((here (point)))
+ (insert doc "\n")
+ (comment-region here (point))
+ (fill-region here (point)))
+ (cusnu-get-options-and-faces members 'groups 'options 'faces)
+ (unless (or options faces)
+ (cusnu-ring-bell "There are no options or faces in %s customized by you" group))
+ (insert "
+;; This file defines the group and sets the options in it, but does
+;; not save the values to your init file.
+;;
+;; To set the values evaluate this file. To do that open this file in Emacs and to
+;;
+;; M-x eval-buffer
+;;
+;; To go back to your default evaluate next line (place point at the end and to C-x C-e):
+")
+ (insert (format ";; (cusnu-reset-group-options-to-my-defaults '%s)\n\n" group))
+ (insert (format "(let ((grp '%s))\n" group))
+ (insert (format " (custom-declare-group grp nil %S)\n" doc))
+ (insert " (put grp 'custom-group nil)\n")
+ (insert (format " (custom-add-to-group 'all-my-loaded-skin-groups '%s 'custom-group)\n" group))
+ (dolist (opt members)
+ (let ((type (cusnu-get-opt-main-type opt)))
+ (when type
+ (insert (format " (custom-add-to-group grp '%s '%s)\n"
+ opt type)))))
+ (insert " (custom-set-variables\n")
+ (dolist (opt options)
+ (let ((my-val (or (get opt 'saved-value)
+ (get opt 'customized-value))))
+ (when my-val
+ (insert (format " '(%s %S)\n" opt (custom-quote (symbol-value opt)))))))
+ (insert " )\n")
+ (insert " (custom-set-faces\n")
+ (dolist (opt faces)
+ (let ((my-val (get opt 'customized-face)))
+ (when my-val
+ (insert (format " '(%s %S)\n" opt my-val)))))
+ (insert " ))\n")
+ (insert (format "\n(customize-group '%s)\n" group))
+ )))
+
+(defun cusnu-get-options-and-faces (members groups-par options-par faces-par)
+ (dolist (sym members)
+ (insert (format ";; sym=%s\n" sym))
+ (cond ((and (get sym 'custom-type)
+ (or (get sym 'saved-value)
+ (get sym 'customize-value)))
+ (add-to-list options-par sym))
+ ((and (get sym 'face)
+ (get sym 'customized-face))
+ (add-to-list faces-par sym))
+ ((get sym 'custom-group)
+ (unless (memq sym groups-par) ;; Don't loop
+ (cusnu-get-options-and-faces groups-par options-par faces-par)))
+ (t (insert ";; Not a custom variable or face: %s\n" sym)))))
+
+(provide 'cus-new-user)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; cus-new-user.el ends here
--- /dev/null
+;;; custsets.el --- Sets of named customizations
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-03-25T00:17:06+0100 Mon
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; After an idea expressed by among other Stephen Turnbull on the
+;; emacs devel list.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defcustom custsets-sets
+ '(
+ ("Windows"
+ (cua-mode t)
+ )
+ )
+ "Sets of customizations."
+ :group 'custsets)
+
+(defun custsets-turn-on (set-name)
+ (interactive "sCustomization set: ")
+ (let ((set (assoc-string set-name custsets-sets t)))
+ (unless set
+ (error "Can't find customization set %s" set-name))
+ (dolist (opt-rec (cdr set))
+ (let* ((opt (car opt-rec))
+ (val (cdr opt-rec))
+ (saved-opt (get opt 'saved-value))
+ (saved-val saved-opt) ;; fix-me
+ (ask (if saved-opt
+ (format "You have currently customized %s to %s. Change this to %s? "
+ opt saved-opt val)
+ (format "Customize %s to %s? " opt val)))
+ )
+ (when (y-or-n-p ask)
+ (customize-set-variable opt val)
+ (customize-set-value opt val)
+ (customize-mark-to-save opt))
+ )
+ )
+ (custom-save-all)))
+
+
+(provide 'custsets)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; custsets.el ends here
--- /dev/null
+;;; ecb-batch-compile.el --- Compile ecb in batch mode
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-08-25T04:46:35+0200 Mon
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Batch byte compile ecb:
+;;
+;; emacs -Q -l ecb-batch-compile
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-and-compile (require 'udev-ecb nil t))
+
+(let* ((this-file load-file-name)
+ (this-dir (file-name-directory this-file))
+ )
+ (add-to-list 'load-path this-dir))
+
+;;(require 'udev-cedet)
+;;(udev-cedet-load-cedet t)
+
+(eval-when (eval)
+ (udev-ecb-load-ecb)
+ (ecb-byte-compile))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ecb-batch-compile.el ends here
--- /dev/null
+;;; ediff-url.el --- Diffing buffer against downloaded url
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Sat Nov 24 2007
+;; Version: 0.56
+;; Last-Updated: 2010-03-18 Thu
+;; URL: http://bazaar.launchpad.net/~nxhtml/nxhtml/main/annotate/head%3A/util/ediff-url.el
+;;
+;; Features that might be required by this library:
+;;
+ ;; `mail-prsvr', `mm-util', `timer', `url-parse', `url-util',
+ ;; `url-vars'.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This file contains a simple function, `ediff-url', to help you
+;; update a single file from the web.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'url-util)
+(eval-when-compile (require 'cl))
+
+(defvar ediff-url-read-url-history nil)
+
+(defun ediff-url-redir-launchpad (url)
+ "Check if bazaar list page on Launchpad.
+If URL is a description page for a file uploaded to EmacsWiki
+suggest to use the download URL instead."
+ (let* ((bazaar-url "http://bazaar.launchpad.net/")
+ (bazaar-len (length bazaar-url)))
+ (if (and (< bazaar-len (length url))
+ (string= bazaar-url (substring url 0 bazaar-len)))
+ (let* ((url-show-status nil) ;; just annoying showing status here
+ (buffer (url-retrieve-synchronously url))
+ (handle nil)
+ (http-status nil)
+ ;; Fix-me: better more flexible pattern?
+ (dl-patt "<a href=\"\\(.*?\\)\">download file</a>")
+ dl-url)
+ (unless buffer
+ (message "Got empty buffer for %s" url)
+ (throw 'command-level nil))
+ (with-current-buffer buffer
+ (if (= 0 (buffer-size))
+ (progn
+ (message "Got empty page for %s" url)
+ (throw 'command-level nil))
+ (require 'url-http)
+ (setq http-status (url-http-parse-response))
+ (if (memq http-status '(200 201))
+ (progn
+ (goto-char (point-min))
+ (unless (search-forward "\n\n" nil t)
+ (error "Could not find header end in buffer for %s" url))
+ (unless (re-search-forward dl-patt nil t)
+ (error "Could not find download link"))
+ (setq dl-url (match-string 1))
+ (set-buffer-modified-p nil)
+ (kill-buffer buffer)
+ dl-url)
+ (kill-buffer buffer)
+ (setq buffer nil)
+ (setq http-status
+ (concat (number-to-string http-status)
+ (case http-status
+ (401 " (unauthorized)")
+ (403 " (forbidden)")
+ (404 " (not found)")
+ (408 " (request timeout)")
+ (410 " (gone)")
+ (500 " (internal server error)")
+ (503 " (service unavailable)")
+ (504 " (gateway timeout)")
+ (530 " (user access denied)")
+ )))
+ (message "Got status %s for %s" http-status url)
+ (throw 'command-level nil)))))
+ url)))
+
+(defun ediff-url-redir-emacswiki-description-page (url)
+ "Check if description page on EmacsWiki.
+If URL is a description page for a file uploaded to EmacsWiki
+suggest to use the download URL instead."
+ ;;(let* ((desc-url "http://www.emacswiki.org/emacs/")
+ (let* ((emacswiki-url "http://www.emacswiki.org/")
+ (emacswiki-len (length emacswiki-url)))
+ (if (and (< emacswiki-len (length url))
+ (string= emacswiki-url (substring url 0 emacswiki-len))
+ (not (string-match-p "/download/" url)))
+ (let ((prompt
+ (concat "This seem to be the description page on EmacsWiki,"
+ "\n\tdo you want the download url instead? ")))
+ (when (y-or-n-p prompt)
+ ;;(let ((start (+ 6 (string-match "/wiki/" url))))
+ (let ((start (+ 7 (string-match "/emacs/" url))))
+ (concat (substring url 0 start)
+ "download/"
+ (substring url start)))))
+ ;; Not on the wiki, just return the url:
+ url)))
+
+(defcustom ediff-url-redirects '(ediff-url-redir-emacswiki-description-page
+ ediff-url-redir-launchpad
+ )
+ "List of functions checking url given to `ediff-url'.
+Each function should take an URL as argument and return this URL
+or a new URL."
+ :type '(repeat function)
+ :group 'ediff)
+
+;;;###autoload
+(defun ediff-url (url)
+ "Compare current buffer to a web URL using `ediff-buffers'.
+Check URL using `ediff-url-redirects' before fetching the file.
+
+This is for checking downloaded file. A the file may have a comment
+telling the download URL of thise form in the header:
+
+ ;; URL: http://the-server.net/the-path/the-file.el
+
+If not the user is asked for the URL."
+ (interactive (let ((url-init (url-get-url-at-point)))
+ (unless url-init
+ (when (eq major-mode 'emacs-lisp-mode)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "URL:[ \t]*" nil t)
+ (setq url-init (url-get-url-at-point))))))
+ (list (read-from-minibuffer "Url for download file: "
+ (cons (or url-init "") 1) ;nil
+ nil nil
+ 'ediff-url-read-url-history
+ ;;url-init
+ ))))
+ (catch 'command-level ;; Fix-me: remove and let go to top later
+ (unless (> (length url) 0)
+ (message "No URL given, aborted by user")
+ (throw 'command-level nil))
+ ;; Check if URL seems reasonable
+ (dolist (fun ediff-url-redirects)
+ (setq url (funcall fun url)))
+ ;; Fetch URL and run ediff
+ (let* ((url-buf-name (concat "URL=" url))
+ (url-buf (get-buffer url-buf-name)))
+ (when url-buf
+ (unless (y-or-n-p "Use previously downloaded url? ")
+ (kill-buffer url-buf)
+ (setq url-buf nil)))
+ (unless url-buf
+ (setq url-buf (get-buffer-create url-buf-name))
+ (let ((current-major major-mode))
+ (with-current-buffer url-buf
+ (url-insert-file-contents url)
+ ;; Assume same modes:
+ (funcall current-major))))
+ (ediff-buffers url-buf (current-buffer)))))
+
+(provide 'ediff-url)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ediff-url.el ends here
--- /dev/null
+;;; ffip.el --- Find files in project
+;;
+;; Authors: extracted from rinari by Phil Hagelberg and Doug Alcorn
+;; Changed by Lennart Borgman
+;; Created: 2008-08-14T23:46:22+0200 Thu
+;; Version: 0.3
+;; Last-Updated: 2008-12-28 Sun
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Project data
+
+;; Fix-me: Change the inner structure of ffip projects
+(defvar ffip-project-name nil "Project name.")
+(defvar ffip-project-roots nil "Project directory roots.")
+(defvar ffip-project-type nil "Project type, `ffip-project-file-types'.")
+(defcustom ffip-project-file-types
+ (list
+ '(ruby "\\(\\.el$\\|\\.rb$\\|\\.js$\\|\\.emacs\\)")
+ (list 'nxhtml (concat
+ (regexp-opt '(".html" ".htm" ".xhtml"
+ ".css"
+ ".js"
+ ".png" ".gif"
+ ))
+ "\\'"))
+ )
+ "Project types and file types.
+The values in this list are used to determine if a file belongs
+to the current ffip project. Entries have the form
+
+ \(TYPE FILE-REGEXP)
+
+TYPE is the parameter set by `ffip-set-current-project'. Files
+matching FILE-REGEXP within the project roots are members of the
+project."
+ :type '(repeat (list
+ (symbol :tag "Type")
+ (regexp :tag "File regexp")))
+ :group 'ffip)
+
+(defvar ffip-project-file-matcher nil "Project file matcher.")
+(defvar ffip-project-files-table nil "Project file cache.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Project handling
+
+(defun ffip-reset-project ()
+ "Clear project data."
+ (remove-hook 'after-save-hook 'ffip-after-save)
+ (setq ffip-project-name nil)
+ (setq ffip-project-roots nil)
+ (setq ffip-project-files-table nil)
+ (setq ffip-project-type nil)
+ (setq ffip-project-file-matcher nil))
+;;(ffip-reset-project)
+
+(defun ffip-is-current (name root type)
+ "Return non-nil if NAME, ROOT and TYPE match current ffip project.
+See `ffip-set-current-project'."
+ (and name
+ (string= ffip-project-name name)
+ (eq ffip-project-type type)
+ (equal ffip-project-roots root)))
+
+;;;###autoload
+(defun ffip-set-current-project (name root type)
+ "Setup ffip project NAME with top directory ROOT of type TYPE.
+ROOT can either be just a directory or a list of directory where
+the first used just for prompting purposes and the files in the
+rest are read into the ffip project.
+
+Type is a type in `ffip-project-file-types'."
+ (unless (ffip-is-current name root type)
+ (ffip-reset-project)
+ (setq ffip-project-name name)
+ (setq ffip-project-type type)
+ (setq ffip-project-roots root)
+ (message "Project %s with %s files setup for find-files-in-project"
+ name (length ffip-project-files-table))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; File cache handling
+
+(defun ffip-cache-project-files (file-regexp)
+ "Read files and cache their names within the ffip project."
+ (let ((root ffip-project-roots))
+ (message "... reading files in %s ..." root)
+ (add-hook 'after-save-hook 'ffip-after-save)
+ (if (not (listp root))
+ (ffip-populate-files-table root file-regexp)
+ (setq root (cdr root))
+ (dolist (r root)
+ (ffip-populate-files-table r file-regexp)))))
+
+(defun ffip-file-matcher ()
+ (when ffip-project-type
+ (cadr (assoc ffip-project-type ffip-project-file-types))))
+
+(defun ffip-project-files ()
+ "Get a list of all files in ffip project.
+The members in the list has the format
+
+ \(SHORT-NAME . FULL-NAME)
+
+where SHORT-NAME is a unique name (normally file name without
+directory) and FULL-NAME is the full file name."
+ (unless ffip-project-files-table
+ (let ((file-regexp (ffip-file-matcher)))
+ (ffip-cache-project-files file-regexp)))
+ ffip-project-files-table)
+
+;; Fix-me: Seems better to rewrite this to use
+;; project-find-settings-file.
+(defun ffip-project-root (&optional dir)
+ (setq dir (or dir
+ ffip-project-roots
+ default-directory))
+ ;;(locate-dominating-file "." "\\`\\find-file-in-project.el\\'")
+ (let ((root (locate-dominating-file dir
+ ;;"\\`\\.emacs-project\\'"
+ "\\`\\.dir-settings\\.el\\'"
+ )))
+ (if root
+ (file-name-directory root)
+ dir)))
+
+(defun ffip-populate-files-table (file file-regexp)
+ ;;(message "ffip-populate-files-table.file=%s" file)
+ (if (file-directory-p file)
+ (mapc (lambda (file)
+ (ffip-populate-files-table file file-regexp))
+ (directory-files (expand-file-name file) t "^[^\.]"))
+ (let* ((file-name (file-name-nondirectory file))
+ (existing-record (assoc file-name ffip-project-files-table))
+ (unique-parts (ffip-get-unique-directory-names file
+ (cdr existing-record))))
+ (when (or (not file-regexp)
+ (string-match file-regexp file-name))
+ (if existing-record
+ (let ((new-key (concat file-name " - " (car unique-parts)))
+ (old-key (concat (car existing-record) " - "
+ (cadr unique-parts))))
+ (setf (car existing-record) old-key)
+ (setq ffip-project-files-table
+ (acons new-key file ffip-project-files-table)))
+ (setq ffip-project-files-table
+ (acons file-name file ffip-project-files-table)))))))
+
+(defun ffip-get-unique-directory-names (path1 path2)
+ (let* ((parts1 (and path1 (split-string path1 "/" t)))
+ (parts2 (and path2 (split-string path2 "/" t)))
+ (part1 (pop parts1))
+ (part2 (pop parts2))
+ (looping t))
+ (while (and part1 part2 looping)
+ (if (equal part1 part2)
+ (setq part1 (pop parts1) part2 (pop parts2))
+ (setq looping nil)))
+ (list part1 part2)))
+
+(defun ffip-file-is-in-project (file-name)
+ "Return non-nil if file is in current ffip project."
+ (save-match-data
+ (let ((file-regexp (ffip-file-matcher))
+ (roots ffip-project-roots)
+ regexp)
+ (if (not (listp roots))
+ (setq roots (list roots))
+ (setq roots (cdr roots)))
+ (catch 'found
+ (dolist (root roots)
+ (setq file-regexp (concat root ".*" file-regexp))
+ (when (string-match file-regexp file-name)
+ (throw 'found t)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Updating on file changes
+
+(defun ffip-add-file-if-in-project (file-name)
+ "Add file to cache if it in ffip project."
+ (when (ffip-file-is-in-project file-name)
+ ;; We have already checked so just use nil for the matcher.
+ (ffip-populate-files-table file-name nil)))
+
+;; For after-save-hook
+(defun ffip-after-save ()
+ "Check if a file should be added to cache."
+ (condition-case err
+ (ffip-add-file-if-in-project buffer-file-name)
+ (error (message "%s" (error-message-string err)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Interactive functions
+
+;;;###autoload
+(defun ffip-find-file-in-dirtree (root)
+ "Find files in directory tree ROOT."
+ (interactive "DFind file in directory tree: ")
+ ;; Setup a temporary
+ (let ((ffip-project-name nil)
+ (ffip-project-roots nil)
+ (ffip-project-files-table nil)
+ (ffip-project-type nil)
+ (ffip-project-file-matcher nil))
+ (ffip-set-current-project "(temporary)" root nil)
+ (call-interactively 'ffip-find-file-in-project)))
+
+(defun ffip-find-file-in-project (file)
+ "Find files in current ffip project."
+ (interactive
+ (list
+ (let* ((prompt (format "Find file in project %s: "
+ ffip-project-name)))
+ (if (memq ido-mode '(file 'both))
+ (ido-completing-read prompt
+ (mapcar 'car (ffip-project-files)))
+ (let ((files (mapcar 'car (ffip-project-files))))
+ (completing-read prompt
+ files
+ (lambda (elem) (member elem files))
+ t))))))
+ (find-file (cdr (assoc file ffip-project-files-table))))
+
+;;(global-set-key (kbd "C-x C-M-f") 'find-file-in-project)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Fix-me: This part should go somewhere else
+(eval-after-load 'ruby-mode
+ '(progn
+ (defun ffip-rails-project-files (&optional file)
+ (let ((default-directory (or file (rails-root))))
+ (unless (and ffip-project-roots
+ (string= default-directory ffip-project-roots))
+ (ffip-set-current-project
+ "Rails proj"
+ root
+ (list default-directory
+ (expand-file-name "app")
+ (expand-file-name "lib")
+ (expand-file-name "test"))
+ 'ruby
+ )))
+ (ffip-project-files))
+
+ (defun ffip-find-file-in-rails (file)
+ (interactive
+ (list (if (memq ido-mode '(file 'both))
+ (ido-completing-read
+ "Find file in project: "
+ (mapcar 'car (ffip-rails-project-files)))
+ (completing-read "Find file in project: "
+ (mapcar 'car (rails-project-files))))))
+ (find-file (cdr (assoc file ffip-project-files-table))))
+
+ (define-key ruby-mode-map (kbd "C-x C-M-f") 'find-file-in-rails)
+ (eval-after-load 'nxhtml-mode
+ '(define-key nxhtml-mode-map (kbd "C-x C-M-f") 'find-file-in-rails))))
+
+(provide 'ffip)
+;;; ffip.el ends here
--- /dev/null
+;;; fold-dwim.el -- Unified user interface for Emacs folding modes
+;;
+;; Copyright (C) 2004 P J Heslin
+;;
+;; Author: Peter Heslin <p.j.heslin@dur.ac.uk>
+;; URL: http://www.dur.ac.uk/p.j.heslin/Software/Emacs/Download/fold-dwim.el
+(defconst fold-dwim:version "1.4")
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; If you do not have a copy of the GNU General Public License, you
+;; can obtain one by writing to the Free Software Foundation, Inc., 59
+;; Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+;;; Overview:
+;;
+;; DWIM stands for "do what I mean", as in the idea that one keystroke
+;; can do different things depending on the context. In this package,
+;; it means that, if the cursor is in a currently hidden folded
+;; construction, we want to show it; if it's not, we want to hide
+;; whatever fold the cursor is in.
+;;
+;; Some editors other than Emacs provide a single mechanism for
+;; folding text which various file types can exploit. The advantage
+;; of this arrangement is that the user only has to know one set of
+;; folding commands; the disadvantage is that the various file types
+;; are limited to using whatever functionality is provided centrally.
+;; Emacs by contrast provides a very general and powerful framework
+;; for hiding text, which major modes can use as they see fit. The
+;; advantage of this is that each major mode can deal with folding in
+;; the way that is suitable for that type of file; the disadvantage is
+;; that different major modes have different styles of folding, and
+;; provide different key bindings.
+;;
+;; In practice, matters are simpler than that, since most major modes
+;; delegate the task of folding to packages like outline.el and
+;; hideshow.el. The key bindings for these two packages alone,
+;; however, are numerous and for some people hard to type. Another
+;; usability complication arises when a package like AucTeX uses
+;; outline-minor-mode for some folds, and provides its own
+;; key-bindings for other kinds of folds. Likewise, nXML-mode
+;; provides its own style of folding for certain types of files, but
+;; for files that don't fit that paradigm (such as XHTML), you may
+;; want to use outline-minor-mode instead.
+;;
+;; The goal of this package is to reduce this complexity to three
+;; globally-defined keystrokes: one to toggle the state of the fold at
+;; point, whatever its type may be, one to hide all folds of all types
+;; in the buffer, and one to show all folds.
+;;
+;; This package currently knows about folding-mode (from folding.el),
+;; hs-minor-mode (from hideshow.el), outline-minor-mode (from
+;; outline.el), TeX-fold-mode (from AUCTeX), and nXML-mode outlining.
+;; More could be added. It is not necessary to have folding.el,
+;; AUCTeX or nXML-mode installed, if you just want to use it with the
+;; built-in modes.
+
+;;; Usage:
+;;
+;; You will need to have one or more of following minor modes switched
+;; on: hs-minor-mode, outline-minor-mode, TeX-fold-mode, folding-mode.
+;; Otherwise no folds may be found. There are three functions to try:
+;;
+;; fold-dwim-toggle: try to show any hidden text at the cursor; if no
+;; hidden text is found, try to hide the text at the cursor.
+;;
+;; fold-dwim-hide-all: hide all folds in the buffer.
+;;
+;; fold-dwim-show-all: show all folds in the buffer.
+
+;;; Configuration
+;;
+;; This package binds no keys by default, so you need to find three
+;; free and convenient key-bindings. This is what I use:
+;;
+;; (global-set-key (kbd "<f7>") 'fold-dwim-toggle)
+;; (global-set-key (kbd "<M-f7>") 'fold-dwim-hide-all)
+;; (global-set-key (kbd "<S-M-f7>") 'fold-dwim-show-all)
+;;
+
+;;; Advanced Configuration
+;;
+;; With respect to outline-minor-mode (or outline-mode), dwim-fold
+;; provides two different styles of usage. The first is a "nested"
+;; style which only shows top-level headings when you fold the whole
+;; buffer, and then allows you to drill down progressively through the
+;; other levels. The other is a "flat" style, whereby folding the
+;; entire buffer shows all headings at every level.
+;;
+;; The default is "flat", but if you want to change the default, you
+;; can set the value of fold-dwim-outline-style-default to be 'flat or
+;; 'nested. If you wish to override the default for a particular
+;; major mode, put a value of either 'flat or 'nested for the
+;; fold-dwim-outline-style property of the major-mode symbol, like so:
+;;
+;; (put 'org-mode 'fold-dwim-outline-style 'nested)
+;;
+;; At present, there is no way to customize nXML-mode outlining to use
+;; the nested style, since it is not really supported by that mode
+;; (there is no function to hide all text and subheadings in the
+;; buffer).
+
+;;; Compatibility
+;;
+;; Tested with GNU Emacs CVS (from Sept. 10, 2004), AUCTeX version
+;; 11.53, nxml-mode version 20041004, folding.el version 2.97.
+;;
+;; If there are any other important major or minor modes that do
+;; folding and that could usefully be handled in this package, please
+;; let me know.
+
+;;; Bugs
+;;
+;; It is possible that some of the various folding modes may interact
+;; badly if used together; I have not tested all permutations.
+;;
+;; The function fold-dwim-hide tries various folding modes in
+;; succession, and stops when it finds one that successfully makes a
+;; fold at point. This means that the order in which those modes are
+;; tried is significant. I have not spent a lot of time thinking
+;; about what the optimal order would be; all I care about is that
+;; hideshow and TeX-fold have priority over outline-minor-mode (since
+;; for me they usually fold smaller chunks of the file).
+;;
+;; I don't use folding.el myself, so that functionality is not well
+;; tested.
+
+;;; Changes
+;;
+;; 1.0 Initial release
+;; 1.1 Bugfix: test if folding-mode is bound
+;; 1.2 fold-dwim-hide-all and -show-all operate only on active region
+;; in transient-mark-mode.
+;; 1.3 Added outline-mode (Lennart Borgman)
+;; 1.4 Removed nxml-mode style folding (Lennart Borgman)
+;; + some functions used by nXhtml.
+
+(require 'outline)
+(require 'hideshow)
+
+;;;###autoload
+(defgroup fold-dwim nil
+ "Unified interface to folding commands"
+ :prefix "fold-dwim-"
+ :group 'editing)
+
+(defcustom fold-dwim-outline-style-default 'flat
+ "Default style in which to fold in outline-minor-mode: 'nested or
+ 'flat."
+ :type '(choice (const :tag "Flat (show all headings)" flat)
+ (const :tag "Nested (nest headings hierarchically)" nested))
+ :group 'fold-dwim)
+
+(defvar fold-dwim-toggle-selective-display 'nil
+ "Set this non-nil to make fold-dwim functions use selective
+ display (folding of all lines indented as much or more than the
+ current line). Probably only useful for minor modes like
+ makefile-mode that don't provide a more intelligent way of
+ folding.")
+
+(make-variable-buffer-local
+ 'fold-dwim-toggle-selective-display)
+
+(defun fold-dwim-maybe-recenter ()
+ "It's annoyingly frequent that hiding a fold will leave you
+with point on the top or bottom line of the screen, looking at
+nothing but an ellipsis. TODO: only recenter if we end up near
+the top or bottom of the screen"
+ (recenter))
+
+(defun fold-dwim-toggle-selective-display ()
+ "Set selective display to indentation of current line"
+ (interactive)
+ (if (numberp selective-display)
+ (set-selective-display nil)
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (let ((col (current-column)))
+ (if (zerop col)
+ (set-selective-display nil)
+ (set-selective-display col))))))
+
+(defun fold-dwim-hide-all ()
+ "Hide all folds of various kinds in the buffer or region"
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (when (and transient-mark-mode mark-active)
+ (narrow-to-region (region-beginning) (region-end)))
+ (when (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ (TeX-fold-buffer))
+ (when hs-minor-mode
+ (hs-hide-all))
+ (when (or outline-minor-mode (eq major-mode 'outline-mode))
+ (if (fold-dwim-outline-nested-p)
+ (hide-sublevels 1)
+ (hide-body)))
+ ;; (when (derived-mode-p 'nxml-mode)
+ ;; (nxml-hide-all-text-content))
+ (when (and (boundp 'folding-mode) folding-mode)
+ (folding-whole-buffer))))
+ (fold-dwim-maybe-recenter))
+
+(defun fold-dwim-show-all ()
+ "Show all folds of various kinds in the buffer or region"
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (when (and transient-mark-mode mark-active)
+ (narrow-to-region (region-beginning) (region-end)))
+ (when (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ (TeX-fold-clearout-buffer))
+ (when hs-minor-mode
+ (hs-show-all))
+ ;; (when (derived-mode-p 'nxml-mode)
+ ;; (nxml-show-all))
+ (when (or outline-minor-mode (eq major-mode 'outline-mode))
+ (show-all))
+ (when (and (boundp 'folding-mode) folding-mode)
+ (folding-open-buffer))
+ (when fold-dwim-toggle-selective-display
+ (set-selective-display 'nil)))))
+
+(defun fold-dwim-hide ()
+ "Hide one item"
+ (or (and (boundp 'TeX-fold-mode)
+ TeX-fold-mode
+ (let ((type (fold-dwim-auctex-env-or-macro)))
+ (when type
+ (TeX-fold-item type))))
+ ;; Look for html headers.
+ (when (and (derived-mode-p 'nxml-mode 'html-mode)
+ outline-minor-mode)
+ (when (save-excursion
+ (save-match-data
+ (looking-back (rx "<" (optional "/")
+ "h" (any "1-6")
+ (0+ (not (any "<")))))))
+ (hide-entry)
+ t))
+ (and hs-minor-mode
+ (when (save-excursion
+ (or (hs-find-block-beginning) (hs-inside-comment-p)))
+ (hs-hide-block)
+ (hs-already-hidden-p)))
+ ;; (and (derived-mode-p 'nxml-mode)
+ ;; (condition-case nil
+ ;; (save-excursion
+ ;; (nxml-back-to-section-start))
+ ;; (error nil))
+ ;; (nxml-hide-text-content))
+ (and (boundp 'folding-mode)
+ folding-mode
+ (condition-case nil
+ (save-excursion
+ (folding-hide-current-entry)
+ t)
+ (error nil)))
+ (when (or outline-minor-mode (eq major-mode 'outline-mode))
+ (if (fold-dwim-outline-nested-p)
+ (hide-subtree)
+ (hide-entry))))
+ (fold-dwim-maybe-recenter))
+
+
+(defun fold-dwim-show ()
+ "If point is in a closed or temporarily open fold,
+ open it. Returns nil if nothing was done"
+ (save-excursion
+ (let ((stop))
+ (when (and (or outline-minor-mode (eq major-mode 'outline-mode))
+ (or (fold-dwim-outline-invisible-p (line-end-position))
+ (and (bolp)
+ (not (bobp))
+ (fold-dwim-outline-invisible-p (1- (point))))))
+ (if (not (fold-dwim-outline-nested-p))
+ (show-entry)
+ (show-children)
+ (show-entry))
+ (setq stop "outline-minor-mode"))
+ (when (and (not stop)
+ hs-minor-mode
+ (hs-already-hidden-p))
+ (hs-show-block)
+ (setq stop "hs-minor-mode"))
+ (when (and (not stop)
+ (boundp 'TeX-fold-mode)
+ TeX-fold-mode)
+ (let ((overlays (overlays-at (point))))
+ (while overlays
+ (when (eq (overlay-get (car overlays) 'category) 'TeX-fold)
+ (delete-overlay (car overlays))
+ (setq stop "Tex-fold-mode"))
+ (setq overlays (cdr overlays)))))
+ ;; (when (and (not stop)
+ ;; (derived-mode-p 'nxml-mode))
+ ;; (let ((overlays (overlays-at (point))))
+ ;; (while (and overlays (not stop))
+ ;; (when (overlay-get (car overlays) 'nxml-outline-display)
+ ;; (setq stop "nxml folding"))
+ ;; (setq overlays (cdr overlays))))
+ ;; (when stop
+ ;; (nxml-show)))
+ (when (and (not stop)
+ (boundp 'folding-mode)
+ folding-mode
+ (save-excursion
+ (beginning-of-line)
+ (let ((current-line-mark (folding-mark-look-at)))
+ (when (and (numberp current-line-mark)
+ (= current-line-mark 0))
+ (folding-show-current-entry)
+ (setq stop "folding-mode"))))))
+ stop)))
+
+;;;###autoload
+(defun fold-dwim-toggle ()
+ "Toggle visibility or some other visual things.
+Try toggling different visual things in this order:
+
+- Images shown at point with `inlimg-mode'
+- Text at point prettified by `html-write-mode'.
+
+For the rest it unhides if possible, otherwise hides in this
+order:
+
+- `org-mode' header or something else using that outlines.
+- Maybe `fold-dwim-toggle-selective-display'.
+- `Tex-fold-mode' things.
+- In html if `outline-minor-mode' and after heading hide content.
+- `hs-minor-mode' things.
+- `outline-minor-mode' things. (Turns maybe on this.)
+
+It uses `fold-dwim-show' to show any hidden text at point; if no
+hidden fold is found, try `fold-dwim-hide' to hide the
+construction at the cursor.
+
+Note: Also first turn on `fold-dwim-mode' to get the keybinding
+for this function from it."
+ (interactive)
+ (fold-dwim-mode 1)
+ (cond
+ ((get-char-property (point) 'html-write)
+ (html-write-toggle-current-tag))
+ ((get-char-property (point) 'inlimg-img)
+ (inlimg-toggle-display (point)))
+ ((eq major-mode 'org-mode)
+ (org-cycle))
+ ((and (fboundp 'outline-cycle)
+ outline-minor-mode)
+ (outline-cycle))
+ (t
+ (unless (or outline-minor-mode hs-minor-mode)
+ (outline-minor-mode 1))
+ (if fold-dwim-toggle-selective-display
+ (fold-dwim-toggle-selective-display)
+ (let ((unfolded (fold-dwim-show)))
+ (if unfolded
+ (message "Fold DWIM showed: %s" unfolded)
+ (fold-dwim-hide)))))))
+
+;;;###autoload
+(define-minor-mode fold-dwim-mode
+ "Key binding for `fold-dwim-toggle'."
+ :global t
+ :group 'nxhtml
+ :group 'foldit
+ nil)
+
+;; Fix-me: Maybe move to fold-dwim and rethink?
+(defvar fold-dwim-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c) ?+] 'fold-dwim-toggle)
+ map))
+
+;;;###autoload
+(defun fold-dwim-unhide-hs-and-outline ()
+ "Unhide everything hidden by Hide/Show and Outline.
+Ie everything hidden by `hs-minor-mode' and
+`outline-minor-mode'."
+ (interactive)
+ (hs-show-all)
+ (show-all))
+
+;;;###autoload
+(defun fold-dwim-turn-on-hs-and-hide ()
+ "Turn on minor mode `hs-minor-mode' and hide.
+If major mode is derived from `nxml-mode' call `hs-hide-block'
+else call `hs-hide-all'."
+ (interactive)
+ (hs-minor-mode 1)
+ (foldit-mode 1)
+ (if (derived-mode-p 'nxml-mode)
+ (hs-hide-block)
+ (hs-hide-all)))
+
+;;;###autoload
+(defun fold-dwim-turn-on-outline-and-hide-all ()
+ "Turn on `outline-minor-mode' and call `hide-body'."
+ (interactive)
+ (outline-minor-mode 1)
+ (foldit-mode 1)
+ (hide-body))
+
+(defun fold-dwim-auctex-env-or-macro ()
+ (let ((type (cond
+ ;; Fold macro before env, unless it's begin or end
+ ((save-excursion
+ (let ((macro-start (TeX-find-macro-start)))
+ (and macro-start
+ (not (= macro-start (point)))
+ (goto-char macro-start)
+ (not (looking-at
+ (concat (regexp-quote TeX-esc)
+ "\\(begin\\|end\\)[ \t]*{"))))))
+ 'macro)
+ ((and (eq major-mode 'context-mode)
+ (save-excursion
+ (ConTeXt-find-matching-start) (point)))
+ 'env)
+ ((and (eq major-mode 'texinfo-mode)
+ (save-excursion
+ (Texinfo-find-env-start) (point)))
+ 'env)
+ ((and (eq major-mode 'latex-mode)
+ (condition-case nil
+ (save-excursion
+ (LaTeX-find-matching-begin) (point)
+ (not (looking-at "\\\\begin[ \t]*{document}")))
+ (error nil)))
+ 'env)
+ (t
+ nil))))
+ type))
+
+(defun fold-dwim-outline-invisible-p (pos)
+ "The version of this function in outline.el doesn't work so
+ well for our purposes, because it doesn't distinguish between
+ invisibility caused by outline, and that of other modes."
+ (save-excursion
+ (goto-char pos)
+ (let ((overlays (overlays-at (point)))
+ (found-one))
+ (while overlays
+ (when (eq (overlay-get (car overlays) 'invisible) 'outline)
+ (setq found-one t))
+ (setq overlays (cdr overlays)))
+ found-one)))
+
+(defun fold-dwim-outline-nested-p ()
+ "Are we using the flat or nested style for outline-minor-mode?"
+ (let ((style (get major-mode 'fold-dwim-outline-style)))
+ (if style
+ (eq style 'nested)
+ (eq fold-dwim-outline-style-default 'nested))))
+
+(provide 'fold-dwim)
--- /dev/null
+;;; foldit.el --- Helpers for folding
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-08-10 Mon
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Defines `foldit-mode' which puts visual clues on hidden regions.
+;; Does not do any folding itself but works with `outline-minor-mode'
+;; and `hs-minor-mode'.
+;;
+;; Fix-me: reveal-mode does not work with this and I have no idea why
+;; ...
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; Fix-me: start-tag-beg/start-tag-end are workarounds for smaller
+;; bugs in hs-minor-mode and outline-minor-mode. Maybe try to fix
+;; them... - but there are a whole bunch of other invisibilty related
+;; bugs that ought to be fixed first since otherwise it is impossible
+;; to know where point goes after hiding/unhiding.
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'hideshow))
+(eval-when-compile (require 'mumamo nil t))
+(eval-when-compile (require 'outline))
+
+(defsubst foldit-overlay-priority ()
+ (1+ (or (and (boundp 'mlinks-link-overlay-priority)
+ mlinks-link-overlay-priority)
+ 100)))
+
+;;;###autoload
+(defgroup foldit nil
+ "Customization group for foldit folding helpers."
+ :group 'nxhtml)
+
+(defvar foldit-temp-at-point-ovl nil)
+(make-variable-buffer-local 'foldit-temp-at-point-ovl)
+
+;;;###autoload
+(define-minor-mode foldit-mode
+ "Minor mode providing visual aids for folding.
+Shows some hints about what you have hidden and how to reveal it.
+
+Supports `hs-minor-mode', `outline-minor-mode' and major modes
+derived from `outline-mode'."
+ :lighter nil
+ (if foldit-mode
+ (progn
+ ;; Outline
+ (add-hook 'outline-view-change-hook 'foldit-outline-change nil t)
+ ;; Add our overlays
+ (when (or (and (boundp 'outline-minor-mode) outline-minor-mode)
+ ;; Fix-me: mumamo
+ (derived-mode-p 'outline-mode)) (foldit-outline-change))
+ ;; hs
+ (unless (local-variable-p 'hs-set-up-overlay)
+ (set (make-local-variable 'hs-set-up-overlay) 'foldit-hs-set-up-overlay))
+ ;; Add our overlays
+ (when (or (and (boundp 'hs-minor-mode) hs-minor-mode))
+ (save-restriction
+ (widen)
+ (let (ovl)
+ (dolist (ovl (overlays-in (point-min) (point-max)))
+ (when (eq (overlay-get ovl 'invisible) 'hs)
+ (funcall hs-set-up-overlay ovl)))))))
+ ;; Outline
+ (remove-hook 'outline-view-change-hook 'foldit-outline-change t)
+ ;; hs
+ (when (and (local-variable-p 'hs-set-up-overlay)
+ (eq hs-set-up-overlay 'foldit-hs-set-up-overlay))
+ (kill-local-variable 'hs-set-up-overlay))
+ ;; Remove our overlays
+ (save-restriction
+ (widen)
+ (let (ovl prop)
+ (dolist (ovl (overlays-in (point-min) (point-max)))
+ (when (setq prop (overlay-get ovl 'foldit))
+ (case prop
+ ;;('display (overlay-put ovl 'display nil))
+ ('foldit (delete-overlay ovl))
+ (t (delete-overlay ovl))
+ )))))))
+
+(defcustom foldit-avoid '(org-mode)
+ "List of major modes to avoid."
+ :group 'foldit)
+
+;;;###autoload
+(define-globalized-minor-mode foldit-global-mode foldit-mode
+ (lambda () (foldit-mode 1))
+ :group 'foldit)
+
+(defun foldit-hidden-line-str (hidden-lines type)
+ "String to display for hidden lines.
+HIDDEN-LINES are the number of lines and TYPE is a string
+indicating how they were hidden."
+ (propertize (format " ...(%d %slines)" hidden-lines type)
+ 'face 'shadow))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Outline
+
+(defvar foldit-outline-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'foldit-outline-show-entry)
+ (define-key map [down-mouse-1] 'foldit-outline-show-entry)
+ (define-key map [S-tab] 'mlinks-backward-link)
+ (define-key map [tab] 'mlinks-forward-link)
+ (define-key map "\t" 'mlinks-forward-link)
+ map))
+
+(defun foldit-outline-change ()
+ "Check outline overlays.
+Run this in `outline-view-change-hook'."
+ ;; We get the variables FROM and TO here from `outline-flag-region'
+ ;; so let us use them. But O is hidden...
+ (let* (from
+ to
+ num-lines
+ ovl
+ (tag ""))
+ (cond
+ ((and (boundp 'start)
+ start
+ (boundp 'end)
+ end)
+ (setq from start)
+ (setq to end))
+ (t
+ (setq from (point-min))
+ (setq to (point-max))))
+ (dolist (ovl (overlays-in from to))
+ (when (eq (overlay-get ovl 'invisible) 'outline)
+ (setq num-lines (count-lines (overlay-start ovl) (overlay-end ovl)))
+ (overlay-put ovl 'display (concat
+ (propertize "+" 'face 'mode-line)
+ ""
+ tag (foldit-hidden-line-str num-lines "")))
+ (overlay-put ovl 'foldit 'display) ;; Should be a list...
+ (overlay-put ovl 'keymap foldit-outline-keymap)
+ (overlay-put ovl 'face 'lazy-highlight)
+ (overlay-put ovl 'mouse-face 'highlight)
+ (overlay-put ovl 'help-echo "Press RET to show hidden part")
+ (overlay-put ovl 'mlinks-link t)
+ (overlay-put ovl 'priority (foldit-overlay-priority))
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (let* ((start-tag-beg (overlay-start ovl))
+ (start-tag-end start-tag-beg))
+ (put-text-property start-tag-beg (+ start-tag-beg 1)
+ 'foldit-tag-end (copy-marker start-tag-end))))
+ ))))
+
+(defvar foldit-outline-hide-again-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'foldit-outline-hide-again)
+ (define-key map [down-mouse-1] 'foldit-outline-hide-again)
+ (define-key map [S-tab] 'mlinks-backward-link)
+ (define-key map [tab] 'mlinks-forward-link)
+ (define-key map "\t" 'mlinks-forward-link)
+ map))
+
+(defun foldit-outline-show-entry ()
+ "Show hidden entry."
+ (interactive)
+ (let ((tag-end (get-text-property (point) 'foldit-tag-end)))
+ (show-entry)
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (set-text-properties (point) (+ (point) 2) 'foldit-tag-end))
+ (when tag-end (goto-char tag-end))
+ (foldit-add-temp-at-point-overlay "-"
+ foldit-outline-hide-again-keymap
+ "Press RET to hide again")))
+
+(defun foldit-outline-hide-again ()
+ "Hide entry again."
+ (interactive)
+ (when (overlayp foldit-temp-at-point-ovl)
+ (delete-overlay foldit-temp-at-point-ovl))
+ (hide-entry))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Hide/Show
+
+(defvar foldit-hs-start-tag-end-func 'foldit-hs-default-start-tag-end)
+(make-variable-buffer-local 'foldit-hs-start-tag-end-func)
+(put 'foldit-hs-start-tag-end-func 'permanent-local t)
+
+(defun foldit-hs-default-start-tag-end (beg)
+ "Find end of hide/show tag beginning at BEG."
+ (min (+ beg 65)
+ (save-excursion
+ (goto-char beg)
+ (line-end-position))))
+
+(defvar foldit-hs-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'foldit-hs-show-block)
+ (define-key map [down-mouse-1] 'foldit-hs-show-block)
+ (define-key map [S-tab] 'mlinks-backward-link)
+ (define-key map [tab] 'mlinks-forward-link)
+ (define-key map "\t" 'mlinks-forward-link)
+ map))
+
+(defvar foldit-hs-hide-again-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'foldit-hs-hide-again)
+ (define-key map [down-mouse-1] 'foldit-hs-hide-again)
+ (define-key map [S-tab] 'mlinks-backward-link)
+ (define-key map [tab] 'mlinks-forward-link)
+ (define-key map "\t" 'mlinks-forward-link)
+ map))
+
+(defun foldit-hs-set-up-overlay (ovl)
+ "Set up overlay OVL for hide/show."
+ (let* ((num-lines (count-lines (overlay-start ovl) (overlay-end ovl)))
+ (here (point))
+ (start-tag-beg (overlay-start ovl))
+ (start-tag-end (funcall foldit-hs-start-tag-end-func start-tag-beg))
+ (tag (buffer-substring start-tag-beg start-tag-end)))
+ (goto-char here)
+ ;;(overlay-put ovl 'isearch-open-invisible t)
+ (overlay-put ovl 'display (concat
+ (propertize "+" 'face 'mode-line)
+ " "
+ tag (foldit-hidden-line-str num-lines "h")))
+ (overlay-put ovl 'foldit 'display)
+ (overlay-put ovl 'keymap foldit-hs-keymap)
+ (overlay-put ovl 'face 'next-error)
+ (overlay-put ovl 'face 'lazy-highlight)
+ (overlay-put ovl 'mouse-face 'highlight)
+ (overlay-put ovl 'help-echo "Press RET to show hidden part")
+ (overlay-put ovl 'mlinks-link t)
+ (overlay-put ovl 'priority (foldit-overlay-priority))
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (put-text-property start-tag-beg (+ start-tag-beg 1)
+ 'foldit-tag-end (copy-marker start-tag-end)))))
+
+(defun foldit-hs-show-block ()
+ "Show hidden block."
+ (interactive)
+ (let ((tag-end (get-text-property (point) 'foldit-tag-end)))
+ (hs-show-block)
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (set-text-properties (point) (+ (point) 2) 'foldit-tag-end))
+ (when tag-end (goto-char tag-end))
+ (foldit-add-temp-at-point-overlay "-"
+ foldit-hs-hide-again-keymap
+ "Press RET to hide again")))
+
+(defun foldit-hs-hide-again ()
+ "Hide hide/show block again."
+ (interactive)
+ (when (overlayp foldit-temp-at-point-ovl)
+ (delete-overlay foldit-temp-at-point-ovl))
+ (hs-hide-block))
+
+
+;;; Fix-me: break out this
+;; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+(defun foldit-add-temp-at-point-overlay (marker keymap msg)
+ "Add a temporary overlay with a marker MARKER and a keymap KEYMAP.
+The overlay is also given the help echo MSG.
+
+This overlay is removed as soon as point moves from current point."
+ (let ((ovl (make-overlay (point) (1+ (point))))
+ (real (buffer-substring (point) (1+ (point)))))
+ (overlay-put ovl 'isearch-open-invisible t)
+ (overlay-put ovl 'display (concat
+ (propertize marker 'face 'mode-line)
+ " "
+ msg
+ real))
+ (overlay-put ovl 'foldit 'foldit)
+ (overlay-put ovl 'keymap keymap)
+ (overlay-put ovl 'face 'lazy-highlight)
+ (overlay-put ovl 'mouse-face 'highlight)
+ (overlay-put ovl 'help-echo msg)
+ (overlay-put ovl 'mlinks-link t)
+ (overlay-put ovl 'priority (foldit-overlay-priority))
+ (setq foldit-temp-at-point-ovl ovl)
+ (add-hook 'post-command-hook
+ 'foldit-remove-temp-at-point-overlay
+ nil t)))
+
+(defun foldit-remove-temp-at-point-overlay ()
+ "Remove overlay made by `foldit-add-temp-at-point-overlay'."
+ (condition-case err
+ (unless (and foldit-temp-at-point-ovl
+ (overlay-buffer foldit-temp-at-point-ovl)
+ (= (overlay-start foldit-temp-at-point-ovl)
+ (point)))
+ (delete-overlay foldit-temp-at-point-ovl)
+ (setq foldit-temp-at-point-ovl nil)
+ (remove-hook 'post-command-hook 'foldit-remove-temp-at-point-overlay t)
+ )
+ (error (message "foldit-remove-temp-at-point-overlay: %s"
+ (propertize (error-message-string err))))))
+;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+
+;; (defun put-before-on-invis ()
+;; (let* (o
+;; (io (catch 'io
+;; (dolist (o (overlays-at (1+ (point))))
+;; (when (overlay-get o 'invisible)
+;; (throw 'io o)))))
+;; (str (propertize "IOSTRING"
+;; 'face 'secondary-selection
+;; )))
+;; (overlay-put io 'before-string str)
+;; ;;(overlay-put io 'display "display")
+;; (overlay-put io 'display nil)
+;; ;;(overlay-put io 'after-string "AFTER")
+;; ))
+
+(provide 'foldit)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; foldit.el ends here
--- /dev/null
+;;; fupd.el --- Helper functions for updating files
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Tue Feb 28 17:21:20 2006
+;; Version: 0.1
+;; Last-Updated: Tue Feb 20 21:09:20 2007 (3600 +0100)
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Helper functions for updating files.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defun fupd-has-contents (file content)
+ "Check if file FILE contains CONTENT.
+Return a vector with these elements:
+- elt 0: t if file contains CONTENT and buffer is not modified.
+- elt 1: t if file contains CONTENT.
+- elt 2: file buffer if file exists.
+- elt 3: nil unless file already was in a buffer."
+ (let (ok same buffer old-buffer)
+ (when (file-exists-p file)
+ (setq buffer (get-file-buffer file))
+ (setq old-buffer (when buffer t))
+ (unless buffer
+ (setq buffer (find-file-noselect file)))
+ (with-current-buffer buffer
+ (setq same (string=
+ content
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (setq ok (and same
+ (not (buffer-modified-p buffer)))))
+ (vector ok same buffer old-buffer)))
+
+(defun fupd-ok (ret-val)
+ "Return t if RET-VAL indicate file is uptodate.
+RET-VAL should be the return value from `fupd-has-contents'."
+ (elt ret-val 0))
+
+(defun fupd-kill-new-buffer (ret-val)
+ "Kill new buffer indicated by RET-VAL.
+RET-VAL should be the return value from `fupd-has-contents'."
+ (unless (elt ret-val 3)
+ (let ((buffer (elt ret-val 2)))
+ (when (bufferp buffer)
+ ;;(message "fupd-kill-new-buffer: %s" (buffer-file-name buffer))(sit-for 4)
+ (kill-buffer buffer)))))
+
+;;(fupd-has-contents buffer-file-name (buffer-string))
+;;(fupd-update-file buffer-file-name (buffer-string))
+(defun fupd-update-file (file content)
+ "Update file FILE with content CONTENT.
+Do nothing if the file already has that content. If the file was
+not in a buffer before kill the file's buffer afterwards.
+
+Return t if the file was updated, otherwise nil."
+ (let* ((osbo (fupd-has-contents file content))
+ (ok (elt osbo 0))
+ (same (elt osbo 1))
+ (buff (elt osbo 2))
+ (oldb (elt osbo 3))
+ wrote
+ )
+ (unless ok
+ (if buff
+ (with-current-buffer buff
+ (unless same
+ (erase-buffer)
+ (insert content))
+ (save-buffer)
+ (setq wrote t)
+ (unless oldb
+ (kill-buffer (current-buffer))))
+ (with-temp-buffer
+ (insert content)
+ (write-file file))))
+ wrote))
+
+;; (defun fupd-copy-file (from-file to-file)
+;; (let (
+;; (from-buff (find-buffer-visiting from-file))
+;; (to-buff (find-buffer-visiting to-file))
+;; (from-attr (file-attributes from-file))
+;; (to-attr (file-attributes to-file))
+;; (from-size (nth 7 from-attr))
+;; (to-size (nth 7 to-attr))
+;; (from-mod (nth 5 from-attr))
+;; (to-mode (nth 5 to-attr))
+;; )
+;; ))
+
+(provide 'fupd)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; fupd.el ends here
--- /dev/null
+;;; gimpedit.el --- Edit files with GIMP
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Wed May 23 14:59:50 2007
+(defconst gimpedit:version "0.31") ;;Version:
+;; Last-Updated: 2009-11-03 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+ ;; `setup-helper', `w32-reg-iface', `w32-regdat'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Simple interface to start editing with GIMP.
+;;
+;; If you want to edit files from within Emacs see the doc string of
+;; `gimpedit-edit-buffer'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-and-compile (require 'w32-regdat nil t))
+
+;; (message "%S" (gimpedit-get-remote-command))
+(defun gimpedit-get-remote-command ()
+ (if (featurep 'w32-regdat)
+ (save-match-data
+ (let ((cmd (w32-regdat-gimp-win-remote-cmd))
+ cmd-list)
+ (while (< 0 (length cmd))
+ (cond
+ ((or (string-match (rx string-start
+ ?\"
+ (submatch
+ (0+ (not (any ?\"))))
+ ?\"
+ (0+ space))
+ cmd)
+ (string-match (rx string-start
+ (submatch
+ (0+ (not (any space))))
+ (0+ space))
+ cmd))
+ (setq cmd-list (cons (match-string-no-properties 1 cmd) cmd-list))
+ (setq cmd (substring cmd (match-end 0))))))
+ (cadr cmd-list)))
+ (if (memq system-type '(windows-nt))
+ (let (prog)
+ (catch 'found-prog
+ (dolist (num '(2 3 4 5 6 7 8 9))
+ (setq prog (concat (getenv "ProgramFiles")
+ "\\GIMP-2.0\\bin\\gimp-2."
+ (number-to-string num)
+ ".exe"))
+ (when (file-exists-p prog)
+ (throw 'found-prog prog)))))
+ "gimp")))
+
+;;;###autoload
+(defgroup gimpedit nil
+ "Customization group for GIMP."
+ :group 'external
+ :group 'nxhtml)
+
+(defcustom gimpedit-remote-command (gimpedit-get-remote-command)
+ "Program name to use when calling GIMP remotely.
+This could be be the full path to the program used when opening
+files with GIMP or a just the program file name if it is in the
+executables path.
+
+Example:
+
+ The value is fetched from the registry on MS Windows if
+ possible or is else given the default value:
+
+ \"C:\\Program Files\\GIMP-2.0\\bin\\gimp-2.6.exe\"
+
+ On other system it has the default value
+
+ \"gimp\"."
+ :type '(choice (file :tag "Full file name" :must-match t)
+ (string :tag "File name (must be in path)"))
+ :group 'gimpedit)
+
+;;;###autoload
+(defun gimpedit-edit-file (image-file &optional extra-args)
+ "Edit IMAGE-FILE with GIMP.
+See also `gimpedit-edit-file'."
+ (interactive (list (or (get-char-property (point) 'image-file)
+ (read-file-name "Image to edit in GIMP: "))))
+ (setq image-file (expand-file-name image-file))
+ (apply 'call-process gimpedit-remote-command
+ nil
+ 0
+ nil
+ (reverse (cons image-file (reverse extra-args))))
+ (let ((msg " Asked GIMP to open %s - you may have to switch to GIMP"))
+ (put-text-property 0 (length msg) 'face 'highlight msg)
+ (message msg (file-name-nondirectory image-file))))
+
+;;;###autoload
+(defun gimpedit-edit-buffer ()
+ "Edit image file in current buffer with GIMP.
+See also `gimpedit-edit-file'.
+
+You may also be interested in gimpedit-mode with which you can edit
+gimp files from within Emacs using GIMP's scripting
+possibilities. See
+
+ URL `http://www.emacswiki.org/emacs/GimpMode'"
+ (interactive)
+ (unless (buffer-file-name)
+ (error
+ "Can't edit in GIMP because this buffer does not have a file name."))
+ (gimpedit-edit-file (buffer-file-name)))
+
+;;;###autoload
+(defun gimpedit-can-edit (file-name)
+ (and file-name
+ (member (downcase (file-name-extension file-name))
+ '("png" "gif" "jpg" "jpeg"))))
+
+;; (defcustom gimpedit-point-key-bindings '(([(control ?c) ?&] gimpedit-edit-file))
+;; "Key bindings suggested for image links etc."
+;; :type '(repeat (list key-sequence function))
+;; :group 'gimpedit)
+
+;; (defun gimpedit-add-point-bindings (map)
+;; "Add `gimpedit-point-key-bindings' to point keymap MAP.
+;; Set it up like this:
+
+;; (eval-after-load 'gimpedit
+;; '(gimpedit-add-point-bindings MY-MAP))
+
+;; There must also be a character property `image-file' at point for this
+;; to work."
+;; (dolist (binding gimpedit-point-key-bindings)
+;; (let ((key (nth 0 binding))
+;; (fun (nth 1 binding)))
+;; (define-key map key fun))))
+
+(provide 'gimpedit)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; gimpedit.el ends here
--- /dev/null
+;;; gpl.el --- Highlight and edit gpl color palettes
+
+(defconst gpl:version "0.01")
+;; Copyright (C) 2008 Niels Giesen
+
+;; Author: Niels Giesen
+;; Keywords: extensions, tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; GPL provides font-locking and has functions to edit the values
+;; of colors (hue, saturation value, red, green and blue vals)
+;; in-place in a simple, intuitive, and lightweight fashion. See the
+;; documentation of `gpl-mode'.
+
+;; The methods and keybindings used are roughly the same as in the new
+;; css-color mode. I should maybe have abstracted both color notation
+;; models better, but did not feel like it. With under 200 lines of
+;; code, it did not seem worth the effort.
+
+;; The css-color.el used is the one by Niels Giesen, at
+;; `http://niels.kicks-ass.org/public/elisp/css-color.el'.
+
+;; Installation:
+
+;; Put this file in your load-path. Put a declaration such as
+
+;; (autoload 'gpl-mode "gpl")
+;; (add-to-list 'auto-mode-alist
+;; '("\\.gpl\\'" . gpl-mode))
+
+;; In your initialization file (e.g. ~/.emacs) to make sure `gpl-mode'
+;; is started anytime you open a *.gpl file, and gpl-mode is only
+;; loaded when needed.
+
+;;; Code:
+(require 'css-color)
+
+(defvar gpl-keywords
+ '(("^[[:space:]]*\\([a-fA-F[:digit:]]\\{1,3\\}\\)[[:space:]]+\\([a-fA-F[:digit:]]\\{1,3\\}\\)[[:space:]]+\\([a-fA-F[:digit:]]\\{1,3\\}\\)"
+ (0
+ (let ((color (concat "#" (apply 'css-color-rgb-to-hex
+ (mapcar 'string-to-number
+ (list
+ (match-string-no-properties 1)
+ (match-string-no-properties 2)
+ (match-string-no-properties 3)))))))
+
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'keymap gpl-map)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'face (list :background
+ color
+ :foreground
+ (css-color-foreground-color
+ color))))))))
+
+;;;###autoload
+(define-derived-mode gpl-mode fundamental-mode "GPL"
+ "Mode for font-locking and editing color palettes of the GPL format.
+
+Such palettes are used and produced by free software applications
+such as the GIMP, Inkscape, Scribus, Agave and on-line tools such
+as http://colourlovers.com.
+
+You can also use
+URL `http://niels.kicks-ass.org/public/elisp/css-palette.el' to import
+such palette into a css-file as hexadecimal color palette."
+ (setq font-lock-defaults
+ '((gpl-keywords)
+ t)))
+
+(defvar gpl-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "=" 'gpl-up)
+ (define-key m "-" 'gpl-down)
+ (define-key m "h" 'gpl-hue-up)
+ (define-key m "H" 'gpl-hue-down)
+ (define-key m "v" 'gpl-value-up)
+ (define-key m "V" 'gpl-value-down)
+ (define-key m "s" 'gpl-saturation-up)
+ (define-key m "S" 'gpl-saturation-down)
+ m)
+ "Mode map for `gpl-mode'")
+
+(defun gpl-get-color-at-point ()
+ (or (get-text-property (point) 'color)
+ (apply 'css-color-rgb-to-hsv
+ (gpl-get-rgb-list-at-point))))
+
+(defun gpl-get-rgb-list-at-point ()
+ (mapcar 'string-to-number
+ (split-string
+ (buffer-substring-no-properties
+ (point-at-bol)
+ (+ 11 (point-at-bol))) "[[:space:]]+" t)))
+
+(defun gpl-replcolor-at-p (fun increment)
+ (let ((pos (point)))
+ (beginning-of-line)
+ (insert
+ (funcall fun
+ (gpl-get-color-at-point)
+ increment))
+ (delete-region (point) (+ (point) 11))
+ (goto-char pos)))
+
+(defun gpl-hsv-to-gimp-color (h s v)
+ (propertize
+ (apply 'format "%3d %3d %3d"
+ (css-color-hsv-to-rgb h s v))
+ 'keymap gpl-map
+ 'color (list h s v)))
+
+(defun gpl-what-channel ()
+ (/ (- (point) (point-at-bol)) 4))
+
+(defun gpl-adjust-channel-at-p (incr)
+ (interactive "p")
+ (let ((pos (point))
+ (channel (gpl-what-channel)))
+ (beginning-of-line)
+ (let ((rgb
+ (gpl-get-rgb-list-at-point)))
+ (setf (nth channel rgb)
+ (css-color-within-bounds
+ (+ incr (nth channel rgb))
+ 0 255))
+ (delete-region (point) (+ 11 (point)))
+ (insert
+ (propertize
+ (apply 'format "%3d %3d %3d" rgb)
+ 'keymap gpl-map
+ 'color nil)))
+ (goto-char pos)))
+
+(defun gpl-inchue (color incr)
+ (destructuring-bind (h s v) color
+ (gpl-hsv-to-gimp-color
+ (+ incr h) s v)))
+
+(defun gpl-incsat (color incr)
+ (destructuring-bind (h s v) color
+ (gpl-hsv-to-gimp-color
+ h (css-color-within-bounds (+ incr s) 0 100) v)))
+
+(defun gpl-incval (color incr)
+ (destructuring-bind (h s v) color
+ (gpl-hsv-to-gimp-color
+ h s (css-color-within-bounds (+ incr v) 0 100))))
+
+(defun gpl-adj-hue-at-p (increment)
+ (interactive "p")
+ (gpl-replcolor-at-p 'gpl-inchue increment))
+
+(defun gpl-adj-saturation-at-p (increment)
+ (interactive "p")
+ (gpl-replcolor-at-p 'gpl-incsat increment))
+
+(defun gpl-adj-value-at-p (increment)
+ (interactive "p")
+ (gpl-replcolor-at-p 'gpl-incval increment))
+
+;; channels (r, g, b)
+(defun gpl-up (val)
+ (interactive "p")
+ (gpl-adjust-channel-at-p val))
+
+(defun gpl-down (val)
+ (interactive "p")
+ (gpl-adjust-channel-at-p (- val)))
+;; hue
+(defun gpl-hue-up (val)
+ (interactive "p")
+ (gpl-adj-hue-at-p val))
+
+(defun gpl-hue-down (val)
+ (interactive "p")
+ (gpl-adj-hue-at-p (- val)))
+;; saturation
+(defun gpl-saturation-up (val)
+ (interactive "p")
+ (gpl-adj-saturation-at-p val))
+
+(defun gpl-saturation-down (val)
+ (interactive "p")
+ (gpl-adj-saturation-at-p (- val)))
+;; value
+(defun gpl-value-up (val)
+ (interactive "p")
+ (gpl-adj-value-at-p val))
+
+(defun gpl-value-down (val)
+ (interactive "p")
+ (gpl-adj-value-at-p (- val)))
+
+(provide 'gpl)
+;;; gpl.el ends here
--- /dev/null
+;;; hfyview.el --- View current buffer as html in web browser
+
+;; Copyright (C) 2005, 2006, 2007 by Lennart Borgman
+
+;; Author: Lennart Borgman
+;; Created: Fri Oct 21 2005
+(defconst hfyview:version "0.63") ;; Version:
+;; Last-Updated: 2010-04-16 Fri
+;; Keywords: printing
+;; URL: http://OurComments.org/Emacs/DL/elisp/hfyview.el
+;; Compatibility:
+;;
+;;
+;; Features that might be required by this library:
+;;
+ ;; `easymenu'.
+;;
+;;
+;; htmlfontify.el is part of Emacs.
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This file shows the current buffer in your web browser with all
+;; the colors it has. The purpose is mainly to make it possible to
+;; easily print what you see in Emacs in colors on different
+;; platforms.
+;;
+;; Put this file in your load-path and in your .emacs this:
+;;
+;; (require 'hfyview)
+;;
+;; This defines the commands `hfyview-buffer', `hfyview-region' and
+;; `hfyview-window' which will show the whole or a part of the buffer
+;; in your web browser.
+;;
+;; You can add those commands to the menus by customizing
+;; `hfyview-quick-print-in-files-menu' to t. This will add an entry
+;; "Quick Print (Using Web Browser)" to the files menu.
+;;
+;;
+;; There is also a command `hfyview-frame' to take a "screen shot" of
+;; your current frame and produce an html look-alike page. If you
+;; turn on `hfyview-frame-mode' you get this function on the <apps>
+;; key in most situations.
+;;
+;;
+;; You can see an example of the output here:
+;;
+;; http://ourcomments.org/Emacs/nXhtml/doc/htmlfontify-example.html
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; To find out more about the GNU General Public License you can visit
+;; Free Software Foundation's website http://www.fsf.org/. Or, write
+;; to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'htmlfontify))
+(require 'easymenu)
+
+(defvar hfyview-selected-window)
+
+(defvar hfyview-frame-mode-emulation-map
+ (let ((m (make-sparse-keymap)))
+ ;;(define-key m [apps] 'hfyview-frame)
+ m))
+
+(defvar hfyview-frame-mode-emulation-maps
+ (list (cons 'hfyview-frame-mode hfyview-frame-mode-emulation-map)))
+
+;; Fix-me: which are needed? Probably only viper, but have to test.
+(defconst hfyview-frame-mode-other-maps
+ '(
+ hfyview-frame-mode-emulation-map
+ minibuffer-local-completion-map
+ minibuffer-local-filename-completion-map
+ minibuffer-local-isearch-map
+ minibuffer-local-map
+ ;; minibuffer-local-must-match-filename-map
+ minibuffer-local-must-match-map
+ minibuffer-local-ns-map
+ viper-minibuffer-map
+ isearch-mode-map))
+
+(define-minor-mode hfyview-frame-mode
+ "Define some useful things for `hfyview-frame'.
+The <apps> key is bound to `hfyview-frame' in this mode. When
+this mode is on you can push <apps> to get all of what you see on
+the screen. Without it the minibuffer/echo area will not be
+shown."
+ :global t
+ :group 'htmlfontify
+ (if hfyview-frame-mode
+ (progn
+ (add-hook 'pre-command-hook 'hfy-grab-minibuffer-content)
+ (add-hook 'post-command-hook 'hfy-grab-echo-content)
+ (add-to-list 'emulation-mode-map-alists 'hfyview-frame-mode-emulation-maps)
+ (dolist (map hfyview-frame-mode-other-maps)
+ (define-key (symbol-value map) [(apps)] 'hfyview-frame)
+ )
+ )
+ (remove-hook 'pre-command-hook 'hfy-grab-minibuffer-content)
+ (remove-hook 'post-command-hook 'hfy-grab-echo-content)
+ (setq emulation-mode-map-alists (delq 'hfyview-frame-mode-emulation-maps emulation-mode-map-alists))
+ (dolist (map hfyview-frame-mode-other-maps)
+ (define-key (symbol-value map) [(apps)] nil))))
+
+(defun hfyview-fontify-region (start end)
+ "Fontify region between START and END the htmlfontify way."
+ ;; If the last command in mumamo resulted in a change of major-mode
+ ;; the big bug watcher in mumamo will get us if we do not tell that
+ ;; we know what we are doing:
+ (let ((mumamo-just-changed-major nil))
+ (if start
+ (save-restriction
+ (widen)
+ (narrow-to-region start end)
+ (assert (= end (point-max)))
+ (assert (= start (point-min)))
+ (htmlfontify-buffer))
+ (htmlfontify-buffer))))
+
+(defun hfyview-buffer-1(start end show-source)
+ "Convert current buffer between START and END to html.
+If SHOW-SOURCE is non-nil then also show produced html in other
+window."
+ (let ((hbuf (hfyview-fontify-region start end)))
+ (with-current-buffer hbuf
+ (setq buffer-file-name nil)
+ (browse-url-of-buffer))
+ (when show-source (switch-to-buffer-other-window hbuf))
+ hbuf))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;; Menus
+
+(defvar hfyview-print-menu (make-sparse-keymap "QP"))
+(defvar hfyview-print-region-menu (make-sparse-keymap "QPR"))
+(defvar hfyview-print-window-menu (make-sparse-keymap "QPW"))
+(defun hfyview-add-to-files-menu ()
+ "Add \"Quick Print\" entry to file menu."
+ ;; Why did I redo this???
+ (setq hfyview-print-menu (make-sparse-keymap "QP"))
+ (setq hfyview-print-region-menu (make-sparse-keymap "QPR"))
+ (setq hfyview-print-window-menu (make-sparse-keymap "QPW"))
+ ;; Main
+ (define-key-after menu-bar-file-menu [hfyview-print]
+ (list 'menu-item
+ "Quick Print (Using Web Browser)"
+ hfyview-print-menu
+ :visible 'hfyview-print-visible)
+ 'separator-print)
+ ;; Main submenu
+ (define-key hfyview-print-menu [hfyview-browser-frame-pre]
+ '(menu-item "Print Preview Frame" hfyview-frame
+ :help "Print preview frame with web browser"))
+ (define-key hfyview-print-menu [hfyview-browser-window-pre]
+ '(menu-item "Print Preview Window" hfyview-window
+ :help "Print preview window with web browser"))
+ (define-key hfyview-print-menu [hfyview-browser-region-pre]
+ (list 'menu-item "Print Preview Region" 'hfyview-region
+ :help "Print preview region with web browser"
+ :enable 'mark-active))
+ (define-key hfyview-print-menu [hfyview-separator-pre]
+ '(menu-item "--"))
+ (define-key hfyview-print-menu [hfyview-browser-pre]
+ '(menu-item "Print Preview Buffer" hfyview-buffer
+ :help "Print preview buffer with web browser"
+ :visible t))
+ )
+
+;;;###autoload
+(defcustom hfyview-quick-print-in-files-menu nil
+ "Add Quick print entries to File menu if non-nil.
+If you set this to nil you have to restart Emacs to get rid of
+the Quick Print entry."
+ :type 'boolean
+ :set (lambda (sym val)
+ (set-default sym val)
+ (if val
+ (hfyview-add-to-files-menu)))
+ :group 'hfy-view)
+
+(defvar hfyview-print-visible t
+ "Non-nil means show Quick Print entry on the file menu.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;; Interactive commands
+
+;;;###autoload
+(defun hfyview-buffer (arg)
+ "Convert buffer to html preserving faces and show in web browser.
+With command prefix ARG also show html source in other window."
+ (interactive "P")
+ (hfyview-buffer-1 nil nil arg))
+
+;;;###autoload
+(defun hfyview-region (arg)
+ "Convert region to html preserving faces and show in web browser.
+With command prefix ARG also show html source in other window."
+ (interactive "P")
+ (hfyview-buffer-1 (region-beginning) (region-end) arg))
+
+;;;###autoload
+(defun hfyview-window (arg)
+ "Convert window to html preserving faces and show in web browser.
+With command prefix ARG also show html source in other window."
+ (interactive "P")
+ (hfyview-buffer-1 (window-start) (window-end) arg))
+
+;;;###autoload
+(defun hfyview-frame (whole-buffers)
+ "Convert frame to html preserving faces and show in web browser.
+Make an XHTML view of the current Emacs frame. Put it in a buffer
+named *hfyview-frame* and show that buffer in a web browser.
+
+If WHOLE-BUFFERS is non-nil then the whole content of the buffers
+is shown in the XHTML page, otherwise just the part that is
+visible currently on the frame.
+
+If you turn on the minor mode `hfyview-frame-mode' you can also
+get the minibuffer/echo area in the output. See this mode for
+details.
+
+With command prefix also show html source in other window."
+ (interactive (list (y-or-n-p "Enter y for whole buffers, n for only visible part? ")))
+ (let ((title "Emacs - Frame Dump")
+ buf)
+ (setq title (frame-parameter (selected-frame) 'name))
+ (setq buf (hfyview-frame-1 whole-buffers title))
+ (when current-prefix-arg
+ (switch-to-buffer-other-window buf))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;; Internal commands
+
+(defconst hfyview-modline-format
+ ;; There seems to be a bug in Firefox that prevents this from
+ ;; displaying correctly. Anyway this is just a quick and reasonable
+ ;; approximation.
+ (concat "<div style=\"width:%sem; color:%s; background:%s; white-space:pre; overflow:hidden; font-family:monospace;\">"
+ ;; Using <pre> gives empty line above and below
+ ;;"<pre>"
+ "-- (Unix)%s <b>%s</b> (%s%s) "
+ (make-string 6 ?-)
+ "%s" ;; Viper
+ (make-string 200 ?-)
+ ;;"</pre>"
+ "</div>"))
+
+(defun hfyview-get-minors ()
+ "Return string with active minor mode highlighters."
+ (let ((minors ""))
+ (dolist (mr minor-mode-alist)
+ (let ((mm (car mr))
+ (ml (cadr mr)))
+ (when (symbol-value mm)
+ (when (stringp ml)
+ (setq minors (concat minors ml))))))
+ minors))
+
+;; (hfyview-dekludge-string "<i> ")
+(defun hfyview-dekludge-string (str)
+ "Return html quoted string STR."
+ (mapconcat (lambda (c)
+ (hfy-html-quote
+ (char-to-string c)))
+ (append str)
+ ""))
+
+(defvar viper-mode-string) ;; Silence compiler
+
+(defun hfyview-fontify-win-to (win tag whole-buffer)
+ "Return html code for window WIN.
+Sorround the code with the html tag <TAG>.
+WHOLE-BUFFER corresponds to the similar argument for
+`hfyview-frame-1'."
+ (let* ((bstart (unless whole-buffer (window-start win)))
+ (bend (unless whole-buffer (window-end win)))
+ (hbuf (hfyview-fontify-region bstart bend))
+ (edges (window-edges win))
+ (width (- (nth 2 edges) (nth 0 edges)))
+ (height (- (nth 3 edges) (nth 1 edges)))
+ (border-color (or (hfy-triplet "SystemActiveBorder")
+ "gray"))
+ start
+ end
+ css-start
+ css-end
+ mod-fgcolor
+ mod-bgcolor
+ mod-width
+ mod
+ bu-name
+ ma-name
+ minors
+ (window-start-line (point-min))
+ (window-end-line (point-max))
+ (is-selected-window (eq win hfyview-selected-window))
+ (mark-viper "")
+ )
+ ;; Fix-me: fetch style too
+ (with-current-buffer (window-buffer win)
+ (unless whole-buffer
+ (save-restriction
+ (widen)
+ (setq window-start-line (line-number-at-pos bstart))
+ (setq window-end-line (line-number-at-pos bend))
+ (unless (or (< (line-number-at-pos (point-min)) window-start-line)
+ (> (line-number-at-pos (point-max)) window-end-line))
+ (setq whole-buffer t))
+ )
+ )
+ (setq mod-fgcolor (face-attribute (if is-selected-window 'mode-line 'mode-line-inactive) :foreground))
+ (setq mod-bgcolor (face-attribute (if is-selected-window 'mode-line 'mode-line-inactive) :background))
+ (setq mod-fgcolor (hfy-triplet mod-fgcolor))
+ (setq mod-bgcolor (hfy-triplet mod-bgcolor))
+ (setq mod (if (buffer-modified-p) "**" "--"))
+ (when buffer-read-only
+ (setq mod "%%"))
+ (setq bu-name (buffer-name))
+ (setq ma-name mode-name)
+ (setq minors (hfyview-get-minors))
+ (when (and (local-variable-p 'viper-mode-string) viper-mode-string)
+ (setq mark-viper viper-mode-string))
+ )
+ ;; Compensate for scroll-bars
+ (setq mod-width (+ width 1))
+ (with-current-buffer hbuf
+ (setq width (- width 2.5))
+ (setq width (* 0.57 width))
+ (setq height (+ height 2)) ;; For pre
+ ;;(setq height (+ height 1.2)) ;; For horisontal scrollbar
+ (setq height (* 1.16 height))
+ (goto-char (point-min))
+ (re-search-forward "<body.*?>")
+ (setq start (point))
+ (insert
+ (format "<%s style=\"width:%sem; height:%sem; border: 1px solid %s; overflow:%s; padding:4px;\">\n"
+ tag width height border-color
+ (if whole-buffer "auto" "hidden") ;; overflow
+ ))
+ (goto-char (point-max))
+ (setq end (search-backward "</body>"))
+ (unless whole-buffer
+ (insert
+ (format "\n<div style=\"margin-top:2em; color: red; text-align: center; \"> Truncated to line %s - %s! </div>\n"
+ window-start-line window-end-line)))
+ (insert "</" tag ">\n")
+ ;;(lwarn t :warning "%s" mark-viper)
+ (insert (format hfyview-modline-format
+ width
+ mod-fgcolor mod-bgcolor mod
+ (hfyview-dekludge-string bu-name)
+ (hfyview-dekludge-string ma-name)
+ (hfyview-dekludge-string minors)
+ (hfyview-dekludge-string mark-viper)))
+ (setq end (point))
+ (goto-char (point-min))
+ (search-forward "<style type=\"text/css\"><!--")
+ (beginning-of-line)
+ (setq css-start (point))
+ (search-forward "--></style>")
+ (setq css-end (point))
+ (set-buffer-modified-p nil)
+ (setq buffer-file-name nil))
+ (list hbuf start end css-start css-end)))
+
+;; (defun hfyview-window-framed ()
+;; "Just a test"
+;; (interactive)
+;; (let* ((res (hfyview-fontify-win-to (selected-window) "div" nil))
+;; (hbuf (nth 0 res)))
+;; (with-current-buffer hbuf
+;; (browse-url-of-buffer))))
+
+(defun hfyview-fontify-tree-win (win whole-buffer)
+ "Return html code for window WIN.
+WHOLE-BUFFER corresponds to the similar argument for
+`hfyview-frame-1'."
+ (with-selected-window win
+ (let* ((start (window-start))
+ (end (window-end))
+ (res (hfyview-fontify-win-to win "div" whole-buffer))
+ (hbuf (nth 0 res)))
+ (with-current-buffer hbuf
+ (rename-buffer (generate-new-buffer-name (format "%s %s-%s" win start end))))
+ ;;(lwarn t :warning "win=%s, hbuf=%s" win hbuf)
+ res)))
+
+(defun hfyview-fontify-tree (wt whole-buffers)
+ "Return list of html code for all windows in tree WT.
+WT should be the result of function `window-tree' or a subtree of
+this. For WHOLE-BUFFERS see `hfyview-frame-1'."
+ (if (not (listp wt))
+ (hfyview-fontify-tree-win wt whole-buffers)
+ (let ((ret))
+ (dolist (w (cddr wt))
+ (setq ret (cons (hfyview-fontify-tree w whole-buffers) ret)))
+ (list (car wt) ret))))
+
+(defun hfyview-frame-to-html (res)
+ "Return list with css and html code for frame.
+RES is the collected result from `hfyview-fontify-tree'."
+ (let ((html "")
+ (css "")
+ (first (car res))
+ (td "<td style=\"vertical-align:top;\">")
+ h)
+ (cond
+ ((memq first '(nil t))
+ (dolist (sub (reverse (cadr res)))
+ (let* ((fres (hfyview-frame-to-html sub))
+ (h (nth 0 fres))
+ (c (nth 1 fres)))
+ (when first (setq h (concat "<tr>\n" h "</tr>\n")))
+ (setq html (concat html h))
+ (setq css (concat css c))))
+ (unless first
+ (setq html (concat "<tr>" html "</tr>\n")))
+ (setq html (concat "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\">\n" html "</table>\n"))
+ (setq html (concat td html "</td>\n"))
+ )
+ ((bufferp first)
+ ;; (buf start end)
+ (let* ((buf (nth 0 res))
+ (sta (nth 1 res))
+ (end (nth 2 res))
+ (cst (nth 3 res))
+ (cnd (nth 4 res))
+ (h
+ ;;(concat "<td>" "temp" "</td>\n")
+ (with-current-buffer buf (buffer-substring-no-properties sta end)))
+ (c
+ ;;(concat "<td>" "temp" "</td>\n")
+ (with-current-buffer buf (buffer-substring-no-properties cst cnd))))
+ (setq h (concat td h
+ "</td>\n"))
+ (setq html (concat html h))
+ (setq css c)
+ (kill-buffer buf)))
+ (t
+ (error "Uh?")))
+ (list html css)))
+
+(defconst hfyview-xhtml-header
+ "<?xml version=\"1.0\" encoding=\"utf-8\"?>
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\">
+ <head>
+ <title>%s</title>
+<style type=\"text/css\"><!--
+body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
+ --></style>
+%s
+ </head>
+ <body>\n")
+
+(defvar hfyview-xhtml-footer "</body>\n</html>\n")
+
+(defun hfyview-wm-border-color ()
+ "Return CSS code for color to use in window borders."
+ (or (hfy-triplet "SystemActiveTitle")
+ (hfy-triplet "blue")))
+
+(defvar hfy-grabbed-echo-content nil)
+(defvar hfy-grabbed-minibuffer-content nil)
+(defvar hfyview-prompt-face nil)
+
+(defun hfyview-frame-minibuff (use-grabbed)
+ "Return html code for minibuffer.
+If USE-GRABBED is non-nil use what has been grabbed by
+`hfy-grab-echo-content' or `hfy-grab-minibuffer-content'.
+Otherwise make a default content for the minibuffer."
+ (if (and use-grabbed
+ (or hfy-grabbed-echo-content
+ hfy-grabbed-minibuffer-content))
+ (let* ((str (if hfy-grabbed-echo-content
+ hfy-grabbed-echo-content
+ hfy-grabbed-minibuffer-content))
+ (tmpbuf (get-buffer-create "*hfy-minibuff-temp*"))
+ (hbuf (with-current-buffer tmpbuf
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ ;; Fix-me: move the propertize to a new
+ ;; copy-buffer in hfy-fontify-buffer. Explained
+ ;; in mail to Vivek.
+ (insert (propertize str
+ 'read-only nil
+ 'intangible nil
+ 'field nil
+ 'modification-hooks nil
+ 'insert-in-front-hooks nil
+ 'insert-behind-hooks nil
+ 'point-entered nil
+ 'point-left nil
+ 'font-sticky nil
+ 'rear-nonsticky nil
+ ))
+ (htmlfontify-buffer))))
+ bdy-start
+ bdy-end
+ bdy-txt
+ css-start
+ css-end
+ css-txt)
+ (with-current-buffer hbuf
+ (goto-char (point-min))
+ (search-forward "<style type=\"text/css\"><!--")
+ (beginning-of-line)
+ (setq css-start (point))
+ (search-forward "--></style>")
+ (setq css-end (point))
+ (goto-char (point-min))
+ (search-forward "<pre>")
+ (setq bdy-start (point))
+ (goto-char (point-max))
+ (search-backward "</pre>")
+ (setq bdy-end (point))
+ (list (buffer-substring css-start css-end)
+ (buffer-substring bdy-start bdy-end))))
+ (let ((mini-bg (face-attribute hfyview-prompt-face :background))
+ (mini-fg (face-attribute hfyview-prompt-face :foreground)))
+ (if (eq mini-fg 'unspecified)
+ (setq mini-fg "")
+ (setq mini-fg (concat "color:" (hfy-triplet mini-fg) "; ")))
+ (if (eq mini-bg 'unspecified)
+ (setq mini-bg "")
+ (setq mini-bg (concat "background:" (hfy-triplet mini-bg) "; ")))
+ (list nil
+ (concat
+ "<span style=\"" mini-fg mini-bg "\">"
+ " M-x "
+ "</span>"
+ " "
+ "hfyview-frame"
+ )))))
+
+(defun hfyview-frame-1(whole-buffers frame-title)
+ "Return buffer with html code for current frame.
+If WHOLE-BUFFERS is non-nil then make scrollable buffers in the
+html output. Otherwise just make html code for the currently
+visible part of the buffers.
+
+FRAME-TITLE is the title to show on the resulting html page."
+ (let* ((wt (window-tree))
+ (hfyview-selected-window (selected-window))
+ (res (hfyview-fontify-tree (car wt) whole-buffers))
+ (title-bg-color (hfyview-wm-border-color))
+ (title-color (or (hfy-triplet "SystemHilightText")
+ "white"))
+ (title-style (concat (format "background-color:%s; color:%s;" title-bg-color title-color)
+ "border: none; padding:4px; vertical-align: middle;"))
+ (outbuf (get-buffer-create "frame"))
+ html
+ css
+ ;; (face-attribute 'minibuffer-prompt :foreground)
+ (hfyview-prompt-face (plist-get minibuffer-prompt-properties 'face))
+ minibuf
+ (frame-width (* 0.56 (frame-width)))
+ table-style
+ (icon-file (expand-file-name "../etc/images/icons/emacs_16.png" exec-directory))
+ (img-tag (if (file-exists-p icon-file)
+ (concat "<img src=\"file://" icon-file "\" height=\"16\" width=\"16\" />")))
+ mini-css
+ mini-html
+ )
+ (setq table-style
+ (format "border: solid %s; width:%sem;"
+ (hfyview-wm-border-color)
+ frame-width
+ ))
+ (setq minibuf (hfyview-frame-minibuff hfyview-frame-mode))
+ (setq mini-css (nth 0 minibuf))
+ (setq mini-html (nth 1 minibuf))
+ (when (string= mini-html "") (setq mini-html " "))
+ (setq res (hfyview-frame-to-html res))
+ (setq html (nth 0 res))
+ (setq css (nth 1 res))
+ (with-current-buffer outbuf
+ ;;(lwarn t :warning "outbuf=%s" outbuf)
+ (erase-buffer)
+ (insert (format hfyview-xhtml-header
+ (concat "Emacs frame dump - " frame-title)
+ css)
+ (if mini-css mini-css "")
+ (format "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" style=\"%s\">\n" table-style)
+ "<tr>\n"
+ (format "<td style=\"%s\">%s %s</td>\n" title-style img-tag
+ (hfyview-dekludge-string frame-title))
+ "</tr>\n"
+ "<tr>\n"
+ html
+ "</tr>\n"
+ "<tr>\n"
+ "<td style=\"padding:1px;\">\n"
+ mini-html
+ "</td>\n"
+ "</tr>\n"
+ "</table>\n"
+ hfyview-xhtml-footer)
+ (browse-url-of-buffer)
+ outbuf)))
+
+(defun hfy-grab-echo-content ()
+ "Return echo area content."
+ (setq hfy-grabbed-echo-content (current-message)))
+
+(defun hfy-grab-minibuffer-content ()
+ "Return minibuffer content."
+ ;;(interactive)
+ (let* ((mw (minibuffer-window))
+ (mb (window-buffer mw)))
+ (setq hfy-grabbed-minibuffer-content
+ (with-current-buffer mb
+ (buffer-substring
+ (point-min) (point-max)))
+ )))
+
+;;(add-hook 'pre-command-hook 'grab-minibuffer-content nil t)
+;;(remove-hook 'pre-command-hook 'grab-minibuffer-content) t)
+
+(provide 'hfyview)
+;;; hfyview.el ends here
--- /dev/null
+;;; hl-needed.el --- Turn on highlighting of line and column when needed
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Fri Nov 30 21:19:18 2007
+;; Version: 0.60
+;; Last-Updated: 2010-03-19 Fri
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/hl-needed.el
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+ ;; `hl-line', `vline'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This is yet another highlight line and/or column idea. The idea is
+;; to try to show line and column only when it is probably most
+;; needed. See `hl-needed-mode' for more info.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'hl-line)
+(require 'vline nil t)
+
+;;;###autoload
+(defgroup hl-needed nil
+ "Customization group for `hl-needed-mode'."
+ :group 'convenience)
+
+(defcustom hl-needed-always nil
+ "Highlight always.
+This is similar to turning on `vline-mode' and `hl-line-mode'"
+ :type 'boolean
+ :group 'hl-needed)
+
+(defcustom hl-needed-mark-line t
+ "Highlight line."
+ :type 'boolean
+ :group 'hl-needed)
+
+(defcustom hl-needed-mark-column t
+ "Highlight column."
+ :type 'boolean
+ :group 'hl-needed)
+
+(defcustom hl-needed-in-readonly-buffers nil
+ "Do not highlight in read-only buffers unless non-nil."
+ :type 'boolean
+ :group 'hl-needed)
+
+(defcustom hl-needed-not-in-modes
+ '(wab-compilation-mode
+ custom-mode)
+ "List of modes where highlighting should not be done."
+ :type '(repeat function)
+ :group 'hl-needed)
+
+;;(setq hl-needed-idle-time 5)
+(defcustom hl-needed-idle-time 20
+ "Highligh current line and/or column if Emacs is idle for more seconds.
+If nil do not turn on `hl-line-mode' when Emacs is idle."
+ :type '(choice (const :tag "Don't turn on when Emacs is idle" nil)
+ (integer :tag "Turn on after (seconds)"))
+ :group 'hl-needed)
+
+(defcustom hl-needed-on-mouse t
+ "Highlight current line and/or column on clicks."
+ :type 'boolean
+ :group 'hl-needed)
+
+(defcustom hl-needed-on-new-window t
+ "Highlight current line and/or column on new window selection."
+ :type 'boolean
+ :group 'hl-needed)
+
+(defcustom hl-needed-on-new-buffer t
+ "Highlight current line and/or column on new buffer selection."
+ :type 'boolean
+ :group 'hl-needed)
+
+(defcustom hl-needed-on-config-change t
+ "Highlight current line and/or column on window conf change."
+ :type 'boolean
+ :group 'hl-needed)
+
+(defcustom hl-needed-on-scrolling t
+ "Highlight current line and/or column after scrolling."
+ :type 'boolean
+ :group 'hl-needed)
+
+(defvar hl-needed-face 'hl-needed-face)
+(defface hl-needed-face
+ '((t (:inherit highlight)))
+ "Face for flashing."
+ :group 'hl-needed)
+
+(defcustom hl-needed-flash-delay 0.0
+ "Time to wait before turning on flash highlighting.
+If a key is pressed before this flash highlighting is not done."
+ :type 'float
+ :group 'hl-needed)
+
+(defcustom hl-needed-flash-duration 1.0
+ "Turn off flash highlighting after this number of second.
+Highlighting is turned off only if it was turned on because of
+some change. It will not be turned off if it was turned on
+because Emacs was idle for more than `hl-needed-idle-time'.
+
+The default time is choosen to not disturb too much. I believe
+human short attention may often be of this time. \(Compare eye
+contact time.)"
+ :type 'float
+ :group 'hl-needed)
+
+(defcustom hl-needed-currently-fun 'hl-needed-currently
+ "Function that checks if highlighting should be done.
+The function should return nil if not needed and non-nil
+otherwise."
+ :type 'function
+ :group 'hl-needed)
+
+(defvar hl-needed-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c) ?? ??] 'hl-needed-show)
+ map))
+
+;;;###autoload
+(define-minor-mode hl-needed-mode
+ "Try to highlight current line and column when needed.
+This is a global minor mode. It can operate in some different
+ways:
+
+- Highlighting can be on always, see `hl-needed-always'.
+
+Or, it can be turned on depending on some conditions. In this
+case highlighting is turned off after each command and turned on
+again in the current window when either:
+
+- A new window was selected, see `hl-needed-on-new-window'.
+- A new buffer was selected, see `hl-needed-on-new-buffer'.
+- Window configuration was changed, see `hl-needed-on-config-change'.
+- Buffer was scrolled see `hl-needed-on-scrolling'.
+- A window was clicked with the mouse, see `hl-needed-on-mouse'.
+
+After this highlighting may be turned off again, normally after a
+short delay, see `hl-needed-flash'.
+
+If either highlighting was not turned on or was turned off again
+it will be turned on when
+
+- Emacs has been idle for `hl-needed-idle-time' seconds.
+
+See also `hl-needed-not-in-modes' and `hl-needed-currently-fun'.
+
+Note 1: For columns to be highlighted vline.el must be available.
+
+Note 2: This mode depends on `hl-line-mode' and `vline-mode' and
+tries to cooperate with them. If you turn on either of these that
+overrides the variables for turning on the respective
+highlighting here."
+ :global t
+ :group 'hl-needed
+ ;;:keymap hl-needed-mode-map
+ (if hl-needed-mode
+ (progn
+ ;;(unless (memq major-mode hl-needed-not-in-modes) (setq hl-needed-window t))
+ (when (featurep 'hl-needed) (hl-needed-show))
+ (add-hook 'post-command-hook 'hl-needed-post-command)
+ (add-hook 'pre-command-hook 'hl-needed-pre-command)
+ (add-hook 'window-configuration-change-hook 'hl-needed-config-change)
+ )
+ (remove-hook 'post-command-hook 'hl-needed-post-command)
+ (remove-hook 'pre-command-hook 'hl-needed-pre-command)
+ (remove-hook 'window-configuration-change-hook 'hl-needed-config-change)
+ (hl-needed-cancel-timer)
+ (hl-needed-cancel-flash-timer)
+ (hl-needed-hide)))
+
+(defvar hl-needed-timer nil)
+(defvar hl-needed-flash-timer nil)
+(defvar hl-needed-window nil)
+(defvar hl-needed-buffer nil)
+(defvar hl-needed-window-start nil)
+(defvar hl-needed-flash-this nil)
+(defvar hl-needed-config-change nil)
+
+(defvar hl-needed-old-blink nil)
+(defun hl-needed-show ()
+ "Highlight current line and/or column now."
+ (interactive)
+ (when (with-no-warnings (called-interactively-p))
+ (setq hl-needed-flash-this nil)
+ (unless hl-needed-mode
+ (message "Use hl-needed-hide to remove highlighting")))
+ (setq hl-needed-old-blink nil) ;; So blink is not turned on by hl-needed-hide
+ (hl-needed-hide)
+ (unless (active-minibuffer-window)
+ (setq hl-needed-old-blink blink-cursor-mode)
+ (when blink-cursor-mode
+ (blink-cursor-mode -1)
+ ;;(when (timerp blink-cursor-timer) (cancel-timer blink-cursor-timer))
+ (blink-cursor-end)
+ )
+ (unless hl-line-mode
+ (when hl-needed-mark-line
+ (let ((hl-line-mode t)
+ (hl-line-sticky-flag nil)
+ (hl-line-face hl-needed-face))
+ (hl-line-highlight))))
+ (unless vline-mode
+ (when hl-needed-mark-column
+ (when (featurep 'vline)
+ (let ((vline-style 'face)
+ (vline-face hl-line-face)
+ (vline-current-window-only t))
+ (vline-show)))))))
+
+(defun hl-needed-hide ()
+ (interactive)
+ (when (and hl-needed-old-blink
+ (not blink-cursor-mode))
+ (blink-cursor-mode 1))
+ (setq hl-needed-old-blink nil)
+ (unless hl-line-mode
+ (hl-line-unhighlight))
+ (when (featurep 'vline)
+ (unless vline-mode
+ (vline-clear))))
+
+(defun hl-needed-cancel-timer ()
+ (when (timerp hl-needed-timer) (cancel-timer hl-needed-timer))
+ (setq hl-needed-timer nil))
+
+(defun hl-needed-start-timer (wait)
+ (hl-needed-cancel-timer)
+ (setq hl-needed-timer
+ (run-with-idle-timer wait
+ nil 'hl-needed-show-in-timer)))
+
+(defun hl-needed-show-in-timer ()
+ "Turn on with special error handling.
+Erros may go unnoticed in timers. This should prevent it."
+ (condition-case err
+ (save-match-data ;; runs in timer
+ (hl-needed-show))
+ (error
+ (lwarn 'hl-needed-show
+ :error "%s" (error-message-string err)))))
+
+(defun hl-needed-hide-in-timer ()
+ "Turn off with special error handling.
+Erros may go unnoticed in timers. This should prevent it."
+ (condition-case err
+ (unless hl-needed-always
+ (hl-needed-hide))
+ (error
+ (lwarn 'hl-needed-hide
+ :error "%s" (error-message-string err)))))
+
+(defun hl-needed-hide-flash-in-timer ()
+ "Turn off with special error handling.
+Erros may go unnoticed in timers. This should prevent it."
+ (condition-case err
+ (unless hl-needed-always
+ (hl-needed-hide)
+ (hl-needed-start-timer hl-needed-idle-time))
+ (error
+ (lwarn 'hl-needed-hide
+ :error "%s" (error-message-string err)))))
+
+(defun hl-needed-currently ()
+ "Check if `hl-line-mode' is needed in buffer."
+ ;; Check for change of buffer and window
+ (if hl-needed-always
+ t
+ (unless (or (memq major-mode hl-needed-not-in-modes)
+ isearch-mode
+ (and buffer-read-only
+ (not hl-needed-in-readonly-buffers)))
+ (or (and hl-needed-on-new-window
+ (not (eq hl-needed-window (selected-window))))
+ ;;(progn (message "here1") nil)
+ (and hl-needed-on-new-buffer
+ (not (eq hl-needed-buffer (current-buffer))))
+ ;;(progn (message "here2") nil)
+ (and hl-needed-on-config-change
+ hl-needed-config-change)
+ ;;(progn (message "here3") nil)
+ (and hl-needed-on-mouse
+ (listp last-input-event)
+ (memq (car last-input-event) '(mouse-1 mouse-2 mouse-3)))
+ ;;(progn (message "here4") nil)
+ (and hl-needed-on-scrolling
+ (and (not (eq hl-needed-window-start (window-start)))
+ (< 1
+ (abs
+ (- (line-number-at-pos hl-needed-window-start)
+ (line-number-at-pos (window-start)))))))))))
+
+(defun hl-needed-cancel-flash-timer ()
+ (when (timerp hl-needed-flash-timer) (cancel-timer hl-needed-flash-timer))
+ (setq hl-needed-flash-timer nil))
+
+(defun hl-needed-start-maybe-flash-timer ()
+ (when (and hl-needed-flash-this
+ (not hl-needed-always))
+ (hl-needed-cancel-flash-timer)
+ (setq hl-needed-flash-timer
+ (run-with-timer (+ hl-needed-flash-delay hl-needed-flash-duration)
+ nil 'hl-needed-hide-flash-in-timer))))
+
+(defvar hl-needed-pre-command-time (current-time))
+
+(defun hl-needed-check ()
+ ;; Cancel `hl-line-mode' and timer
+ (unless (active-minibuffer-window)
+ (if (funcall hl-needed-currently-fun)
+ (progn
+ ;; Some time calc for things that pause to show us where we are:
+ (let* ((time-pre hl-needed-pre-command-time)
+ (time-now (current-time))
+ (pre (+ (nth 1 time-pre) (* 0.0000001 (nth 2 time-pre))))
+ (now (+ (nth 1 time-now) (* 0.0000001 (nth 2 time-now)))))
+ (if (< 1 (- now pre)) ;; Fix-me: option?
+ nil ;; Don't show anything here, it just disturbs
+ ;;(hl-needed-show)
+ (hl-needed-start-timer hl-needed-flash-delay)
+ (hl-needed-start-maybe-flash-timer))))
+ ;; Submit an idle timer that can turn highlighting on.
+ (hl-needed-start-timer hl-needed-idle-time)))
+ (setq hl-needed-config-change nil)
+ (unless (active-minibuffer-window)
+ (setq hl-needed-window (selected-window))
+ (setq hl-needed-buffer (current-buffer))
+ (setq hl-needed-window-start (window-start))))
+
+(defvar hl-needed-after-active-minibuffer nil)
+
+(defun hl-needed-pre-command ()
+ ;;(message "active-minibuffer-window=%s" (active-minibuffer-window))
+ (setq hl-needed-after-active-minibuffer (active-minibuffer-window))
+ (condition-case err
+ (progn
+ (hl-needed-cancel-timer)
+ (hl-needed-cancel-flash-timer)
+ (hl-needed-hide)
+ (setq hl-needed-flash-this hl-needed-flash-duration)
+ (setq hl-needed-pre-command-time (current-time)))
+ (error
+ (message "hl-needed-pre-command error: %s" err))))
+
+(defun hl-needed-post-command ()
+ (condition-case err
+ (if (eq last-command 'keyboard-quit)
+ (hl-needed-hide)
+ (hl-needed-check))
+ (error
+ (message "hl-needed-post-command error: %s" err))))
+
+(defvar hl-needed-minibuffer-active nil)
+
+(defun hl-needed-config-change ()
+ (condition-case err
+ (if (active-minibuffer-window)
+ (setq hl-needed-minibuffer-active t)
+ ;; Changing buffer in the echo area is a config change. Catch this:
+ (setq hl-needed-config-change (not hl-needed-after-active-minibuffer))
+ (setq hl-needed-after-active-minibuffer nil)
+ (setq hl-needed-minibuffer-active nil))
+ (error
+ (message "hl-needed-config-change error: %s" err))))
+
+(provide 'hl-needed)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; hl-needed.el ends here
--- /dev/null
+;;; html-write.el --- Hide some tags for writing text in XHTML
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-10-03T01:29:44+0200 Thu
+(defconst html-write:version "0.6") ;; Version:
+;; Last-Updated: 2009-08-11 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; The minor mode `html-write-mode' displays simple tags like <i>,
+;; <b>, <em>, <strong> or <a> with appropriate faces (for example bold
+;; and italic) instead of displaying the tags.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; Silence byte compiler
+(defvar jit-lock-start)
+(defvar jit-lock-end)
+
+(eval-when-compile (require 'mumamo)) ;; Just for the defmacro ...
+(eval-when-compile (require 'mlinks nil t))
+
+;;;###autoload
+(defgroup html-write nil
+ "Customization group for html-write."
+ :group 'nxhtml
+ :group 'convenience)
+
+(defface html-write-base
+ '((t (:inherit font-lock-type-face)))
+ "Face from which other faces inherits."
+ :group 'html-write)
+
+(defface html-write-em
+ '((t (:inherit html-write-base :slant italic)))
+ "Face used for <em> tags."
+ :group 'html-write)
+
+(defface html-write-strong
+ '((t (:inherit html-write-base :weight bold)))
+ "Face used for <strong> tags."
+ :group 'html-write)
+
+(defface html-write-link
+ '((t (:inherit html-write-base :underline t)))
+ "Face used for <a> tags."
+ :group 'html-write)
+
+(defconst html-write-tag-list
+ '(("i" html-write-em-tag-actions)
+ ("b" html-write-strong-tag-actions)
+ ("em" html-write-em-tag-actions)
+ ("strong" html-write-strong-tag-actions)
+ ("a" html-write-a-tag-actions)
+ ;;("img" html-write-img-tag-actions t)
+ )
+ "List of tags that should be hidden.
+A record in the list has the format
+
+ \(TAG HANDLE [SINGLE])
+
+where
+- TAG is the tag name string.
+
+- HANDLE is a function to call when hiding the tag. It takes
+ three parameters, TAG-BEGIN, TAG-END and OVERLAY. TAG-BEGIN
+ and TAG-END are start and end of the start tag. OVERLAY is an
+ overlay used for faces, keymaps etc that covers the whole tag."
+ )
+
+(defun html-write-em-tag-actions (tag-begin tag-end overlay)
+ "Do actions for <em> tags for tag between TAG-BEGIN and TAG-END.
+OVERLAY is the overlay added by `html-write-mode' for this tag."
+ (overlay-put overlay 'face 'html-write-em))
+
+(defun html-write-strong-tag-actions (tag-begin tag-end overlay)
+ "Do actions for <strong> tags for tag between TAG-BEGIN and TAG-END.
+OVERLAY is the overlay added by `html-write-mode' for this tag."
+ (overlay-put overlay 'face 'html-write-strong))
+
+;; Fix-me
+(defun html-write-img-tag-actions (tag-begin tag-end overlay)
+ "Do actions for <img> tags for tag between TAG-BEGIN and TAG-END.
+OVERLAY is the overlay added by `html-write-mode' for this tag."
+ (save-match-data
+ (let ((here (point-marker))
+ href)
+ (save-restriction
+ (narrow-to-region tag-begin tag-end)
+ (goto-char tag-begin)
+ (when (looking-at (rx (*? anything)
+ (1+ space)
+ "src=\""
+ (submatch
+ (+ (not (any "\"\n"))))
+ "\""))
+ (setq href (match-string-no-properties 1))))
+ (when href
+ (overlay-put overlay 'display (concat "image " href))
+ (overlay-put overlay 'html-write-url href))
+ (goto-char (point)))))
+
+(defun html-write-point-entered-echo (left entered)
+ (let ((msg (get-char-property entered 'help-echo)))
+ (when msg (message "%s" msg))))
+
+(defun html-write-a-tag-actions (tag-begin tag-end overlay)
+ "Do actions for <a> tags for tag between TAG-BEGIN and TAG-END.
+OVERLAY is the overlay added by `html-write-mode' for this tag."
+ (save-match-data
+ (let ((here (point-marker))
+ href)
+ (save-restriction
+ (narrow-to-region tag-begin tag-end)
+ (goto-char tag-begin)
+ (when (looking-at (rx (*? anything)
+ (1+ space)
+ "href=\""
+ (submatch
+ (+ (not (any "\"\n"))))
+ "\""))
+ (setq href (match-string-no-properties 1))))
+ (when href
+ (overlay-put overlay 'face 'html-write-link)
+ (overlay-put overlay 'help-echo href)
+ ;; Fix-me: Seems like point-entered must be a text prop
+ (overlay-put overlay 'point-entered 'html-write-point-entered-echo)
+ (overlay-put overlay 'mouse-face 'highlight)
+ (if (eq ?# (string-to-char href))
+ (setq href (concat "file:///" buffer-file-name href))
+ (when (file-exists-p href)
+ (setq href (expand-file-name href))))
+ (overlay-put overlay 'html-write-url href))
+ (goto-char (point)))))
+
+(defun html-write-get-tag-ovl ()
+ "Get tag overlay at current point."
+ (catch 'ranges
+ (dolist (ovl (overlays-at (point)))
+ (let ((ranges (overlay-get ovl 'html-write)))
+ (when ranges
+ (throw 'ranges ovl))))))
+
+(defun html-write-toggle-current-tag ()
+ "Toggle display of tag at current point."
+ (interactive)
+ (let* ((ovl (html-write-get-tag-ovl))
+ (hiding-ranges (overlay-get ovl 'html-write))
+ (invis (get-text-property (caar hiding-ranges) 'invisible))
+ (ovl-start (overlay-start ovl))
+ (ovl-end (overlay-end ovl)))
+ (if invis
+ (progn
+ (overlay-put ovl 'html-face (overlay-get ovl 'face))
+ (overlay-put ovl 'face 'highlight)
+ (dolist (range hiding-ranges)
+ (let ((start (car range))
+ (end (cdr range)))
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (put-text-property start end 'invisible nil)))))
+ (delete-overlay ovl)
+ (html-write-hide-tags ovl-start ovl-end))))
+
+(defun html-write-browse-link ()
+ "Browse link in current tag."
+ (interactive)
+ (let* ((ovl (html-write-get-tag-ovl))
+ (url (overlay-get ovl 'html-write-url)))
+ (unless url
+ (error "No link in this tag"))
+ (browse-url url)
+ ))
+
+(defvar html-write-keymap
+ (let ((map (make-sparse-keymap))
+ keys)
+ (define-key map [(control ?c) ?+] 'html-write-toggle-current-tag)
+ (define-key map [(control ?c) ?!] 'html-write-browse-link)
+ (define-key map [mouse-1] 'html-write-browse-link)
+ (when (featurep 'mlinks)
+ (setq keys (where-is-internal 'mlinks-goto mlinks-mode-map))
+ (dolist (key keys)
+ (define-key map key 'html-write-mlinks-goto))
+ (setq keys (where-is-internal 'mlinks-goto-other-window mlinks-mode-map))
+ (dolist (key keys)
+ (define-key map key 'html-write-mlinks-goto-other-window))
+ (setq keys (where-is-internal 'mlinks-goto-other-frame mlinks-mode-map))
+ (dolist (key keys)
+ (define-key map key 'html-write-mlinks-goto-other-frame))
+ )
+ map))
+
+(defun html-write-mlinks-goto ()
+ "Goto link."
+ (interactive)
+ (html-write-mlinks-goto-1 'mlinks-goto))
+
+(defun html-write-mlinks-goto-other-window ()
+ "Goto link in other window."
+ (interactive)
+ (html-write-mlinks-goto-1 'mlinks-goto-other-window))
+
+(defun html-write-mlinks-goto-other-frame ()
+ "Goto link in other frame."
+ (interactive)
+ (html-write-mlinks-goto-1 'mlinks-goto-other-frame))
+
+(defun html-write-mlinks-goto-1 (goto-fun)
+ (let* ((ovl (html-write-get-tag-ovl))
+ (ovl-start (overlay-start ovl))
+ (ovl-end (overlay-end ovl))
+ (here (point-marker)))
+ (goto-char ovl-start)
+ (skip-chars-forward "^\"" ovl-end)
+ (forward-char)
+ (unless (funcall goto-fun) (goto-char here))
+ ))
+
+;;(html-write-make-hide-tags-regexp)
+(defun html-write-make-hide-tags-regexp ()
+ "Make regexp used for finding tags to hide."
+ ;; fix-me: single tags. Fix-me: what did I mean??? Maybe < etc...
+ (let ((tags-re
+ (mapconcat 'identity
+ (mapcar (lambda (elt)
+ (if (stringp elt)
+ elt
+ (car elt)))
+ html-write-tag-list)
+ "\\|")))
+ (concat
+ "<\\(?1:"
+ "\\(?:" tags-re "\\)"
+ "\\)[^>]*>\\(?3:[^<]*\\)\\(?2:</\\1>\\)"
+ )))
+
+(defvar html-write-pending-changes nil)
+(make-variable-buffer-local 'html-write-pending-changes)
+(put 'html-write-pending-changes 'permanent-local t)
+
+
+(defun html-write-hide-tags (start end)
+ "Hide tags matching `html-write-tag-list' between START and END."
+ ;;(message "html-write-hide-tags %s %s" start end)
+ (let ((here (point-marker))
+ (buffer-name (buffer-file-name))
+ (dbg nil))
+ (save-restriction
+ (widen)
+ (goto-char start)
+ (save-match-data
+ (let ((hide-tags-regexp (html-write-make-hide-tags-regexp)))
+ (when dbg (message "before search start=%s end=%s, point=%s" start end (point)))
+ (while (re-search-forward hide-tags-regexp end t)
+ (let* ((ovl (make-overlay (match-beginning 0) (match-end 0)
+ nil t nil))
+ (tag-fun (cadr (assoc (match-string-no-properties 1)
+ html-write-tag-list)))
+ hiding-ranges)
+ ;;(overlay-put ovl 'face 'font-lock-variable-name-face)
+ (overlay-put ovl 'keymap html-write-keymap)
+ (setq hiding-ranges
+ (list (cons (1- (match-beginning 1)) (match-beginning 3))
+ (cons (match-beginning 2) (match-end 2))))
+ (overlay-put ovl 'html-write hiding-ranges)
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (dolist (range hiding-ranges)
+ (let ((start (car range))
+ (end (cdr range)))
+ (put-text-property start end 'invisible 'html-write)
+ ;; Fix-me: more careful rear-nonsticky?
+ (put-text-property (1- end) end
+ 'rear-nonsticky '(invisible)))))
+ ;; Let tag-fun override
+ (when tag-fun
+ (funcall tag-fun (match-end 1) (match-beginning 3) ovl))
+ )))))
+ (goto-char here)))
+
+(defun html-write-reveal-tags (start end)
+ "Reveal tags between START and END."
+ (let ((here (point-marker)))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (save-match-data
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (remove-text-properties start
+ end
+ '(invisible html-write))
+ (dolist (ovl (overlays-in start end))
+ (when (overlay-get ovl 'html-write)
+ (let ((end (overlay-end ovl)))
+ (remove-list-of-text-properties (1- end) end '(rear-nonsticky))
+ (delete-overlay ovl)))))))
+ (goto-char here)))
+
+;;;###autoload
+(define-minor-mode html-write-mode
+ "Minor mode for convenient display of some HTML tags.
+When this mode is on a tag in `html-write-tag-list' is displayed as
+the inner text of the tag with a face corresponding to the tag.
+By default for example <i>...</i> is displayed as italic and
+<a>...</a> is displayed as an underlined clickable link.
+
+Only non-nested tags are hidden. The idea is just that it should
+be easier to read and write, not that it should look as html
+rendered text.
+
+See the customization group `html-write' for more information about
+faces.
+
+The following keys are defined when you are on a tag handled by
+this minor mode:
+
+\\{html-write-keymap}
+
+IMPORTANT: Most commands you use works also on the text that is
+hidden. The movement commands is an exception, but as soon as
+you edit the buffer you may also change the hidden parts.
+
+Hint: Together with `wrap-to-fill-column-mode' this can make it
+easier to see what text you are actually writing in html parts of
+a web file."
+ :group 'html-write
+ (if t
+ (if html-write-mode
+ (html-write-font-lock t)
+ (html-write-font-lock nil)
+ (save-restriction
+ (widen)
+ (html-write-reveal-tags (point-min) (point-max))))))
+(put html-write-mode 'permanent-local t)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Font lock
+
+(defun html-write-jit-extend-after-change (start end old-len)
+ "For JIT lock extending.
+Should be on `jit-lock-after-change-extend-region-functions'.
+
+START, END and OLD-LEN are the parameters from after change."
+ (let ((our-ovls nil))
+ (dolist (ovl (append (overlays-in start end)
+ (overlays-at start)
+ nil))
+ ;; Leave the overlays until re-fontification time, but note their extent.
+ (when (overlay-get ovl 'html-write)
+ (setq jit-lock-start (min jit-lock-start (overlay-start ovl)))
+ (setq jit-lock-end (max jit-lock-end (overlay-end ovl)))))))
+
+
+(defun html-write-fontify (bound)
+ ;;(message "html-write-fontify %s" bound)
+ (let (tag-ovl)
+ ;;(save-match-data
+ (let* ((hide-tags-regexp (html-write-make-hide-tags-regexp))
+ (next-tag (re-search-forward hide-tags-regexp bound t))
+ (tag-beg (when next-tag (match-beginning 0)))
+ (tag-end (when next-tag (match-end 0)))
+ (tag-nam (when next-tag (match-string-no-properties 1)))
+ (tag-fun (when next-tag (cadr (assoc tag-nam html-write-tag-list))))
+ tag-hid
+ (old-start (next-single-char-property-change (max (point-min) (1- (point))) 'html-write nil bound)))
+ ;;(message "here a old-start=%s, tag-beg/end=%s/%s" old-start tag-beg tag-end)
+ (setq tag-ovl (when next-tag (make-overlay tag-beg tag-end)))
+ (when old-start
+ ;; Fix-me: maybe valid, perhaps better keep it then?
+ (let ((ovl (catch 'ovl
+ (dolist (o (append (overlays-at old-start)
+ (overlays-in old-start (1+ old-start))
+ nil))
+ (when (overlay-get o 'html-write)
+ (throw 'ovl o))))))
+ (when ovl ;; fix-me: there should be one...
+ ;;(message "here b")
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (remove-list-of-text-properties (overlay-start ovl) (overlay-end ovl) '(invisible html-write)))
+ (delete-overlay ovl))))
+ ;;(html-write-hide-tags start end)
+ ;;(message "here d, tag-ovl=%s" tag-ovl)
+ (when tag-ovl
+ (overlay-put tag-ovl 'face 'font-lock-variable-name-face)
+ (overlay-put tag-ovl 'keymap html-write-keymap)
+ (setq tag-hid
+ (list (cons (1- (match-beginning 1)) (match-beginning 3))
+ (cons (match-beginning 2) (match-end 2))))
+ (overlay-put tag-ovl 'html-write tag-hid)
+ (when tag-fun
+ (funcall tag-fun (match-end 1) (match-beginning 3) tag-ovl))
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (dolist (range tag-hid)
+ (let ((start (car range))
+ (end (cdr range)))
+ (put-text-property start end 'invisible 'html-write)
+ ;;(put-text-property start end 'html-write t)
+ ;; Fix-me: more careful rear-nonsticky?
+ (put-text-property (1- end) end
+ 'rear-nonsticky '(invisible)))))))
+ ;;)
+ (when tag-ovl
+ (set-match-data (list (copy-marker (overlay-start tag-ovl))
+ (copy-marker (overlay-end tag-ovl))))
+ (goto-char (1+ (overlay-end tag-ovl)))
+ t)))
+
+(defun html-write-font-lock (on)
+ ;; See mlinks.el
+ (let* ((add-or-remove (if on 'font-lock-add-keywords 'font-lock-remove-keywords))
+ (fontify-fun 'html-write-fontify)
+ (args (list nil `(( ,fontify-fun ( 0 'html-write-base t ))))))
+ (when fontify-fun
+ (when on (setq args (append args (list t))))
+ (apply add-or-remove args)
+ (font-lock-mode -1)
+ (font-lock-mode 1)
+ )))
+
+(provide 'html-write)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; html-write.el ends here
--- /dev/null
+;;; idn.el --- Recommended Identifier Profiles for IDN
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2010-03-24 Wed
+;; Version: 0.1
+;; Last-Updated: 2010-03-26 Fri
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+ ;; `nxhtml-base'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Functions for handling IDN chars defined by
+;; `http://www.unicode.org/reports/tr39/'.
+;;
+;; See `idn-is-recommended'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; Fix-me: You have to change this if you are not using nXhtml:
+(require 'nxhtml-base)
+(defvar uts39-datadir (expand-file-name "etc/uts39/" nxhtml-install-dir))
+
+(defun idn-init (bv)
+ (save-match-data
+ (let* ((idnchars-file (expand-file-name "idnchars.txt" uts39-datadir))
+ (idnchars-old (find-buffer-visiting idnchars-file))
+ (idnchars-buf (or idnchars-old
+ (if (not (file-exists-p idnchars-file))
+ (message "Can't find file %S" idnchars-file)
+ (find-file-noselect idnchars-file))))
+ here
+ (range-patt (rx bol
+ (group (repeat 4 (any xdigit)))
+ (optional ".."
+ (group (repeat 4 (any xdigit))))))
+ (num-idn 0))
+ (when idnchars-buf
+ (with-current-buffer idnchars-buf
+ (setq here (point))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward range-patt nil t)
+ (let* ((str-beg (match-string 0))
+ (str-end (match-string 2))
+ (beg (string-to-number str-beg 16))
+ (end (or (when str-end (string-to-number str-end 16))
+ beg)))
+ ;;(message "str-beg=%S str-end=%S" str-beg str-end)
+ (dotimes (ii (1+ (- end beg)))
+ (let ((num (+ ii beg)))
+ ;;(message "setting idn-char %s #%4x" num num)
+ (setq num-idn (1+ num-idn))
+ (aset bv num t))))))
+ (goto-char here))
+ (unless idnchars-old (kill-buffer idnchars-buf))
+ (message "Found %d IDN chars" num-idn)
+ t))))
+
+(defconst idn-char-vector
+ (let ((bv (make-bool-vector (* 256 256) nil)))
+ (when (idn-init bv)
+ ;; (string-to-number "002D" 16)
+ ;; Make a quick sanity check:
+ (unless (and (not (aref bv 44))
+ (aref bv 45))
+ (message "idn-char-vector: Bad idn data in file idnchars.txt"))
+ bv))
+ "Boolean vector with recommended IDN chars.")
+
+
+;;(idn-is-recommended 0)
+;;(idn-is-recommended 65535)
+(defsubst idn-is-recommended (char)
+ "Return t if character CHAR is a recommended IDN char.
+See URL `http://www.unicode.org/reports/tr39/'.
+
+Data is initialized from the file idnchars.txt in the directory
+`uts39-datadir'. This file is fetched from the above URL."
+ (aref idn-char-vector char))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Below are some help functions that can be commented out.
+
+;;(global-set-key [f9] 'idn-char-at-point)
+(defun idn-char-at-point (pos)
+ "Tell if char at POS is an recommended IDN char.
+Default POS is current point."
+ (interactive "d")
+ (let* ((this-char (char-after pos))
+ (recommended (idn-is-recommended this-char)))
+ (message "IDN char at point: %s (#%000x)" recommended this-char)))
+
+(defun idn-list-chars ()
+ "Show all IDN chars.
+For more info see `idn-is-recommended'.
+
+Note: This may crash Emacs currently, at least on w32."
+ (interactive)
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'idn-list-chars) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert
+ "Recommended Identifier Characters for IDN:\n\n")
+ (let ((col 0)
+ (cnt 0))
+ (dotimes (nn (length idn-char-vector))
+ (when (aref idn-char-vector nn)
+ (setq cnt (1+ cnt))
+ (setq col (mod (1+ col) 20))
+ (when (= col 0) (insert "\n "))
+ (insert " " (char-to-string nn))))
+ (insert "\n\n"
+ (format "There were %d IDN chars defined in `idn-char-vector'." cnt))
+ ))))
+
+(provide 'idn)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; idn.el ends here
--- /dev/null
+;;; inlimg.el --- Display images inline
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-09-27
+(defconst inlimg:version "0.7") ;; Version:
+;; Last-Updated: 2009-07-14 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Display images inline. See `inlimg-mode' for more information.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'mumamo nil t))
+(eval-when-compile (require 'ourcomments-util nil t))
+
+(defvar inlimg-assoc-ext
+ '((png (".png"))
+ (gif (".gif"))
+ (tiff (".tiff"))
+ (jpeg (".jpg" ".jpeg"))
+ (xpm (".xpm"))
+ (xbm (".xbm"))
+ (pbm (".pbm"))))
+
+(defvar inlimg-img-regexp nil)
+(make-variable-buffer-local 'inlimg-img-regexp)
+(put 'inlimg-img-regexp 'permanent-local t)
+
+(defvar inlimg-img-regexp-html
+ (rx (or (and "<img"
+ (1+ space)
+ (0+ (1+ (not (any " <>")))
+ (1+ space))
+ "src=\""
+ (group (1+ (not (any "\""))))
+ "\""
+ (*? anything)
+ "/>")
+ (and "url("
+ ?\"
+ (group (1+ (not (any "\)"))))
+ ?\"
+ ")"
+ )
+ (and "url("
+ (group (+? (not (any ")"))))
+ ")"
+ )
+ )))
+
+(defvar inlimg-img-regexp-org
+ (rx-to-string
+ `(and "[[file:"
+ (group (+? (not (any "\]")))
+ ,(let ((types nil))
+ (dolist (typ image-types)
+ (when (image-type-available-p typ)
+ (dolist (ext (cadr (assoc typ inlimg-assoc-ext)))
+ (setq types (cons ext types)))))
+ (cons 'or types)))
+ "]"
+ (optional "["
+ (+? (not (any "\]")))
+ "]")
+ "]"
+ )))
+
+(defconst inlimg-modes-img-values
+ '(
+ (html-mode inlimg-img-regexp-html)
+ (org-mode inlimg-img-regexp-org)
+ ))
+
+(defun inlimg-img-spec-p (spec)
+ (assoc spec inlimg-modes-img-values))
+
+;;;###autoload
+(defgroup inlimg nil
+ "Customization group for inlimg."
+ :group 'nxhtml)
+
+(defcustom inlimg-margins '(50 . 5)
+ "Margins when displaying image."
+ :type '(cons (integer :tag "Left margin")
+ (integer :tag "Top margin"))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (fboundp 'inlimg-update-all-buffers)
+ (inlimg-update-all-buffers)))
+ :group 'inlimg)
+
+(defcustom inlimg-slice '(0 0 400 100)
+ "How to slice images."
+ :type '(choice (const :tag "Show whole images" nil)
+ (list :tag "Show slice of image"
+ (integer :tag "Top")
+ (integer :tag "Left")
+ (integer :tag "Width")
+ (integer :tag "Height")))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (fboundp 'inlimg-update-all-buffers)
+ (inlimg-update-all-buffers)))
+ :group 'inlimg)
+
+(define-widget 'inlimg-spec-widget 'symbol
+ "An inline image specification."
+ :complete-function (lambda ()
+ (interactive)
+ (lisp-complete-symbol 'inlimg-img-spec-p))
+ :prompt-match 'inlimg-img-spec-p
+ :prompt-history 'widget-function-prompt-value-history
+ :match-alternatives '(inlimg-img-spec-p)
+ :validate (lambda (widget)
+ (unless (inlimg-img-spec-p (widget-value widget))
+ (widget-put widget :error (format "Invalid function: %S"
+ (widget-value widget)))
+ widget))
+ :value 'org-mode
+ :tag "Inlimg image values spec name")
+
+;; (customize-option 'inlimg-mode-specs)
+(defcustom inlimg-mode-specs
+ '(
+ (xml-mode html-mode)
+ (sgml-mode html-mode)
+ (nxml-mode html-mode)
+ (php-mode html-mode)
+ (css-mode html-mode)
+ )
+ "Equivalent mode for image tag search.
+Note that derived modes \(see info) are recognized by default.
+
+To add new image tag patterns modify `inlimg-modes-img-values'."
+ :type '(repeat
+ (list (major-mode-function :tag "Major mode")
+ (inlimg-spec-widget :tag "Use tags as specified in")))
+ :group 'inlimg)
+
+(defface inlimg-img-tag '((t :inherit 'lazy-highlight))
+ "Face added to img tag when displaying image."
+ :group 'inlimg)
+
+(defface inlimg-img-remote '((t :inherit 'isearch-fail))
+ "Face used for notes telling image is remote."
+ :group 'inlimg)
+
+(defface inlimg-img-missing '((t :inherit 'trailing-whitespace))
+ "Face used for notes telling image is missing."
+ :group 'inlimg)
+
+(defvar inlimg-img-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c) ?+] 'inlimg-toggle-display)
+ (define-key map [(control ?c) ?%] 'inlimg-toggle-slicing)
+ map)
+ "Keymap on image overlay.")
+
+(eval-after-load 'gimp
+ '(gimp-add-point-bindings inlimg-img-keymap))
+
+(defsubst inlimg-ovl-p (ovl)
+ "Return non-nil if OVL is an inlimg image overlay."
+ (overlay-get ovl 'inlimg-img))
+
+(defun inlimg-ovl-valid-p (ovl)
+ (and (overlay-get ovl 'inlimg-img)
+ inlimg-img-regexp
+ (save-match-data
+ (let ((here (point)))
+ (goto-char (overlay-start ovl))
+ (prog1
+ (looking-at (symbol-value inlimg-img-regexp))
+ (goto-char here))))))
+
+(defun inlimg-next (pt display-image)
+ "Display or hide next image after point PT.
+If DISPLAY-IMAGE is non-nil then display image, otherwise hide it.
+
+Return non-nil if an img tag was found."
+ (when inlimg-img-regexp
+ (let (src dir beg end img ovl remote beg-face)
+ (goto-char pt)
+ (save-match-data
+ (when (re-search-forward (symbol-value inlimg-img-regexp) nil t)
+ (setq src (or (match-string-no-properties 1)
+ (match-string-no-properties 2)
+ (match-string-no-properties 3)))
+ (setq beg (match-beginning 0))
+ (setq beg-face (get-text-property beg 'face))
+ (setq remote (string-match "^https?://" src))
+ (setq end (- (line-end-position) 0))
+ (setq ovl (catch 'old-ovl
+ (dolist (ovl (overlays-at beg))
+ (when (inlimg-ovl-p ovl)
+ (throw 'old-ovl ovl)))
+ nil))
+ (unless ovl
+ (setq ovl (make-overlay beg end))
+ (overlay-put ovl 'inlimg-img t)
+ (overlay-put ovl 'priority 100)
+ (overlay-put ovl 'face 'inlimg-img-tag)
+ (overlay-put ovl 'keymap inlimg-img-keymap))
+ (overlay-put ovl 'image-file src)
+ (overlay-put ovl 'inlimg-slice inlimg-slice)
+ (if display-image
+ (unless (memq beg-face '(font-lock-comment-face font-lock-string-face))
+ (unless remote
+ (setq dir (if (buffer-file-name)
+ (file-name-directory (buffer-file-name))
+ default-directory))
+ (setq src (expand-file-name src dir)))
+ (if (or remote (not (file-exists-p src)))
+ (setq img (propertize
+ (if remote " Image is on the web " " Image not found ")
+ 'face (if remote 'inlimg-img-remote 'inlimg-img-missing)))
+ (setq img (create-image src nil nil
+ :relief 5
+ :margin inlimg-margins))
+ (setq img (inlimg-slice-img img inlimg-slice)))
+ (let ((str (copy-sequence "\nX")))
+ (setq str (propertize str 'face 'inlimg-img-tag))
+ (put-text-property 1 2 'display img str)
+ (overlay-put ovl 'after-string str)))
+ (overlay-put ovl 'after-string nil))))
+ ovl)))
+
+(defun inlimg-slice-img (img slice)
+ (if (not slice)
+ img
+ (let* ((sizes (image-size img t))
+ (width (car sizes))
+ (height (cdr sizes))
+ (sl-left (nth 0 slice))
+ (sl-top (nth 1 slice))
+ (sl-width (nth 2 slice))
+ (sl-height (nth 3 slice)))
+ (when (> sl-left width) (setq sl-left 0))
+ (when (> (+ sl-left sl-width) width) (setq sl-width (- width sl-left)))
+ (when (> sl-top height) (setq sl-top 0))
+ (when (> (+ sl-top sl-height) height) (setq sl-height (- height sl-top)))
+ (setq img (list img))
+ (setq img (cons (append '(slice)
+ slice
+ (list sl-top sl-left sl-width sl-height)
+ nil)
+ img)))))
+
+;;;###autoload
+(define-minor-mode inlimg-mode
+ "Display images inline.
+Search buffer for image tags. Display found images.
+
+Image tags are setup per major mode in `inlimg-mode-specs'.
+
+Images are displayed on a line below the tag referencing them.
+The whole image or a slice of it may be displayed, see
+`inlimg-slice'. Margins relative text are specified in
+`inlimg-margins'.
+
+See also the commands `inlimg-toggle-display' and
+`inlimg-toggle-slicing'.
+
+Note: This minor mode uses `font-lock-mode'."
+ :keymap nil
+ :group 'inlimg
+ (if inlimg-mode
+ (progn
+ (let ((major-mode (or (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode
+ (fboundp 'mumamo-main-major-mode)
+ (mumamo-main-major-mode))
+ major-mode)))
+ (inlimg-get-buffer-img-values)
+ (unless inlimg-img-regexp
+ (message "inlim-mode: No image spec, can't do anything"))
+ (add-hook 'font-lock-mode-hook 'inlimg-on-font-lock-off))
+ (inlimg-font-lock t))
+ (inlimg-font-lock nil)
+ (inlimg-delete-overlays)))
+(put 'inlimg-mode 'permanent-local t)
+
+(defun inlimg-delete-overlays ()
+ (save-restriction
+ (widen)
+ (let (ovl)
+ (dolist (ovl (overlays-in (point-min) (point-max)))
+ (when (inlimg-ovl-p ovl)
+ (delete-overlay ovl))))))
+
+(defun inlimg-get-buffer-img-values ()
+ (let* (rec
+ (spec (or (catch 'spec
+ (dolist (rec inlimg-mode-specs)
+ (when (derived-mode-p (car rec))
+ (throw 'spec (nth 1 rec)))))
+ major-mode))
+ (values (when spec (nth 1 (assoc spec inlimg-modes-img-values))))
+ )
+ (setq inlimg-img-regexp values)
+ ))
+
+(defun inlimg--global-turn-on ()
+ (inlimg-get-buffer-img-values)
+ (when inlimg-img-regexp
+ (inlimg-mode 1)))
+
+;;;###autoload
+(define-globalized-minor-mode inlimg-global-mode inlimg-mode inlimg--global-turn-on)
+
+;;;###autoload
+(defun inlimg-toggle-display (point)
+ "Toggle display of image at point POINT.
+See also the command `inlimg-mode'."
+ (interactive (list (point)))
+ (let ((here (point))
+ (ovl
+ (catch 'ovl
+ (dolist (ovl (overlays-at (point)))
+ (when (inlimg-ovl-p ovl)
+ (throw 'ovl ovl)))))
+ is-displayed)
+ (if (not ovl)
+ (message "No image at point %s" here)
+ (setq is-displayed (overlay-get ovl 'after-string))
+ (inlimg-next (overlay-start ovl) (not is-displayed))
+ (goto-char here))))
+
+;;;###autoload
+(defun inlimg-toggle-slicing (point)
+ "Toggle slicing of image at point POINT.
+See also the command `inlimg-mode'."
+ (interactive (list (point)))
+ (let* ((here (point))
+ (ovl
+ (catch 'ovl
+ (dolist (ovl (overlays-at (point)))
+ (when (inlimg-ovl-p ovl)
+ (throw 'ovl ovl)))))
+ (inlimg-slice inlimg-slice)
+ is-displayed)
+ (if (not ovl)
+ (message "No image at point %s" here)
+ (setq is-displayed (overlay-get ovl 'after-string))
+ (when (overlay-get ovl 'inlimg-slice)
+ (setq inlimg-slice nil))
+ (inlimg-next (overlay-start ovl) is-displayed)
+ (goto-char here))))
+
+
+(defun inlimg-font-lock-fun (bound)
+ (let ((here (point))
+ old-ovls new-ovls ovl)
+ (goto-char (line-beginning-position))
+ (dolist (ovl (overlays-in (point) bound))
+ (when (inlimg-ovl-p ovl)
+ (setq old-ovls (cons ovl old-ovls))))
+ (while (and (< (point) bound)
+ (setq ovl (inlimg-next (point) t)))
+ (setq new-ovls (cons ovl new-ovls)))
+ (dolist (ovl old-ovls)
+ (unless (inlimg-ovl-valid-p ovl)
+ (delete-overlay ovl)
+ ))))
+
+;; Fix-me: This stops working for changes with nxhtml-mumamo-mode, but
+;; works for nxhtml-mode and html-mumamo-mode...
+(defvar inlimg-this-is-not-font-lock-off nil)
+(defun inlimg-font-lock (on)
+ (let ((add-or-remove (if on 'font-lock-add-keywords 'font-lock-remove-keywords))
+ (link-fun))
+ (funcall add-or-remove nil
+ `((inlimg-font-lock-fun
+ 1
+ mlinks-link
+ prepend)))
+ (let ((inlimg-this-is-not-font-lock-off t)
+ (mumamo-multi-major-mode nil))
+ (font-lock-mode -1)
+ (font-lock-mode 1))))
+
+(defun inlimg-on-font-lock-off ()
+ (unless (or inlimg-this-is-not-font-lock-off
+ (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode))
+ (when inlimg-mode
+ (inlimg-mode -1)
+ )))
+(put 'inlimg-on-font-lock-off 'permanent-local-hook t)
+
+
+(provide 'inlimg)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; inlimg.el ends here
--- /dev/null
+;;; key-cat.el --- List key bindings by category
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Sat Jan 28 2006
+;; Version: 0.25
+;; Last-Updated: 2009-05-09 Sat
+;; Keywords:
+;; Compatibility:
+;;
+;; Requires Emacs 22.
+;;
+;; Features that might be required by this library:
+;;
+ ;; `cl'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Display help that looks like a reference sheet for common
+;; commands.
+;;
+;; To use this in your .emacs put
+;;
+;; (require 'key-cat)
+;;
+;; Then use the command
+;;
+;; M-x key-cat-help
+;;
+;; For more information see that command.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defconst key-cat-cmd-list
+ '(
+ (error-testing
+ (commands
+ :visible nil
+ hallo
+ key-cat-help
+ key-cat-where-is
+ ))
+ ("Help"
+ (commands
+ help-for-help
+ info-emacs-manual
+ info
+ ))
+ ("Special Functions and Keys"
+ ;; For similar functions that are most often bound to a specific key
+ (commands
+ key-cat-tab
+ key-cat-complete
+ )
+ )
+ ("Files, Buffers and Windows"
+ (commands
+ find-file
+ save-buffer
+ write-file
+ split-window-vertically
+ split-window-horizontally
+ delete-other-windows
+ other-window
+ buffer-menu
+ ))
+ ("Search and replace"
+ (commands
+ isearch-forward
+ isearch-backward
+ query-replace
+ isearch-forward-regexp
+ isearch-backward-regexp
+ query-replace-regexp
+ occur
+ lgrep
+ rgrep
+ ))
+ ("Lines"
+ (commands
+ move-beginning-of-line
+ move-end-of-line
+ kill-line
+ ))
+ ("Words"
+ (commands
+ forward-word
+ backward-word
+ kill-word
+ ))
+ ("Region"
+ (commands
+ set-mark-command
+ ;;cua-set-mark
+ kill-region
+ copy-region-as-kill
+ yank
+ yank-pop
+ ))
+ ("Undo"
+ (commands
+ undo
+ ))
+ ("Viper"
+ (commands
+ :visible (lambda()
+ (and (featurep 'viper)
+ viper-mode))
+ viper-next-line
+ viper-previous-line
+ viper-forward-word
+ viper-backward-word
+ viper-forward-Word
+ viper-backward-Word
+ viper-repeat
+ viper-forward-char
+ viper-backward-char
+ viper-next-line-at-bol
+ viper-previous-line-at-bol
+ viper-command-argument
+ viper-digit-argument
+ ))
+ )
+ "List with common commands to display by `key-cat-help'.
+The elements of this list corresponds to sections to show in the
+help. Each element consists of sublists beginning with the
+keyword 'commands. The sublists may after 'command contain the
+keyword :visible which takes a variable or function as argument.
+If the argument evaluates to non-nil the list is shown."
+ )
+
+
+(defvar key-cat-cmd-list-1 nil)
+
+(defun key-cat-help()
+ "Display reference sheet style help for common commands.
+See also `key-cat-cmd-list'."
+ (interactive)
+ (if (> 22 emacs-major-version)
+ (message "Sorry, this requires Emacs 22 or later")
+ ;; Delay to get correct bindings when running through M-x
+ (setq key-cat-cmd-list-1 key-cat-cmd-list)
+ (run-with-timer 0.1 nil 'key-cat-help-internal)))
+
+(defun key-cat-help-internal() ;(category)
+ (message "Please wait ...")
+ (condition-case err
+ (save-match-data ;; runs in timer
+ (let ((result))
+ (help-setup-xref (list #'key-cat-help)
+ (interactive-p))
+ ;; (push (list "Changing commands"
+ ;; (list
+ ;; 'command
+ ;; indent-line-function
+ ;; ))
+ ;; key-cat-cmd-list-1)
+ (dolist (catentry key-cat-cmd-list-1)
+ (let ((category (car catentry))
+ (commands (cdr catentry))
+ (cmds)
+ (keyw)
+ (visible)
+ (visible-fun)
+ (cmdstr)
+ (doc))
+ (dolist (cmdlist commands)
+ (setq cmdlist (cdr cmdlist))
+ (setq visible t)
+ (while (keywordp (setq keyw (car cmdlist)))
+ (setq cmdlist (cdr cmdlist))
+ (case keyw
+ (:visible (setq visible-fun (pop cmdlist))
+ (setq visible (if (symbolp visible-fun)
+ (progn
+ (symbol-value visible-fun))
+ (funcall visible-fun)))
+ )
+ ))
+ (when visible
+ (dolist (cmd cmdlist)
+ (setq cmds (cons cmd cmds)))))
+ (when cmds
+ (push (format "\n%s:\n"
+ (let ((s (format "%s" category)))
+ (put-text-property 0 (length s)
+ 'face (list
+ 'bold
+ )
+ s)
+ s))
+ result))
+ (setq cmds (reverse cmds))
+ (dolist (cmd cmds)
+ (setq cmdstr
+ (let ((s "Where to find it:" ))
+ (put-text-property 0 (length s)
+ 'face '(:slant italic
+ :background "RGB:dd/dd/ff"
+ ) s) s))
+ (if (not (functionp cmd))
+ (cond
+ ((eq 'key-cat-tab cmd)
+ (let ((s "Indent line"))
+ (put-text-property 0 (length s) 'face '(:foreground "blue") s)
+ (push s result))
+ (push ":\n" result)
+ (push (concat
+ " "
+ "Indent current line (done by specific major mode function).\n")
+ result)
+ (push (format " %17s %s\n" cmdstr (key-description [tab])) result)
+ )
+ ((eq 'key-cat-complete cmd)
+ (let ((s "Completion"))
+ (put-text-property 0 (length s) 'face '(:foreground "blue") s)
+ (push s result))
+ (push ":\n" result)
+ (push (concat
+ " "
+ "Performe completion at point (done by specific major mode function).\n")
+ result)
+ (push (format " %17s %s\n" cmdstr (key-description [meta tab])) result)
+ )
+ (t
+ (let ((s (format "`%s': (not a function)\n" cmd)))
+ (put-text-property 0 (length s) 'face '(:foreground "red") s)
+ (push s result))))
+ (let ((keys (key-cat-where-is cmd)))
+ (push (format "`%s':\n" cmd) result)
+ (setq doc (documentation cmd t))
+ (push
+ (concat
+ " "
+ (if doc
+ (substring doc 0 (string-match "\n" doc))
+ "(not documented)")
+ "\n")
+ result)
+ (if (not keys)
+ (if (interactive-form cmd)
+ (push (format " %17s M-x %s\n" cmdstr cmd) result)
+ (let ((s "(not an interactive command)"))
+ (put-text-property 0 (length s) 'face '(:foreground "red") s)
+ (push (format " %17s %s\n" cmdstr s) result)))
+ (dolist (key keys)
+ (push (format " %17s " cmdstr) result)
+ (push (format "%s\n"
+ (if (eq (elt key 0) 'xmenu-bar)
+ "Menus"
+ (key-description key)))
+ result)
+ (setq cmdstr ""))))))))
+ (save-excursion
+ (with-current-buffer (help-buffer)
+ (with-output-to-temp-buffer (help-buffer)
+ (insert
+ (let ((s "Some important commands\n"))
+ (put-text-property 0 (length s)
+ 'face '(:weight bold
+ :height 1.5
+ :foreground "RGB:00/00/66") s)
+ s))
+ (setq result (reverse result))
+ (dolist (r result)
+ (insert r))
+ )))
+ (message "")))
+ (error (message "%s" (error-message-string err)))))
+
+;; Mostly copied from `where-is':
+(defun key-cat-where-is (definition)
+ "Return key sequences that invoke the command DEFINITION.
+Argument is a command definition, usually a symbol with a function definition."
+ (let ((func (indirect-function definition))
+ (defs nil)
+ (all-keys))
+ ;; In DEFS, find all symbols that are aliases for DEFINITION.
+ (mapatoms (lambda (symbol)
+ (and (fboundp symbol)
+ (not (eq symbol definition))
+ (eq func (condition-case ()
+ (indirect-function symbol)
+ (error symbol)))
+ (push symbol defs))))
+ ;; Look at all the symbols--first DEFINITION,
+ ;; then its aliases.
+ (dolist (symbol (cons definition defs))
+ (let* ((remapped (command-remapping symbol))
+ (keys (where-is-internal
+ ;;symbol overriding-local-map nil nil remapped)))
+ symbol nil nil nil remapped)))
+ (when keys
+ (dolist (key keys)
+ (setq all-keys (cons key all-keys))))))
+ all-keys))
+
+
+
+(provide 'key-cat)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; key-cat.el ends here
--- /dev/null
+;;; majmodpri.el --- Major mode priorities handling
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-08-26
+(defconst majmodpri:version "0.62") ;;Version:
+;; Last-Updated: 2009-04-30 Thu
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Different elisp libraries may try to handle the same type of files.
+;; They normally do that by entering their major mode for a file type
+;; in `auto-mode-alist' or the other lists affecting `normal-mode'.
+;; Since the libraries may be loaded in different orders in different
+;; Emacs sessions this can lead to rather stochastic choices of major
+;; mode.
+;;
+;; This library tries to give the control of which major modes will be
+;; used back to the user. It does that by letting the user set up
+;; priorities among the major modes. This priorities are used to sort
+;; the lists used by `normal-mode'.
+;;
+;; To setup this libray and get more information do
+;;
+;; M-x customize-group RET majmodpri RET
+;;
+;; Or, see the commands `majmodpri-sort-lists'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'mumamo nil t))
+(eval-when-compile (require 'ourcomments-indirect-fun nil t))
+
+;;;; Idle sorting
+
+(defvar majmodpri-idle-sort-timer nil)
+
+(defun majmodpri-cancel-idle-sort ()
+ "Cancel idle sorting request."
+ (when majmodpri-idle-sort-timer
+ (cancel-timer majmodpri-idle-sort-timer)
+ (setq majmodpri-idle-sort-timer nil)))
+
+(defun majmodpri-start-idle-sort ()
+ "Request idle sorting."
+ (majmodpri-cancel-idle-sort)
+ (setq majmodpri-idle-sort-timer
+ (run-with-idle-timer 0 nil 'majmodpri-sort-lists-in-timer)))
+
+(defun majmodpri-sort-lists-in-timer ()
+ (condition-case err
+ (save-match-data ;; runs in timer
+ (majmodpri-sort-lists))
+ (error (message "(majmodpri-sort-lists): %s" err))))
+
+
+;;;; Sorting
+
+(defvar majmodpri-schwarzian-ordnum nil)
+(defun majmodpri-schwarzian-in (rec)
+ "Transform REC before sorting."
+ (setq majmodpri-schwarzian-ordnum (1+ majmodpri-schwarzian-ordnum))
+ (let ((mode (cdr rec)))
+ (list
+ (list mode majmodpri-schwarzian-ordnum)
+ rec)))
+
+(defun majmodpri-schwarzian-out (rec)
+ "Get original value of REC after sorting."
+ (cadr rec))
+
+;; Fix-me: default for Emacs 22??
+(defcustom majmodpri-no-nxml (< emacs-major-version 23)
+ "Don't use multi major modes with nxml if non-nil.
+The default for Emacs prior to version 23 is to not use this
+multi major modes by default since there are some problems.
+
+This gives those multi major mode lower priority, but it does not
+prevent use of them."
+ :type 'boolean
+ :group 'majmodpri)
+
+;; (majmodpri-priority 'html-mumamo-mode)
+;; (majmodpri-priority 'nxhtml-mumamo-mode)
+(defsubst majmodpri-priority (mode)
+ "Return major mode MODE priority."
+ (if (and majmodpri-no-nxml
+ ;; (symbolp mode)
+ ;; (save-match-data
+ ;; (string-match "nxhtml-mumamo" (symbol-name mode))))
+ (let* ((real (or (ourcomments-indirect-fun mode)
+ mode))
+ (chunk (when real (get real 'mumamo-chunk-family)))
+ (major-mode (when chunk
+ (cadr chunk))))
+ (when major-mode
+ (derived-mode-p 'nxml-mode))))
+ 0
+ (length (memq mode majmodpri-mode-priorities))))
+
+(defun majmodpri-compare-auto-modes (rec1 rec2)
+ "Compare record REC1 and record REC2.
+Comparision:
+
+- First check `majmodpri-mode-priorities'.
+- Then use old order in list."
+ (let* ((schw1 (car rec1))
+ (schw2 (car rec2))
+ (mod1 (nth 0 schw1))
+ (mod2 (nth 0 schw2))
+ (ord1 (nth 1 schw1))
+ (ord2 (nth 1 schw2))
+ (pri1 (majmodpri-priority mod1))
+ (pri2 (majmodpri-priority mod2)))
+ (cond
+ ((/= pri1 pri2) (> pri1 pri2))
+ (t (> ord1 ord2)))))
+
+;;(benchmark 100 (quote (majmodpri-sort-lists)))
+;;(defvar my-auto-mode-alist nil)
+(defun majmodpri-sort-auto-mode-alist ()
+ "Sort `auto-mode-alist' after users priorities."
+ (setq majmodpri-schwarzian-ordnum 0)
+ ;; Do not reorder function part, but put it first.
+ (let (fun-list
+ mod-list)
+ (dolist (rec auto-mode-alist)
+ (if (listp (cdr rec))
+ (setq fun-list (cons rec fun-list))
+ (setq mod-list (cons rec mod-list))))
+ (setq fun-list (nreverse fun-list))
+ (setq auto-mode-alist
+ (append
+ fun-list
+ (mapcar 'majmodpri-schwarzian-out
+ (sort
+ (mapcar 'majmodpri-schwarzian-in mod-list)
+ 'majmodpri-compare-auto-modes))))))
+
+(defun majmodpri-sort-magic-list (magic-mode-list-sym)
+ "Sort list MAGIC-MODE-LIST-SYM after users priorities."
+ (let ((orig-ordnum 0))
+ (set magic-mode-list-sym
+ ;; S out
+ (mapcar (lambda (rec)
+ (cadr rec))
+ ;; Sort
+ (sort
+ ;; S in
+ (mapcar (lambda (rec)
+ (setq orig-ordnum (1+ orig-ordnum))
+ (let ((mode (cdr rec)))
+ (list
+ (list mode orig-ordnum)
+ rec)))
+ (symbol-value magic-mode-list-sym))
+ (lambda (rec1 rec2)
+ (let* ((schw1 (car rec1))
+ (schw2 (car rec2))
+ (mod1 (nth 0 schw1))
+ (mod2 (nth 0 schw2))
+ (ord1 (nth 1 schw1))
+ (ord2 (nth 1 schw2))
+ (pri1 (majmodpri-priority mod1))
+ (pri2 (majmodpri-priority mod2)))
+ (cond
+ ((/= pri1 pri2) (> pri1 pri2))
+ (t (> ord1 ord2))))))))))
+
+;;;###autoload
+(defun majmodpri-sort-lists ()
+ "Sort the list used when selecting major mode.
+Only sort those lists choosen in `majmodpri-lists-to-sort'.
+Sort according to priorities in `majmodpri-mode-priorities'.
+Keep the old order in the list otherwise.
+
+The lists can be sorted when loading elisp libraries, see
+`majmodpri-sort-after-load'.
+
+See also `majmodpri-apply-priorities'."
+ (interactive)
+ ;;(message "majmodpri-sort-lists running ...")
+ (majmodpri-cancel-idle-sort)
+ (when (memq 'magic-mode-alist majmodpri-lists-to-sort)
+ (majmodpri-sort-magic-list 'magic-mode-alist))
+ (when (memq 'auto-mode-alist majmodpri-lists-to-sort)
+ (majmodpri-sort-auto-mode-alist))
+ (when (memq 'magic-fallback-mode-alist majmodpri-lists-to-sort)
+ (majmodpri-sort-magic-list 'magic-fallback-mode-alist))
+ ;;(message "majmodpri-sort-lists running ... (done)")
+ )
+
+
+;;;###autoload
+(defun majmodpri-apply ()
+ "Sort major mode lists and apply to existing buffers.
+Note: This function is suitable to add to
+`desktop-after-read-hook'. It will restore the multi major modes
+in buffers."
+ (majmodpri-apply-priorities t))
+
+(defun majmodpri-sort-apply-to-current ()
+ "Sort lists and apply to current buffer."
+ (majmodpri-sort-lists)
+ (add-hook 'find-file-hook 'normal-mode t t))
+
+(defun majmodpri-check-normal-mode ()
+ "Like `normal-mode', but keep major mode if same."
+ (let ((keep-mode-if-same t)
+ (old-major-mode major-mode)
+ (old-mumamo-multi-major-mode (when (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)))
+ (report-errors "File mode specification error: %s"
+ (set-auto-mode t))
+ ;;(msgtrc "majmodpri-check %s %s %s" (current-buffer) major-mode mumamo-multi-major-mode)
+ (unless (and (eq old-major-mode major-mode)
+ (or (not old-mumamo-multi-major-mode)
+ (eq old-mumamo-multi-major-mode mumamo-multi-major-mode)))
+ (msgtrc "majmodpri-check changing")
+ (report-errors "File local-variables error: %s"
+ (hack-local-variables))
+ ;; Turn font lock off and on, to make sure it takes account of
+ ;; whatever file local variables are relevant to it.
+ (when (and font-lock-mode
+ ;; Font-lock-mode (now in font-core.el) can be ON when
+ ;; font-lock.el still hasn't been loaded.
+ (boundp 'font-lock-keywords)
+ (eq (car font-lock-keywords) t))
+ (setq font-lock-keywords (cadr font-lock-keywords))
+ (font-lock-mode 1))
+ (message "majmodpri-apply-priorities: buffer=%s, %s,%s => %s,%s"
+ (current-buffer)
+ old-major-mode
+ old-mumamo-multi-major-mode
+ major-mode
+ (when (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)))))
+
+;;;###autoload
+(defun majmodpri-apply-priorities (change-modes)
+ "Apply major mode priorities.
+First run `majmodpri-sort-lists' and then if CHANGE-MODES is
+non-nil apply to existing file buffers. If interactive ask
+before applying."
+ (interactive '(nil))
+ (message "majmodpri-apply-priorities running ...")
+ (majmodpri-sort-lists)
+ (when (or change-modes
+ (with-no-warnings (called-interactively-p)))
+ (let (file-buffers)
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (let ((name (buffer-name))
+ (file buffer-file-name))
+ (or (string= (substring name 0 1) " ") ;; Internal
+ (not file)
+ (setq file-buffers (cons buffer file-buffers))))))
+ (if (not file-buffers)
+ (when change-modes
+ ;;(message "majmodpri-apply-priorities: No file buffers to change modes in")
+ )
+ (when (with-no-warnings (called-interactively-p))
+ (setq change-modes
+ (y-or-n-p "Check major mode in all file visiting buffers? ")))
+ (when change-modes
+ (dolist (buffer file-buffers)
+ (with-current-buffer buffer
+ (let ((old-major major-mode))
+ (majmodpri-check-normal-mode)
+ )))))))
+ (message "majmodpri-apply-priorities running ... (done)"))
+
+
+;;;; Custom
+
+;;;###autoload
+(defgroup majmodpri nil
+ "Customization group for majmodpri.el"
+ :group 'nxhtml
+ )
+
+(defcustom majmodpri-mode-priorities
+ '(
+ cperl-mumamo-mode
+ csound-sgml-mumamo-mode
+ django-nxhtml-mumamo-mode
+ django-html-mumamo-mode
+ embperl-nxhtml-mumamo-mode
+ embperl-html-mumamo-mode
+ eruby-nxhtml-mumamo-mode
+ eruby-html-mumamo-mode
+ genshi-nxhtml-mumamo-mode
+ genshi-html-mumamo-mode
+ jsp-nxhtml-mumamo-mode
+ jsp-html-mumamo-mode
+ laszlo-nxml-mumamo-mode
+ metapost-mumamo-mode
+ mjt-nxhtml-mumamo-mode
+ mjt-html-mumamo-mode
+ noweb2-mumamo-mode
+ ;;org-mumamo-mode
+ perl-mumamo-mode
+ smarty-nxhtml-mumamo-mode
+ smarty-html-mumamo-mode
+ ;;tt-html-mumamo-mode
+
+ nxhtml-mumamo-mode
+ html-mumamo-mode
+ nxml-mumamo-mode
+ nxml-mode
+
+ javascript-mode
+ ;;espresso-mode
+ rhtml-mode
+ )
+ "Priority list for major modes.
+Modes that comes first have higher priority.
+See `majmodpri-sort-lists' for more information."
+ :type '(repeat symbol)
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (and (boundp 'majmodpri-sort-after-load)
+ majmodpri-sort-after-load)
+ (majmodpri-start-idle-sort)))
+ :group 'majmodpri)
+
+(defcustom majmodpri-lists-to-sort
+ '(magic-mode-alist auto-mode-alist magic-fallback-mode-alist)
+ ;;nil
+ "Which major mode lists to sort.
+See `majmodpri-sort-lists' for more information."
+ :type '(set (const magic-mode-alist)
+ (const auto-mode-alist)
+ (const magic-fallback-mode-alist))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (and (boundp 'majmodpri-sort-after-load)
+ majmodpri-sort-after-load)
+ (majmodpri-start-idle-sort)))
+ :group 'majmodpri)
+
+(defcustom majmodpri-sort-after-load
+ '(
+ chart
+ gpl
+ ;;nxhtml-autoload
+ php-mode
+ rnc-mode
+ ruby-mode
+ )
+ "Sort major mode lists after loading elisp libraries if non-nil.
+This should not really be needed since just loading a library
+should not change how Emacs behaves. There are however quite a
+few thirt party libraries that does change `auto-mode-alist'
+\(including some of my own) since that sometimes seems
+reasonable. Some of them are in the default value of this
+variable.
+
+There are two possibilities for sorting here:
+
+- Value=list of features (default). Sort immediately after loading a
+ library in the list. Apply to current buffer.
+
+- Value=t. Sort after loading any library. Sorting is then not
+ done immediately. Instead it runs in an idle timer. This
+ means that if several elisp libraries are loaded in a command
+ then the sorting will only be done once, after the command has
+ finished. After sorting apply to all buffers.
+
+Note that the default does break Emacs rule that loading a
+library should not change how Emacs behave. On the other hand
+the default tries to compensate for that the loaded libraries
+breaks this rule by changing `auto-mode-alist'.
+
+See `majmodpri-sort-lists' for more information."
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "After loading any elisp library" t)
+ (repeat :tag "After loading specified features" symbol))
+ :set (lambda (sym val)
+ (set-default sym val)
+ ;; Clean up `after-load-alist' first.
+ (setq after-load-alist
+ (delq nil
+ (mapcar (lambda (rec)
+ (unless (member (cadr rec)
+ '((majmodpri-start-idle-sort)
+ (majmodpri-sort-lists)))
+ rec))
+ after-load-alist)))
+ (when val
+ ;;(message "majmodpri-sort-after-load: val=%s" val)
+ (let ((sort-and-apply nil))
+ (if (not (listp val))
+ (add-to-list 'after-load-alist
+ (if (eq val t)
+ '(".*" (majmodpri-start-idle-sort))
+ '("." (majmodpri-sort-lists))))
+ (dolist (feat val)
+ ;;(message "feat=%s" feat)
+ (if (featurep feat)
+ (setq sort-and-apply t)
+ (if (eq val t)
+ (eval-after-load feat '(majmodpri-start-idle-sort))
+ (eval-after-load feat '(majmodpri-sort-apply-to-current))))))
+ (when sort-and-apply
+ ;;(message "majmodpri-sort-after-load: sort-and-apply")
+ (majmodpri-apply-priorities t))
+ (if (eq val t)
+ (majmodpri-start-idle-sort)
+ (majmodpri-apply-priorities t)))))
+ :group 'majmodpri)
+
+
+(provide 'majmodpri)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; majmodpri.el ends here
--- /dev/null
+;;; markchars.el --- Mark chars fitting certain characteristics
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2010-03-22 Mon
+;; Version:
+;; Last-Updated: 2010-03-25 Thu
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; Required feature `markchars' was not provided.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Mark special chars, by default non-ascii, non-IDN chars. See
+;; `markchars-mode'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'idn)
+
+;;;###autoload
+(defgroup markchars nil
+ "Customization group for `markchars-mode'."
+ :group 'convenience)
+
+(defface markchars-light
+ '((t (:underline "light blue")))
+ "Light face for `markchars-mode' char marking."
+ :group 'markchars)
+
+(defface markchars-heavy
+ '((t (:underline "magenta")))
+ "Heavy face for `markchars-mode' char marking."
+ :group 'markchars)
+
+(defcustom markchars-face 'markchars-heavy
+ "Pointer to face used for marking chars."
+ :type 'face
+ :group 'markchars)
+
+;; (markchars-nonidn-fun (point-max))
+;; åäö
+;; character: å (229, #o345, #xe5)
+;; (idn-is-recommended 229) => t
+;; 152F ; 00B7 0034 ; SL # ( ᔯ → ·4 ) CANADIAN SYLLABICS YWE → MIDDLE DOT, DIGIT FOUR # {source:835} ᐧ4 {[source:696]}
+
+(defun markchars-nonidn-fun (bound)
+ "Font lock matcher for non-IDN, non-ascii chars."
+ (let* ((beg (catch 'beg
+ (while (< (point) bound)
+ (let ((char (char-after)))
+ (unless (or (< char 256)
+ (idn-is-recommended char))
+ (throw 'beg (point)))
+ (forward-char)))))
+ (end (when beg
+ (catch 'end
+ (while (< (point) bound)
+ (let ((char (char-after (point))))
+ (when (or (< char 256)
+ (idn-is-recommended char))
+ (throw 'end (point)))
+ (forward-char)))))))
+ (when beg
+ (setq end (or end bound))
+ (set-match-data (list (copy-marker beg) (copy-marker end)))
+ t)))
+
+(defcustom markchars-keywords (or (when (fboundp 'idn-is-recommended) 'markchars-nonidn-fun)
+ "[[:nonascii:]]+")
+ "Regexp or function for font lock to use for characters to mark.
+By default it matches non-IDN, non-ascii chars."
+ :type '(choice (const :tag "Non-ascii chars" "[[:nonascii:]]+")
+ (const :tag "Non IDN chars (Unicode.org tr39 suggestions)" markchars-nonidn-fun))
+ :group 'markchars)
+
+(defvar markchars-used-keywords nil
+ "Keywords currently used for font lock.")
+(put 'markchars-used-keywords 'permanent-local t)
+
+(defun markchars-set-keywords ()
+ "Set `markchars-used-keywords' from options."
+ (set (make-local-variable 'markchars-used-keywords)
+ (list
+ (list markchars-keywords
+ (list 0 '(put-text-property (match-beginning 0) (match-end 0)
+ 'face markchars-face))))))
+
+;;;###autoload
+(define-minor-mode markchars-mode
+ "Mark special characters.
+Which characters to mark are defined by `markchars-keywords'.
+
+The default is to mark non-IDN, non-ascii chars with a magenta
+underline.
+
+For information about IDN chars see `idn-is-recommended'.
+
+If you change anything in the customization group `markchars' you
+must restart this minor mode for the changes to take effect."
+ :group 'markchars
+ :lighter " ø"
+ (if markchars-mode
+ (progn
+ (markchars-set-keywords)
+ (font-lock-add-keywords nil markchars-used-keywords))
+ (font-lock-remove-keywords nil markchars-used-keywords))
+ ;; Fix-me: Something like mumamo-mark-for-refontification should be in Emacs.
+ (if (fboundp 'mumamo-mark-for-refontification)
+ (save-restriction
+ (widen)
+ (mumamo-mark-for-refontification (point-min) (point-max)))
+ (font-lock-fontify-buffer)))
+
+;;;###autoload
+(define-globalized-minor-mode markchars-global-mode markchars-mode
+ (lambda () (markchars-mode 1))
+ :group 'markchars)
+
+(provide 'markchars)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; markchars.el ends here
--- /dev/null
+;;; mlinks.el --- Minor mode making major mode dependent links
+;;
+;; Author: Lennar Borgman
+;; Created: Tue Jan 16 2007
+(defconst mlinks:version "0.28") ;;Version:
+;; Last-Updated: 2010-01-05 Tue
+;; Keywords:
+;; Compatibility:
+;;
+;; Fxeatures that might be required by this library:
+;;
+;; `appmenu', `cl', `mail-prsvr', `mm-util', `ourcomments-util',
+;; `url-expand', `url-methods', `url-parse', `url-util',
+;; `url-vars'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This file implements the minor mode `mlinks-mode' that create
+;; hyperlinks for different major modes. Such links can be visible or
+;; invisible. The meanings of the links are defined per mode.
+;;
+;; Examples:
+;;
+;; - In in html style modes the links are visible they can mean either
+;; open a file for editing, go to an achnor or view the link in a
+;; web browser etc.
+;;
+;; - In emacs lisp mode the links are invisible, but maybe highlighed
+;; when point or mouse is on them. (Having them highlighted when
+;; point is on them can be a quick way to check that you have
+;; spelled a symbol correct.) The meanings of the links in emacs
+;; lisp mode are go to definition.
+;;
+;; Common to links that open a buffer in Emacs is that you can the
+;; buffer opened in the same window, the other window or in a new
+;; frame. The same key binding is used in all major modes for this.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; FIX-ME: url-hexify-string etc
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'appmenu nil t))
+(eval-when-compile (require 'mumamo nil t))
+(eval-when-compile (require 'ourcomments-util nil t))
+
+(require 'rx)
+(require 'url-parse)
+(require 'url-expand)
+
+(defvar mlinks-point-hilighter-overlay nil)
+(make-variable-buffer-local 'mlinks-point-hilighter-overlay)
+(put 'mlinks-point-hilighter-overlay 'permanent-local t)
+
+;;;###autoload
+(defgroup mlinks nil
+ "Customization group for `mlinks-mode'."
+ :group 'nxhtml
+ :group 'hypermedia)
+
+(defvar mlinks-link-face 'mlinks-link-face)
+(defface mlinks-link-face
+ '((t (:inherit highlight)))
+ "Face normally active links have on them."
+ :group 'mlinks)
+
+(defvar mlinks-hyperactive-link-face 'mlinks-hyperactive-link-face)
+(defface mlinks-hyperactive-link-face
+ '((t (:inherit isearch)))
+ "Face hyper active links have on them."
+ :group 'mlinks)
+
+(defvar mlinks-font-lock-face 'mlinks-font-lock-face)
+(defface mlinks-font-lock-face
+ '((t :inherit link))
+ "Default face for MLinks' links."
+ :group 'mlinks)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Mode function bindings
+
+;;(customize-option mlinks-mode-functions)
+(defcustom mlinks-mode-functions
+ '(
+ ;; For message buffer etc.
+ (fundamental-mode
+ ((goto mlinks-elisp-goto)
+ (hili mlinks-elisp-hili)
+ (hion t)
+ )
+ )
+ (emacs-lisp-mode
+ ((goto mlinks-elisp-goto)
+ (hili mlinks-elisp-hili)
+ (hion t)
+ )
+ )
+ ;; *scractch*
+ (lisp-interaction-mode
+ ((goto mlinks-elisp-goto)
+ (hili mlinks-elisp-hili)
+ (hion t)
+ )
+ )
+ (help-mode
+ ((goto mlinks-elisp-goto)
+ (hili mlinks-elisp-hili)
+ (hion t)
+ )
+ )
+ (Info-mode
+ ((goto mlinks-elisp-goto)
+ (hili mlinks-elisp-hili)
+ (hion t)
+ )
+ )
+ (Custom-mode
+ ((goto mlinks-elisp-custom-goto)
+ (hili mlinks-elisp-hili)
+ (hion t)
+ (fontify mlinks-custom-fontify)
+ )
+ )
+ (text-mode
+ ((goto mlinks-goto-plain-url)
+ (hion t)
+ (fontify mlinks-plain-urls-fontify)
+ )
+ )
+ (nxhtml-mode
+ ((hion t)
+ (fontify mlinks-html-fontify)
+ (goto mlinks-html-style-goto)
+ )
+ )
+ (nxml-mode
+ ((hion t)
+ (fontify mlinks-html-fontify)
+ (goto mlinks-html-style-goto)
+ )
+ )
+ (sgml-mode
+ ((hion t)
+ (fontify mlinks-html-fontify)
+ (goto mlinks-html-style-goto)
+ )
+ )
+ (html-mode
+ ((hion t)
+ (fontify mlinks-html-fontify)
+ (goto mlinks-html-style-goto)
+ )
+ )
+ )
+ "Defines MLinks hyperlinks for major modes.
+"
+ ;; Each element in the list is a list with two elements
+
+ ;; \(MAJOR-MODE SETTINGS)
+
+ ;; where MAJOR-MODE is the major mode for which the settings SETTINGS should be used.
+ ;; SETTINGS is an association list which can have the following element types
+
+ ;; \(hili HILIGHT-FUN) ;; Mandatory
+ ;; \(goto GOTO-FUN) ;; Mandatory
+ ;; \(hion HION-BOOL) ;; Optional
+ ;; \(next NEXT-FUN) ;; Optional
+ ;; \(prev PREV-FUN) ;; Optional
+
+ ;; Where
+ ;; - HILIGHT-FUN is the function to hilight a link when point is
+ ;; inside the link. This is done when Emacs is idle.
+ ;; - GOTO-FUN is the function to follow the link at point.
+ ;; - HION-BOOL is t or nil depending on if hilighting should be on
+ ;; by default.
+ ;; - NEXT-FUN is the function to go to the next link.
+ ;; - PREV-FUN is the function to go to the previous link."
+ ;; ;;:type '(repeat (alist :key-type symbol :value-type (alist :key-type symbol :value symbol)))
+ :type '(alist :key-type major-mode-function
+ :value-type (list
+ (set
+ (const :tag "Enable MLinks in this major mode" hion)
+ (const :tag "Mark All Links" mark)
+ (list :tag "Enable" (const :tag "Hilighting" hili) function)
+ (list :tag "Enable" (const :tag "Follow Link" goto) function)
+ (list :tag "Enable" (const :tag "Goto Next Link" next) function)
+ (list :tag "Enable" (const :tag "Goto Previous Link" prev) function)
+ )))
+ :group 'mlinks)
+
+
+(defun mlinks-get-mode-value (which)
+ (let* ((major major-mode)
+ (mode-rec (assoc major mlinks-mode-functions)))
+ (catch 'mode-rec
+ (while (and major
+ (not mode-rec))
+ (setq major (get major 'derived-mode-parent))
+ (setq mode-rec (assoc major mlinks-mode-functions))
+ (when mode-rec (throw 'mode-rec nil))))
+ (when mode-rec
+ (let* ((mode (car mode-rec))
+ (funs-alist (cadr mode-rec))
+ (funs (assoc which funs-alist)))
+ (cdr funs)))))
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Minor modes
+
+;; (appmenu-dump-keymap mlinks-mode-map)
+(defvar mlinks-mode-map
+ (let ((m (make-sparse-keymap "mlinks")))
+ (define-key m [(control ?c) ?\r ?\r] 'mlinks-goto)
+ (define-key m [(control ?c) ?\r ?w] 'mlinks-goto-other-window)
+ (define-key m [(control ?c) ?\r ?f] 'mlinks-goto-other-frame)
+ (define-key m [(control ?c) ?\r ?n] 'mlinks-next-saved-position)
+ (define-key m [(control ?c) ?\r ?p] 'mlinks-prev-saved-position)
+ (define-key m [(control ?c) ?\r S-tab] 'mlinks-backward-link)
+ (define-key m [(control ?c) ?\r tab] 'mlinks-forward-link)
+ (define-key m [(control ?c) ?\r ?h] 'mlinks-toggle-hilight)
+ (define-key m [(control ?c) ?\r ?c] 'mlinks-copy-link-text)
+ m))
+
+;;;###autoload
+(define-minor-mode mlinks-mode
+ "Recognizes certain parts of a buffer as hyperlinks.
+The hyperlinks are created in different ways for different major
+modes with the help of the functions in the list
+`mlinks-mode-functions'.
+
+The hyperlinks can be hilighted when point is over them. Use
+`mlinks-toggle-hilight' to toggle this feature for the current
+buffer.
+
+All keybindings in this mode are by default done under the prefi§x
+key
+
+ C-c RET
+
+which is supposed to be a kind of mnemonic for link (alluding to
+the RET key commonly used in web browser to follow a link).
+\(Unfortunately this breaks the rules in info node `Key Binding
+Conventions'.) Below are the key bindings defined by this mode:
+
+\\{mlinks-mode-map}
+
+For some major modes `mlinks-backward-link' and
+`mlinks-forward-link' will take you to the previous/next link.
+By default the link moved to will be active, see
+`mlinks-active-links'.
+
+"
+ nil
+ " L"
+ nil
+ :keymap mlinks-mode-map
+ :group 'mlinks
+ (if mlinks-mode
+ (progn
+ (mlinks-add-appmenu)
+ (mlinks-start-point-hilighter)
+ (mlinks-add-font-lock))
+ (mlinks-stop-point-hilighter)
+ (when mlinks-point-hilighter-overlay
+ (when (overlayp mlinks-point-hilighter-overlay)
+ (delete-overlay mlinks-point-hilighter-overlay))
+ (setq mlinks-point-hilighter-overlay nil))
+ (mlinks-remove-font-lock)))
+(put 'mlinks-mode 'permanent-local t)
+
+(defun mlinks-turn-on-in-buffer ()
+ (let ((hion (unless (and (boundp 'mumamo-set-major-running)
+ mumamo-set-major-running)
+ (mlinks-get-mode-value 'hion))))
+ (when hion (mlinks-mode 1))))
+
+;;;###autoload
+(define-globalized-minor-mode mlinks-global-mode mlinks-mode
+ mlinks-turn-on-in-buffer
+ "Turn on `mlink-mode' in all buffer where it is specified.
+This is specified in `mlinks-mode-functions'."
+ :group 'mlinks)
+
+;; The problem with global minor modes:
+(when (and mlinks-global-mode
+ (not (boundp 'define-global-minor-mode-bug)))
+ (mlinks-global-mode 1))
+
+;;(define-toggle mlinks-active-links t
+(define-minor-mode mlinks-active-links
+ "Use quick movement keys on active links if non-nil.
+When moving to an mlink with `mlinks-forward-link' or
+`mlinks-backward-link' the link moved to will be in an active
+state. This is marked with a new color \(the face `isearch').
+When the new color is shown the following keys are active
+
+\\{mlinks-hyperactive-point-hilighter-keymap}
+Any command cancels this state."
+ :global t
+ :init-value t
+ :group 'mlinks)
+
+
+
+(defun mlinks-link-text-prop-range (pos)
+ (let* ((link-here (get-text-property pos 'mlinks-link))
+ (beg (when link-here (previous-single-char-property-change (+ pos 1) 'mlinks-link)))
+ (end (when link-here (next-single-char-property-change (- pos 0) 'mlinks-link))))
+ (when (and beg end)
+ (cons beg end))))
+
+(defun mlinks-link-range (pos)
+ (or (mlinks-link-text-prop-range pos)
+ (let ((funs-- (mlinks-get-mode-value 'hili)))
+ (when funs--
+ (save-match-data
+ (run-hook-with-args-until-success 'funs--))))))
+
+(defun mlinks-link-at-point ()
+ "Get link at point."
+ (mlinks-point-hilighter-1)
+ (when (and mlinks-point-hilighter-overlay
+ (overlay-buffer mlinks-point-hilighter-overlay))
+ (let* ((ovl mlinks-point-hilighter-overlay)
+ (beg (overlay-start ovl))
+ (end (overlay-end ovl)))
+ (buffer-substring-no-properties beg end))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; At point highligher
+
+(defvar mlinks-point-hilighter-timer nil)
+
+(defun mlinks-stop-point-hilighter ()
+ (when (timerp mlinks-point-hilighter-timer)
+ (cancel-timer mlinks-point-hilighter-timer)
+ (setq mlinks-point-hilighter-timer nil)))
+
+(defun mlinks-start-point-hilighter ()
+ (mlinks-stop-point-hilighter)
+ (setq mlinks-point-hilighter-timer
+ (run-with-idle-timer 0.1 t 'mlinks-point-hilighter)))
+
+(defvar mlinks-link-overlay-priority 100)
+
+(defun mlinks-make-point-hilighter-overlay (bounds)
+ (unless mlinks-point-hilighter-overlay
+ (setq mlinks-point-hilighter-overlay
+ (make-overlay (car bounds) (cdr bounds)))
+ (overlay-put mlinks-point-hilighter-overlay 'priority mlinks-link-overlay-priority)
+ (overlay-put mlinks-point-hilighter-overlay 'mouse-face 'highlight)
+ (mlinks-set-normal-point-hilight)
+ ))
+
+(defun mlinks-point-hilighter ()
+ "Mark link at point if any.
+This moves the hilight point overlay to point or deletes it."
+ ;; This runs in a timer, protect it.
+ (condition-case err
+ (let ((inhibit-point-motion-hooks t))
+ (mlinks-point-hilighter-1))
+ (error "mlinks-point-hilighter error: %s" (error-message-string err))))
+
+(defun mlinks-point-hilighter-1 ()
+ (when mlinks-mode
+ (let ((bounds-- (mlinks-link-range (point))))
+ (if bounds--
+ (if mlinks-point-hilighter-overlay
+ (move-overlay mlinks-point-hilighter-overlay (car bounds--) (cdr bounds--))
+ (mlinks-make-point-hilighter-overlay bounds--))
+ (when mlinks-point-hilighter-overlay
+ (delete-overlay mlinks-point-hilighter-overlay))))))
+
+(defvar mlinks-hyperactive-point-hilighter-keymap
+ (let ((m (make-sparse-keymap "mlinks")))
+ (define-key m [S-tab] 'mlinks-backward-link)
+ (define-key m [tab] 'mlinks-forward-link)
+ (define-key m "\t" 'mlinks-forward-link)
+ (define-key m [?\r] 'mlinks-goto)
+ (define-key m [?w] 'mlinks-goto-other-window)
+ (define-key m [?f] 'mlinks-goto-other-frame)
+ (define-key m [mouse-1] 'mlinks-goto)
+ (set-keymap-parent m mlinks-mode-map)
+ m))
+
+(defvar mlinks-point-hilighter-keymap
+ (let ((m (make-sparse-keymap "mlinks")))
+ (define-key m [mouse-1] 'mlinks-goto)
+ (set-keymap-parent m mlinks-mode-map)
+ m))
+
+(defun mlinks-point-hilighter-pre-command ()
+ (condition-case err
+ (unless (let ((map (overlay-get mlinks-point-hilighter-overlay 'keymap)))
+ (where-is-internal this-command
+ (list
+ map)))
+ (mlinks-set-normal-point-hilight)
+ (unless mlinks-point-hilighter-timer
+ (delete-overlay mlinks-point-hilighter-overlay)))
+ (error (message "mlinks-point-hilighter-pre-command: %s" err))))
+(put 'mlinks-point-hilighter-pre-command 'permanent-local t)
+
+(defun mlinks-set-hyperactive-point-hilight ()
+ "Make link hyper active, ie add some special key binding.
+Used after jumping specifically to a link. The idea is that the
+user may want to easily jump between links in this state."
+ (add-hook 'pre-command-hook 'mlinks-point-hilighter-pre-command nil t)
+ (mlinks-point-hilighter)
+ (overlay-put mlinks-point-hilighter-overlay 'face mlinks-hyperactive-link-face)
+ (overlay-put mlinks-point-hilighter-overlay 'keymap mlinks-hyperactive-point-hilighter-keymap))
+
+(defun mlinks-set-normal-point-hilight ()
+ "Make link normally active as if you happened to be on it."
+ (remove-hook 'pre-command-hook 'mlinks-point-hilighter-pre-command t)
+ (mlinks-point-hilighter)
+ (overlay-put mlinks-point-hilighter-overlay 'face mlinks-link-face)
+ (overlay-put mlinks-point-hilighter-overlay 'keymap mlinks-point-hilighter-keymap))
+
+(defun mlinks-set-point-hilight-after-jump-to ()
+ "Set hilight style after jump to link."
+ (if mlinks-active-links
+ (mlinks-set-hyperactive-point-hilight)
+ (mlinks-set-normal-point-hilight)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Jumping around
+
+(defvar mlinks-places nil)
+(make-variable-buffer-local 'mlinks-placesn)
+(put 'mlinks-places 'permanent-local t)
+
+(defvar mlinks-places-n 0)
+(make-variable-buffer-local 'mlinks-places-n)
+(put 'mlinks-places-n 'permanent-local t)
+
+(defun mlinks-has-links ()
+ (or (mlinks-get-mode-value 'fontify)
+ (when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ ;; Fix-me: just assume multi major has it... Need a list of
+ ;; major modes. There is no way to get such a list for the
+ ;; multi major mode (since you can't know what the chunk
+ ;; functions will return. However you can get a list of
+ ;; current chunks major mode.
+ t
+ )))
+
+(defun mlinks-backward-link ()
+ "Go to previous `mlinks-mode' link in buffer."
+ (interactive)
+ (if (not (mlinks-has-links))
+ (message "There is no way to go to previous link for this major mode")
+ (let ((res (mlinks-prev-link)))
+ (if res
+ (progn
+ (goto-char res)
+ (mlinks-set-point-hilight-after-jump-to))
+ (message "No previous link found")))))
+
+(defun mlinks-forward-link ()
+ "Go to next `mlinks-mode' link in buffer."
+ (interactive)
+ (if (not (mlinks-has-links))
+ (message "There is no way to go to next link for this major mode")
+ (let ((res (mlinks-next-link)))
+ (if res
+ (progn
+ (goto-char res)
+ (mlinks-set-point-hilight-after-jump-to))
+ (message "No next link found")))))
+
+
+(defun mlinks-goto ()
+ "Follow `mlinks-mode' link at current point.
+Save the current position so that they can be move to again by
+`mlinks-prev-saved-position' and `mlinks-next-saved-position'.
+
+Return non-nil if link was followed, otherewise nil."
+ (interactive)
+ (mlinks-goto-1 nil))
+
+(defun mlinks-goto-other-window ()
+ "Like `mlinks-goto' but opens in other window.
+Uses `switch-to-buffer-other-window'."
+ (interactive)
+ (mlinks-goto-1 'other-window))
+
+(defun mlinks-goto-other-frame ()
+ "Like `mlinks-goto' but opens in other frame.
+Uses `switch-to-buffer-other-frame'."
+ (interactive)
+ (mlinks-goto-1 'other-frame))
+
+(defun mlinks-goto-1(where)
+ (push-mark)
+ (let* ((funs (mlinks-get-mode-value 'goto))
+ (old (point-marker))
+ (mlinks-temp-buffer-where where)
+ (res (run-hook-with-args-until-success 'funs)))
+ (if (not res)
+ (progn
+ (message "Don't know how to follow this MLink link")
+ nil)
+ (unless (= old (point-marker))
+ (let* ((prev (car mlinks-places)))
+ (when (or (not prev)
+ ;;(not (markerp prev))
+ (not (marker-buffer prev))
+ (/= old prev))
+ (setq mlinks-places (cons old mlinks-places))
+ (setq mlinks-places-n (length mlinks-places))))))))
+
+
+(defun mlinks-prev-saved-position ()
+ "Go to previous position saved by `mlinks-goto'."
+ (interactive)
+ (unless (mlinks-goto-n (1- mlinks-places-n))
+ (message "No previous MLink position")))
+
+(defun mlinks-next-saved-position ()
+ "Go to next position saved by `mlinks-goto'."
+ (interactive)
+ (unless (mlinks-goto-n (1+ mlinks-places-n))
+ (message "No next MLink position")))
+
+(defun mlinks-goto-n (to)
+ (if (not mlinks-places)
+ (message "No saved MLinks positions")
+ (let ((minp 1)
+ (maxp (length mlinks-places)))
+ (if (<= to minp)
+ (progn
+ (setq to minp)
+ (message "Going to first MLinks position"))
+ (if (>= to maxp)
+ (progn
+ (setq to maxp)
+ (message "Going to last MLinks position"))))
+ (setq mlinks-places-n to)
+ (let ((n (- maxp to))
+ (places mlinks-places)
+ place
+ buffer
+ point)
+ (while (> n 0)
+ (setq places (cdr places))
+ (setq n (1- n)))
+ (setq place (car places))
+ (mlinks-switch-to-buffer (marker-buffer place))
+ (goto-char place)))))
+
+(defvar mlinks-temp-buffer-where nil)
+(defun mlinks-switch-to-buffer (buffer)
+ (mlinks-switch-to-buffer-1 buffer mlinks-temp-buffer-where))
+
+(defun mlinks-switch-to-buffer-1(buffer where)
+ (cond
+ ((null where)
+ (switch-to-buffer buffer))
+ ((eq where 'other-window)
+ (switch-to-buffer-other-window buffer))
+ ((eq where 'other-frame)
+ (switch-to-buffer-other-frame buffer))
+ (t
+ (error "Invalid argument, where=%s" where))))
+
+;; FIXME: face, var
+(defun mlinks-custom (var)
+ (customize-option var)
+ )
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; AppMenu support
+
+(defun mlinks-appmenu ()
+ (when mlinks-mode
+ ;; Fix-me: reverse the list
+ (let ((link-val (mlinks-link-at-point))
+ (map (make-sparse-keymap "mlinks"))
+ (num 2))
+ (when (mlinks-get-mode-value 'prev)
+ (define-key map [mlinks-next-link]
+ (list 'menu-item "Next Link" 'mlinks-forward-link)))
+ (when (mlinks-get-mode-value 'next)
+ (define-key map [mlinks-prev-link]
+ (list 'menu-item "Previous Link" 'mlinks-backward-link)))
+ (when link-val
+ (let* ((possible (when (member major-mode '(html-mode nxhtml-mode nxml-mode sqml-mode text-mode))
+ (mlinks-html-possible-href-actions link-val)))
+ (mailto (assoc 'mailto possible))
+ (view-web (assoc 'view-web possible))
+ (view-web-base (assoc 'view-web-base possible))
+ (edit (assoc 'edit possible))
+ (file (nth 1 edit))
+ (anchor (nth 2 edit))
+ (choices)
+ (answer)
+ )
+ (when (> (length map) num)
+ (define-key map [mlinks-href-sep] (list 'menu-item "--")))
+ (setq num (length map))
+ (when view-web
+ (define-key map [mlinks-href-view-web]
+ (list 'menu-item "Browse Link Web Url"
+ `(lambda () (interactive)
+ (browse-url ,link-val)))))
+ (when view-web-base
+ (define-key map [mlinks-href-view-web-based]
+ (list 'menu-item "Browse Link Web Url (base URL found)"
+ `(lambda () (interactive)
+ (browse-url (cdr ,view-web-base))))))
+ (when mailto
+ (define-key map [mlinks-href-mail]
+ (list 'menu-item (concat "&Mail to " (substring link-val 7))
+ `(lambda () (interactive)
+ (mlinks-html-mail-to ,link-val)))))
+ (when edit
+ (when (and (file-exists-p file)
+ (not anchor)
+ (assoc 'upload possible))
+ (let ((abs-file (expand-file-name file)))
+ (define-key map [mlinks-href-upload]
+ (list 'menu-item "Upload Linked File"
+ `(lambda () (interactive)
+ (html-upl-upload-file ,abs-file))))))
+ (when (and (file-exists-p file)
+ (not anchor)
+ (assoc 'edit-gimp possible))
+ (let ((abs-file (expand-file-name file)))
+ (define-key map [mlinks-href-edit-gimp]
+ (list 'menu-item "Edit Linked File with GIMP"
+ `(lambda () (interactive)
+ (gimpedit-edit-file ,abs-file))))))
+ (when (and (file-exists-p file)
+ (assoc 'view-local possible))
+ (let ((url (concat "file:///" (expand-file-name file))))
+ (when anchor
+ (let ((url-anchor (concat url "#" anchor)))
+ (define-key map [mlinks-href-view-file-at]
+ (list 'menu-item (concat "Browse Linked File URL at #" anchor)
+ `(lambda () (interactive)
+ (browse-url ,url-anchor))))))
+ (define-key map [mlinks-href-view-file]
+ (list 'menu-item "&Browse Linked File URL"
+ `(lambda () (interactive)
+ (browse-url ,url))))))
+ (when (> (length map) num)
+ (define-key map [mlinks-href-sep-2] (list 'menu-item "--")))
+ (setq num (length map))
+ (unless (equal file (buffer-file-name))
+ (define-key map [mlinks-href-edit]
+ (list 'menu-item "&Open Linked File"
+ `(lambda () (interactive) (mlinks-goto))))
+ (define-key map [mlinks-href-edit-window]
+ (list 'menu-item "&Open Linked File in Other Window"
+ `(lambda () (interactive) (mlinks-goto-other-window))))
+ (define-key map [mlinks-href-edit-frame]
+ (list 'menu-item "&Open Linked File in New Frame"
+ `(lambda () (interactive) (mlinks-goto-other-frame))))
+ )
+ (when (and (file-exists-p file) anchor)
+ (define-key map [mlinks-href-edit-at]
+ (list 'menu-item (concat "Open Linked File &at #" anchor)
+ `(lambda () (interactive)
+ (mlinks-goto)))))
+ )
+ (when (> (length map) num)
+ (define-key map [mlinks-href-sep-1] (list 'menu-item "--")))
+ (setq num (length map))
+ (when link-val
+ (define-key map [mlinks-href-copy-link]
+ (list 'menu-item "&Copy Link Text"
+ 'mlinks-copy-link-text)))))
+ (when (> (length map) 2)
+ map))))
+
+(defun mlinks-add-appmenu ()
+ "Add entries for MLinks to AppMenu."
+ (when (featurep 'appmenu)
+ (appmenu-add 'mlinks 100 'mlinks-mode "Current MLink" 'mlinks-appmenu)))
+
+(defun mlinks-copy-link-text ()
+ "Copy text of `mlinks-mode' link at point to clipboard."
+ (interactive)
+ (mlinks-point-hilighter)
+ (let ((ovl mlinks-point-hilighter-overlay))
+ (if (and ovl
+ (overlayp ovl)
+ (overlay-buffer ovl)
+ (eq (current-buffer)
+ (overlay-buffer ovl))
+ (<= (overlay-start ovl)
+ (point))
+ (>= (overlay-end ovl)
+ (point)))
+ (let* ((beg (overlay-start ovl))
+ (end (overlay-end ovl))
+ (str (buffer-substring beg end)))
+ (copy-region-as-kill beg end)
+ (message "Copied %d chars to clipboard" (length str)))
+ (message "No link here to copy"))))
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;; text-mode etc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar mlinks-plain-urls-regexp
+ (rx-to-string `(or (submatch (optional "mailto:")
+ (regexp ,(concat
+ ;;"[a-z0-9$%(*-=?[_][^<>\")!;:,{}]*"
+ "[a-z0-9$%(*=?[_-][^<>\")!;:,{}]*"
+ "\@"
+ "\\(?:[a-z0-9\-]+\.\\)+[a-z0-9]\\{2,4\\}")))
+ (submatch (or (regexp "https?://")
+ "www.")
+ (1+ (any ,url-get-url-filename-chars))
+ )
+ )))
+
+(defun mlinks-plain-urls-fontify (bound)
+ (mlinks-fontify bound mlinks-plain-urls-regexp 0))
+
+(defun mlinks-goto-plain-url ()
+ (let* ((range (mlinks-link-range (point)))
+ (link (when range (buffer-substring-no-properties (car range) (cdr range)))))
+ ;;(mlinks-html-href-act-on link)
+ (when (= 0 (string-match mlinks-plain-urls-regexp link))
+ (let ((which (if (match-end 1) 1 2)))
+ (cond
+ ((= 1 which)
+ (mlinks-html-mail-to link)
+ t)
+ ((= 2 which)
+ (browse-url link)
+ t)
+ (t nil))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;; nxhtml-mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun mlinks-html-style-goto ()
+ (mlinks-html-style-mode-fun t))
+
+(defvar mlinks-html-link-regexp
+ ;; This value takes care of nxhtml-strval-mode (and is therefore a little bit incorrect ...)
+ ;;"\\(?:^\\|[[:space:]]\\)\\(?:href\\|src\\)[[:space:]]*=[[:space:]]*\"\\([^<«\"]*\\)\""
+ (rx (or "^" space)
+ (or "href" "src")
+ (0+ space)
+ "="
+ (0+ space)
+ (submatch
+ (or
+ (seq "\""
+ (and
+ (0+ (not (any "\""))))
+ "\"")
+ (seq "'"
+ (and
+ (0+ (not (any "\'"))))
+ "'")))))
+
+(defun mlinks-html-style-mode-fun (goto)
+ (let (start
+ end
+ bounds)
+ (save-excursion
+ (forward-char)
+ (when (< 0 (skip-chars-forward "^\"'" (line-end-position)))
+ (forward-char)
+ (save-match-data
+ (when (looking-back
+ mlinks-html-link-regexp
+ (line-beginning-position -1))
+ (let ((which (if (match-beginning 1) 1 2)))
+ (setq start (1+ (match-beginning which)))
+ (setq end (1- (match-end which))))
+ (setq bounds (cons start end))))))
+ (when start
+ (if (not goto)
+ bounds
+ (let ((href-val (buffer-substring-no-properties start end)))
+ (mlinks-html-href-act-on href-val))
+ t))))
+
+(defun mlink-check-file-to-edit (file)
+ (assert (file-name-absolute-p file))
+ (let ((file-dir (file-name-directory file)))
+ (unless (file-directory-p file-dir)
+ (if (file-directory-p (file-name-directory file))
+ (if (yes-or-no-p (format "Directory %s does not exist. Create it? " file-dir))
+ (make-directory file-dir)
+ (setq file nil))
+ (if (yes-or-no-p (format "Directory %s and its parent does not exist. Create them? " file-dir))
+ (make-directory file-dir t)
+ (setq file nil))))
+ file))
+
+(defun mlinks-html-edit-at (file &optional anchor)
+ (let ((abs-file (if (file-name-absolute-p file)
+ file
+ (expand-file-name file))))
+ (if (or (file-directory-p abs-file)
+ (string= abs-file
+ (file-name-as-directory abs-file)))
+ (if (file-directory-p abs-file)
+ (when (y-or-n-p (format "Do you want to edit the directory %s? : " abs-file))
+ (dired abs-file))
+ (message "Can't find directory %s" abs-file))
+ (when (mlink-check-file-to-edit abs-file)
+ (let ((b (find-file-noselect abs-file)))
+ (mlinks-switch-to-buffer b))
+ (when anchor
+ (let ((here (point))
+ (anchor-regexp (concat "\\(?:id\\|name\\)[[:space:]]*=[[:space:]]*\"" anchor "\"")))
+ (goto-char (point-min))
+ (if (search-forward-regexp anchor-regexp nil t)
+ (backward-char 2)
+ (message "Anchor \"%s\" not found" anchor)
+ (goto-char here))))))))
+
+(defun mlinks-html-mail-to (addr)
+ (browse-url addr))
+
+(defun mlinks-html-href-act-on (href-val)
+ (if href-val
+ (let* ((possible (mlinks-html-possible-href-actions href-val))
+ (edit (assoc 'edit possible))
+ (file (nth 1 edit))
+ (anchor (nth 2 edit))
+ )
+ (cond (edit
+ (mlinks-html-edit-at file anchor)
+ t)
+ ((assoc 'mailto possible)
+ (when (y-or-n-p "This is a mail address. Do you want to send a message to this mail address? ")
+ (mlinks-html-mail-to href-val)))
+ ((assoc 'view-web possible)
+ (when (y-or-n-p "Can't edit this URL, it is on the web. View the URL in your web browser? ")
+ (browse-url href-val)))
+ ((assoc 'view-web-base possible)
+ (when (y-or-n-p "Can't edit, based URL is to the web. View resulting URL in your web browser? ")
+ (browse-url (cdr (assoc 'view-web-base possible)))))
+ (t
+ (message "Do not know how to handle this URL"))
+ ))
+ (message "No value for href attribute")))
+
+(defun mlinks-html-possible-href-actions (link)
+ (let ((urlobj (url-generic-parse-url link))
+ (edit nil)
+ (possible nil))
+ (cond ((member (url-type urlobj) '("http" "https"))
+ (add-to-list 'possible (cons 'view-web link)))
+ ((member (url-type urlobj) '("mailto"))
+ (add-to-list 'possible (cons 'mailto link)))
+ ((url-host urlobj)
+ (message "Do not know how to handle this URL"))
+ (t (setq edit t)))
+ (when edit
+ (let ((base-href (mlinks-html-find-base-href)))
+ (when base-href
+ (let ((baseobj (url-generic-parse-url base-href)))
+ (setq edit nil)
+ (cond ((member (url-type baseobj) '("http" "https"))
+ (add-to-list 'possible (cons 'view-web-base (url-expand-file-name link base-href))))
+ ((url-host urlobj)
+ (message "Do not know how to handle this URL"))
+ (t (setq edit t)))))
+ (when edit
+ (let* ((full (split-string (url-filename urlobj) "#"))
+ (file (nth 0 full))
+ (anchor (nth 1 full))
+ )
+ (when (equal file "")
+ (setq file (buffer-file-name)))
+ (when base-href
+ ;; We know at this point it is not a http url
+ (setq file (expand-file-name file base-href)))
+ (let ((ext (downcase (file-name-extension file))))
+ (when (member ext '("htm" "html"))
+ (add-to-list 'possible (cons 'view-local (list file anchor))))
+ (when (and (featurep 'gimpedit)
+ (member ext '("gif" "png" "jpg" "jpeg")))
+ (add-to-list 'possible (cons 'edit-gimp (list file anchor)))))
+ (when (featurep 'html-upl)
+ (add-to-list 'possible (cons 'upload (list file anchor))))
+ (add-to-list 'possible (cons 'edit (list file anchor)))))))
+ possible))
+
+(defun mlinks-html-find-base-href ()
+ "Return base href found in the current file."
+ (let ((base-href))
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not base-href)
+ (search-forward-regexp "<!--[^!]*-->\\|<base[[:space:]]" nil t))
+ (when (equal " " (char-to-string (char-before)))
+ (backward-char 6)
+ (when (looking-at "<base [^>]*href *= *\"\\(.*?\\)\"")
+ (setq base-href (match-string-no-properties 1))))))
+ base-href))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;; Custom-mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun mlinks-elisp-custom-goto ()
+ (mlinks-elisp-mode-fun 'custom))
+
+(defvar mlinks-custom-link-regexp
+ (rx "`"
+ (group
+ (1+ (not (any "'"))))
+ "'"))
+
+(defun mlinks-custom-fontify (bound)
+ (mlinks-fontify bound mlinks-custom-link-regexp 0))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;; emacs-lisp-mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun mlinks-elisp-goto ()
+ (mlinks-elisp-mode-fun 'source))
+
+(defun mlinks-elisp-hili ()
+ (mlinks-elisp-mode-fun nil))
+
+(defun mlinks-elisp-mode-fun (goto)
+ (let ((symbol-name (thing-at-point 'symbol)))
+ (when symbol-name
+ (let ((bounds-- (bounds-of-thing-at-point 'symbol))
+ ret--)
+ (if (save-excursion
+ (goto-char (cdr bounds--))
+ (looking-back (concat "(\\(?:require\\|featurep\\)\s+'" symbol-name)
+ (line-beginning-position)))
+ (progn
+ (setq ret-- bounds--)
+ (when goto
+ (mlinks-elisp-mode-require symbol-name)))
+ (when (mlinks-elisp-mode-symbol symbol-name goto)
+ (setq ret-- bounds--)))
+ ret--))))
+
+(defun mlinks-elisp-function (symbol)
+ "Go to an elisp function."
+ (interactive "aElisp function: ")
+ (mlinks-elisp-mode-symbol (symbol-name symbol) 'source))
+
+(defun mlinks-elisp-mode-symbol (symbol-name-- goto--)
+ ;; Fix-me: use uninterned variables (see mail from Miles)
+ ;; Make these names a bit strange because they are boundp at the time of checking:
+ (let ((symbol-- (intern-soft symbol-name--))
+ defs--)
+ (when (and symbol-- (boundp symbol--))
+ (add-to-list 'defs-- 'variable))
+ (when (fboundp symbol--)
+ (add-to-list 'defs-- 'function))
+ (when (facep symbol--)
+ (add-to-list 'defs-- 'face))
+ ;; Avoid some fails hits
+ (when (memq symbol--
+ '(goto t
+ bounds-- funs-- ret--
+ symbol-- defs-- symbol-name-- goto--))
+ (setq defs-- nil))
+ (let (defs-places
+ def)
+ (if (not goto--)
+ (progn
+ defs--)
+ (if (not defs--)
+ (progn
+ (message "Could not find definition of '%s" symbol-name--)
+ nil)
+ (dolist (type (cond
+ ((eq goto-- 'source)
+ '(nil defvar defface))
+ ((eq goto-- 'custom)
+ '(defvar defface))
+ (t
+ (error "Bad goto-- value: %s" goto--))))
+ (condition-case err
+ (add-to-list 'defs-places
+ (cons
+ type
+ (save-excursion
+ (let* ((bp (find-definition-noselect symbol-- type))
+ (b (car bp))
+ (p (cdr bp)))
+ (unless p
+ (with-current-buffer b
+ (save-restriction
+ (widen)
+ (setq bp (find-definition-noselect symbol-- type)))))
+ bp))))
+ (error
+ ;;(lwarn '(mlinks) :error "%s" (error-message-string err))
+ (when t
+ (cond
+ ((eq (car err) 'search-failed))
+ ((and (eq (car err) 'error)
+ (string= (error-message-string err)
+ (format "Don't know where `%s' is defined" symbol--))))
+ (t
+ (message "%s: %s" (car err) (error-message-string err))))))))
+ (if (= 1 (length defs-places))
+ (setq def (car defs-places))
+ (let ((many nil)
+ lnk)
+ (dolist (d defs-places)
+ (if (not lnk)
+ (setq lnk (cdr d))
+ (unless (equal lnk (cdr d))
+ (setq many t))))
+ (if (not many)
+ (setq def (car defs-places))
+ (let* ((alts (mapcar (lambda (elt)
+ (let ((type (car elt))
+ str)
+ (setq str
+ (cond
+ ((not type)
+ "Function")
+ ((eq type 'defvar)
+ "Variable")
+ ((eq type 'defface)
+ "Face")))
+ (cons str elt)))
+ defs-places))
+ (stralts (mapcar (lambda (elt)
+ (car elt))
+ alts))
+ (completion-ignore-case t)
+ (stralt (completing-read "Type: " stralts nil t))
+ (alt (assoc stralt alts)))
+ (setq def (cdr alt))))))
+ (when def
+ (cond
+ ((eq goto-- 'source)
+ ;; Be sure to go to the real sources from CVS:
+ (let* ((buf (car (cdr def)))
+ ;; Avoid going to source
+ ;;(file (find-source-lisp-file (with-current-buffer buf buffer-file-name)) )
+ (file (with-current-buffer buf buffer-file-name))
+ (orig-buf (find-file-noselect file)))
+ (mlinks-switch-to-buffer orig-buf)
+ (let ((p (cdr (cdr def))))
+ ;; Fix-me: Move this test to a more general place.
+ (if (or (< p (point-min))
+ (> p (point-max)))
+ ;; Check for cloned indirect buffers.
+ (progn
+ (setq orig-buf
+ (catch 'view-in-buf
+ (dolist (indirect-buf (buffer-list))
+ ;;(message "base-buffer=%s, orig-buf=%s, eq => %s" (buffer-base-buffer indirect-buf) orig-buf (eq (buffer-base-buffer indirect-buf) orig-buf))
+ (when (eq (buffer-base-buffer indirect-buf) orig-buf)
+ (with-current-buffer indirect-buf
+ ;;(message "indirect-buf=%s" indirect-buf)
+ (unless (or (< p (point-min))
+ (> p (point-max)))
+ ;;(message "switching")
+ ;;(mlinks-switch-to-buffer indirect-buf)
+ (message "mlinks: Switching to indirect buffer because of narrowing")
+ (throw 'view-in-buf indirect-buf)
+ ))
+ ))))
+ (when orig-buf
+ (mlinks-switch-to-buffer orig-buf))
+ ;;(message "cb=%s" (current-buffer))
+ (if (or (< p (point-min))
+ (> p (point-max)))
+ (when (y-or-n-p (format "%s is invisible because of narrowing. Widen? " symbol--))
+ (widen)
+ (goto-char p))
+ (goto-char p)))
+ (goto-char p)))))
+ ((eq goto-- 'custom)
+ (mlinks-custom symbol--))
+ (t
+ (error "Back goto-- value again: %s" goto--)))))))))
+
+(defun mlinks-elisp-mode-require (module)
+ (let ((where mlinks-temp-buffer-where))
+ (cond
+ ((null where)
+ (find-library module))
+ ((eq where 'other-window)
+ (other-window 1)
+ (find-library module))
+ ((eq where 'other-frame)
+ (make-frame-command)
+ (find-library module))
+ (t
+ (error "Invalid argument, where=%s" where)))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;; Helpers when adopting for modes ;;;;;;;;;;;;;;;;;
+
+;;; Save this, do not delete this comment:
+
+;; (defun mlinks-hit-test ()
+;; "Just a helper function for adding support for new modes."
+;; (let* (
+;; (s0 (if (match-string 0) (match-string 0) ""))
+;; (s1 (if (match-string 1) (match-string 1) ""))
+;; (s2 (if (match-string 2) (match-string 2) ""))
+;; (s3 (if (match-string 3) (match-string 3) ""))
+;; )
+;; (message "match0=%s, match1=%s, match2=%s, match3=%s" s0 s1 s2 s3)))
+
+;; (defun mlinks-handle-reg-fun-list (reg-fun-list)
+;; "Just a helper function."
+;; (let (done
+;; regexp
+;; hitfun
+;; m
+;; p
+;; b
+;; )
+;; (dolist (rh reg-fun-list)
+;; (message "rh=%s" rh);(sit-for 2)
+;; (unless done
+;; (setq regexp (car rh))
+;; (setq hitfun (cadr rh))
+;; (message "regexp=%s, hitfun=%s" regexp hitfun);(sit-for 1)
+;; (when (and (save-match-data
+;; (setq m (re-search-backward regexp (line-beginning-position) t))
+;; (> p (match-beginning 0))))
+;; (setq done t)
+;; (setq b (match-beginning 0))
+;; (setq e (match-end 0))
+;; )
+;; (if (not (and b e
+;; (< b p)
+;; (< p e)))
+;; (message "MLinks Mode did not find any link here")
+;; (goto-char b)
+;; (if (not (looking-at regexp))
+;; (error "Internal error, regexp %s, no match looking-at" regexp)
+;; (let ((last (car mlinks-places))
+;; (m (make-marker)))
+;; (set-marker m (line-beginning-position))
+;; (when (or (not last)
+;; (/= m last))
+;; (setq mlinks-places (cons m mlinks-places))))
+;; (funcall hitfun))
+;; )))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Font Lock use
+
+(defvar mlinks-link-update-pos-max nil)
+(make-variable-buffer-local 'mlinks-link-update-pos-max)
+(put 'mlinks-link-update-pos-max 'permanent-local t)
+
+(defun mlinks-remove-font-lock ()
+ "Remove info from font-lock."
+ (when (mlinks-want-font-locking)
+ (mlink-font-lock nil)))
+
+(defun mlinks-add-font-lock ()
+ "Add info to font-lock."
+ (when (mlinks-want-font-locking)
+ (mlink-font-lock t)))
+
+(defun mlinks-want-font-locking ()
+ (or (mlinks-get-mode-value 'fontify)
+ (mlinks-get-mode-value 'next-mark)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Font Lock integration
+
+(defun mlink-font-lock (on)
+ (let* ((add-or-remove (if on 'font-lock-add-keywords 'font-lock-remove-keywords))
+ (fontify-fun (car (mlinks-get-mode-value 'fontify)))
+ (args (list nil `(( ,fontify-fun ( 0 mlinks-font-lock-face t ))))))
+ (when fontify-fun
+ ;; Note: Had a lot of trouble with this which I modelled first
+ ;; after dlink. Using hi-lock as a model made it work with
+ ;; mumamo too.
+ ;;
+ ;; Next arg, HOW, is needed to get it to work with mumamo. This
+ ;; adds it last, like hi-lock.
+ (when on (setq args (append args (list t))))
+ (apply add-or-remove args)
+ (font-lock-mode -1)
+ (font-lock-mode 1))))
+
+(defun mlinks-html-fontify (bound)
+ (mlinks-fontify bound mlinks-html-link-regexp 1))
+
+(defun mlinks-fontify (bound regexp border)
+ (let ((start (point))
+ end-start
+ stop next-stop
+ (more t)
+ old-beg old-end
+ (wn 1)
+ ret)
+ ;; Note: we shouldnot use save-match-data here. Instead
+ ;; set-match-data is called below!
+ (if (not (re-search-forward regexp bound t))
+ (setq end-start bound)
+ (setq ret t)
+ (setq end-start (- (point) 2))
+ (let* ((which (if (match-beginning 1) 1 2))
+ (beg (+ (match-beginning which) border))
+ (end (- (match-end which) border)))
+ (put-text-property beg end 'mlinks-link t)
+ (set-match-data (list (copy-marker end) (copy-marker beg)))))
+ (setq stop start)
+ (setq next-stop -1)
+ (while (and (> 100 (setq wn (1+ wn)))
+ (setq next-stop (next-single-char-property-change stop 'mlinks-link nil end-start))
+ (/= next-stop stop))
+ (setq stop next-stop)
+ (if (get-text-property stop 'mlinks-link)
+ (setq old-beg stop)
+ (when old-beg
+ (remove-list-of-text-properties old-beg stop '(mlinks-link 'mouse-face)))))
+ ret))
+
+(defun mlinks-next-link ()
+ "Find next link, fontify as necessary."
+ (let* ((here (point))
+ (prev-pos (point))
+ (fontified-here (get-text-property (max (point-min) (1- prev-pos)) 'fontified))
+ (fontified-to (next-single-char-property-change prev-pos 'fontified))
+ (pos (next-single-char-property-change prev-pos 'mlinks-link nil
+ (or fontified-to (point-max))))
+ (fontified-all (and fontified-here (not fontified-to)))
+ ready
+ next-fontified-to)
+ (while (not (or ready
+ (and fontified-all
+ (not pos))))
+ (if pos
+ (progn
+ (unless (get-text-property pos 'mlinks-link)
+ ;; Get to next link
+ (setq prev-pos pos)
+ (setq pos (next-single-char-property-change prev-pos 'mlinks-link nil
+ (or fontified-to (point-max)))))
+ (when pos
+ (setq ready (get-text-property pos 'mlinks-link))
+ (setq prev-pos pos)
+ (unless ready (setq pos nil))))
+ (unless (or fontified-all fontified-to)
+ (if (get-text-property prev-pos 'fontified)
+ (setq fontified-all
+ (not (setq fontified-to
+ (next-single-char-property-change prev-pos 'fontified))))
+ (setq fontified-to ( or (previous-single-char-property-change prev-pos 'fontified)
+ 1))))
+ (setq next-fontified-to (min (+ fontified-to 5000)
+ (point-max)))
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (progn
+ (put-text-property fontified-to next-fontified-to 'fontified t)
+ (font-lock-fontify-region fontified-to next-fontified-to)))
+ (setq fontified-to (next-single-char-property-change (1- next-fontified-to)
+ 'fontified))
+ (setq fontified-all (not fontified-to))
+ (setq pos (next-single-char-property-change prev-pos 'mlinks-link nil
+ (or fontified-to (point-max))))))
+ (when ready prev-pos)))
+
+(defun mlinks-prev-link ()
+ "Find previous link, fontify as necessary."
+ (let* ((prev-pos (point))
+ (fontified-from (previous-single-char-property-change prev-pos 'fontified))
+ (fontified-here (get-text-property (max (point-min) (1- prev-pos)) 'fontified))
+ (fontified-all (and fontified-here (not fontified-from)))
+ (pos (when fontified-here
+ (previous-single-char-property-change prev-pos 'mlinks-link nil
+ (or fontified-from 1))))
+ ready
+ next-fontified-from)
+ (while (not (or ready
+ (and fontified-all
+ (not pos))))
+ (assert (numberp prev-pos) t)
+ (if pos
+ (progn
+ (when (and (> (1- pos) (point-min))
+ (get-text-property (1- pos) 'mlinks-link))
+ ;; Get out of current link
+ (setq prev-pos pos)
+ (setq pos (previous-single-char-property-change prev-pos 'mlinks-link nil
+ (or fontified-from 1))))
+ (when pos
+ (setq prev-pos pos)
+ (setq ready (and (get-text-property pos 'fontified)
+ (or (= 1 pos)
+ (not (get-text-property (1- pos) 'mlinks-link)))
+ (get-text-property pos 'mlinks-link)))
+ (unless ready (setq pos nil))))
+ (setq next-fontified-from (max (- fontified-from 5000)
+ (point-min)))
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (progn
+ (put-text-property next-fontified-from fontified-from 'fontified t)
+ (font-lock-fontify-region next-fontified-from fontified-from)))
+ (setq fontified-from (previous-single-char-property-change
+ (1+ next-fontified-from) 'fontified))
+ (setq fontified-all (not fontified-from))
+ (setq pos (previous-single-char-property-change prev-pos 'mlinks-link nil
+ (or fontified-from 1)))))
+ (when ready pos)))
+
+
+;;; This is for the problem reported by some Asian users:
+;;;
+;;; Lisp error: (invalid-read-syntax "] in a list")
+;;;
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+(provide 'mlinks)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; mlinks.el ends here
--- /dev/null
+;;; mumamo-aspnet.el --- Support for ASP .Net in `mumamo-mode'.
+;;
+;;;;; John: Please change here to what you want:
+;; Author: John J Foerch (jjfoerch A earthlink O net)
+;; Maintainer:
+;; Created: ??
+;; Version: ==
+;; Last-Updated: Wed Dec 12 21:55:11 2007 (3600 +0100)
+;; URL: http://OurComments.org/Emacs/Emacs.html
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Support for ASP .Net in `mumamo-mode'. If you want to use VB then
+;; you have to get the vb mode that this is written for here:
+;;
+;; http://www.emacswiki.org/cgi-bin/wiki/VbDotNetMode
+;;
+;; A C# mode is already included in nXhtml. That is the one that this
+;; library has been tested with.
+;;
+;;
+;;; Usage:
+;;
+;; Put this file in you Emacs `load-path' and add in your .emacs:
+;;
+;; (eval-after-load 'mumamo
+;; (require 'mumamo-aspnet)
+;; (mumamo-aspnet-add-me))
+;;
+;; A file with the extension .aspx will no be opened with nxhtml-mode
+;; as the main major mode and with chunks in csharp-mode etc.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(eval-when-compile (require 'mumamo))
+
+;;;
+
+;; (defun mumamo-aspnet-add-me()
+;; "Make mumamo aware of the ASP.Net extension."
+;; (add-to-list 'mumamo-chunk-family-list
+;; '("ASP.Net nXhtml Family" nxhtml-mode
+;; (mumamo-chunk-aspnet
+;; mumamo-chunk-aspnet-script
+;; mumamo-chunk-inlined-style
+;; mumamo-chunk-inlined-script
+;; mumamo-chunk-style=
+;; mumamo-chunk-onjs=
+;; ))
+;; t)
+;; (add-to-list 'mumamo-chunk-family-list
+;; '("ASP.Net XHTML Family" html-mode
+;; (mumamo-chunk-aspnet
+;; mumamo-chunk-aspnet-script
+;; mumamo-chunk-inlined-style
+;; mumamo-chunk-inlined-script
+;; mumamo-chunk-style=
+;; mumamo-chunk-onjs=
+;; ))
+;; t)
+
+
+;; (add-to-list 'mumamo-filenames-list
+;; '("\\.aspx\\'" "ASP.Net nXhtml Family"))
+;; ;; Make it SET for current session in Custom.
+;; (customize-set-variable 'mumamo-filenames-list mumamo-filenames-list)
+;; (customize-set-value 'mumamo-filenames-list mumamo-filenames-list)
+
+;; ;; this is how to set up mode aliases, should we need them.
+;; (add-to-list 'mumamo-major-modes '(csharp-mode csharp-mode))
+;; (add-to-list 'mumamo-major-modes '(vbnet-mode vbnet-mode))
+;; ;; Make it SET for current session in Custom.
+;; (customize-set-variable 'mumamo-major-modes mumamo-major-modes)
+;; (customize-set-value 'mumamo-major-modes mumamo-major-modes)
+;; )
+
+
+;;; aspnet
+
+(defvar mumamo-aspnet-page-language-mode-spec nil
+ "A mumamo mode-spec for the default language of an ASP.Net page.
+This is what is set with the directive `@ Page Language' on the
+page.
+
+Internal variable.")
+(make-variable-buffer-local 'mumamo-aspnet-page-language-mode-spec)
+;;(add-to-list 'mumamo-survive 'mumamo-aspnet-page-language-mode-spec)
+(put 'mumamo-aspnet-page-language-mode-spec 'permanent-local t)
+
+(defconst mumamo-aspnet-language-regex
+ (rx (0+ (not (any ">")))
+ word-start "language" (0+ space) "=" (0+ space) ?\" (submatch (0+ (not (any ?\" ?>)))) ?\"
+ ))
+
+(defun mumamo-aspnet-get-page-language-mode-spec ()
+ (or mumamo-aspnet-page-language-mode-spec
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "<%@ Page")
+ (let ((case-fold-search t))
+ (when (looking-at mumamo-aspnet-language-regex)
+ (mumamo-aspnet-mode-spec-for-language (match-string 1))))))
+ 'fundamental-mode))
+
+(defun mumamo-aspnet-get-mode-for-chunk (&optional chunk-type)
+ (cond ((eq chunk-type 'script)
+ (mumamo-get-major-mode-substitute
+ (or (if (looking-at mumamo-aspnet-language-regex)
+ (mumamo-aspnet-mode-spec-for-language (match-string 1))
+ (mumamo-aspnet-get-page-language-mode-spec))
+ 'fundamental-mode)
+ 'fontification))
+ ((eq chunk-type 'directive)
+ 'fundamental-mode)
+ ;;(t (mumamo-mode-from-modespec
+ (t (mumamo-get-major-mode-substitute
+ (mumamo-aspnet-get-page-language-mode-spec)
+ 'fontification
+ ))))
+
+
+(defun mumamo-chunk-aspnet(pos min max)
+ "Find <% ... %>."
+ (mumamo-find-possible-chunk pos min max
+ 'mumamo-search-bw-exc-start-aspnet
+ 'mumamo-search-bw-exc-end-jsp
+ 'mumamo-search-fw-exc-start-jsp
+ 'mumamo-search-fw-exc-end-jsp))
+
+(defun mumamo-search-bw-exc-start-aspnet(pos min)
+ ;;(let ((exc-start (mumamo-search-bw-exc-start-str pos min "<%")))
+ (let ((exc-start (mumamo-chunk-start-bw-str pos min "<%")))
+ (when (and exc-start
+ (<= exc-start pos))
+ (cons exc-start
+ (mumamo-aspnet-get-mode-for-chunk
+ (if (eq (char-after exc-start) ?@)
+ 'directive))))))
+
+(defconst mumamo-aspnet-script-tag-start-regex
+ (rx "<script" word-end
+ (0+ (not (any ">")))
+ word-start "runat" (0+ space) "=" (0+ space) ?\" "server" ?\"
+ (0+ (not (any ">")))
+ ">"
+ ))
+
+(defun mumamo-aspnet-mode-spec-for-language (language)
+ (let ((language (downcase language)))
+ (cond ((equal language "c#") 'csharp-mode)
+ ((equal language "vb") 'vbnet-mode)
+ (t 'fundamental-mode))))
+
+(defun mumamo-search-bw-exc-start-aspnet-script(pos min)
+ (goto-char (+ pos 7))
+ (let ((marker-start (search-backward "<script" min t))
+ exc-mode
+ exc-start)
+ (when marker-start
+ (when (looking-at mumamo-aspnet-script-tag-start-regex)
+ (setq exc-start (match-end 0))
+ (setq exc-mode (mumamo-aspnet-get-mode-for-chunk 'script))
+ (goto-char exc-start)
+ (when (<= exc-start pos)
+ (cons (point) exc-mode))))))
+
+(defun mumamo-search-fw-exc-start-aspnet-script(pos max)
+ (goto-char (1+ pos))
+ (skip-chars-backward "^<")
+ ;; Handle <![CDATA[
+ (when (and
+ (eq ?< (char-before))
+ (eq ?! (char-after))
+ (not (bobp)))
+ (backward-char)
+ (skip-chars-backward "^<"))
+ (unless (bobp)
+ (backward-char 1))
+ (let ((exc-start (search-forward "<script" max t))
+ exc-mode)
+ (when exc-start
+ (goto-char (- exc-start 7))
+ (when (looking-at mumamo-aspnet-script-tag-start-regex)
+ (goto-char (match-end 0))
+ (point)
+ ))))
+
+(defun mumamo-chunk-aspnet-script(pos min max)
+ "Find inlined script, <script runat=\"server\">...</script>."
+ (mumamo-find-possible-chunk pos min max
+ 'mumamo-search-bw-exc-start-aspnet-script
+ 'mumamo-search-bw-exc-end-inlined-script
+ 'mumamo-search-fw-exc-start-aspnet-script
+ 'mumamo-search-fw-exc-end-inlined-script))
+
+;; Fix-me: define a multi major mode for asp. Or maybe just drop this
+;; file?
+
+(provide 'mumamo-aspnet)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; mumamo-aspnet.el ends here
--- /dev/null
+;;; mumamo-fun.el --- Multi major mode functions
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-03-09T01:35:21+0100 Sun
+;; Version: 0.51
+;; Last-Updated: 2008-08-04T17:54:29+0200 Mon
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `backquote', `bytecomp', `cl', `flyspell', `ispell', `mumamo',
+;; `sgml-mode'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Defines some "multi major modes" functions. See mumamo.el for more
+;; information.
+;;
+;;;; Usage:
+;;
+;; See mumamo.el for how to use the multi major mode functions
+;; defined here.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (add-to-list 'load-path default-directory))
+(eval-when-compile (require 'mumamo))
+(eval-when-compile (require 'sgml-mode))
+;;(mumamo-require)
+
+;;;#autoload
+;;(defun mumamo-fun-require ())
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; File wide key bindings
+
+(defun mumamo-multi-mode-map ()
+ "Return mumamo multi mode keymap."
+ (symbol-value
+ (intern-soft (concat (symbol-name mumamo-multi-major-mode) "-map"))))
+
+;; (defun mumamo-multi-mode-hook-symbol ()
+;; "Return mumamo multi mode hook symbol."
+;; (intern-soft (concat (symbol-name mumamo-multi-major-mode) "-hook")))
+
+;;;###autoload
+(defun mumamo-define-html-file-wide-keys ()
+ "Define keys in multi major mode keymap for html files."
+ (let ((map (mumamo-multi-mode-map)))
+ (define-key map [(control ?c) (control ?h) ?b] 'nxhtml-browse-file)
+ ))
+;; (defun mumamo-add-html-file-wide-keys (hook)
+;; (add-hook hook 'mumamo-define-html-file-wide-keys)
+;; )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Chunk search routines for XHTML things
+
+(defun mumamo-chunk-attr= (pos min max attr= attr=is-regex attr-regex submode)
+ "This should work similar to `mumamo-find-possible-chunk'.
+See `mumamo-chunk-style=' for an example of use.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-chunk-attr=-new pos max attr= attr=is-regex attr-regex submode))
+
+(defun mumamo-chunk-attr=-new-fw-exc-fun (pos max)
+ ;;(msgtrc "(mumamo-chunk-attr=-new-fw-exc-fun %s %s)" pos max)
+ (save-match-data
+ (let ((here (point))
+ first-dq
+ next-dq
+ (this-chunk (mumamo-get-existing-new-chunk-at pos)))
+ (if this-chunk
+ (goto-char (overlay-end this-chunk))
+ (goto-char (overlay-end mumamo-last-chunk)))
+ (setq first-dq (search-forward "\"" max t))
+ (unless (bobp)
+ (backward-char)
+ (condition-case err
+ (with-syntax-table (standard-syntax-table)
+ (setq next-dq (scan-sexps (point) 1)))
+ (error nil)))
+ (prog1
+ next-dq
+ (goto-char here)))))
+
+(defun mumamo-chunk-attr=-new-find-borders-fun (start-border end-border dummy)
+ ;;(setq borders (funcall find-borders-fun start-border end-border exc-mode))
+ (save-match-data
+ (let ((here (point))
+ (end2 (when end-border (1- end-border)))
+ start2)
+ (goto-char start-border)
+ (save-match-data
+ (setq start2 (search-forward "\"" (+ start-border 200) t)))
+ (goto-char here)
+ (list start2 end2))))
+
+(defun mumamo-chunk-attr=-new (pos
+ ;;min
+ max
+ attr=
+ attr=is-regex
+ attr-regex
+ submode)
+ ;;(message "\n(mumamo-chunk-attr=-new %s %s %s %s %s %s)" pos max attr= attr=is-regex attr-regex submode)
+ ;;(mumamo-condition-case err
+ (condition-case err
+ (save-match-data
+ (let ((here (point))
+ (next-attr= (progn
+ ;; fix-me:
+ (if (not attr=is-regex)
+ (goto-char (+ pos (length attr=)))
+ (goto-char pos)
+ (skip-chars-forward "a-zA-Z="))
+ (goto-char pos)
+ (if attr=is-regex
+ (re-search-forward attr= max t)
+ (search-forward attr= max t))))
+ next-attr-sure
+ ;;next-attr=
+ start start-border
+ end end-border
+ exc-mode
+ borders
+ exc-start-next
+ exc-end-next
+ exc-start-next
+ exc-end-next
+ (tries 0)
+ (min (1- pos))
+ look-max
+ )
+ ;; make sure if we have find prev-attr= or not
+ (unless (eq (char-after) ?\")
+ (setq next-attr= nil))
+ (when next-attr=
+ (forward-char)
+ (skip-chars-forward "^\"")
+ (setq look-max (+ (point) 2)))
+ (while (and next-attr=
+ (< min (point))
+ (not next-attr-sure)
+ (< tries 5))
+ ;;(msgtrc "attr=-new: min=%s, point=%s" min (point))
+ (setq tries (1+ tries))
+ ;;(if (not (re-search-backward "<[^?]" (- min 300) t))
+ (if (not (re-search-backward "<[^?]\\|\?>" (- min 300) t))
+ (setq next-attr= nil)
+ ;;(if (looking-at attr-regex)
+ (if (let ((here (point)))
+ (prog1
+ (re-search-forward attr-regex look-max t)
+ (goto-char here)))
+ ;;(if (mumamo-end-in-code (point) next-attr= 'php-mode)
+ (setq next-attr-sure 'found)
+ (unless (bobp)
+ (backward-char)
+ ;;(msgtrc "attr=-new 1: min=%s, point=%s" min (point))
+ (setq next-attr= (if attr=is-regex
+ (re-search-backward attr= (- min 300) t)
+ (search-backward attr= (- min 300) t)))))))
+ (unless next-attr-sure (setq next-attr= nil))
+
+
+ ;; find prev change and if inside style= the next change
+ (when next-attr=
+ (setq exc-start-next (match-beginning 1))
+ (setq exc-end-next (match-end 2))
+ (when (>= exc-start-next pos)
+ (if (> pos exc-end-next)
+ (progn
+ (setq start (+ (match-end 2) 1))
+ ;;(setq start-border (+ (match-end 2) 2))
+ )
+ (setq exc-mode submode)
+ (setq start (match-beginning 1))
+ (setq start-border (match-beginning 2))
+ (setq end (1+ (match-end 2)))
+ (setq end-border (1- end)))
+ ))
+ ;; find next change
+ (unless end
+ (if start
+ (goto-char start)
+ (goto-char pos)
+ (search-backward "<" min t))
+ ;;(msgtrc "attr=-new 2: min=%s, point=%s" min (point))
+ (setq next-attr= (if attr=is-regex
+ (re-search-forward attr= max t)
+ (search-forward attr= max t)))
+ (when (and next-attr=
+ (search-backward "<" min t))
+ (when (looking-at attr-regex)
+ (setq end (match-beginning 1)))))
+ (when start (assert (>= start pos) t))
+ (when end (assert (<= pos end) t))
+ ;;(message "start-border=%s end-border=%s" start-border end-border)
+ (when (or start-border end-border)
+ (setq borders (list start-border end-border nil)))
+ ;; (message "mumamo-chunk-attr=-new: %s"
+ ;; (list start
+ ;; end
+ ;; exc-mode
+ ;; borders
+ ;; nil ;; parseable-by
+ ;; 'mumamo-chunk-attr=-new-fw-exc-fun ;; fw-exc-fun
+ ;; 'mumamo-chunk-attr=-new-find-borders-fun ;; find-borders-fun
+ ;; ))
+ (goto-char here)
+ (setq end nil)
+ (when (or start end)
+ (list start
+ end
+ exc-mode
+ borders
+ nil ;; parseable-by
+ 'mumamo-chunk-attr=-new-fw-exc-fun ;; fw-exc-fun
+ 'mumamo-chunk-attr=-new-find-borders-fun ;; find-borders-fun
+ ))))
+ (error (mumamo-display-error 'mumamo-chunk-attr=-new "%s" (error-message-string err)))
+ ))
+
+;;;; xml pi
+
+(defvar mumamo-xml-pi-mode-alist
+ '(("php" . php-mode)
+ ("python" . python-mode))
+ "Alist used by `mumamo-chunk-xml-pi' to get exception mode." )
+
+;; Fix-me: make it possible to make the borders part of the php chunk
+;; so that parsing of them by nxml may be skipped. Or, rather if the
+;; borders are not part of the chunk then assume nxml can not parse
+;; the chunk and the borders.
+;; (defun mumamo-search-bw-exc-start-xml-pi-1 (pos min lt-chars)
+;; "Helper for `mumamo-chunk-xml-pi'.
+;; POS is where to start search and MIN is where to stop.
+;; LT-CHARS is just <?.
+
+;; Actual use is in `mumamo-search-bw-exc-start-xml-pi'."
+;; (let ((exc-start (mumamo-chunk-start-bw-str (+ pos 2) min lt-chars))
+;; spec
+;; exc-mode
+;; hit)
+;; (when exc-start
+;; (goto-char exc-start)
+;; (when (and (not (looking-at "xml"))
+;; (looking-at (rx (0+ (any "a-z")))))
+;; ;; (setq exc-start (match-end 0)) include it in sub chunk instead
+;; (setq exc-start (- exc-start 2))
+;; (setq spec (match-string-no-properties 0))
+;; (setq exc-mode (assoc spec mumamo-xml-pi-mode-alist))
+;; (when exc-mode (setq exc-mode (cdr exc-mode)))
+;; (setq hit t)
+;; )
+;; (when hit
+;; (unless exc-mode
+;; ;;(setq exc-mode 'fundamental-mode)
+;; ;; Fix-me: Better assume php-mode
+;; (setq exc-mode 'php-mode))
+;; (when (<= exc-start pos)
+;; ;;(cons exc-start exc-mode)
+;; (list exc-start exc-mode nil)
+;; )))))
+
+;; (defun mumamo-search-bw-exc-start-xml-pi (pos min)
+;; "Helper for `mumamo-chunk-xml-pi'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-search-bw-exc-start-xml-pi-1 pos min "<?"))
+
+(defun mumamo-search-fw-exc-start-xml-pi-new (pos max)
+ (let ((here (point))
+ start
+ spec
+ exc-mode
+ ret)
+ (setq start (search-forward "<?" max t))
+ (when (and start
+ (looking-at (rx (0+ (any "a-z")))))
+ (setq spec (match-string-no-properties 0))
+ (unless (string= spec "xml")
+ (when (= 0 (length spec))
+ (setq spec "php"))
+ (setq exc-mode (assoc spec mumamo-xml-pi-mode-alist))
+ (if exc-mode
+ (setq exc-mode (cdr exc-mode))
+ (setq exc-mode 'mumamo-bad-mode))
+ (setq ret (list (- start 2) exc-mode nil))))
+ (goto-char here)
+ ret))
+
+(defun mumamo-xml-pi-end-is-xml-end (pos)
+ "Return t if the ?> at pos is end of <?xml."
+ (when (> 1000 pos)
+;;; (assert (and (= (char-after pos) ??)
+;;; (= (char-after (1+ pos)) ?>)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (save-match-data
+ (when (search-backward "<" (- pos 150) t)
+ (when (looking-at (rx line-start "<\?xml" (1+ space)))
+ (mumamo-msgfntfy "mumamo-xml-pi-end-is-xml-end %s => t" pos)
+ t)))))))
+
+;; (defun mumamo-search-bw-exc-end-xml-pi (pos min)
+;; "Helper for `mumamo-chunk-xml-pi'.
+;; POS is where to start search and MIN is where to stop."
+;; ;; Fix me: merge xml header
+;; (mumamo-msgfntfy "mumamo-search-bw-exc-end-xml-pi %s %s" pos min)
+;; ;;(let ((end-pos (mumamo-chunk-end-bw-str pos min "?>")))
+;; (let ((end-pos (mumamo-chunk-end-bw-str-inc pos min "?>")))
+;; (mumamo-msgfntfy " end-pos=%s" end-pos)
+;; (when end-pos
+;; (unless (or (mumamo-xml-pi-end-is-xml-end end-pos)
+;; (= (save-restriction
+;; (widen)
+;; (char-after (- end-pos 1)))
+;; ?<))
+;; (mumamo-msgfntfy " returning end-pos")
+;; end-pos))))
+
+(defun mumamo-search-fw-exc-end-xml-pi (pos max)
+ "Helper for `mumamo-chunk-xml-pi'.
+POS is where to start search and MAX is where to stop."
+ ;; Fix me: merge xml header
+ ;;(let ((end-pos (mumamo-chunk-end-fw-str pos max "?>")))
+ (save-match-data
+ (let ((end-pos (mumamo-chunk-end-fw-str-inc pos max "?>")))
+ (when end-pos
+ (unless (mumamo-xml-pi-end-is-xml-end end-pos)
+ end-pos)))))
+
+(defun mumamo-search-fw-exc-start-xml-pi-1 (pos max lt-chars)
+ "Helper for `mumamo-chunk-xml-pi'.
+POS is where to start search and MAX is where to stop.
+
+Used in `mumamo-search-fw-exc-start-xml-pi'. For an explanation
+of LT-CHARS see `mumamo-search-bw-exc-start-xml-pi-1'."
+ (goto-char pos)
+ (skip-chars-backward "a-zA-Z")
+ ;;(let ((end-out (mumamo-chunk-start-fw-str (point) max lt-chars)))
+ (let ((end-out (mumamo-chunk-start-fw-str-inc (point) max lt-chars))
+ spec
+ exc-mode
+ hit)
+ (when (looking-at "xml")
+ (if t ;(= 1 pos)
+ (setq end-out (mumamo-chunk-start-fw-str-inc (1+ (point)) max lt-chars))
+ (setq end-out nil)))
+ (when end-out
+ ;; Get end-out:
+ (if (looking-at (rx (0+ (any "a-z"))))
+ (progn
+ ;;(setq end-out (match-end 0))
+ (setq end-out (- (match-beginning 0) 2))
+ (setq spec (match-string-no-properties 0))
+ (setq exc-mode (assoc spec mumamo-xml-pi-mode-alist))
+ (if exc-mode
+ (setq exc-mode (cdr exc-mode))
+ (setq exc-mode 'php-mode))
+ (setq end-out (list end-out exc-mode nil))
+ )
+ (setq end-out nil))
+ end-out)))
+
+(defun mumamo-search-fw-exc-start-xml-pi-old (pos max)
+ "Helper for `mumamo-chunk-xml-pi'.
+POS is where to start search and MAX is where to stop."
+ (mumamo-search-fw-exc-start-xml-pi-1 pos max "<?"))
+
+;; Add a find-borders-fun here so that for example src="<?php some
+;; code ?>" can be handled.
+;;
+;; Fix-me: Maybe generalize for other values than <?php
+(defun mumamo-find-borders-xml-pi (start end exc-mode)
+ (let (start-border
+ end-border
+ (inc t)
+ ;;(begin-mark "<?php")
+ (begin-mark "<?")
+ (end-mark "?>")
+ (here (point)))
+ (if (and inc) ;; exc-mode)
+ (progn
+ (when start
+ ;;(setq start-border (+ start (length begin-mark)))
+ (goto-char (+ start (length begin-mark)))
+ (skip-chars-forward "=a-zA-Z")
+ (setq start-border (point))
+ )
+ (when end
+ (setq end-border
+ (- end (length end-mark)))))
+ (if (and (not inc) (not exc-mode))
+ (progn
+ (when start
+ (setq start-border
+ (+ start (length end-mark))))
+ (when end
+ (setq end-border (- end (length begin-mark)))
+ ;;(goto-char end)
+ ;;(skip-chars-forward "=a-zA-Z")
+ ;;(setq end-border (point))
+ ))))
+ (goto-char here)
+ (when (or start-border end-border)
+ (list start-border end-border))))
+
+(defun mumamo-chunk-xml-pi (pos min max)
+ "Find process instruction, <? ... ?>. Return range and wanted mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-exc-start-xml-pi
+ ;; 'mumamo-search-bw-exc-end-xml-pi
+ ;; 'mumamo-search-fw-exc-start-xml-pi-old
+ ;; 'mumamo-search-fw-exc-end-xml-pi
+ ;; 'mumamo-find-borders-xml-pi)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-xml-pi-new
+ 'mumamo-search-fw-exc-end-xml-pi
+ 'mumamo-find-borders-xml-pi))
+
+
+;;;; <style ...>
+
+(defconst mumamo-style-tag-start-regex
+ (rx "<style"
+ space
+ (0+ (not (any ">")))
+ "type"
+ (0+ space)
+ "="
+ (0+ space)
+ ?\"
+ "text/css"
+ ?\"
+ (0+ (not (any ">")))
+ ">"
+ ;; FIX-ME: Commented out because of bug in Emacs
+ ;;
+ ;;(optional (0+ space) "<![CDATA[")
+ ))
+
+;; (defun mumamo-search-bw-exc-start-inlined-style (pos min)
+;; "Helper for `mumamo-chunk-inlined-style'.
+;; POS is where to start search and MIN is where to stop."
+;; (goto-char (+ pos 6))
+;; (let ((marker-start (search-backward "<style" min t))
+;; exc-mode
+;; exc-start)
+;; (when marker-start
+;; (when (looking-at mumamo-style-tag-start-regex)
+;; (setq exc-start (match-end 0))
+;; (goto-char exc-start)
+;; (when (<= exc-start pos)
+;; ;;(cons (point) 'css-mode)
+;; ;;(list (point) 'css-mode '(nxml-mode))
+;; ;; Fix-me: Kubica looping problem
+;; (list (point) 'css-mode)
+;; )
+;; ))))
+
+;; (defun mumamo-search-bw-exc-end-inlined-style (pos min)
+;; "Helper for `mumamo-chunk-inlined-style'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str pos min "</style>"))
+
+;; (defun mumamo-search-fw-exc-start-inlined-style-old (pos max)
+;; "Helper for `mumamo-chunk-inlined-style'.
+;; POS is where to start search and MAX is where to stop."
+;; (goto-char (1+ pos))
+;; (skip-chars-backward "^<")
+;; ;; Handle <![CDATA[
+;; (when (and
+;; (eq ?< (char-before))
+;; (eq ?! (char-after))
+;; (not (bobp)))
+;; (backward-char)
+;; (skip-chars-backward "^<"))
+;; (unless (bobp)
+;; (backward-char 1))
+;; (let ((exc-start (search-forward "<style" max t))
+;; exc-mode)
+;; (when exc-start
+;; (goto-char (- exc-start 6))
+;; (when (looking-at mumamo-style-tag-start-regex)
+;; (goto-char (match-end 0))
+;; (point)
+;; ))))
+
+(defun mumamo-search-fw-exc-end-inlined-style (pos max)
+ "Helper for `mumamo-chunk-inlined-style'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max "</style>")))
+
+;; (defun mumamo-chunk-inlined-style-old (pos min max)
+;; "Find <style>...</style>. Return range and 'css-mode.
+;; See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+;; (mumamo-find-possible-chunk pos min max
+;; 'mumamo-search-bw-exc-start-inlined-style
+;; 'mumamo-search-bw-exc-end-inlined-style
+;; 'mumamo-search-fw-exc-start-inlined-style-old
+;; 'mumamo-search-fw-exc-end-inlined-style))
+
+(defun mumamo-search-fw-exc-start-inlined-style (pos max)
+ "Helper for `mumamo-chunk-inlined-style'.
+POS is where to start search and MAX is where to stop."
+ (goto-char (1+ pos))
+ (skip-chars-backward "^<")
+ ;; Handle <![CDATA[
+ (when (and
+ (eq ?< (char-before))
+ (eq ?! (char-after))
+ (not (bobp)))
+ (backward-char)
+ (skip-chars-backward "^<"))
+ (unless (bobp)
+ (backward-char 1))
+ (let ((exc-start (search-forward "<style" max t))
+ exc-mode)
+ (when exc-start
+ (goto-char (- exc-start 6))
+ (when (looking-at mumamo-style-tag-start-regex)
+ (goto-char (match-end 0))
+ (list (point) 'css-mode nil)
+ ))))
+
+(defun mumamo-chunk-inlined-style (pos min max)
+ "Find <style>...</style>. Return range and 'css-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-inlined-style
+ 'mumamo-search-fw-exc-end-inlined-style))
+
+;;;; <script ...>
+
+(defconst mumamo-script-tag-start-regex
+ (rx "<script"
+ space
+ (0+ (not (any ">")))
+ "type"
+ (0+ space)
+ "="
+ (0+ space)
+ ?\"
+ ;;(or "text" "application")
+ ;;"/"
+ ;;(or "javascript" "ecmascript")
+ "text/javascript"
+ ?\"
+ (0+ (not (any ">")))
+ ">"
+ ;; FIX-ME: Commented out because of bug in Emacs
+ ;;
+ ;;(optional (0+ space) "<![CDATA[" )
+ ))
+
+;; (defun mumamo-search-bw-exc-start-inlined-script (pos min)
+;; "Helper for `mumamo-chunk-inlined-script'.
+;; POS is where to start search and MIN is where to stop."
+;; (goto-char (+ pos 7))
+;; (let ((marker-start (when (< min (point)) (search-backward "<script" min t)))
+;; exc-mode
+;; exc-start)
+;; (when marker-start
+;; (when (looking-at mumamo-script-tag-start-regex)
+;; (setq exc-start (match-end 0))
+;; (goto-char exc-start)
+;; (when (<= exc-start pos)
+;; ;;(cons (point) 'javascript-mode)
+;; (list (point) 'javascript-mode '(nxml-mode))
+;; )
+;; ))))
+
+;; (defun mumamo-search-bw-exc-end-inlined-script (pos min)
+;; "Helper for `mumamo-chunk-inlined-script'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str pos min "</script>"))
+
+;; (defun mumamo-search-fw-exc-start-inlined-script-old (pos max)
+;; "Helper for `mumamo-chunk-inlined-script'.
+;; POS is where to start search and MAX is where to stop."
+;; (goto-char (1+ pos))
+;; (skip-chars-backward "^<")
+;; ;; Handle <![CDATA[
+;; (when (and
+;; (eq ?< (char-before))
+;; (eq ?! (char-after))
+;; (not (bobp)))
+;; (backward-char)
+;; (skip-chars-backward "^<"))
+;; (unless (bobp)
+;; (backward-char 1))
+;; (let ((exc-start (search-forward "<script" max t))
+;; exc-mode)
+;; (when exc-start
+;; (goto-char (- exc-start 7))
+;; (when (looking-at mumamo-script-tag-start-regex)
+;; (goto-char (match-end 0))
+;; (point)
+;; ))))
+
+(defun mumamo-search-fw-exc-end-inlined-script (pos max)
+ "Helper for `mumamo-chunk-inlined-script'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max "</script>")))
+
+;; (defun mumamo-chunk-inlined-script-old (pos min max)
+;; "Find <script>...</script>. Return range and 'javascript-mode.
+;; See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+;; (mumamo-find-possible-chunk pos min max
+;; 'mumamo-search-bw-exc-start-inlined-script
+;; 'mumamo-search-bw-exc-end-inlined-script
+;; 'mumamo-search-fw-exc-start-inlined-script-old
+;; 'mumamo-search-fw-exc-end-inlined-script))
+
+(defun mumamo-search-fw-exc-start-inlined-script (pos max)
+ "Helper for `mumamo-chunk-inlined-script'.
+POS is where to start search and MAX is where to stop."
+ (goto-char (1+ pos))
+ (skip-chars-backward "^<")
+ ;; Handle <![CDATA[
+ (when (and
+ (eq ?< (char-before))
+ (eq ?! (char-after))
+ (not (bobp)))
+ (backward-char)
+ (skip-chars-backward "^<"))
+ (unless (bobp)
+ (backward-char 1))
+ (let ((exc-start (search-forward "<script" max t))
+ exc-mode)
+ (when exc-start
+ (goto-char (- exc-start 7))
+ (when (looking-at mumamo-script-tag-start-regex)
+ (goto-char (match-end 0))
+ (list (point) 'javascript-mode '(nxml-mode))
+ ))))
+
+(defun mumamo-chunk-inlined-script (pos min max)
+ "Find <script>...</script>. Return range and 'javascript-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-inlined-script
+ 'mumamo-search-fw-exc-end-inlined-script))
+
+;;;; on[a-z]+=\"javascript:"
+
+(defconst mumamo-onjs=-attr=
+ (rx
+ ;;"on[a-z]+="
+ (or "onclick" "ondblclick" "onmousedown" "onmousemove" "onmouseout" "onmouseover" "onmouseup" "onkeydown" "onkeypress" "onkeyup")
+ "="))
+
+(defconst mumamo-onjs=-attr-regex
+ (rx point
+ (or "<" "?>")
+ (* (not (any ">")))
+ space
+ (submatch
+ ;;"on" (1+ (any "a-za-z"))
+ (or "onclick" "ondblclick" "onmousedown" "onmousemove" "onmouseout" "onmouseover" "onmouseup" "onkeydown" "onkeypress" "onkeyup")
+ "=")
+ (0+ space)
+ ?\"
+ (submatch
+ (opt "javascript:")
+ (0+
+ (not (any "\""))))
+ ))
+
+(defun mumamo-chunk-onjs=(pos min max)
+ "Find javascript on...=\"...\". Return range and 'javascript-mode."
+ (mumamo-chunk-attr= pos min max mumamo-onjs=-attr= t mumamo-onjs=-attr-regex
+ 'javascript-mode))
+
+;;;; py:somthing=\"python\"
+
+(defconst mumamo-py:=-attr= "py:[a-z]+=")
+
+(defconst mumamo-py:=-attr-regex
+ (rx point
+ (or "<" "?>")
+ (* (not (any ">")))
+ space
+ (submatch
+ "py:" (1+ (any "a-za-z"))
+ "=")
+ (0+ space)
+ ?\"
+ (submatch
+ (0+
+ (not (any "\""))))
+ ))
+
+(defun mumamo-chunk-py:=(pos min max)
+ "Find python py:...=\"...\". Return range and 'python-mode."
+ (mumamo-chunk-attr= pos min max mumamo-py:=-attr= t mumamo-py:=-attr-regex
+ 'python-mode))
+
+(defun mumamo-chunk-py:match (pos min max)
+ (save-match-data
+ (let ((here (point))
+ (py:match (progn
+ (goto-char pos)
+ (re-search-forward (rx "py:match"
+ (1+ space)
+ (0+ (not (any ">")))
+ word-start
+ (submatch "path=")
+ (0+ space)
+ ?\"
+ (submatch
+ (0+
+ (not (any "\"")))))
+ max t)))
+ start end borders
+ )
+ (when py:match
+ (setq start (match-beginning 1))
+ (setq end (match-end 2))
+ (setq borders (list (match-end 1) (1- end)))
+ )
+ (goto-char here)
+ (when start
+ (list start
+ end
+ 'python-mode
+ borders
+ nil ;; parseable-by
+ 'mumamo-chunk-attr=-new-fw-exc-fun ;; fw-exc-fun
+ 'mumamo-chunk-attr=-new-find-borders-fun ;; find-borders-fun
+ )))))
+
+;;;; style=
+
+(defconst mumamo-style=start-regex
+ (rx "<"
+ (0+ (not (any ">")))
+ space
+ (submatch "style=")
+ (0+ space)
+ ?\"
+ (submatch
+ (0+
+ (not (any "\""))))
+ ))
+
+(defun mumamo-chunk-style=(pos min max)
+ "Find style=\"...\". Return range and 'css-mode."
+ (mumamo-chunk-attr= pos min max "style=" nil mumamo-style=start-regex
+ 'css-mode))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; HTML w html-mode
+
+(put 'mumamo-alt-php-tags-mode 'permanent-local t)
+(define-minor-mode mumamo-alt-php-tags-mode
+ "Minor mode for using '(?php' instead of '<?php' in buffer.
+When turning on this mode <?php is replace with (?php in the buffer.
+If you write the buffer to file (?php is however written as <?php.
+
+When turning off this mode (?php is replace with <?php in the buffer.
+
+The purpose of this minor mode is to work around problems with
+using the `nxml-mode' parser in php files. `nxml-mode' knows
+damned well that you can not have the character < in strings and
+I can't make it forget that. For PHP programmers it is however
+very convient to use <?php ... ?> in strings.
+
+There is no reason to use this minor mode unless you want XML
+validation and/or completion in your php file. If you do not
+want that then you can simply use a multi major mode based on
+`html-mode' instead of `nxml-mode'/`nxhtml-mode'. Or, of course,
+just `php-mode' if there is no html code in the file."
+ :lighter "<?php "
+ (if mumamo-alt-php-tags-mode
+ (progn
+ ;;(unless mumamo-multi-major-mode (error "Only for mumamo multi major modes"))
+ (unless (let ((major-mode (mumamo-main-major-mode)))
+ (derived-mode-p 'nxml-mode))
+ ;;(error "Mumamo multi major mode must be based on nxml-mode")
+ )
+ (unless (memq 'mumamo-chunk-alt-php (caddr mumamo-current-chunk-family))
+ (error "Mumamo multi major must have chunk function mumamo-chunk-alt-php"))
+
+ ;; Be paranoid about the file/content write hooks
+ (when (<= emacs-major-version 22)
+ (with-no-warnings
+ (when local-write-file-hooks ;; obsolete, but check!
+ (error "Will not do this because local-write-file-hooks is non-nil"))))
+ (remove-hook 'write-contents-functions 'mumamo-alt-php-write-contents t)
+ (when write-contents-functions
+ (error "Will not do this because write-contents-functions is non-nil"))
+ (when (delq 'recentf-track-opened-file (copy-sequence write-file-functions))
+ (error "Will not do this because write-file-functions is non-nil"))
+
+ (add-hook 'write-contents-functions 'mumamo-alt-php-write-contents t t)
+ (put 'write-contents-functions 'permanent-local t)
+ (save-restriction
+ (let ((here (point)))
+ (widen)
+ (goto-char (point-min))
+ (while (search-forward "<?php" nil t)
+ (replace-match "(?php"))
+ (goto-char (point-min))
+ (while (search-forward "<?=" nil t)
+ (replace-match "(?="))
+ (goto-char (point-min))
+ (while (search-forward "?>" nil t)
+ (replace-match "?)"))
+ (goto-char here))))
+ (save-restriction
+ (let ((here (point)))
+ (widen)
+ (goto-char (point-min))
+ (while (search-forward "(?php" nil t)
+ (replace-match "<?php"))
+ (goto-char (point-min))
+ (while (search-forward "(?=" nil t)
+ (replace-match "<?="))
+ (goto-char (point-min))
+ (while (search-forward "?)" nil t)
+ (replace-match "?>"))
+ (goto-char here)))
+ (remove-hook 'write-contents-functions 'mumamo-alt-php-write-contents t)))
+
+(defun mumamo-chunk-alt-php (pos min max)
+ "Find (?php ... ?), return range and `php-mode'.
+Workaround for the problem that I can not tame `nxml-mode' to recognize <?php.
+
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (when mumamo-alt-php-tags-mode
+ (mumamo-quick-static-chunk pos min max "(?php" "?)" t 'php-mode t)))
+
+(defun mumamo-chunk-alt-php= (pos min max)
+ "Find (?= ... ?), return range and `php-mode'.
+Workaround for the problem that I can not tame `nxml-mode' to recognize <?php.
+
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (when mumamo-alt-php-tags-mode
+ (mumamo-quick-static-chunk pos min max "(?=" "?)" t 'php-mode t)))
+
+;;;###autoload
+(define-mumamo-multi-major-mode html-mumamo-mode
+ "Turn on multiple major modes for (X)HTML with main mode `html-mode'.
+This covers inlined style and javascript and PHP."
+ ("HTML Family" html-mode
+ (mumamo-chunk-xml-pi
+ mumamo-chunk-alt-php
+ mumamo-chunk-alt-php=
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+(add-hook 'html-mumamo-mode-hook 'mumamo-define-html-file-wide-keys)
+(mumamo-inherit-sub-chunk-family 'html-mumamo-mode)
+
+;; (define-mumamo-multi-major-mode xml-pi-only-mumamo-mode
+;; "Test"
+;; ("HTML Family" html-mode
+;; (mumamo-chunk-xml-pi
+;; )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; XHTML w nxml-mode
+
+(defun mumamo-alt-php-write-contents ()
+ "For `write-contents-functions' when `mumamo-chunk-alt-php' is used."
+ (let ((here (point)))
+ (save-match-data
+ (save-restriction
+ (widen)
+ (condition-case nil
+ (atomic-change-group
+ (progn
+ (goto-char (point-min))
+ (while (search-forward "(?php" nil t)
+ (replace-match "<?php"))
+ (goto-char (point-min))
+ (while (search-forward "(?=" nil t)
+ (replace-match "<?="))
+ (goto-char (point-min))
+ (while (search-forward "?)" nil t)
+ (replace-match "?>"))
+ (basic-save-buffer-1)
+ (signal 'mumamo-error-ind-0 nil)))
+ (mumamo-error-ind-0)))
+ (set-buffer-modified-p nil))
+ (goto-char here))
+ ;; saved, return t
+ t)
+
+;;;###autoload
+(define-mumamo-multi-major-mode nxml-mumamo-mode
+ "Turn on multiple major modes for (X)HTML with main mode `nxml-mode'.
+This covers inlined style and javascript and PHP.
+
+See also `mumamo-alt-php-tags-mode'."
+ ("nXml Family" nxml-mode
+ (mumamo-chunk-xml-pi
+ mumamo-chunk-alt-php
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+(add-hook 'nxml-mumamo-mode-hook 'mumamo-define-html-file-wide-keys)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Mason (not ready)
+;; http://www.masonhq.com/docs/manual/Devel.html#examples_and_recommended_usage
+
+(defun mumamo-chunk-mason-perl-line (pos min max)
+ (mumamo-whole-line-chunk pos min max "%" 'perl-mode))
+
+(defun mumamo-chunk-mason-perl-single (pos min max)
+ (mumamo-quick-static-chunk pos min max "<% " " %>" t 'perl-mode t))
+
+(defun mumamo-chunk-mason-perl-block (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%perl>" "</%perl>" t 'perl-mode t))
+
+(defun mumamo-chunk-mason-perl-init (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%init>" "</%init>" t 'perl-mode t))
+
+(defun mumamo-chunk-mason-perl-once (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%once>" "</%once>" t 'perl-mode t))
+
+(defun mumamo-chunk-mason-perl-cleanup (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%cleanup>" "</%cleanup>" t 'perl-mode t))
+
+(defun mumamo-chunk-mason-perl-shared (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%shared>" "</%shared>" t 'perl-mode t))
+
+(defun mumamo-chunk-mason-simple-comp (pos min max)
+ (mumamo-quick-static-chunk pos min max "<& " " &>" t 'text-mode t))
+
+(defun mumamo-chunk-mason-args (pos min max)
+ ;; Fix-me: perl-mode is maybe not the best here?
+ (mumamo-quick-static-chunk pos min max "<%args>" "</%args>" t 'perl-mode t))
+
+(defun mumamo-chunk-mason-doc (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%doc>" "</%doc>" t 'mumamo-comment-mode t))
+
+(defun mumamo-chunk-mason-text (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%text>" "</%text>" t 'text-mode t))
+
+;; component calls with content
+
+;; (defun mumamo-chunk-mason-compcont-bw-exc-start-fun (pos min)
+;; (let ((exc-start (mumamo-chunk-start-bw-str-inc pos min "<&| ")))
+;; (and exc-start
+;; (<= exc-start pos)
+;; (cons exc-start 'html-mode))))
+
+;; (defun mumamo-chunk-mason-compcont-fw-exc-start-fun-old (pos max)
+;; (mumamo-chunk-start-fw-str-inc pos max "<&| "))
+
+(defun mumamo-chunk-mason-compcont-fw-exc-end-fun (pos max)
+ (mumamo-chunk-end-fw-str-inc pos max "</&>"))
+
+(defun mumamo-chunk-mason-compcont-find-borders-fun (start end dummy)
+ (when dummy
+ (list
+ (when start
+ (save-match-data
+ (let ((here (point))
+ ret)
+ (goto-char start)
+ (when (re-search-forward "[^>]* &>" end t)
+ (setq ret (point))
+ (goto-char here)
+ ret))
+ ))
+ (when end (- end 4))
+ dummy)))
+
+;; (defun mumamo-chunk-mason-compcont-old (pos min max)
+;; (mumamo-find-possible-chunk-new pos
+;; max
+;; 'mumamo-chunk-mason-compcont-bw-exc-start-fun
+;; 'mumamo-chunk-mason-compcont-fw-exc-start-fun-old
+;; 'mumamo-chunk-mason-compcont-fw-exc-end-fun
+;; 'mumamo-chunk-mason-compcont-find-borders-fun))
+
+(defun mumamo-chunk-mason-compcont-fw-exc-start-fun (pos max)
+ (let ((where (mumamo-chunk-start-fw-str-inc pos max "<&| ")))
+ (when where
+ (list where 'html-mode nil))))
+
+(defun mumamo-chunk-mason-compcont (pos min max)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-chunk-mason-compcont-fw-exc-start-fun
+ 'mumamo-chunk-mason-compcont-fw-exc-end-fun
+ 'mumamo-chunk-mason-compcont-find-borders-fun))
+
+;;;###autoload
+(define-mumamo-multi-major-mode mason-html-mumamo-mode
+ "Turn on multiple major modes for Mason using main mode `html-mode'.
+This covers inlined style and javascript."
+ ("Mason html Family" html-mode
+ (
+ mumamo-chunk-mason-perl-line
+ mumamo-chunk-mason-perl-single
+ mumamo-chunk-mason-perl-block
+ mumamo-chunk-mason-perl-init
+ mumamo-chunk-mason-perl-once
+ mumamo-chunk-mason-perl-cleanup
+ mumamo-chunk-mason-perl-shared
+ mumamo-chunk-mason-simple-comp
+ mumamo-chunk-mason-compcont
+ mumamo-chunk-mason-args
+ mumamo-chunk-mason-doc
+ mumamo-chunk-mason-text
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+(add-hook 'mason-html-mumamo-mode-hook 'mumamo-define-html-file-wide-keys)
+(mumamo-inherit-sub-chunk-family-locally 'mason-html-mumamo-mode 'mason-html-mumamo-mode)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Embperl
+
+(defun mumamo-chunk-embperl-<- (pos min max)
+ "Find [- ... -], return range and `perl-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "[-" "-]" t 'perl-mode t))
+
+(defun mumamo-chunk-embperl-<+ (pos min max)
+ "Find [+ ... +], return range and `perl-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "[+" "+]" t 'perl-mode nil))
+
+(defun mumamo-chunk-embperl-<! (pos min max)
+ "Find [! ... !], return range and `perl-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "[!" "!]" t 'perl-mode t))
+
+(defun mumamo-chunk-embperl-<$ (pos min max)
+ "Find [$ ... $], return range and `perl-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; This is a bit tricky since [$var] etc must be avoided.
+ (let* ((begin-mark "[$")
+ (end-mark "$]")
+ (good-chars '(32 ;space
+ 10 ;line feed
+ 9 ;tab
+ ))
+ ;; (search-bw-exc-start (lambda (pos min)
+ ;; (let ((not-found t)
+ ;; (next-char nil)
+ ;; (exc-start (mumamo-chunk-start-bw-str
+ ;; pos min begin-mark))
+ ;; (here (point)))
+ ;; (while (and not-found
+ ;; exc-start)
+ ;; (setq next-char (char-after (+ (point) 2)))
+ ;; (if (memq next-char good-chars)
+ ;; (setq not-found nil)
+ ;; (setq exc-start
+ ;; (search-backward begin-mark
+ ;; min t))))
+ ;; (when (and exc-start
+ ;; (<= exc-start pos))
+ ;; (cons exc-start 'perl-mode)))))
+ ;; (search-bw-exc-end (lambda (pos min)
+ ;; (mumamo-chunk-end-bw-str pos min end-mark)))
+ ;; (search-fw-exc-start-old (lambda (pos max)
+ ;; (let ((not-found t)
+ ;; (next-char nil)
+ ;; (exc-start (mumamo-chunk-start-fw-str
+ ;; pos max begin-mark))
+ ;; (here (point)))
+ ;; (while (and not-found
+ ;; exc-start)
+ ;; (setq next-char (char-after))
+ ;; (if (memq next-char good-chars)
+ ;; (setq not-found nil)
+ ;; (setq exc-start
+ ;; (search-forward begin-mark
+ ;; max t))))
+ ;; exc-start)))
+ (search-fw-exc-start (lambda (pos max)
+ (let ((not-found t)
+ (next-char nil)
+ (exc-start (mumamo-chunk-start-fw-str
+ pos max begin-mark))
+ (here (point)))
+ (while (and not-found
+ exc-start)
+ (setq next-char (char-after))
+ (if (memq next-char good-chars)
+ (setq not-found nil)
+ (setq exc-start
+ (search-forward begin-mark
+ max t))))
+ (list exc-start 'perl-mode))))
+ (search-fw-exc-end (lambda (pos max)
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max end-mark))))
+ )
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; search-bw-exc-start
+ ;; search-bw-exc-end
+ ;; search-fw-exc-start-old
+ ;; search-fw-exc-end)
+ (mumamo-possible-chunk-forward pos max
+ search-fw-exc-start
+ search-fw-exc-end)
+ ))
+
+;;;###autoload
+(define-mumamo-multi-major-mode embperl-html-mumamo-mode
+ "Turn on multiple major modes for Embperl files with main mode `html-mode'.
+This also covers inlined style and javascript."
+ ("Embperl HTML Family" html-mode
+ (mumamo-chunk-embperl-<-
+ mumamo-chunk-embperl-<+
+ mumamo-chunk-embperl-<!
+ mumamo-chunk-embperl-<$
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; django
+
+(defun mumamo-chunk-django4(pos min max)
+ "Find {% comment %}. Return range and `django-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "{% comment %}" "{% endcomment %}" t 'mumamo-comment-mode t))
+
+(defun mumamo-chunk-django3(pos min max)
+ "Find {# ... #}. Return range and `django-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "{#" "#}" t 'mumamo-comment-mode t))
+
+(defun mumamo-chunk-django2(pos min max)
+ "Find {{ ... }}. Return range and `django-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "{{" "}}" t 'django-variable-mode t))
+
+(defun mumamo-chunk-django (pos min max)
+ "Find {% ... %}. Return range and `django-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (let ((chunk (mumamo-quick-static-chunk pos min max "{%" "%}" t 'django-mode t)))
+ (when chunk
+ (setcdr (last chunk) '(mumamo-template-indentor))
+ chunk)))
+
+;; (defun mumamo-search-bw-exc-start-django (pos min)
+;; "Helper for `mumamo-chunk-django'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str-inc pos min "{%")))
+;; (and exc-start
+;; (<= exc-start pos)
+;; (cons exc-start 'django-mode))))
+
+;; (defun mumamo-search-bw-exc-start-django2(pos min)
+;; "Helper for `mumamo-chunk-django2'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str-inc pos min "{{")))
+;; (and exc-start
+;; (<= exc-start pos)
+;; (cons exc-start 'django-mode))))
+
+;; (defun mumamo-search-bw-exc-start-django3(pos min)
+;; "Helper for `mumamo-chunk-django3'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str-inc pos min "{#")))
+;; (and exc-start
+;; (<= exc-start pos)
+;; (cons exc-start 'mumamo-comment-mode))))
+
+;; (defun mumamo-search-bw-exc-start-django4(pos min)
+;; "Helper for `mumamo-chunk-django4'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str-inc pos min
+;; "{% comment %}")))
+;; (and exc-start
+;; (<= exc-start pos)
+;; (cons exc-start 'mumamo-comment-mode))))
+
+;; (defun mumamo-search-bw-exc-end-django (pos min)
+;; "Helper for `mumamo-chunk-django'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str-inc pos min "%}"))
+
+;; (defun mumamo-search-bw-exc-end-django2(pos min)
+;; "Helper for `mumamo-chunk-django2'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str-inc pos min "}}"))
+
+;; (defun mumamo-search-bw-exc-end-django3(pos min)
+;; "Helper for `mumamo-chunk-django3'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str-inc pos min "#}"))
+
+;; (defun mumamo-search-bw-exc-end-django4(pos min)
+;; "Helper for `mumamo-chunk-django4'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str-inc pos min "{% endcomment %}"))
+
+(defun mumamo-search-fw-exc-start-django (pos max)
+ "Helper for `mumamo-chunk-django'.
+POS is where to start search and MAX is where to stop."
+ (mumamo-chunk-start-fw-str-inc pos max "{%"))
+
+(defun mumamo-search-fw-exc-start-django2(pos max)
+ "Helper for `mumamo-chunk-django2'.
+POS is where to start search and MAX is where to stop."
+ (mumamo-chunk-start-fw-str-inc pos max "{{"))
+
+(defun mumamo-search-fw-exc-start-django3(pos max)
+ "Helper for `mumamo-chunk-django3'.
+POS is where to start search and MAX is where to stop."
+ (mumamo-chunk-start-fw-str-inc pos max "{#"))
+
+(defun mumamo-search-fw-exc-start-django4(pos max)
+ "Helper for `mumamo-chunk-django4'.
+POS is where to start search and MAX is where to stop."
+ (mumamo-chunk-start-fw-str-inc pos max "{% comment %}"))
+
+(defun mumamo-search-fw-exc-end-django (pos max)
+ "Helper for `mumamo-chunk-django'.
+POS is where to start search and MAX is where to stop."
+ (mumamo-chunk-end-fw-str-inc pos max "%}"))
+
+(defun mumamo-search-fw-exc-end-django2(pos max)
+ "Helper for `mumamo-chunk-django2'.
+POS is where to start search and MAX is where to stop."
+ (mumamo-chunk-end-fw-str-inc pos max "}}"))
+
+(defun mumamo-search-fw-exc-end-django3(pos max)
+ "Helper for `mumamo-chunk-django3'.
+POS is where to start search and MAX is where to stop."
+ (mumamo-chunk-end-fw-str-inc pos max "#}"))
+
+(defun mumamo-search-fw-exc-end-django4(pos max)
+ "Helper for `mumamo-chunk-django4'.
+POS is where to start search and MAX is where to stop."
+ (mumamo-chunk-end-fw-str-inc pos max "{% endcomment %}"))
+
+;;;###autoload
+(define-mumamo-multi-major-mode django-html-mumamo-mode
+ "Turn on multiple major modes for Django with main mode `html-mode'.
+This also covers inlined style and javascript."
+ ("Django HTML Family" html-mode
+ (mumamo-chunk-django4
+ mumamo-chunk-django
+ mumamo-chunk-django2
+ mumamo-chunk-django3
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Genshi / kid
+
+;; {% python ... %}
+(defun mumamo-chunk-genshi%(pos min max)
+ "Find {% python ... %}. Return range and `genshi-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "{% python" "%}" t 'python-mode t))
+
+;; ${expr}
+(defun mumamo-chunk-genshi$(pos min max)
+ "Find ${ ... }, return range and `python-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (let ((chunk
+ (mumamo-quick-static-chunk pos min max "${" "}" t 'python-mode t)))
+ (when chunk
+ ;; Test for clash with %}
+ (let ((sub-mode (nth 2 chunk))
+ (start (nth 0 chunk)))
+ (if sub-mode
+ chunk
+ ;;(message "point.1=%s" (point))
+ (when (and start
+ (eq ?% (char-before start)))
+ ;;(message "point.2=%s" (point))
+ ;;(message "clash with %%}, chunk=%s" chunk)
+ ;;(setq chunk nil)
+ (setcar chunk (1- start))
+ )
+ ;;(message "chunk.return=%s" chunk)
+ chunk)))))
+
+;; Fix-me: Because of the way chunks currently are searched for there
+;; is an error when a python chunk is used. This is because mumamo
+;; gets confused by the %} ending and the } ending. This can be
+;; solved by running a separate phase to get the chunks first and
+;; during that phase match start and end of the chunk.
+
+
+;; Note: You will currently get fontification errors if you use
+;; python chunks
+
+;; {% python ... %}
+
+;; The reason is that the chunk routines currently do not know when
+;; to just look for the } or %} endings. However this should not
+;; affect your editing normally.
+
+;;;###autoload
+(define-mumamo-multi-major-mode genshi-html-mumamo-mode
+ "Turn on multiple major modes for Genshi with main mode `html-mode'.
+This also covers inlined style and javascript."
+ ("Genshi HTML Family" html-mode
+ (
+ ;;mumamo-chunk-genshi%
+ mumamo-chunk-genshi$
+ mumamo-chunk-py:=
+ mumamo-chunk-py:match
+ mumamo-chunk-xml-pi
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; MJT
+
+;; ${expr}
+(defun mumamo-chunk-mjt$(pos min max)
+ "Find ${ ... }, return range and `javascript-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "${" "}" t 'javascript-mode t))
+
+;;;###autoload
+(define-mumamo-multi-major-mode mjt-html-mumamo-mode
+ "Turn on multiple major modes for MJT with main mode `html-mode'.
+This also covers inlined style and javascript."
+ ("MJT HTML Family" html-mode
+ (
+ mumamo-chunk-mjt$
+ mumamo-chunk-xml-pi
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; smarty
+
+(defun mumamo-chunk-smarty-literal (pos min max)
+ "Find {literal} ... {/literal}. Return range and 'html-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "{literal}" "{/literal}" t 'html-mode t))
+
+(defun mumamo-chunk-smarty-t (pos min max)
+ "Find {t} ... {/t}. Return range and 'html-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "{t}" "{/t}" t 'text-mode t))
+
+(defun mumamo-chunk-smarty-comment (pos min max)
+ "Find {* ... *}. Return range and 'mumamo-comment-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "{*" "*}" t 'mumamo-comment-mode nil))
+
+(defun mumamo-chunk-smarty (pos min max)
+ "Find { ... }. Return range and 'smarty-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "{" "}" t 'smarty-mode nil))
+
+;;;###autoload
+(define-mumamo-multi-major-mode smarty-html-mumamo-mode
+ "Turn on multiple major modes for Smarty with main mode `html-mode'.
+This also covers inlined style and javascript."
+ ("Smarty HTML Family" html-mode
+ (mumamo-chunk-xml-pi
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ ;;mumamo-chunk-inlined-style
+ ;;mumamo-chunk-inlined-script
+ mumamo-chunk-smarty-literal
+ mumamo-chunk-smarty-t
+ mumamo-chunk-smarty-comment
+ mumamo-chunk-smarty
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; ssjs - server side javascript
+
+;; http://www.sitepoint.com/blogs/2009/03/10/server-side-javascript-will-be-as-common-as-php/
+;;
+;; It looks like there are different syntaxes, both
+;;
+;; <script runat="server">...</script> and <% ... %>.
+
+(defun mumamo-chunk-ssjs-% (pos min max)
+ "Find <% ... %>. Return range and 'javascript-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "<%" "%>" t 'javascript-mode t))
+
+(defconst mumamo-ssjs-tag-start-regex
+ (rx "<script"
+ space
+ (0+ (not (any ">")))
+ "runat"
+ (0+ space)
+ "="
+ (0+ space)
+ ?\"
+ ;;(or "text" "application")
+ ;;"/"
+ ;;(or "javascript" "ecmascript")
+ (or "server" "both" "server-proxy")
+ ?\"
+ (0+ (not (any ">")))
+ ">"
+ ;; FIX-ME: Commented out because of bug in Emacs
+ ;;
+ ;;(optional (0+ space) "<![CDATA[" )
+ ))
+
+;; (defun mumamo-search-bw-exc-start-inlined-ssjs (pos min)
+;; "Helper for `mumamo-chunk-inlined-ssjs'.
+;; POS is where to start search and MIN is where to stop."
+;; (goto-char (+ pos 7))
+;; (let ((marker-start (when (< min (point)) (search-backward "<script" min t)))
+;; exc-mode
+;; exc-start)
+;; (when marker-start
+;; (when (looking-at mumamo-ssjs-tag-start-regex)
+;; (setq exc-start (match-end 0))
+;; (goto-char exc-start)
+;; (when (<= exc-start pos)
+;; ;;(cons (point) 'javascript-mode)
+;; (list (point) 'javascript-mode '(nxml-mode))
+;; )
+;; ))))
+
+;; (defun mumamo-search-fw-exc-start-inlined-ssjs-old (pos max)
+;; "Helper for `mumamo-chunk-inlined-ssjs'.
+;; POS is where to start search and MAX is where to stop."
+;; (goto-char (1+ pos))
+;; (skip-chars-backward "^<")
+;; ;; Handle <![CDATA[
+;; (when (and
+;; (eq ?< (char-before))
+;; (eq ?! (char-after))
+;; (not (bobp)))
+;; (backward-char)
+;; (skip-chars-backward "^<"))
+;; (unless (bobp)
+;; (backward-char 1))
+;; (let ((exc-start (search-forward "<script" max t))
+;; exc-mode)
+;; (when exc-start
+;; (goto-char (- exc-start 7))
+;; (when (looking-at mumamo-ssjs-tag-start-regex)
+;; (goto-char (match-end 0))
+;; (point)
+;; ))))
+
+(defun mumamo-search-fw-exc-start-inlined-ssjs (pos max)
+ "Helper for `mumamo-chunk-inlined-ssjs'.
+POS is where to start search and MAX is where to stop."
+ (goto-char (1+ pos))
+ (skip-chars-backward "^<")
+ ;; Handle <![CDATA[
+ (when (and
+ (eq ?< (char-before))
+ (eq ?! (char-after))
+ (not (bobp)))
+ (backward-char)
+ (skip-chars-backward "^<"))
+ (unless (bobp)
+ (backward-char 1))
+ (let ((exc-start (search-forward "<script" max t))
+ exc-mode)
+ (when exc-start
+ (goto-char (- exc-start 7))
+ (when (looking-at mumamo-ssjs-tag-start-regex)
+ (goto-char (match-end 0))
+ (list (point) 'javascript-mode)
+ ))))
+
+(defun mumamo-chunk-inlined-ssjs (pos min max)
+ "Find <script runat=...>...</script>. Return range and 'javascript-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-exc-start-inlined-ssjs
+ ;; 'mumamo-search-bw-exc-end-inlined-script
+ ;; 'mumamo-search-fw-exc-start-inlined-ssjs-old
+ ;; 'mumamo-search-fw-exc-end-inlined-script)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-inlined-ssjs
+ 'mumamo-search-fw-exc-end-inlined-script))
+
+;;;###autoload
+(define-mumamo-multi-major-mode ssjs-html-mumamo-mode
+ "Turn on multiple major modes for SSJS with main mode `html-mode'.
+This covers inlined style and javascript."
+ ("HTML Family" html-mode
+ (mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-inlined-ssjs
+ mumamo-chunk-ssjs-%
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+(add-hook 'html-mumamo-mode-hook 'mumamo-define-html-file-wide-keys)
+(mumamo-inherit-sub-chunk-family 'ssjs-html-mumamo-mode)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; gsp
+
+(defun mumamo-chunk-gsp (pos min max)
+ "Find <% ... %>. Return range and 'groovy-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "<%" "%>" t 'groovy-mode t))
+
+;;;###autoload
+(define-mumamo-multi-major-mode gsp-html-mumamo-mode
+ "Turn on multiple major modes for GSP with main mode `html-mode'.
+This also covers inlined style and javascript."
+ ("GSP HTML Family" html-mode
+ (mumamo-chunk-gsp
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; jsp - Java Server Pages
+
+(defun mumamo-chunk-jsp (pos min max)
+ "Find <% ... %>. Return range and 'java-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "<%" "%>" t 'java-mode t))
+
+;;;###autoload
+(define-mumamo-multi-major-mode jsp-html-mumamo-mode
+ "Turn on multiple major modes for JSP with main mode `html-mode'.
+This also covers inlined style and javascript."
+ ("JSP HTML Family" html-mode
+ (mumamo-chunk-jsp
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; eruby
+
+;; Fix-me: Maybe take care of <%= and <%- and -%>, but first ask the
+;; ruby people if this is worth doing.
+;;
+;; See also http://wiki.rubyonrails.org/rails/pages/UnderstandingViews
+(defun mumamo-chunk-eruby (pos min max)
+ "Find <% ... %>. Return range and 'ruby-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (let ((chunk (mumamo-quick-static-chunk pos min max "<%" "%>" t 'ruby-mode t)))
+ (when chunk
+ ;; Put indentation type on 'mumamo-next-indent on the chunk:
+ ;; Fix-me: use this!
+ (setcdr (last chunk) '(mumamo-template-indentor))
+ chunk)))
+
+(defun mumamo-chunk-eruby-quoted (pos min max)
+ "Find \"<%= ... %>\". Return range and 'ruby-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX.
+
+This is a workaround for problems with strings."
+ (let ((chunk (mumamo-quick-static-chunk pos min max "\"<%=" "%>\"" t 'ruby-mode t)))
+ (when chunk
+ ;; Put indentation type on 'mumamo-next-indent on the chunk:
+ ;; Fix-me: use this!
+ (setcdr (last chunk) '(mumamo-template-indentor))
+ chunk)))
+
+(defun mumamo-chunk-eruby-comment (pos min max)
+ "Find <%# ... %>. Return range and 'ruby-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX.
+
+This is needed since otherwise the end marker is thought to be
+part of a comment."
+ (mumamo-quick-static-chunk pos min max "<%#" "%>" t 'mumamo-comment-mode t))
+
+;; (defun mumamo-search-bw-exc-start-ruby (pos min)
+;; "Helper for `mumamo-chunk-ruby'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str pos min "<%")))
+;; (when (and exc-start
+;; (<= exc-start pos))
+;; (cons exc-start 'ruby-mode))))
+
+;;;###autoload
+(define-mumamo-multi-major-mode eruby-mumamo-mode
+ "Turn on multiple major mode for eRuby with unspecified main mode.
+Current major-mode will be used as the main major mode."
+ ("eRuby Family" nil
+ (mumamo-chunk-eruby-comment
+ mumamo-chunk-eruby
+ )))
+
+;;;###autoload
+(define-mumamo-multi-major-mode eruby-html-mumamo-mode
+ "Turn on multiple major modes for eRuby with main mode `html-mode'.
+This also covers inlined style and javascript."
+ ("eRuby Html Family" html-mode
+ (
+ mumamo-chunk-eruby-comment
+ mumamo-chunk-eruby
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+;;;###autoload
+(define-mumamo-multi-major-mode eruby-javascript-mumamo-mode
+ "Turn on multiple major modes for eRuby with main mode `javascript-mode'."
+ ("eRuby Html Family" javascript-mode
+ (
+ mumamo-chunk-eruby-comment
+ mumamo-chunk-eruby-quoted
+ mumamo-chunk-eruby
+ ;;mumamo-chunk-inlined-style
+ ;;mumamo-chunk-inlined-script
+ ;;mumamo-chunk-style=
+ ;;mumamo-chunk-onjs=
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; heredoc
+
+(defcustom mumamo-heredoc-modes
+ '(
+ ("HTML" html-mode)
+ ("CSS" css-mode)
+ ("JAVASCRIPT" javascript-mode)
+ ("JAVA" java-mode)
+ ("GROOVY" groovy-mode)
+ ("SQL" sql-mode)
+ )
+ "Matches for heredoc modes.
+The entries in this list have the form
+
+ (REGEXP MAJOR-MODE-SPEC)
+
+where REGEXP is a regular expression that should match the
+heredoc marker line and MAJOR-MODE-SPEC is the major mode spec to
+use in the heredoc part.
+
+The major mode spec is translated to a major mode using
+`mumamo-major-mode-from-modespec'."
+ :type '(repeat
+ (list
+ regexp
+ (function :tag "Major mode")))
+ :group 'mumamo-modes)
+
+(defun mumamo-mode-for-heredoc (marker)
+ "Return major mode associated with MARKER.
+Use first match in `mumamo-heredoc-modes'.
+If no match use `text-mode'."
+ (let ((mode (catch 'mode
+ (save-match-data
+ (dolist (rec mumamo-heredoc-modes)
+ (let ((regexp (nth 0 rec))
+ (mode (nth 1 rec)))
+ (when (string-match regexp marker)
+ (throw 'mode mode))))))))
+ (if mode
+ (mumamo-major-mode-from-modespec mode)
+ 'text-mode)))
+
+(defun mumamo-chunk-heredoc (pos min max lang)
+ "This should work similar to `mumamo-find-possible-chunk'.
+POS, MIN and MAX have the same meaning as there.
+
+LANG is the programming language.
+Supported values are 'perl."
+ ;; Fix-me: LANG
+ ;; Fix-me: use mumamo-end-in-code
+ (mumamo-condition-case err
+ (let ((old-point (point)))
+ (goto-char pos)
+ (beginning-of-line)
+ (let (next-<<
+ (want-<< t)
+ heredoc-mark
+ end-mark-len
+ heredoc-line
+ delimiter
+ skipped
+ (skip-b "")
+ start-inner
+ end
+ exc-mode
+ fw-exc-fun
+ border-fun
+ allow-code-after
+ start-outer
+ ps
+ )
+ (goto-char pos)
+ (beginning-of-line)
+ (case lang
+ ('sh
+ (setq allow-code-after t)
+ (while want-<<
+ (setq next-<< (search-forward "<<" max t))
+ (if (not next-<<)
+ (setq want-<< nil) ;; give up
+ ;; Check inside string or comment.
+ (setq ps (parse-partial-sexp (line-beginning-position) (point)))
+ (unless (or (nth 3 ps) (nth 4 ps))
+ (setq want-<< nil))))
+ (when next-<<
+ (setq start-outer (- (point) 2))
+ (when (= (char-after) ?-)
+ (setq skip-b "\t*")
+ (unless (eolp) (forward-char)))
+ ;; fix-me: space
+ (setq skipped (skip-chars-forward " \t"))
+ (when (memq (char-after) '(?\" ?\'))
+ (setq delimiter (list (char-after))))
+ (if (and (> skipped 0) (not delimiter))
+ (setq heredoc-mark "")
+ (when (looking-at (rx-to-string
+ `(and (regexp ,(if delimiter
+ (concat delimiter "\\([^\n<>;]+\\)" delimiter)
+ "\\([^ \t\n<>;]+\\)"))
+ (or blank line-end))))
+ (setq heredoc-mark (buffer-substring-no-properties
+ (match-beginning 1)
+ (match-end 1)))))
+ (when heredoc-mark
+ (setq heredoc-line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+ (setq start-inner (1+ (point-at-eol)))
+ (setq end-mark-len (length heredoc-mark))
+ )))
+ ('w32-ps (error "No support for windows power shell yet"))
+ ('php
+ (while want-<<
+ (setq next-<< (search-forward "<<<" max t))
+ ;; Check inside string or comment.
+ (if (not next-<<)
+ (setq want-<< nil) ;; give up
+ (setq ps (parse-partial-sexp (line-beginning-position) (- (point) 0)))
+ (unless (or (nth 3 ps) (nth 4 ps))
+ (setq want-<< nil))))
+ (when next-<<
+ (setq start-outer (- (point) 3))
+ (skip-chars-forward " \t")
+ (when (looking-at (concat "\\([^\n;]*\\)[[:blank:]]*\n"))
+ (setq heredoc-mark (buffer-substring-no-properties
+ (match-beginning 1)
+ (match-end 1)))
+ (setq heredoc-line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+ ;; fix-me: nowdoc
+ (when (and (= ?\' (string-to-char heredoc-mark))
+ (= ?\' (string-to-char (substring heredoc-mark (1- (length heredoc-mark))))))
+ (setq heredoc-mark (substring heredoc-mark 1 (- (length heredoc-mark) 1))))
+ (setq end-mark-len (1+ (length heredoc-mark)))
+ (setq start-inner (match-end 0)))))
+ ('perl
+ (setq allow-code-after t)
+ (while want-<<
+ (setq next-<< (search-forward "<<" max t))
+ (if (not next-<<)
+ (setq want-<< nil) ;; give up
+ ;; Check inside string or comment.
+ (setq ps (parse-partial-sexp (line-beginning-position) (point)))
+ (unless (or (nth 3 ps) (nth 4 ps))
+ (setq want-<< nil))))
+ (when next-<<
+ (setq start-outer (- (point) 2))
+ ;; fix-me: space
+ (setq skipped (skip-chars-forward " \t"))
+ (when (memq (char-after) '(?\" ?\'))
+ (setq delimiter (list (char-after))))
+ (if (and (> skipped 0) (not delimiter))
+ (setq heredoc-mark "") ;; blank line
+ (when (looking-at (rx-to-string
+ `(and (regexp ,(if delimiter
+ (concat delimiter "\\([^\n;]*\\)" delimiter)
+ "\\([^ \t\n<>;]+\\)"))
+ (or blank ";"))))
+ (setq heredoc-mark (buffer-substring-no-properties
+ (match-beginning 1)
+ (match-end 1)))))
+ (when heredoc-mark
+ (setq heredoc-line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+ ;;(setq start-inner (1+ (match-end 0)))
+ (setq start-inner (1+ (point-at-eol)))
+ (setq end-mark-len (length heredoc-mark))
+ )))
+ ('python
+ (unless (eobp) (forward-char))
+ (while want-<<
+ (setq next-<< (re-search-forward "\"\"\"\\|'''" max t))
+ (setq start-outer (- (point) 3))
+ (if (not next-<<)
+ (setq want-<< nil) ;; give up
+ ;; Check inside string or comment.
+ (setq ps (parse-partial-sexp (line-beginning-position) (- (point) 3)))
+ (unless (or (nth 3 ps) (nth 4 ps))
+ (setq want-<< nil)))))
+ ('ruby
+ (while want-<<
+ (setq next-<< (search-forward "<<" max t))
+ (if (not next-<<)
+ (setq want-<< nil) ;; give up
+ ;; Check inside string or comment.
+ (setq ps (parse-partial-sexp (line-beginning-position) (point)))
+ (unless (or (nth 3 ps) (nth 4 ps))
+ (setq want-<< nil))))
+ (when next-<<
+ (setq start-outer (- (point) 2))
+ (when (= (char-after) ?-)
+ (setq skip-b "[ \t]*")
+ (forward-char))
+ (when (looking-at (concat "[^\n[:blank:]]*"))
+ (setq heredoc-mark (buffer-substring-no-properties
+ (match-beginning 0)
+ (match-end 0)))
+ (setq end-mark-len (length heredoc-mark))
+ (setq heredoc-line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+ (setq start-inner (match-end 0)))))
+ (t (error "next-<< not implemented for lang %s" lang)))
+ (when start-inner (assert (<= pos start-inner) t))
+ (goto-char old-point)
+ (when (or start-inner end)
+ (let ((endmark-regexp
+ (case lang
+ ('sh (concat "^" skip-b heredoc-mark "$"))
+ ('php (concat "^" heredoc-mark ";?$"))
+ ('perl (concat "^" heredoc-mark "$"))
+ ('python (concat "^" heredoc-mark "[[:space:]]*"))
+ ('ruby (concat "^" skip-b heredoc-mark "$"))
+ (t (error "mark-regexp not implemented for %s" lang)))))
+ ;; Fix-me: rename start-inner <=> start-outer...
+ (setq border-fun `(lambda (start end exc-mode)
+ ;; Fix-me: use lengths...
+ (list
+ (if ,allow-code-after nil (+ start (- ,start-inner ,start-outer 1)))
+ (when end (- end ,end-mark-len)))))
+ (setq fw-exc-fun `(lambda (pos max)
+ (save-match-data
+ (let ((here (point)))
+ (goto-char pos)
+ (prog1
+ (when (re-search-forward ,endmark-regexp max t)
+ (- (point) 1 ,(length heredoc-mark))
+ (- (point) 0)
+ )
+ (goto-char here)))))))
+ (setq exc-mode (mumamo-mode-for-heredoc heredoc-line))
+ (list start-inner end exc-mode nil nil fw-exc-fun nil)
+ ;; Fix me: Add overriding for inner chunks (see
+ ;; http://www.emacswiki.org/emacs/NxhtmlMode#toc13). Maybe
+ ;; make fw-exc-fun a list (or a cons, since overriding is
+ ;; probably all that I want to add)? And make the
+ ;; corresponding chunk property a list too?
+ ;;(list start-outer end exc-mode (list start-inner end) nil fw-exc-fun border-fun 'heredoc)
+ (list (if allow-code-after start-inner start-outer)
+ end exc-mode (list start-inner end) nil fw-exc-fun border-fun 'heredoc)
+ )))
+ (error (mumamo-display-error 'mumamo-chunk-heredoc
+ "%s" (error-message-string err)))))
+
+
+;;;; Unix style sh heredoc
+
+(defun mumamo-chunk-sh-heredoc (pos min max)
+ "Find sh here docs.
+See `mumamo-find-possible-chunk' for POS, MIN
+and MAX."
+ (let ((r (mumamo-chunk-heredoc pos min max 'sh)))
+ r))
+
+;;;###autoload
+(define-mumamo-multi-major-mode sh-heredoc-mumamo-mode
+ "Turn on multiple major modes for sh heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes."
+ ("SH HereDoc" sh-mode
+ (mumamo-chunk-sh-heredoc
+ )))
+(mumamo-inherit-sub-chunk-family 'sh-heredoc-mumamo-mode)
+
+
+;;;; PHP heredoc
+
+(defun mumamo-chunk-php-heredoc (pos min max)
+ "Find PHP here docs.
+See `mumamo-find-possible-chunk' for POS, MIN
+and MAX."
+ (let ((r (mumamo-chunk-heredoc pos min max 'php)))
+ r))
+
+;;;###autoload
+(define-mumamo-multi-major-mode php-heredoc-mumamo-mode
+ "Turn on multiple major modes for PHP heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes."
+ ("PHP HereDoc" php-mode
+ (mumamo-chunk-php-heredoc
+ )))
+(mumamo-inherit-sub-chunk-family 'php-heredoc-mumamo-mode)
+(mumamo-inherit-sub-chunk-family-locally 'php-heredoc-mumamo-mode 'html-mumamo-mode)
+
+
+;;;; Perl heredoc
+
+(defun mumamo-chunk-perl-heredoc (pos min max)
+ "Find perl here docs.
+See `mumamo-find-possible-chunk' for POS, MIN
+and MAX."
+ (let ((r (mumamo-chunk-heredoc pos min max 'perl)))
+ r))
+
+;;;###autoload
+(define-mumamo-multi-major-mode perl-heredoc-mumamo-mode
+ "Turn on multiple major modes for Perl heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes."
+ ("Perl HereDoc" perl-mode
+ (mumamo-chunk-perl-heredoc
+ )))
+(mumamo-inherit-sub-chunk-family 'perl-heredoc-mumamo-mode)
+
+;;;###autoload
+(define-mumamo-multi-major-mode cperl-heredoc-mumamo-mode
+ "Turn on multiple major modes for Perl heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes."
+ ("Perl HereDoc" cperl-mode
+ (mumamo-chunk-perl-heredoc
+ )))
+(mumamo-inherit-sub-chunk-family 'cperl-heredoc-mumamo-mode)
+
+
+;;;; Python heredoc
+
+(defun mumamo-chunk-python-heredoc (pos min max)
+ "Find python here docs.
+See `mumamo-find-possible-chunk' for POS, MIN
+and MAX."
+ (let ((r (mumamo-chunk-heredoc pos min max 'python)))
+ r))
+
+;;;###autoload
+(define-mumamo-multi-major-mode python-heredoc-mumamo-mode
+ "Turn on multiple major modes for Perl heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes."
+ ("Python HereDoc" python-mode
+ (mumamo-chunk-python-heredoc
+ )))
+(mumamo-inherit-sub-chunk-family 'python-heredoc-mumamo-mode)
+
+
+;;;; Ruby heredoc
+
+(defun mumamo-chunk-ruby-heredoc (pos min max)
+ "Find Ruby here docs.
+See `mumamo-find-possible-chunk' for POS, MIN
+and MAX."
+ (let ((r (mumamo-chunk-heredoc pos min max 'ruby)))
+ r))
+
+;;;###autoload
+(define-mumamo-multi-major-mode ruby-heredoc-mumamo-mode
+ "Turn on multiple major modes for Ruby heredoc document.
+See `mumamo-heredoc-modes' for how to specify heredoc major modes."
+ ("Ruby HereDoc" ruby-mode
+ (mumamo-chunk-ruby-heredoc
+ )))
+(mumamo-inherit-sub-chunk-family 'ruby-heredoc-mumamo-mode)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Tex meta
+
+;; (defun mumamo-search-bw-textext-start (pos min)
+;; "Helper for `mumamo-chunk-textext'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str pos min "textext(\""))
+;; (exc-mode 'plain-tex-mode))
+;; (when exc-start
+;; (when (<= exc-start pos)
+;; (cons exc-start exc-mode)))))
+
+(defconst mumamo-textext-end-regex
+ (rx "textext("
+ (0+
+ (0+ (not (any "\"()")))
+ ?\"
+ (0+ (not (any "\"")))
+ ?\"
+ )
+ (0+ (not (any "\"()")))
+ ")"))
+
+(defun mumamo-textext-test-is-end (pos)
+ "Helper for `mumamo-chunk-textext'.
+Return POS if POS is at the end of textext chunk."
+ (when pos
+ (let ((here (point))
+ hit)
+ (goto-char (+ 2 pos))
+ (when (looking-back mumamo-textext-end-regex)
+ (setq hit t))
+ (goto-char here)
+ (when hit pos))))
+
+;; (defun mumamo-search-bw-textext-end (pos min)
+;; "Helper for `mumamo-chunk-textext'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((end (mumamo-chunk-end-bw-str pos min "\")"))
+;; res)
+;; (while (and end
+;; (not (setq res (mumamo-textext-test-is-end end))))
+;; (setq end (mumamo-chunk-end-bw-str (1- end) min "\")")))
+;; res))
+
+;; (defun mumamo-search-fw-textext-start-old (pos max)
+;; "Helper for `mumamo-chunk-textext'.
+;; POS is where to start search and MAX is where to stop."
+;; (mumamo-chunk-start-fw-str pos max "textext(\""))
+
+(defun mumamo-search-fw-textext-start (pos max)
+ "Helper for `mumamo-chunk-textext'.
+POS is where to start search and MAX is where to stop."
+ (let ((where (mumamo-chunk-start-fw-str pos max "textext(\"")))
+ (when where
+ (list where 'plain-tex-mode))))
+
+(defun mumamo-search-fw-textext-end (pos max)
+ "Helper for `mumamo-chunk-textext'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (let ((end (mumamo-chunk-end-fw-str pos max "\")")))
+ (mumamo-textext-test-is-end end))))
+
+(defun mumamo-chunk-textext (pos min max)
+ "Find textext or TEX chunks. Return range and 'plain-tex-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-textext-start
+ ;; 'mumamo-search-bw-textext-end
+ ;; 'mumamo-search-fw-textext-start-old
+ ;; 'mumamo-search-fw-textext-end)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-textext-start
+ 'mumamo-search-fw-textext-end))
+
+;; (defun mumamo-search-bw-verbatimtex-start (pos min)
+;; "Helper for `mumamo-chunk-verbatimtextext'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str pos min "\nverbatimtex"))
+;; (exc-mode 'plain-tex-mode))
+;; (when exc-start
+;; (when (<= exc-start pos)
+;; (cons exc-start exc-mode)))))
+
+;; (defun mumamo-search-bw-verbatimtex-end (pos min)
+;; "Helper for `mumamo-chunk-verbatimtextext'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str pos min "\netex"))
+
+;; (defun mumamo-search-fw-verbatimtex-start-old (pos max)
+;; "Helper for `mumamo-chunk-verbatimtextext'.
+;; POS is where to start search and MAX is where to stop."
+;; (mumamo-chunk-start-fw-str pos max "\nverbatimtex"))
+
+(defun mumamo-search-fw-verbatimtex-start (pos max)
+ "Helper for `mumamo-chunk-verbatimtextext'.
+POS is where to start search and MAX is where to stop."
+ (let ((where (mumamo-chunk-start-fw-str pos max "\nverbatimtex")))
+ (when where
+ (list where 'plain-tex-mode))))
+
+(defun mumamo-search-fw-verbatimtex-end (pos max)
+ "Helper for `mumamo-chunk-verbatimtextext'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max "\netex")))
+
+(defun mumamo-chunk-verbatimtex (pos min max)
+ "Find verbatimtex - etex chunks. Return range and 'plain-tex-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-verbatimtex-start
+ ;; 'mumamo-search-bw-verbatimtex-end
+ ;; 'mumamo-search-fw-verbatimtex-start-old
+ ;; 'mumamo-search-fw-verbatimtex-end)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-verbatimtex-start
+ 'mumamo-search-fw-verbatimtex-end))
+
+;; (defun mumamo-search-bw-btex-start (pos min)
+;; "Helper for `mumamo-chunk-btex'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str pos min "\nverbatimtex"))
+;; (exc-mode 'plain-tex-mode))
+;; (when exc-start
+;; (when (<= exc-start pos)
+;; (cons exc-start exc-mode)))))
+
+;; (defun mumamo-search-bw-btex-end (pos min)
+;; "Helper for `mumamo-chunk-btex'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str pos min "\netex"))
+
+;; (defun mumamo-search-fw-btex-start-old (pos max)
+;; "Helper for `mumamo-chunk-btex'.
+;; POS is where to start search and MAX is where to stop."
+;; (mumamo-chunk-start-fw-str pos max "\nverbatimtex"))
+
+(defun mumamo-search-fw-btex-start (pos max)
+ "Helper for `mumamo-chunk-btex'.
+POS is where to start search and MAX is where to stop."
+ (let ((where (mumamo-chunk-start-fw-str pos max "\nverbatimtex")))
+ (when where
+ (list where 'plain-tex-mode))))
+
+(defun mumamo-search-fw-btex-end (pos max)
+ "Helper for `mumamo-chunk-btex'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max "\netex")))
+
+(defun mumamo-chunk-btex (pos min max)
+ "Find btex - etex chunks.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-btex-start
+ ;; 'mumamo-search-bw-btex-end
+ ;; 'mumamo-search-fw-btex-start-old
+ ;; 'mumamo-search-fw-btex-end)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-btex-start
+ 'mumamo-search-fw-btex-end))
+
+;;;###autoload
+(define-mumamo-multi-major-mode metapost-mumamo-mode
+ "Turn on multiple major modes for MetaPost."
+ ("MetaPost TeX Family" metapost-mode
+ (mumamo-chunk-textext
+ mumamo-chunk-verbatimtex
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; OpenLaszlo
+
+(defconst mumamo-lzx-method-tag-start-regex
+ (rx "<method"
+ (optional
+ space
+ (0+ (not (any ">"))))
+ ">"
+ ;; FIX-ME: Commented out because of bug in Emacs
+ ;;
+ ;;(optional (0+ space) "<![CDATA[" )
+ ))
+
+(defun mumamo-search-bw-exc-start-inlined-lzx-method (pos min)
+ "Helper for `mumamo-chunk-inlined-lzx-method'.
+POS is where to start search and MIN is where to stop."
+ (goto-char (+ pos 7))
+ (let ((marker-start (search-backward "<method" min t))
+ exc-mode
+ exc-start)
+ (when marker-start
+ (when (looking-at mumamo-lzx-method-tag-start-regex)
+ (setq exc-start (match-end 0))
+ (goto-char exc-start)
+ (when (<= exc-start pos)
+ (cons (point) 'javascript-mode))
+ ))))
+
+;; (defun mumamo-search-bw-exc-end-inlined-lzx-method (pos min)
+;; "Helper for `mumamo-chunk-inlined-lzx-method'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str pos min "</method>"))
+
+;; (defun mumamo-search-fw-exc-start-inlined-lzx-method-old (pos max)
+;; "Helper for `mumamo-chunk-inlined-lzx-method'.
+;; POS is where to start search and MAX is where to stop."
+;; (goto-char (1+ pos))
+;; (skip-chars-backward "^<")
+;; ;; Handle <![CDATA[
+;; (when (and
+;; (eq ?< (char-before))
+;; (eq ?! (char-after))
+;; (not (bobp)))
+;; (backward-char)
+;; (skip-chars-backward "^<"))
+;; (unless (bobp)
+;; (backward-char 1))
+;; (let ((exc-start (search-forward "<method" max t))
+;; exc-mode)
+;; (when exc-start
+;; (goto-char (- exc-start 7))
+;; (when (looking-at mumamo-lzx-method-tag-start-regex)
+;; (goto-char (match-end 0))
+;; (point)
+;; ))))
+
+(defun mumamo-search-fw-exc-start-inlined-lzx-method (pos max)
+ "Helper for `mumamo-chunk-inlined-lzx-method'.
+POS is where to start search and MAX is where to stop."
+ (goto-char (1+ pos))
+ (skip-chars-backward "^<")
+ ;; Handle <![CDATA[
+ (when (and
+ (eq ?< (char-before))
+ (eq ?! (char-after))
+ (not (bobp)))
+ (backward-char)
+ (skip-chars-backward "^<"))
+ (unless (bobp)
+ (backward-char 1))
+ (let ((exc-start (search-forward "<method" max t))
+ exc-mode)
+ (when exc-start
+ (goto-char (- exc-start 7))
+ (when (looking-at mumamo-lzx-method-tag-start-regex)
+ (goto-char (match-end 0))
+ (list (point) 'javascript-mode)
+ ))))
+
+(defun mumamo-search-fw-exc-end-inlined-lzx-method (pos max)
+ "Helper for `mumamo-chunk-inlined-lzx-method'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max "</method>")))
+
+(defun mumamo-chunk-inlined-lzx-method (pos min max)
+ "Find <method>...</method>. Return range and 'javascript-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-exc-start-inlined-lzx-method
+ ;; 'mumamo-search-bw-exc-end-inlined-lzx-method
+ ;; 'mumamo-search-fw-exc-start-inlined-lzx-method-old
+ ;; 'mumamo-search-fw-exc-end-inlined-lzx-method)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-inlined-lzx-method
+ 'mumamo-search-fw-exc-end-inlined-lzx-method))
+
+(defconst mumamo-lzx-handler-tag-start-regex
+ (rx "<handler"
+ (optional
+ space
+ (0+ (not (any ">"))))
+ ">"
+ ;; FIX-ME: Commented out because of bug in Emacs
+ ;;
+ ;;(optional (0+ space) "<![CDATA[" )
+ ))
+
+;; (defun mumamo-search-bw-exc-start-inlined-lzx-handler (pos min)
+;; "Helper for `mumamo-chunk-inlined-lzx-handler'.
+;; POS is where to start search and MIN is where to stop."
+;; (goto-char (+ pos 8))
+;; (let ((marker-start (search-backward "<handler" min t))
+;; exc-mode
+;; exc-start)
+;; (when marker-start
+;; (when (looking-at mumamo-lzx-handler-tag-start-regex)
+;; (setq exc-start (match-end 0))
+;; (goto-char exc-start)
+;; (when (<= exc-start pos)
+;; (cons (point) 'javascript-mode))
+;; ))))
+
+;; (defun mumamo-search-bw-exc-end-inlined-lzx-handler (pos min)
+;; "Helper for `mumamo-chunk-inlined-lzx-handler'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str pos min "</handler>"))
+
+;; (defun mumamo-search-fw-exc-start-inlined-lzx-handler-old (pos max)
+;; "Helper for `mumamo-chunk-inlined-lzx-handler'.
+;; POS is where to start search and MAX is where to stop."
+;; (goto-char (1+ pos))
+;; (skip-chars-backward "^<")
+;; ;; Handle <![CDATA[
+;; (when (and
+;; (eq ?< (char-before))
+;; (eq ?! (char-after))
+;; (not (bobp)))
+;; (backward-char)
+;; (skip-chars-backward "^<"))
+;; (unless (bobp)
+;; (backward-char 1))
+;; (let ((exc-start (search-forward "<handler" max t))
+;; exc-mode)
+;; (when exc-start
+;; (goto-char (- exc-start 8))
+;; (when (looking-at mumamo-lzx-handler-tag-start-regex)
+;; (goto-char (match-end 0))
+;; (point)
+;; ))))
+
+(defun mumamo-search-fw-exc-start-inlined-lzx-handler (pos max)
+ "Helper for `mumamo-chunk-inlined-lzx-handler'.
+POS is where to start search and MAX is where to stop."
+ (goto-char (1+ pos))
+ (skip-chars-backward "^<")
+ ;; Handle <![CDATA[
+ (when (and
+ (eq ?< (char-before))
+ (eq ?! (char-after))
+ (not (bobp)))
+ (backward-char)
+ (skip-chars-backward "^<"))
+ (unless (bobp)
+ (backward-char 1))
+ (let ((exc-start (search-forward "<handler" max t))
+ exc-mode)
+ (when exc-start
+ (goto-char (- exc-start 8))
+ (when (looking-at mumamo-lzx-handler-tag-start-regex)
+ (goto-char (match-end 0))
+ (list (point) 'javascript-mode)
+ ))))
+
+(defun mumamo-search-fw-exc-end-inlined-lzx-handler (pos max)
+ "Helper for `mumamo-chunk-inlined-lzx-handler'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max "</handler>")))
+
+(defun mumamo-chunk-inlined-lzx-handler (pos min max)
+ "Find <handler>...</handler>. Return range and 'javascript-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-exc-start-inlined-lzx-handler
+ ;; 'mumamo-search-bw-exc-end-inlined-lzx-handler
+ ;; 'mumamo-search-fw-exc-start-inlined-lzx-handler-old
+ ;; 'mumamo-search-fw-exc-end-inlined-lzx-handler)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-inlined-lzx-handler
+ 'mumamo-search-fw-exc-end-inlined-lzx-handler))
+
+
+;;;###autoload
+(define-mumamo-multi-major-mode laszlo-nxml-mumamo-mode
+ "Turn on multiple major modes for OpenLaszlo."
+ ("OpenLaszlo Family" nxml-mode
+ (mumamo-chunk-inlined-script
+ mumamo-chunk-inlined-lzx-method
+ mumamo-chunk-inlined-lzx-handler
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; csound
+
+;; (defun mumamo-search-bw-exc-start-csound-orc (pos min)
+;; "Helper for `mumamo-chunk-csound-orc'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str pos min "<csinstruments>")))
+;; (and exc-start
+;; (<= exc-start pos)
+;; (cons exc-start 'csound-orc-mode))))
+
+;; (defun mumamo-search-bw-exc-end-csound-orc (pos min)
+;; "Helper for `mumamo-chunk-csound-orc'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str pos min "</csinstruments>"))
+
+;; (defun mumamo-search-fw-exc-start-csound-orc-old (pos max)
+;; "Helper for `mumamo-chunk-csound-orc'.
+;; POS is where to start search and MAX is where to stop."
+;; (mumamo-chunk-start-fw-str pos max "<csinstruments>"))
+
+(defun mumamo-search-fw-exc-start-csound-orc (pos max)
+ "Helper for `mumamo-chunk-csound-orc'.
+POS is where to start search and MAX is where to stop."
+ (let ((where (mumamo-chunk-start-fw-str pos max "<csinstruments>")))
+ (when where
+ (list where 'csound-orc-mode))))
+
+(defun mumamo-search-fw-exc-end-csound-orc (pos max)
+ "Helper for `mumamo-chunk-csound-orc'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max "</csinstruments>")))
+
+(defun mumamo-chunk-csound-orc (pos min max)
+ "Find <csinstruments>...</...>. Return range and 'csound-orc-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-exc-start-csound-orc
+ ;; 'mumamo-search-bw-exc-end-csound-orc
+ ;; 'mumamo-search-fw-exc-start-csound-orc-old
+ ;; 'mumamo-search-fw-exc-end-csound-orc)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-csound-orc
+ 'mumamo-search-fw-exc-end-csound-orc))
+
+;; (defun mumamo-search-bw-exc-start-csound-sco (pos min)
+;; "Helper for `mumamo-chunk-csound-sco'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-str pos min "<csscore>")))
+;; (and exc-start
+;; (<= exc-start pos)
+;; (cons exc-start 'csound-sco-mode))))
+
+;; (defun mumamo-search-bw-exc-end-csound-sco (pos min)
+;; "Helper for `mumamo-chunk-csound-sco'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str pos min "</csscore>"))
+
+;; (defun mumamo-search-fw-exc-start-csound-sco-old (pos max)
+;; "Helper for `mumamo-chunk-csound-sco'.
+;; POS is where to start search and MAX is where to stop."
+;; (mumamo-chunk-start-fw-str pos max "<csscore>"))
+
+(defun mumamo-search-fw-exc-start-csound-sco (pos max)
+ "Helper for `mumamo-chunk-csound-sco'.
+POS is where to start search and MAX is where to stop."
+ (let ((where (mumamo-chunk-start-fw-str pos max "<csscore>")))
+ (when where
+ (list where 'csound-sco-mode))))
+
+(defun mumamo-search-fw-exc-end-csound-sco (pos max)
+ "Helper for `mumamo-chunk-csound-sco'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max "</csscore>")))
+
+(defun mumamo-chunk-csound-sco (pos min max)
+ "Found <csscore>...</csscore>. Return range and 'csound-sco-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-exc-start-csound-sco
+ ;; 'mumamo-search-bw-exc-end-csound-sco
+ ;; 'mumamo-search-fw-exc-start-csound-sco-old
+ ;; 'mumamo-search-fw-exc-end-csound-sco)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-csound-sco
+ 'mumamo-search-fw-exc-end-csound-sco))
+
+;;;###autoload
+(define-mumamo-multi-major-mode csound-sgml-mumamo-mode
+ "Turn on mutiple major modes for CSound orc/sco Modes."
+ ("CSound orc/sco Modes" sgml-mode
+ (mumamo-chunk-csound-sco
+ mumamo-chunk-csound-orc
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; noweb
+
+;;;###autoload
+(defgroup mumamo-noweb2 nil
+ "Customization group for `noweb2-mumamo-mode'."
+ :group 'mumamo-modes)
+
+(defcustom mumamo-noweb2-mode-from-ext
+ '(
+ ("php" . php-mode)
+ ("c" . c-mode)
+ )
+ "File extension regexp to major mode mapping.
+Used by `noweb2-mumamo-mode'."
+ :type '(repeat
+ (cons regexp major-mode-function))
+ :group 'mumamo-noweb2)
+
+(defvar mumamo-noweb2-found-mode-from-ext nil
+ "Major modes determined from file names. Internal use.")
+
+(defun mumamo-noweb2-chunk-start-fw (pos max)
+ "Helper for `mumamo-noweb2-chunk'.
+POS is where to start search and MAX is where to stop."
+ (let ((where (mumamo-chunk-start-fw-re pos max "^<<\\(.*?\\)>>="))
+ (exc-mode 'text-mode))
+ (when where
+ (let* ((file-name (match-string-no-properties 1))
+ (file-ext (when file-name (file-name-extension file-name))))
+ (when file-ext
+ (setq exc-mode (catch 'major
+ (dolist (rec mumamo-noweb2-mode-from-ext)
+ (when (string-match (car rec) file-ext)
+ (throw 'major (cdr rec))))
+ nil))))
+ (list where exc-mode))))
+
+;; (defun mumamo-noweb2-chunk-start-bw (pos min)
+;; "Helper for `mumamo-noweb2-chunk'.
+;; POS is where to start search and MIN is where to stop."
+;; (let ((exc-start (mumamo-chunk-start-bw-re pos min "^<<\\(.*?\\)>>="))
+;; (exc-mode 'text-mode))
+;; (when exc-start
+;; (let* ((file-name (match-string 1))
+;; (file-ext (when file-name (file-name-extension file-name))))
+;; (when file-ext
+;; (setq exc-mode (catch 'major
+;; (dolist (rec mumamo-noweb2-mode-from-ext)
+;; (when (string-match (car rec) file-ext)
+;; (throw 'major (cdr rec))))
+;; nil))
+;; (unless exc-mode
+;; (setq exc-mode
+;; (cdr (assoc file-ext mumamo-noweb2-found-mode-from-ext)))
+;; (unless exc-mode
+;; ;; Get the major mode from file name
+;; (with-temp-buffer
+;; (setq buffer-file-name file-name)
+;; (condition-case err
+;; (normal-mode)
+;; (error (message "error (normal-mode): %s"
+;; (error-message-string err))))
+;; (setq exc-mode (or major-mode
+;; 'text-mode))
+;; (add-to-list 'mumamo-noweb2-found-mode-from-ext
+;; (cons file-ext exc-mode)))
+;; ))))
+;; (cons exc-start exc-mode))))
+
+(defun mumamo-noweb2-chunk-end-fw (pos max)
+ "Helper for `mumamo-noweb2-chunk'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-re pos max "^@")))
+
+;; (defun mumamo-noweb2-chunk-end-bw (pos min)
+;; "Helper for `mumamo-noweb2-chunk'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-re pos min "^@"))
+
+(defun mumamo-noweb2-code-chunk (pos min max)
+ "Find noweb chunks. Return range and found mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (save-match-data
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-noweb2-chunk-start-bw
+ ;; 'mumamo-noweb2-chunk-end-bw
+ ;; 'mumamo-noweb2-chunk-start-fw-old
+ ;; 'mumamo-noweb2-chunk-end-fw)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-noweb2-chunk-start-fw
+ 'mumamo-noweb2-chunk-end-fw)))
+
+
+;;;###autoload
+(define-mumamo-multi-major-mode noweb2-mumamo-mode
+ "Multi major mode for noweb files."
+ ("noweb Family" latex-mode
+ (mumamo-noweb2-code-chunk)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Template-Toolkit
+
+
+
+;; (setq auto-mode-alist
+;; (append '(("\\.tt2?$" . tt-mode)) auto-mode-alist ))
+
+;;(require 'tt-mode)
+(defun mumamo-chunk-tt (pos min max)
+ "Find [% ... %], return range and `tt-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX.
+
+This is for Template Toolkit.
+See URL `http://dave.org.uk/emacs/' for `tt-mode'."
+ (mumamo-quick-static-chunk pos min max "[%" "%]" t 'tt-mode nil))
+
+(define-mumamo-multi-major-mode tt-html-mumamo-mode
+ "Turn on multiple major modes for TT files with main mode `nxhtml-mode'.
+TT = Template-Toolkit.
+
+This also covers inlined style and javascript."
+ ("TT HTML Family" html-mode
+ (mumamo-chunk-tt
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Asp
+
+;;;; asp <%@language="javscript"%>
+
+(defvar mumamo-asp-default-major 'asp-js-mode)
+(make-variable-buffer-local 'mumamo-asp-default-major)
+(put 'mumamo-asp-default-major 'permanent-local t)
+
+(defconst mumamo-asp-lang-marker
+ (rx "<%@"
+ (0+ space)
+ "language"
+ (0+ space)
+ "="
+ (0+ space)
+ "\""
+ (submatch (1+ (not (any "\""))))
+ "\""
+ (0+ space)))
+
+(defun mumamo-search-fw-exc-start-jsp (pos min max)
+ ;; fix-me
+ )
+(defun mumamo-chunk-asp (pos min max)
+ "Find <% ... %>. Return range and 'asp-js-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; Fix-me: this is broken!
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-exc-start-asp
+ ;; 'mumamo-search-bw-exc-end-jsp
+ ;; 'mumamo-search-fw-exc-start-jsp-old
+ ;; 'mumamo-search-fw-exc-end-jsp)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-exc-start-asp
+ 'mumamo-search-fw-exc-end-jsp))
+
+
+;;;; asp <% ...>
+
+(defun mumamo-chunk-asp% (pos min max)
+ "Find <% ... %>. Return range and 'asp-js-mode or 'asp-vb-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (let* ((chunk (mumamo-quick-static-chunk pos min max "<%" "%>" t 'java-mode t))
+ (beg (nth 0 chunk))
+ (here (point))
+ glang)
+ (when chunk
+ (goto-char beg)
+ (if (looking-at mumamo-asp-lang-marker)
+ (progn
+ (setq glang (downcase (match-string 1)))
+ (cond
+ ((string= glang "javascript")
+ (setq mumamo-asp-default-major 'asp-js-mode))
+ ((string= glang "vbscript")
+ (setq mumamo-asp-default-major 'asp-vb-mode))
+ )
+ (setcar (nthcdr 2 chunk) 'mumamo-comment-mode))
+ (setcar (nthcdr 2 chunk) mumamo-asp-default-major))
+ chunk)))
+
+;;;; asp <script ...>
+
+(defconst mumamo-asp-script-tag-start-regex
+ (rx "<script"
+ space
+ (0+ (not (any ">")))
+ "language"
+ (0+ space)
+ "="
+ (0+ space)
+ ?\"
+ ;;(or "text" "application")
+ ;;"/"
+ ;;(or "javascript" "ecmascript")
+ ;; "text/javascript"
+ (submatch
+ (or "javascript" "vbscript"))
+ ?\"
+ (0+ (not (any ">")))
+ ">"
+ ;; FIX-ME: Commented out because of bug in Emacs
+ ;;
+ ;;(optional (0+ space) "<![CDATA[" )
+ ))
+
+;; (defun mumamo-asp-search-bw-exc-start-inlined-script (pos min)
+;; "Helper function for `mumamo-asp-chunk-inlined-script'.
+;; POS is where to start search and MIN is where to stop."
+;; (goto-char (+ pos 7))
+;; (let ((marker-start (search-backward "<script" min t))
+;; (exc-mode 'asp-vb-mode)
+;; exc-start
+;; lang)
+;; (when marker-start
+;; (when (looking-at mumamo-asp-script-tag-start-regex)
+;; (setq lang (downcase (match-string-no-properties 1)))
+;; (cond
+;; ((string= lang "javascript")
+;; (setq exc-mode 'asp-js-mode))
+;; ((string= lang "vbscript")
+;; (setq exc-mode 'asp-vb-mode))))
+;; (setq exc-start (match-end 0))
+;; (goto-char exc-start)
+;; (when (<= exc-start pos)
+;; (cons (point) exc-mode))
+;; )))
+
+;; (defun mumamo-asp-search-fw-exc-start-inlined-script-old (pos max)
+;; "Helper for `mumamo-chunk-inlined-script'.
+;; POS is where to start search and MAX is where to stop."
+;; (goto-char (1+ pos))
+;; (skip-chars-backward "^<")
+;; ;; Handle <![CDATA[
+;; (when (and
+;; (eq ?< (char-before))
+;; (eq ?! (char-after))
+;; (not (bobp)))
+;; (backward-char)
+;; (skip-chars-backward "^<"))
+;; (unless (bobp)
+;; (backward-char 1))
+;; (let ((exc-start (search-forward "<script" max t))
+;; exc-mode)
+;; (when exc-start
+;; (goto-char (- exc-start 7))
+;; (when (looking-at mumamo-asp-script-tag-start-regex)
+;; (goto-char (match-end 0))
+;; (point)
+;; ))))
+
+(defun mumamo-asp-search-fw-exc-start-inlined-script (pos max)
+ "Helper for `mumamo-chunk-inlined-script'.
+POS is where to start search and MAX is where to stop."
+ (goto-char (1+ pos))
+ (skip-chars-backward "^<")
+ ;; Handle <![CDATA[
+ (when (and
+ (eq ?< (char-before))
+ (eq ?! (char-after))
+ (not (bobp)))
+ (backward-char)
+ (skip-chars-backward "^<"))
+ (unless (bobp)
+ (backward-char 1))
+ (let ((exc-start (search-forward "<script" max t))
+ (exc-mode 'asp-vb-mode)
+ (lang "vbscript"))
+ (when exc-start
+ (goto-char (- exc-start 7))
+ (when (looking-at mumamo-asp-script-tag-start-regex)
+ (goto-char (match-end 0))
+ (setq lang (downcase (match-string-no-properties 1)))
+ (cond
+ ((string= lang "javascript")
+ (setq exc-mode 'asp-js-mode))
+ ((string= lang "vbscript")
+ (setq exc-mode 'asp-vb-mode)))
+ (list (point) exc-mode)
+ ))))
+
+(defun mumamo-asp-chunk-inlined-script (pos min max)
+ "Find <script language=... runat=...>...</script>. Return 'asp-js-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-asp-search-bw-exc-start-inlined-script
+ ;; 'mumamo-search-bw-exc-end-inlined-script
+ ;; 'mumamo-asp-search-fw-exc-start-inlined-script-old
+ ;; 'mumamo-search-fw-exc-end-inlined-script)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-asp-search-fw-exc-start-inlined-script
+ 'mumamo-search-fw-exc-end-inlined-script))
+
+;;;###autoload
+(define-mumamo-multi-major-mode asp-html-mumamo-mode
+ "Turn on multiple major modes for ASP with main mode `html-mode'.
+This also covers inlined style and javascript."
+ ("ASP Html Family" html-mode
+ (mumamo-chunk-asp%
+ mumamo-asp-chunk-inlined-script
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Org-mode
+
+(defcustom mumamo-org-submodes
+ '(
+ (emacs-lisp emacs-lisp-mode)
+ (ruby ruby-mode)
+ (python python-mode)
+ (sh sh-mode)
+ (R R-mode)
+ (ditaa picture-mode)
+ )
+ "Alist for conversion of org #+BEGIN_SRC specifier to major mode.
+Works kind of like `mumamo-major-modes'.
+
+This may be used for example for org-babel \(see URL
+`http://orgmode.org/worg/org-contrib/babel/')."
+ :type '(alist
+ :key-type (symbol :tag "Symbol in #BEGIN_SRC specifier")
+ :value-type (repeat (choice
+ (command :tag "Major mode")
+ (symbol :tag "Major mode (not yet loaded)")))
+ )
+ :group 'mumamo-modes)
+
+(defun mumamo-org-mode-from-spec (major-spec)
+ "Translate MAJOR-SPEC to a major mode.
+Translate MAJOR-SPEC used in #BEGIN_SRC to a major mode.
+
+See `mumamo-org-submodes' for an explanation."
+ (mumamo-major-mode-from-spec major-spec mumamo-org-submodes))
+
+(defun mumamo-chunk-org-html (pos min max)
+ "Find #+BEGIN_HTML ... #+END_HTML, return range and `html-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "#+BEGIN_HTML" "#+END_HTML" nil 'html-mode nil))
+
+;; (defun mumamo-search-bw-org-src-start (pos min)
+;; "Helper for `mumamo-chunk-org-src'.
+;; POS is where to start search and MIN is where to stop."
+;; (let* ((exc-start (mumamo-chunk-start-bw-str pos min "#+BEGIN_SRC"))
+;; (exc-mode (when exc-start
+;; (let ((here (point)))
+;; (goto-char exc-start)
+;; (prog1
+;; (read (current-buffer))
+;; (goto-char here))))))
+;; (setq exc-mode (mumamo-org-mode-from-spec exc-mode))
+;; ;;(setq exc-mode (eval exc-mode))
+;; ;;(setq exc-mode 'text-mode)
+;; ;;(when exc-mode (setq exc-mode (quote exc-mode)))
+;; ;;(assert (eq exc-mode 'emacs-lisp-mode) t)
+;; (when exc-start
+;; (when (<= exc-start pos)
+;; (cons exc-start exc-mode)))))
+
+;; (defun mumamo-search-bw-org-src-end (pos min)
+;; "Helper for `mumamo-chunk-org-src'.
+;; POS is where to start search and MIN is where to stop."
+;; (mumamo-chunk-end-bw-str pos min "#+END_SRC"))
+
+;; (defun mumamo-search-fw-org-src-start-old (pos max)
+;; "Helper for `mumamo-chunk-org-src'.
+;; POS is where to start search and MAX is where to stop."
+;; (mumamo-chunk-start-fw-str pos max "#+BEGIN_SRC"))
+
+(defun mumamo-search-fw-org-src-start (pos max)
+ "Helper for `mumamo-chunk-org-src'.
+POS is where to start search and MAX is where to stop."
+ (let ((where (mumamo-chunk-start-fw-str pos max "#+BEGIN_SRC")))
+ (when where
+ (let ((exc-mode (let ((here (point)))
+ (goto-char where)
+ (prog1
+ (read (current-buffer))
+ (goto-char here)))))
+ (setq exc-mode (mumamo-org-mode-from-spec exc-mode))
+ (list where exc-mode)))))
+
+(defun mumamo-search-fw-org-src-end (pos max)
+ "Helper for `mumamo-chunk-org-src'.
+POS is where to start search and MAX is where to stop."
+ (save-match-data
+ (mumamo-chunk-end-fw-str pos max "#+END_SRC")))
+
+(defun mumamo-chunk-org-src (pos min max)
+ "Find #+BEGIN_SRC ... #+END_SRC, return range and choosen major mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX.
+
+See Info node `(org) Literal Examples' for how to specify major
+mode."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-search-bw-org-src-start
+ ;; 'mumamo-search-bw-org-src-end
+ ;; 'mumamo-search-fw-org-src-start-old
+ ;; 'mumamo-search-fw-org-src-end)
+ (mumamo-possible-chunk-forward pos max
+ 'mumamo-search-fw-org-src-start
+ 'mumamo-search-fw-org-src-end))
+
+;;;###autoload
+(define-mumamo-multi-major-mode org-mumamo-mode
+ "Turn on multiple major modes for `org-mode' files with main mode `org-mode'.
+** Note about HTML subchunks:
+Unfortunately this only allows `html-mode' (not `nxhtml-mode') in
+sub chunks."
+ ("Org Mode + Html" org-mode
+ (mumamo-chunk-org-html
+ mumamo-chunk-org-src
+ )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Mako
+
+;; See http://www.makotemplates.org/docs/syntax.html
+
+;;; Comments mode
+;; Fix-me: move to mumamo.el
+(defconst mumamo-comment-font-lock-keywords
+ (list
+ (cons "\\(.*\\)" (list 1 font-lock-comment-face))
+ ))
+(defvar mumamo-comment-font-lock-defaults
+ '(mumamo-comment-font-lock-keywords t t))
+
+(define-derived-mode mumamo-comment-mode nil "Comment chunk"
+ "For comment blocks."
+ (set (make-local-variable 'font-lock-defaults) mumamo-comment-font-lock-defaults))
+
+
+
+(defun mumamo-chunk-mako-<% (pos min max)
+ "Find <% ... %> and <%! ... %>. Return range and `python-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;; (mumamo-find-possible-chunk pos min max
+ ;; 'mumamo-mako-<%-bw-start
+ ;; 'mumamo-mako-<%-bw-end
+ ;; 'mumamo-mako-<%-fw-start-old
+ ;; 'mumamo-mako-<%-fw-end
+ ;; 'mumamo-mako-<%-find-borders)
+ (let ((chunk (mumamo-possible-chunk-forward pos max
+ 'mumamo-mako-<%-fw-start
+ 'mumamo-mako-<%-fw-end
+ 'mumamo-mako-<%-find-borders
+ )))
+ (when chunk
+ (setcdr (last chunk) '(mumamo-template-indentor))
+ chunk)))
+
+(defun mumamo-mako-<%-find-borders (start end exc-mode)
+ (when exc-mode
+ (list
+ (when start
+ (+ start
+ (if (eq ?! (char-after (+ start 2)))
+ 3
+ 2)))
+ (when end (- end 2))
+ exc-mode)))
+
+;; (defun mumamo-mako-<%-bw-start (pos min)
+;; (let ((here (point))
+;; start
+;; ret
+;; )
+;; (goto-char (+ pos 3))
+;; (setq start (re-search-backward "<%!?\\(?:[ \t]\\|$\\)" min t))
+;; (when (and start (<= start pos))
+;; (setq ret (list start 'python-mode)))
+;; (goto-char here)
+;; ret))
+
+;; (defun mumamo-mako-<%-bw-end (pos min)
+;; (mumamo-chunk-end-bw-str-inc pos min "%>")) ;; ok
+
+;; (defun mumamo-mako-<%-fw-start-old (pos max)
+;; (let ((here (point))
+;; start
+;; ret)
+;; (goto-char pos)
+;; (setq start
+;; (re-search-forward "<%!?\\(?:[ \t]\\|$\\)" max t))
+;; (when start
+;; (setq ret (match-beginning 0)))
+;; (goto-char here)
+;; ret))
+
+(defun mumamo-mako-<%-fw-start (pos max)
+ (let ((here (point))
+ start
+ ret)
+ (goto-char pos)
+ (setq start
+ (re-search-forward "<%!?\\(?:[ \t]\\|$\\)" max t))
+ (when start
+ (setq ret (match-beginning 0)))
+ (goto-char here)
+ (when ret
+ (list ret 'python-mode))))
+
+(defun mumamo-mako-<%-fw-end (pos max)
+ (save-match-data
+ (mumamo-chunk-end-fw-str-inc pos max "%>"))) ;; ok
+
+
+
+(defun mumamo-chunk-mako-% (pos min max)
+ "Find % python EOL. Return range and `python-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (let ((chunk (mumamo-whole-line-chunk pos min max "%" 'python-mode)))
+ (when chunk
+ (setcdr (last chunk) '(mumamo-template-indentor))
+ chunk)))
+
+(defun mumamo-chunk-mako-one-line-comment (pos min max)
+ "Find ## comment EOL. Return range and `python-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-whole-line-chunk pos min max "##" 'mumamo-comment-mode))
+
+;; Fix-me: Move this to mumamo.el
+;; Fix-me: does not work with new chunk div
+(defun mumamo-whole-line-chunk-fw-exc-end-fun (pos max)
+ (let ((here (point)))
+ (goto-char pos)
+ (prog1
+ (line-end-position)
+ (goto-char here))))
+
+(defun mumamo-whole-line-chunk (pos min max marker mode)
+ (let* ((here (point))
+ (len-marker (length marker))
+ (pattern (rx-to-string `(and bol (0+ blank) ,marker blank) t))
+ (whole-line-chunk-borders-fun
+ `(lambda (start end dummy)
+ (let ((start-border (+ start ,len-marker)))
+ (list start-border nil))))
+ beg
+ end
+ ret)
+ (goto-char pos)
+ (setq beg (re-search-forward pattern max t))
+ (when beg
+ (setq beg (- beg len-marker 1))
+ (setq end (line-end-position))
+ (setq ret (list beg
+ end
+ mode
+ (let ((start-border (+ beg len-marker)))
+ (list start-border nil))
+ nil
+ 'mumamo-whole-line-chunk-fw-exc-end-fun
+ whole-line-chunk-borders-fun
+ )))
+ (goto-char here)
+ ret))
+
+;; (defun mumamo-single-regexp-chunk (pos min max begin-mark end-mark mode)
+;; "Not ready yet. `mumamo-quick-static-chunk'"
+;; (let ((here (point))
+;; (len-marker (length marker))
+;; beg
+;; end
+;; ret)
+;; (goto-char pos)
+;; (setq beg (line-beginning-position))
+;; (setq end (line-end-position))
+;; (unless (or (when min (< beg min))
+;; (when max (> end max))
+;; (= pos end))
+;; (goto-char beg)
+;; (skip-chars-forward " \t")
+;; (when (and
+;; (string= marker (buffer-substring-no-properties (point) (+ (point) len-marker)))
+;; (memq (char-after (+ (point) len-marker))
+;; '(?\ ?\t ?\n))
+;; (>= pos (point)))
+;; (setq ret
+;; (list (point)
+;; end
+;; mode
+;; (let ((start-border (+ (point) len-marker)))
+;; (list start-border nil))))))
+;; (unless ret
+;; (let ((range-regexp
+;; (concat "^[ \t]*"
+;; "\\("
+;; (regexp-quote marker)
+;; "[ \t\n].*\\)$")))
+;; ;; Backward
+;; (goto-char pos)
+;; (unless (= pos (line-end-position))
+;; (goto-char (line-beginning-position)))
+;; (setq beg (re-search-backward range-regexp min t))
+;; (when beg (setq beg (match-end 1)))
+;; ;; Forward, take care of indentation part
+;; (goto-char pos)
+;; (unless (= pos (line-end-position))
+;; (goto-char (line-beginning-position)))
+;; (setq end (re-search-forward range-regexp max t))
+;; (when end (setq end (match-beginning 1))))
+;; (setq ret (list beg end)))
+;; (goto-char here)
+;; ;;(setq ret nil)
+;; ret))
+
+
+(defun mumamo-chunk-mako-<%doc (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%doc>" "</%doc>" t 'mumamo-comment-mode t))
+
+(defun mumamo-chunk-mako-<%include (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%include" "/>" t 'html-mode t))
+
+(defun mumamo-chunk-mako-<%inherit (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%inherit" "/>" t 'html-mode t))
+
+(defun mumamo-chunk-mako-<%namespace (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%namespace" "/>" t 'html-mode t))
+
+(defun mumamo-chunk-mako-<%page (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%page" "/>" t 'html-mode t))
+
+;; Fix-me: this is not correct
+(defun mumamo-chunk-mako-<%def (pos min max)
+ (mumamo-quick-static-chunk pos min max "<%def" "</%def>" t 'html-mode t))
+
+(defun mumamo-chunk-mako$(pos min max)
+ "Find ${ ... }, return range and `python-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (mumamo-quick-static-chunk pos min max "${" "}" t 'python-mode t))
+
+;;;###autoload
+(define-mumamo-multi-major-mode mako-html-mumamo-mode
+ "Turn on multiple major modes for Mako with main mode `html-mode'.
+This also covers inlined style and javascript."
+;; Fix-me: test case
+;;
+;; Fix-me: Add chunks for the tags, but make sure these are made
+;; invisible to nxml-mode parser.
+;;
+;; Fix-me: Maybe finally add that indentation support for one-line chunks?
+ ("Mako HTML Family" html-mode
+ (
+ mumamo-chunk-mako-one-line-comment
+ mumamo-chunk-mako-<%doc
+ mumamo-chunk-mako-<%include
+ mumamo-chunk-mako-<%inherit
+ mumamo-chunk-mako-<%namespace
+ mumamo-chunk-mako-<%page
+
+ mumamo-chunk-mako-<%def
+ ;;mumamo-chunk-mako-<%namesp:name
+ ;;mumamo-chunk-mako-<%call
+ ;;mumamo-chunk-mako-<%text
+
+ mumamo-chunk-mako-<%
+ mumamo-chunk-mako-%
+ mumamo-chunk-mako$
+
+ mumamo-chunk-xml-pi
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ mumamo-chunk-style=
+ mumamo-chunk-onjs=
+ )))
+(mumamo-inherit-sub-chunk-family-locally 'mako-html-mumamo-mode 'mako-html-mumamo-mode)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; XSL
+
+;;;###autoload
+(define-mumamo-multi-major-mode xsl-nxml-mumamo-mode
+ "Turn on multi major mode for XSL with main mode `nxml-mode'.
+This covers inlined style and javascript."
+ ("XSL nXtml Family" nxml-mode
+ (
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ )))
+
+;;;###autoload
+(define-mumamo-multi-major-mode xsl-sgml-mumamo-mode
+ "Turn on multi major mode for XSL with main mode `sgml-mode'.
+This covers inlined style and javascript."
+ ("XSL SGML Family" sgml-mode
+ (
+ mumamo-chunk-inlined-style
+ mumamo-chunk-inlined-script
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Markdown
+
+(defun mumamo-chunk-markdown-html-1 (pos min max)
+ (save-restriction
+ (goto-char pos)
+ (narrow-to-region (or min (point)) (or max (point-max)))
+ (save-match-data
+ (let ((here (point)))
+ (when (re-search-forward (rx (* space)
+ (submatch "<")
+ (* (any "a-z"))
+ (or ">" (any " \t\n")))
+ nil t)
+ (let ((beg (match-beginning 1))
+ (end))
+ (goto-char beg)
+ (condition-case err
+ (progn
+ (while (not (sgml-skip-tag-forward 1)))
+ (setq end (point)))
+ (error (message "mumamo-chunk-markdown-html-1: %s" err)))
+ (goto-char here)
+ (when (and beg end)
+ (cons beg end))))))))
+
+(defun mumamo-chunk-markdown-html-fw-exc-fun (pos max)
+ (let ((beg-end (mumamo-chunk-markdown-html-1 pos nil max)))
+ (cdr beg-end)))
+
+(defun mumamo-chunk-markdown-html (pos min max)
+ "Find a chunk of html code in `markdown-mode'.
+Return range and `html-mode'.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ (let ((beg-end (mumamo-chunk-markdown-html-1 pos nil max)))
+ (when beg-end
+ (let ((beg (car beg-end))
+ (end (cdr beg-end)))
+ (list beg end 'html-mode
+ nil ;; borders
+ nil ;; parseable y
+ 'mumamo-chunk-markdown-html-fw-exc-fun
+ nil ;; find-borders fun
+ )))))
+
+;;;###autoload
+(define-mumamo-multi-major-mode markdown-html-mumamo-mode
+ "Turn on multi major markdown mode in buffer.
+Main major mode will be `markdown-mode'.
+Inlined html will be in `html-mode'.
+
+You need `markdown-mode' which you can download from URL
+`http://jblevins.org/projects/markdown-mode/'."
+ ("Markdown HTML Family" markdown-mode
+ (
+ mumamo-chunk-markdown-html
+ )))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Latex related
+
+(defun mumamo-latex-closure-chunk (pos min max)
+ (mumamo-quick-static-chunk pos min max "\\begin{clojure}" "\\end{clojure}" t 'clojure-mode t))
+
+;;;###autoload
+(define-mumamo-multi-major-mode latex-clojure-mumamo-mode
+ "Turn on multi major mode latex+clojure.
+Main major mode will be `latex-mode'.
+Subchunks will be in `clojure-mode'.
+
+You will need `clojure-mode' which you can download from URL
+`http://github.com/jochu/clojure-mode/tree'."
+ ("Latex+clojur Family" latex-mode
+ (
+ mumamo-latex-closure-chunk
+ )))
+
+(add-to-list 'auto-mode-alist '("\\.lclj\\'" . latex-clojure-mumamo-mode))
+
+
+(defun mumamo-latex-haskell-chunk (pos min max)
+ (mumamo-quick-static-chunk pos min max "\\begin{code}" "\\end{code}" t 'haskell-mode t))
+
+;;;###autoload
+(define-mumamo-multi-major-mode latex-haskell-mumamo-mode
+ "Turn on multi major mode latex+haskell.
+Main major mode will be `latex-mode'.
+Subchunks will be in `haskell-mode'.
+
+You will need `haskell-mode' which you can download from URL
+`http://projects.haskell.org/haskellmode-emacs/'."
+ ("Latex+haskell Family" latex-mode
+ (
+ mumamo-latex-haskell-chunk
+ )))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Python + ReST
+
+;; From Martin Soto
+
+(defun python-rst-long-string-chunk (pos min max)
+ "Find Python long strings. Return range and 'mumamo-comment-mode.
+See `mumamo-find-possible-chunk' for POS, MIN and MAX."
+ ;;(mumamo-quick-static-chunk pos min max "\"\"\"((" "))\"\"\"" nil 'rst-mode nil))
+ (mumamo-quick-static-chunk pos min max "\"\"\"" "\"\"\"" t 'rst-mode t))
+
+;;;###autoload
+(define-mumamo-multi-major-mode python-rst-mumamo-mode
+ "Turn on multiple major modes for Python with RestructuredText docstrings."
+ ("Python ReST Family" python-mode
+ (
+ python-rst-long-string-chunk
+ )))
+
+
+(provide 'mumamo-fun)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; mumamo-fun.el ends here
--- /dev/null
+;;; mumamo-regions.el --- user defined regions with mumamo
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-05-31 Sun
+;; Version: 0.5
+;; Last-Updated: 2009-06-01 Mon
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Add temporary mumamo chunks (called mumamo regions). This are
+;; added interactively from a highlighted region.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'mumamo))
+(eval-when-compile (require 'ourcomments-widgets))
+(require 'ps-print) ;; For ps-print-ensure-fontified
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Internal side functions etc
+
+(defvar mumamo-regions nil
+ "List of active mumamo regions. Internal use only.
+The entries in this list should be like this
+
+ \(OVL-DEF OVL-CHUNK)
+
+where OVL-DEF is an overlay containing the definitions, ie `major-mode'.
+OVL-CHUNK is the definitions set up temporarily for mumamo chunks.
+
+The fontification functions in mumamo looks in this list, but the
+chunk dividing functions defined by
+`define-mumamo-multi-major-mode' does not. The effect is that
+the normal chunks exists regardless of what is in this list, but
+fontification etc is overridden by what this list says.")
+(make-variable-buffer-local 'mumamo-regions)
+(put 'mumamo-regions 'permanent-local t)
+
+(defun mumamo-add-region-1 (major start end buffer)
+ "Add a mumamo region with major mode MAJOR from START to END.
+Return the region. The returned value can be used in
+`mumamo-clear-region'.
+
+START and END should be markers in the buffer BUFFER. They may
+also be nil in which case they extend the region to the buffer
+boundaries."
+ (unless mumamo-multi-major-mode
+ (mumamo-temporary-multi-major))
+ (or (not start)
+ (markerp start)
+ (eq (marker-buffer start) buffer)
+ (error "Bad arg start: %s" start))
+ (or (not end)
+ (markerp end)
+ (eq (marker-buffer end) buffer)
+ (error "Bad arg end: %s" end))
+ (let ((ovl (make-overlay start end)))
+ (overlay-put ovl 'mumamo-region 'defined)
+ (overlay-put ovl 'face 'mumamo-region)
+ (overlay-put ovl 'priority 2)
+ (mumamo-region-set-major ovl major)
+ (setq mumamo-regions (cons (list ovl nil) mumamo-regions))
+ (mumamo-mark-for-refontification (overlay-start ovl) (overlay-end ovl))
+ (message "Added mumamo region from %d to %d" (+ 0 start) (+ 0 end))
+ ovl))
+
+(defun mumamo-clear-region-1 (region-entry)
+ "Clear mumamo region REGION-ENTRY.
+The entry must have been returned from `mumamo-add-region-1'."
+ (let ((buffer (overlay-buffer (car region-entry)))
+ (entry (cdr region-entry)))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (let ((ovl1 (car region-entry))
+ (ovl2 (cadr region-entry)))
+ (delete-overlay ovl1)
+ (when ovl2
+ (mumamo-mark-for-refontification (overlay-start ovl2) (overlay-end ovl2))
+ (delete-overlay ovl2))
+ (setq mumamo-regions (delete region-entry mumamo-regions)))))))
+
+(defvar mumamo-region-priority 0)
+(make-variable-buffer-local 'mumamo-region-priority)
+(put 'mumamo-region-priority 'permanent-local t)
+
+(defun mumamo-get-region-from-1 (point)
+ "Return mumamo region values for POINT.
+The return value is either mumamo chunk or a cons with
+information about where regions starts to hide normal chunks.
+Such a cons has the format \(BELOW . OVER) where each of them is
+a position or nil."
+ (when mumamo-regions
+ (save-restriction
+ (widen)
+ (let* ((start nil)
+ (end nil)
+ (major nil)
+ hit-reg
+ ret-val)
+ (catch 'found-major
+ (dolist (reg mumamo-regions)
+ (assert (eq (overlay-get (car reg) 'mumamo-region) 'defined) t)
+ (assert (or (not (cadr reg)) (overlayp (cadr reg))))
+ (let* ((this-ovl (car reg))
+ (this-start (overlay-start this-ovl))
+ (this-end (overlay-end this-ovl)))
+ (when (<= this-end point)
+ (setq start this-end))
+ (when (< point this-start)
+ (setq end this-start))
+ (when (and (<= this-start point)
+ (< point this-end))
+ (setq major (overlay-get this-ovl 'mumamo-major-mode))
+ (setq start (max this-start (or start this-start)))
+ (setq end (min this-end (or end this-end)))
+ (setq hit-reg reg)
+ (throw 'found-major nil)))))
+ (if major
+ (progn
+ (setq ret-val (nth 1 hit-reg))
+ (when ret-val (assert (eq (overlay-get ret-val 'mumamo-region) 'used) t))
+ (if ret-val
+ (move-overlay ret-val start end)
+ (setq ret-val (make-overlay start end nil t nil)) ;; fix-me
+ (setcar (cdr hit-reg) ret-val)
+ (overlay-put ret-val 'mumamo-region 'used)
+ (overlay-put ret-val 'priority ;; above normal chunks + chunks on chunks
+ (setq mumamo-region-priority (1+ mumamo-region-priority)))
+ ;;(overlay-put ret-val 'face '(:background "chocolate")) ;; temporary
+ (overlay-put ret-val 'mumamo-major-mode
+ (overlay-get (car hit-reg) 'mumamo-major-mode))))
+ (setq ret-val (cons start end)))
+ ;;(message "mumamo-get-region-from-1, point=%s ret-val=%s" point ret-val)
+ ret-val))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; User side functions
+
+(defun mumamo-temporary-multi-major ()
+ "Turn on a temporary multi major mode from buffers current mode.
+Define one if no one exists. It will have no chunk dividing
+routines. It is meant mainly to be used with mumamo regions when
+there is no mumamo multi major mode in the buffer and the user
+wants to add a mumamo region \(which requires a multi major mode
+to work)."
+ (when mumamo-multi-major-mode
+ (error "Mumamo is already active in buffer"))
+ (let* ((temp-mode-name (concat "mumamo-1-"
+ (symbol-name major-mode)))
+ (temp-mode-sym (intern-soft temp-mode-name)))
+ (unless (and temp-mode-sym
+ (fboundp temp-mode-sym))
+ (setq temp-mode-sym (intern temp-mode-name))
+ (eval
+ `(define-mumamo-multi-major-mode ,temp-mode-sym
+ "Temporary multi major mode."
+ ("Temporary" ,major-mode nil))))
+ (put temp-mode-sym 'mumamo-temporary major-mode)
+ (funcall temp-mode-sym)))
+
+(defface mumamo-region
+ '((t (:background "white")))
+ "Face for mumamo-region regions."
+ :group 'mumamo)
+
+;;;###autoload
+(defun mumamo-add-region ()
+ "Add a mumamo region from selection.
+Mumamo regions are like another layer of chunks above the normal chunks.
+They does not affect the normal chunks, but they overrides them.
+
+To create a mumamo region first select a visible region and then
+call this function.
+
+If the buffer is not in a multi major mode a temporary multi
+major mode will be created applied to the buffer first.
+To get out of this and get back to a single major mode just use
+
+ M-x normal-mode"
+ (interactive)
+ (if (not mark-active)
+ (message (propertize "Please select a visible region first" 'face 'secondary-selection))
+ (let ((beg (region-beginning))
+ (end (region-end))
+ (maj (mumamo-region-read-major)))
+ (mumamo-add-region-1 maj (copy-marker beg) (copy-marker end) (current-buffer))
+ (setq deactivate-mark t))))
+
+;;;###autoload
+(defun mumamo-add-region-from-string ()
+ "Add a mumamo region from string at point.
+Works as `mumamo-add-region' but for string or comment at point.
+
+Buffer must be fontified."
+ (interactive)
+ ;; assure font locked.
+ (require 'ps-print)
+ (ps-print-ensure-fontified (point-min) (point-max))
+ (let ((the-face (get-text-property (point) 'face)))
+ (if (not (memq the-face
+ '(font-lock-doc-face
+ font-lock-string-face
+ font-lock-comment-face)))
+ (message "No string or comment at point")
+ (let ((beg (previous-single-property-change (point) 'face))
+ (end (next-single-property-change (point) 'face))
+ (maj (mumamo-region-read-major)))
+ (setq beg (or (when beg (1+ beg))
+ (point-min)))
+ (setq end (or (when end (1- end))
+ (point-max)))
+ (mumamo-add-region-1 maj (copy-marker beg) (copy-marker end) (current-buffer))))))
+;; (dolist (o (overlays-in (point-min) (point-max))) (delete-overlay o))
+(defun mumamo-clear-all-regions ()
+ "Clear all mumamo regions in buffer.
+For information about mumamo regions see `mumamo-add-region'."
+ (interactive)
+ (unless mumamo-multi-major-mode
+ (error "There can be no mumamo regions to clear unless in multi major modes"))
+ (while mumamo-regions
+ (mumamo-clear-region-1 (car mumamo-regions))
+ (setq mumamo-regions (cdr mumamo-regions)))
+ (let ((old (get mumamo-multi-major-mode 'mumamo-temporary)))
+ (when old (funcall old)))
+ (message "Cleared all mumamo regions"))
+
+(defun mumamo-region-read-major ()
+ "Prompt user for major mode.
+Accept only single major mode, not mumamo multi major modes."
+ (let ((major (read-command "Major mode: ")))
+ (unless (major-modep major) (error "Not a major mode: %s" major))
+ (when (mumamo-multi-major-modep major) (error "Multi major modes not allowed: %s" major))
+ (when (let ((major-mode major))
+ (derived-mode-p 'nxml-mode))
+ (error "%s is based on nxml-mode and can't be used here" major))
+ major))
+
+(defun mumamo-region-at (point)
+ "Return mumamo region at POINT."
+ (let ((ovls (overlays-at (point))))
+ (catch 'overlay
+ (dolist (o ovls)
+ (when (overlay-get o 'mumamo-region)
+ (throw 'overlay o)))
+ nil)))
+
+(defun mumamo-region-set-major (ovl major)
+ "Change major mode for mumamo region at point.
+For information about mumamo regions see `mumamo-add-region'.
+
+If run non-interactively then OVL should be a mumamo region and
+MAJOR the major mode to set for that region."
+ (interactive
+ (list (or (mumamo-region-at (point))
+ (error "There is no mumamo region at point"))
+ (mumamo-region-read-major)))
+ (overlay-put ovl 'mumamo-major-mode `(,major))
+ (overlay-put ovl 'help-echo (format "Mumamo region, major mode `%s'" major)))
+
+(defun mumamo-clear-region (ovl)
+ "Clear the mumamo region at point.
+For information about mumamo regions see `mumamo-add-region'.
+
+If run non-interactively then OVL should be the mumamo region to
+clear."
+ (interactive
+ (list (or (mumamo-region-at (point))
+ (error "There is no mumamo region at point"))))
+ (let ((region-entry (rassoc (list ovl) mumamo-regions)))
+ (unless region-entry
+ (error "No mumamo region found at point"))
+ (mumamo-clear-region-1 region-entry)))
+
+
+(provide 'mumamo-regions)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; mumamo-regions.el ends here
--- /dev/null
+(trace-function-background 'mumamo-fontify-region-1)
+(trace-function-background 'mumamo-fontify-region-with)
+(trace-function-background 'mumamo-mark-for-refontification)
+(trace-function-background 'syntax-ppss-flush-cache)
+
+;;(untrace-all)
--- /dev/null
+;;; mumamo.el --- Multiple major modes in a buffer
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Maintainer:
+;; Created: Fri Mar 09 2007
+(defconst mumamo:version "0.91") ;;Version:
+;; Last-Updated: 2009-10-19 Mon
+;; URL: http://OurComments.org/Emacs/Emacs.html
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `appmenu', `apropos', `backquote', `button', `bytecomp', `cl',
+;; `comint', `compile', `easymenu', `flyspell', `grep', `ido',
+;; `ispell', `mail-prsvr', `mlinks', `mm-util', `nxml-enc',
+;; `nxml-glyph', `nxml-mode', `nxml-ns', `nxml-outln',
+;; `nxml-parse', `nxml-rap', `nxml-util', `ourcomments-util',
+;; `recentf', `ring', `rng-dt', `rng-loc', `rng-match',
+;; `rng-parse', `rng-pttrn', `rng-uri', `rng-util', `rng-valid',
+;; `rx', `sgml-mode', `timer', `tool-bar', `tree-widget',
+;; `url-expand', `url-methods', `url-parse', `url-util',
+;; `url-vars', `wid-edit', `xmltok'.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Commentary:
+;;
+;; In some cases you may find that it is quite hard to write one major
+;; mode that does everything for the type of file you want to handle.
+;; That is the case for example for a PHP file where there comes
+;; useful major modes with Emacs for the html parts, and where you can
+;; get a major mode for PHP from other sources (see EmacsWiki for
+;; Aaron Hawleys php-mode.el, or the very similar version that comes
+;; with nXhtml).
+;;
+;; Using one major mode for the HTML part and another for the PHP part
+;; sounds like a good solution. But this means you want to use (at
+;; least) two major modes in the same buffer.
+;;
+;; This file implements just that, support for MUltiple MAjor MOdes
+;; (mumamo) in a buffer.
+;;
+;;
+;;;; Usage:
+;;
+;; The multiple major mode support is turned on by calling special
+;; functions which are used nearly the same way as major modes. See
+;; `mumamo-defined-multi-major-modes' for more information about those
+;; functions.
+;;
+;; Each such function defines how to take care of a certain mix of
+;; major functions in the buffer. We call them "multi major modes".
+;;
+;; You may call those functions directly (like you can with major mode
+;; functions) or you may use them in for example `auto-mode-alist'.
+;;
+;; You can load mumamo in your .emacs with
+;;
+;; (require 'mumamo-fun)
+;;
+;; or you can generate an autoload file from mumamo-fun.el
+;;
+;; Note that no multi major mode functions are defined in this file.
+;; Together with this file comes the file mumamo-fun.el that defines
+;; some such functions. All those functions defined in that file are
+;; marked for autoload.
+;;
+;;
+;;
+;; Thanks to Stefan Monnier for beeing a good and knowledgeable
+;; speaking partner for some difficult parts while I was trying to
+;; develop this.
+;;
+;; Thanks to RMS for giving me support and ideas about the programming
+;; interface. That simplified the code and usage quite a lot.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; How to add support for a new mix of major modes
+;;
+;; This is done by creating a new function using
+;; `define-mumamo-multi-major-mode'. See that function for more
+;; information.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Information for major mode authors
+;;
+;; There are a few special requirements on major modes to make them
+;; work with mumamo:
+;;
+;; - fontification-functions should be '(jit-lock-function). However
+;; nxml-mode derivates can work too, see the code for more info.
+;;
+;; - narrowing should be respected during fontification and
+;; indentation when font-lock-dont-widen is non-nil.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Information for minor mode authors
+;;
+;; Some minor modes are written to be specific for the file edited in
+;; the buffer and some are written to be specific for a major
+;; modes. Others are emulating another editor. Those are probably
+;; global, but might still have buffer local values.
+;;
+;; Those minor modes that are not meant to be specific for a major
+;; mode should probably survive changing major mode in the
+;; buffer. That is mostly not the case in Emacs today.
+;;
+;; There are (at least) two type of values for those minor modes that
+;; sometimes should survive changing major mode: buffer local
+;; variables and functions added locally to hooks.
+;;
+;; * Some buffer local variables are really that - buffer local. Other
+;; are really meant not for the buffer but for the major mode or
+;; some minor mode that is local to the buffer.
+;;
+;; If the buffer local variable is meant for the buffer then it is
+;; easy to make them survive changing major mode: just add
+;;
+;; (put 'VARIABLE 'permanent-local t)
+;;
+;; to those variables. That will work regardless of the way major
+;; mode is changed.
+;;
+;; If one only wants the variables to survive the major mode change
+;; that is done when moving between chunks with different major
+;; modes then something different must be used. To make a variable
+;; survive this, but not a major mode change for the whole buffer,
+;; call any the function `mumamo-make-variable-buffer-permanent':
+;;
+;; (mumamo-make-variable-buffer-permanent 'VARIABLE)
+;;
+;; * For functions entered to local hooks use this
+;;
+;; (put 'FUNSYM 'permanent-local-hook t)
+;; (add-hook 'HOOKSYM 'FUNSYM nil t)
+;;
+;; where HOOKSYM is the hook and FUNSYM is the function.
+;;
+;; * Some functions that are run in `change-major-mode' and dito
+;; after- must be avoided when mumamo changes major mode. The
+;; functions to avoid should be listed in
+;;
+;; `mumamo-change-major-mode-no-nos'
+;; `mumamo-after-change-major-mode-no-nos'
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Comments on code etc:
+;;
+;; This is yet another way to try to get different major modes for
+;; different chunks of a buffer to work. (I borrowed the term "chunk"
+;; here from multi-mode.el.) I am aware of two main previous elisp
+;; packages that tries to do this, multi-mode.el and mmm-mode.el.
+;; (See http://www.emacswiki.org/cgi-bin/wiki/MultipleModes where
+;; there are also some other packages mentioned.) The solutions in
+;; those are a bit different from the approach here.
+;;
+;; The idea of doing it the way mumamo does it is of course based on a
+;; hope that switching major mode when moving between chunks should be
+;; quick. I found that it took from 0 - 62 000 ms, typically 0 - 16
+;; 000 ms on a 3ghz cpu. However unfortunately this is not the whole
+;; truth. It could take longer time, depending on what is run in the
+;; hooks: The major mode specific hook, `after-change-major-mode-hook'
+;; and `change-major-mode-hook'.
+;;
+;; Because it currently may take long enough time switching major mode
+;; when moving between chunks to disturb smooth moving around in the
+;; buffer I have added a way to let the major mode switching be done
+;; after moving when Emacs is idle. This is currently the default, but
+;; see the custom variable `mumamo-set-major-mode-delay'.
+;;
+;; Since the intention is to set up the new major mode the same way as
+;; it should have been done if this was a major mode for the whole
+;; buffer these hooks must be run. However if this idea is developed
+;; further some of the things done in these hooks (like switching on
+;; minor modes) could perhaps be streamlined so that switching minor
+;; modes off and then on again could be avoided. In fact there is
+;; already tools for this in mumamo.el, see the section below named
+;; "Information for minor mode authors".
+;;
+;; Another problem is that the major modes must use
+;; `font-lock-fontify-region-function'. Currently the only major
+;; modes I know that does not do this are `nxml-mode' and its
+;; derivatives.
+;;
+;; The indentation is currently working rather ok, but with the price
+;; that buffer modified is sometimes set even though there are no
+;; actual changes. That seems a bit unnecessary and it could be
+;; avoided if the indentation functions for the the various major
+;; modes were rewritten so that you could get the indentation that
+;; would be done instead of actually doing the indentation. (Or
+;; mumamo could do this better, but I do not know how right now.)
+;;
+;; See also "Known bugs and problems etc" below.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Known bugs:
+;;
+;; - See the various FIX-ME for possible bugs. See also below.
+;;
+;;
+;;;; Known problems and ideas:
+;;
+;; - There is no way in Emacs to tell a mode not to change
+;; fontification when changing to or from that mode.
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cc-engine))
+(eval-when-compile (require 'desktop))
+(eval-when-compile (require 'flyspell))
+(eval-when-compile (require 'rngalt nil t))
+(eval-when-compile (require 'nxml-mode nil t))
+(eval-when-compile
+ (when (featurep 'nxml-mode)
+ (require 'rng-valid nil t)
+ ;;(require 'rngalt nil t)
+ ))
+(eval-when-compile (require 'sgml-mode)) ;; For sgml-xml-mode
+;; For `define-globalized-minor-mode-with-on-off':
+;;(require 'ourcomments-util)
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; rng-valid.el support
+
+(defvar rng-get-major-mode-chunk-function nil
+ "Function to use to get major mode chunk.
+It should take one argument, the position where to get the major
+mode chunk.
+
+This is to be set by multiple major mode frame works, like
+mumamo.
+
+See also `rng-valid-nxml-major-mode-chunk-function' and
+`rng-end-major-mode-chunk-function'. Note that all three
+variables must be set.")
+(make-variable-buffer-local 'rng-get-major-mode-chunk-function)
+(put 'rng-get-major-mode-chunk-function 'permanent-local t)
+
+(defvar rng-valid-nxml-major-mode-chunk-function nil
+ "Function to use to check if nxml can parse major mode chunk.
+It should take one argument, the chunk.
+
+For more info see also `rng-get-major-mode-chunk-function'.")
+(make-variable-buffer-local 'rng-valid-nxml-major-mode-chunk-function)
+(put 'rng-valid-nxml-major-mode-chunk-function 'permanent-local t)
+
+(defvar rng-end-major-mode-chunk-function nil
+ "Function to use to get the end of a major mode chunk.
+It should take one argument, the chunk.
+
+For more info see also `rng-get-major-mode-chunk-function'.")
+(make-variable-buffer-local 'rng-end-major-mode-chunk-function)
+(put 'rng-end-major-mode-chunk-function 'permanent-local t)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Some variables
+
+(defvar mumamo-major-mode-indent-line-function nil)
+(make-variable-buffer-local 'mumamo-major-mode-indent-line-function)
+
+(defvar mumamo-buffer-locals-per-major nil)
+(make-variable-buffer-local 'mumamo-buffer-locals-per-major)
+(put 'mumamo-buffer-locals-per-major 'permanent-local t)
+
+(defvar mumamo-just-changed-major nil
+ "Avoid refontification when switching major mode.
+Set to t by `mumamo-set-major'. Checked and reset to nil by
+`mumamo-jit-lock-function'.")
+(make-variable-buffer-local 'mumamo-just-changed-major)
+
+(defvar mumamo-multi-major-mode nil
+ "The function that handles multiple major modes.
+If this is nil then multiple major modes in the buffer is not
+handled by mumamo.
+
+Set by functions defined by `define-mumamo-multi-major-mode'.")
+(make-variable-buffer-local 'mumamo-multi-major-mode)
+(put 'mumamo-multi-major-mode 'permanent-local t)
+
+(defvar mumamo-set-major-running nil
+ "Internal use. Handling of mumamo turn off.")
+
+(defun mumamo-chunk-car (chunk prop)
+ (car (overlay-get chunk prop)))
+
+(defun mumamo-chunk-cadr (chunk prop)
+ (cadr (overlay-get chunk prop)))
+
+;; (let ((l '(1 2))) (setcar (nthcdr 1 l) 10) l)
+;; setters
+(defsubst mumamo-chunk-value-set-min (chunk-values min)
+ "In CHUNK-VALUES set min value to MIN.
+CHUNK-VALUES should have the format return by
+`mumamo-create-chunk-values-at'."
+ (setcar (nthcdr 0 chunk-values) min))
+(defsubst mumamo-chunk-value-set-max (chunk-values max)
+ "In CHUNK-VALUES set max value to MAX.
+See also `mumamo-chunk-value-set-min'."
+ (setcar (nthcdr 1 chunk-values) max))
+(defsubst mumamo-chunk-value-set-syntax-min (chunk-values min)
+ "In CHUNK-VALUES set min syntax diff value to MIN.
+See also `mumamo-chunk-value-set-min'."
+ (setcar (nthcdr 3 chunk-values) min))
+(defsubst mumamo-chunk-value-set-syntax-max (chunk-values max)
+ "In CHUNK-VALUES set max syntax diff value to MAX.
+See also `mumamo-chunk-value-set-min'."
+ (setcar (nthcdr 3 chunk-values) max))
+;; getters
+(defsubst mumamo-chunk-value-min (chunk-values)
+ "Get min value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 0 chunk-values))
+(defsubst mumamo-chunk-value-max (chunk-values)
+ "Get max value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 1 chunk-values))
+(defsubst mumamo-chunk-value-major (chunk-values)
+ "Get major value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 2 chunk-values))
+(defsubst mumamo-chunk-value-syntax-min (chunk-values)
+ "Get min syntax diff value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 3 chunk-values))
+(defsubst mumamo-chunk-value-syntax-max (chunk-values)
+ "Get max syntax diff value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 4 chunk-values))
+(defsubst mumamo-chunk-value-parseable-by (chunk-values)
+ "Get parseable-by from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'.
+For parseable-by see `mumamo-find-possible-chunk'."
+ (nth 5 chunk-values))
+;; (defsubst mumamo-chunk-prev-chunk (chunk-values)
+;; "Get previous chunk from CHUNK-VALUES.
+;; See also `mumamo-chunk-value-set-min'."
+;; (nth 6 chunk-values))
+(defsubst mumamo-chunk-value-fw-exc-fun (chunk-values)
+ "Get function that find chunk end from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 6 chunk-values))
+
+(defsubst mumamo-chunk-major-mode (chunk)
+ "Get major mode specified in CHUNK."
+ ;;(assert chunk)
+ ;;(assert (overlay-buffer chunk))
+ (let ((mode-spec (if chunk
+ (mumamo-chunk-car chunk 'mumamo-major-mode)
+ (mumamo-main-major-mode))))
+ (mumamo-major-mode-from-modespec mode-spec)))
+
+(defsubst mumamo-chunk-syntax-min-max (chunk no-obscure)
+ (when chunk
+ (let* ((ovl-end (overlay-end chunk))
+ (ovl-start (overlay-start chunk))
+ (syntax-min (min ovl-end
+ (+ ovl-start
+ (or (overlay-get chunk 'mumamo-syntax-min-d)
+ 0))))
+ ;;(dummy (msgtrc "chunk-syntax-min-max:syntax-min=%s, chunk=%S" syntax-min chunk))
+ (syntax-max
+ (max ovl-start
+ (- (overlay-end chunk)
+ (or (overlay-get chunk 'mumamo-syntax-max-d)
+ 0)
+ (if (= (1+ (buffer-size))
+ (overlay-end chunk))
+ 0
+ ;; Note: We must subtract one here because
+ ;; overlay-end is +1 from the last point in the
+ ;; overlay.
+ ;;
+ ;; This cured the problem with
+ ;; kubica-freezing-i.html that made Emacs loop
+ ;; in `font-lock-extend-region-multiline'. But
+ ;; was it really this one, I can't find any
+ ;; 'font-lock-multiline property. So it should
+ ;; be `font-lock-extend-region-whole-lines'.
+ ;;
+ ;; Should not the problem then be the value of font-lock-end?
+ ;;
+ ;; Fix-me: however this is not correct since it
+ ;; leads to not fontifying the last character in
+ ;; the chunk, see bug 531324.
+ ;;
+ ;; I think this is cured by now. I have let
+ ;; bound `font-lock-extend-region-functions'
+ ;; once more before the call to
+ ;; `font-lock-fontify-region'.
+ 0
+ ;;0
+ ))))
+ (obscure (unless no-obscure (overlay-get chunk 'obscured)))
+ (region-info (cadr obscure))
+ (obscure-min (car region-info))
+ (obscure-max (cdr region-info))
+ ;;(dummy (message "syn-mn-mx:obs=%s r-info=%s ob=%s/%s" obscure region-info obscure-min obscure-max ))
+ (actual-min (max (or obscure-min ovl-start)
+ (or syntax-min ovl-start)))
+ (actual-max (min (or obscure-max ovl-end)
+ (or syntax-max ovl-end)))
+ (maj (mumamo-chunk-car chunk 'mumamo-major-mode))
+ ;;(dummy (message "syn-mn-mx:obs=%s r-info=%s ob=%s/%s ac=%s/%s" obscure region-info obscure-min obscure-max actual-min actual-max))
+ )
+ (cons actual-min actual-max))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Macros
+
+;; Borrowed from font-lock.el
+(defmacro mumamo-save-buffer-state (varlist &rest body)
+ "Bind variables according to VARLIST and eval BODY restoring buffer state.
+Do not record undo information during evaluation of BODY."
+ (declare (indent 1) (debug let))
+ (let ((modified (make-symbol "modified")))
+ `(let* ,(append varlist
+ `((,modified (buffer-modified-p))
+ (buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ buffer-file-name
+ buffer-file-truename))
+ (progn
+ ,@body)
+ (unless ,modified
+ (restore-buffer-modified-p nil)))))
+
+;; From jit-lock.el:
+(defmacro mumamo-jit-with-buffer-unmodified (&rest body)
+ "Eval BODY, preserving the current buffer's modified state."
+ (declare (debug t))
+ (let ((modified (make-symbol "modified")))
+ `(let ((,modified (buffer-modified-p)))
+ (unwind-protect
+ (progn ,@body)
+ (unless ,modified
+ (restore-buffer-modified-p nil))))))
+
+(defmacro mumamo-with-buffer-prepared-for-jit-lock (&rest body)
+ "Execute BODY in current buffer, overriding several variables.
+Preserves the `buffer-modified-p' state of the current buffer."
+ (declare (debug t))
+ `(mumamo-jit-with-buffer-unmodified
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ buffer-file-name
+ buffer-file-truename)
+ ,@body)))
+
+(defmacro mumamo-condition-case (var body-form &rest handlers)
+ "Like `condition-case', but optional.
+If `mumamo-use-condition-case' is non-nil then do
+
+ (condition-case VAR
+ BODY-FORM
+ HANDLERS).
+
+Otherwise just evaluate BODY-FORM."
+ (declare (indent 2) (debug t))
+ `(if (not mumamo-use-condition-case)
+ (let* ((debugger (or mumamo-debugger 'debug))
+ (debug-on-error (if debugger t debug-on-error)))
+ ,body-form)
+ (condition-case ,var
+ ,body-form
+ ,@handlers)))
+
+(defmacro mumamo-msgfntfy (format-string &rest args)
+ "Give some messages during fontification.
+This macro should just do nothing during normal use. However if
+there are any problems you can uncomment one of the lines in this
+macro and recompile/reeval mumamo.el to get those messages.
+
+You have to search the code to see where you will get them. All
+uses are in this file.
+
+FORMAT-STRING and ARGS have the same meaning as for the function
+`message'."
+ ;;(list 'apply (list 'quote 'msgtrc) format-string (append '(list) args))
+ ;;(list 'apply (list 'quote 'message) format-string (append '(list) args))
+ ;;(list 'progn 'apply (list 'quote 'message) format-string (append '(list) args) nil)
+ ;; (condition-case err
+ ;; (list 'apply (list 'quote 'message) format-string (append '(list) args)) ;; <--
+ ;; (error (message "err in msgfntfy %S" err)))
+ ;;(message "%s %S" format-string args)
+ ;;(list 'apply (list 'quote 'message) (list 'concat "%s: " format-string)
+ ;; (list 'get-internal-run-time) (append '(list) args))
+ )
+;;(mumamo-msgfntfy "my-format=%s" (get-internal-run-time))
+
+(defmacro mumamo-msgindent (format-string &rest args)
+ "Give some messages during indentation.
+This macro should just do nothing during normal use. However if
+there are any problems you can uncomment one of the lines in this
+macro and recompile/reeval mumamo.el to get those messages.
+
+You have to search the code to see where you will get them. All
+uses are in this file.
+
+FORMAT-STRING and ARGS have the same meaning as for the function
+`message'."
+ ;;(list 'apply (list 'quote 'msgtrc) format-string (append '(list) args))
+ ;;(list 'apply (list 'quote 'message) format-string (append '(list) args)) ;; <---
+ ;;(list 'apply (list 'quote 'message) (list 'concat "%s: " format-string)
+ ;; (list 'get-internal-run-time) (append '(list) args))
+ )
+
+(defmacro mumamo-with-major-mode-setup (major for-what &rest body)
+ "Run code with some local variables set as in specified major mode.
+Set variables as needed for major mode MAJOR when doing FOR-WHAT
+and then run BODY using `with-syntax-table'.
+
+FOR-WHAT is used to choose another major mode than MAJOR in
+certain cases. It should be 'fontification or 'indentation.
+
+Note: We must let-bind the variables here instead of make them buffer
+local since they otherwise could be wrong at \(point) in top
+level \(ie user interaction level)."
+ (declare (indent 2) (debug t))
+ `(let ((need-major-mode (mumamo-get-major-mode-substitute ,major ,for-what)))
+ ;;(msgtrc "mumamo-with-major-mode-setup %s => %s, modified=%s" ,major need-major-mode (buffer-modified-p))
+ ;;(msgtrc "with-major-mode-setup <<<<<<<<<< body=%S\n>>>>>>>>>>" '(progn ,@body))
+ ;;(msgtrc "with-major-mode-setup:in buffer %s after-chunk=%s" (current-buffer) (when (boundp 'after-chunk) after-chunk))
+ (let ((major-mode need-major-mode)
+ (evaled-set-mode (mumamo-get-major-mode-setup need-major-mode)))
+ ;;(message ">>>>>> before %s" evaled-set-mode)
+ ;;(message ">>>>>> before %s, body=%s" evaled-set-mode (list ,@body))
+ (funcall (symbol-value evaled-set-mode)
+ (list 'progn
+ ,@body))
+ ;;(mumamo-msgfntfy "<<<<<< after evaled-set-mode modified=%s" (buffer-modified-p))
+ )))
+
+(defmacro mumamo-with-major-mode-fontification (major &rest body)
+ "With fontification variables set as major mode MAJOR eval BODY.
+This is used during font locking and indentation. The variables
+affecting those are set as they are in major mode MAJOR.
+
+See the code in `mumamo-fetch-major-mode-setup' for exactly which
+local variables that are set."
+ (declare (indent 1) (debug t))
+ `(mumamo-with-major-mode-setup ,major 'fontification
+ ,@body))
+;; Fontification disappears in for example *grep* if
+;; font-lock-mode-major-mode is 'permanent-local t.
+;;(put 'font-lock-mode-major-mode 'permanent-local t)
+
+(defmacro mumamo-with-major-mode-indentation (major &rest body)
+ "With indentation variables set as in another major mode do things.
+Same as `mumamo-with-major-mode-fontification' but for
+indentation. See that function for some notes about MAJOR and
+BODY."
+ (declare (indent 1) (debug t))
+ `(mumamo-with-major-mode-setup ,major 'indentation ,@body))
+
+;; fix-me: tell no sub-chunks in sub-chunks
+;;;###autoload
+(defmacro define-mumamo-multi-major-mode (fun-sym spec-doc chunks)
+ "Define a function that turn on support for multiple major modes.
+Define a function FUN-SYM that set up to divide the current
+buffer into chunks with different major modes.
+
+The documentation string for FUN-SYM should contain the special
+documentation in the string SPEC-DOC, general documentation for
+functions of this type and information about chunks.
+
+The new function will use the definitions in CHUNKS \(which is
+called a \"chunk family\") to make the dividing of the buffer.
+
+The function FUN-SYM can be used to setup a buffer instead of a
+major mode function:
+
+- The function FUN-SYM can be called instead of calling a major
+ mode function when you want to use multiple major modes in a
+ buffer.
+
+- The defined function can be used instead of a major mode
+ function in for example `auto-mode-alist'.
+
+- As the very last thing FUN-SYM will run the hook FUN-SYM-hook,
+ just as major modes do.
+
+- There is also a general hook, `mumamo-turn-on-hook', which is
+ run when turning on mumamo with any of these functions. This
+ is run right before the hook specific to any of the functions
+ above that turns on the multiple major mode support.
+
+- The multi major mode FUN-SYM has a keymap named FUN-SYM-map.
+ This overrides the major modes' keymaps since it is handled as
+ a minor mode keymap.
+
+- There is also a special mumamo keymap, `mumamo-map' that is
+ active in every buffer with a multi major mode. This is also
+ handled as a minor mode keymap and therefor overrides the major
+ modes' keymaps.
+
+- However when this support for multiple major mode is on the
+ buffer is divided into chunks, each with its own major mode.
+
+- The chunks are fontified according the major mode assigned to
+ them for that.
+
+- Indenting is also done according to the major mode assigned to
+ them for that.
+
+- The actual major mode used in the buffer is changed to the one
+ in the chunk when moving point between these chunks.
+
+- When major mode is changed the hooks for the new major mode,
+ `after-change-major-mode-hook' and `change-major-mode-hook' are
+ run.
+
+- There will be an alias for FUN-SYM called mumamo-alias-FUN-SYM.
+ This can be used to check whic multi major modes have been
+ defined.
+
+** A little bit more technical description:
+
+The dividing of a buffer into chunks is done during fontification
+by `mumamo-get-chunk-at'.
+
+The name of the function is saved in in the buffer local variable
+`mumamo-multi-major-mode' when the function is called.
+
+All functions defined by this macro is added to the list
+`mumamo-defined-multi-major-modes'.
+
+Basically Mumamo handles only major modes that uses jit-lock.
+However as a special effort also `nxml-mode' and derivatives
+thereof are handled. Since it seems impossible to me to restrict
+those major modes fontification to only a chunk without changing
+`nxml-mode' the fontification is instead done by
+`html-mode'/`sgml-mode' for chunks using `nxml-mode' and its
+derivates.
+
+CHUNKS is a list where each entry have the format
+
+ \(CHUNK-DEF-NAME MAIN-MAJOR-MODE SUBMODE-CHUNK-FUNCTIONS)
+
+CHUNK-DEF-NAME is the key name by which the entry is recognized.
+MAIN-MAJOR-MODE is the major mode used when there is no chunks.
+If this is nil then `major-mode' before turning on this mode will
+be used.
+
+SUBMODE-CHUNK-FUNCTIONS is a list of the functions that does the
+chunk division of the buffer. They are tried in the order they
+appear here during the chunk division process.
+
+If you want to write new functions for chunk divisions then
+please see `mumamo-find-possible-chunk'. You can perhaps also
+use `mumamo-quick-static-chunk' which is more easy-to-use
+alternative. See also the file mumamo-fun.el where there are
+many routines for chunk division.
+
+When you write those new functions you may want to use some of
+the functions for testing chunks:
+
+ `mumamo-test-create-chunk-at' `mumamo-test-create-chunks-at-all'
+ `mumamo-test-easy-make' `mumamo-test-fontify-region'
+
+These are in the file mumamo-test.el."
+ ;;(let ((c (if (symbolp chunks) (symbol-value chunks) chunks))) (message "c=%S" c))
+ (let* (;;(mumamo-describe-chunks (make-symbol "mumamo-describe-chunks"))
+ (turn-on-fun (if (symbolp fun-sym)
+ fun-sym
+ (error "Parameter FUN-SYM must be a symbol")))
+ (turn-on-fun-alias (intern (concat "mumamo-alias-" (symbol-name fun-sym))))
+ ;; Backward compatibility nXhtml v 1.60
+ (turn-on-fun-old (when (string= (substring (symbol-name fun-sym) -5)
+ "-mode")
+ (intern (substring (symbol-name fun-sym) 0 -5))))
+ (turn-on-hook (intern (concat (symbol-name turn-on-fun) "-hook")))
+ (turn-on-map (intern (concat (symbol-name turn-on-fun) "-map")))
+ (turn-on-hook-doc (concat "Hook run at the very end of `"
+ (symbol-name turn-on-fun) "'."))
+ (chunks2 (if (symbolp chunks)
+ (symbol-value chunks)
+ chunks))
+ (docstring
+ (concat
+ spec-doc
+ "
+
+
+
+This function is called a multi major mode. It sets up for
+multiple major modes in the buffer in the following way:
+
+"
+ ;; Fix-me: During byte compilation the next line is not
+ ;; expanded as I thought because the functions in CHUNKS
+ ;; are not defined. How do I fix this? Move out the
+ ;; define-mumamo-multi-major-mode calls?
+ (funcall 'mumamo-describe-chunks chunks2)
+ "
+At the very end this multi major mode function runs first the hook
+`mumamo-turn-on-hook' and then `" (symbol-name turn-on-hook) "'.
+
+There is a keymap specific to this multi major mode, but it is
+not returned by `current-local-map' which returns the chunk's
+major mode's local keymap.
+
+The multi mode keymap is named `" (symbol-name turn-on-map) "'.
+
+
+
+The main use for a multi major mode is to use it instead of a
+normal major mode in `auto-mode-alist'. \(You can of course call
+this function directly yourself too.)
+
+The value of `mumamo-multi-major-mode' tells you which multi
+major mode if any has been turned on in a buffer. For more
+information about multi major modes please see
+`define-mumamo-multi-major-mode'.
+
+Note: When adding new font-lock keywords for major mode chunks
+you should use the function `mumamo-refresh-multi-font-lock'
+afterwards.
+" )))
+ `(progn
+ ;;(add-to-list 'mumamo-defined-multi-major-modes (cons (car ',chunks2) ',turn-on-fun))
+ (mumamo-add-to-defined-multi-major-modes (cons (car ',chunks2) ',turn-on-fun))
+ (defvar ,turn-on-hook nil ,turn-on-hook-doc)
+ (defvar ,turn-on-map (make-sparse-keymap)
+ ,(concat "Keymap for multi major mode function `"
+ (symbol-name turn-on-fun) "'"))
+ (defvar ,turn-on-fun nil)
+ (make-variable-buffer-local ',turn-on-fun)
+ (put ',turn-on-fun 'permanent-local t)
+ (put ',turn-on-fun 'mumamo-chunk-family (copy-tree ',chunks2))
+ (put ',turn-on-fun-alias 'mumamo-chunk-family (copy-tree ',chunks2))
+ (defun ,turn-on-fun nil ,docstring
+ (interactive)
+ (let ((old-major-mode (or mumamo-major-mode
+ major-mode)))
+ (kill-all-local-variables)
+ (run-hooks 'change-major-mode-hook)
+ (setq mumamo-multi-major-mode ',turn-on-fun)
+ (setq ,turn-on-fun t)
+ (mumamo-add-multi-keymap ',turn-on-fun ,turn-on-map)
+ (setq mumamo-current-chunk-family (copy-tree ',chunks2))
+ (mumamo-turn-on-actions old-major-mode)
+ (run-hooks ',turn-on-hook)))
+ (defalias ',turn-on-fun-alias ',turn-on-fun)
+ (when (intern-soft ',turn-on-fun-old)
+ (defalias ',turn-on-fun-old ',turn-on-fun))
+ )))
+
+;;;###autoload
+(defun mumamo-add-to-defined-multi-major-modes (entry)
+ (add-to-list 'mumamo-defined-multi-major-modes entry))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Debugging etc
+
+(defsubst mumamo-while (limit counter where)
+ (let ((count (symbol-value counter)))
+ (if (= count limit)
+ (progn
+ (msgtrc "Reached (while limit=%s, where=%s)" limit where)
+ nil)
+ (set counter (1+ count)))))
+
+;; (defun dbg-smarty-err ()
+;; ;; (insert "}{")
+
+;; ;; (insert "}{")
+;; ;; (backward-char)
+;; ;; (backward-char)
+;; ;; (search-backward "}")
+
+;; ;; This gives an error rather often, but not always:
+;; (delete-char 3)
+;; (search-backward "}")
+;; )
+
+;; (defun dbg-smarty-err2 ()
+;; (forward-char 5)
+;; (insert "}{")
+;; ;; Start in nxhtml part and make sure the insertion is in smarty
+;; ;; part. Gives reliably an error if moved backward so point stay in
+;; ;; the new nxhtml-mode part, otherwise not.
+;; ;;
+;; ;; Eh, no. If chunk family is changed and reset there is no more an
+;; ;; error.
+;; ;;
+;; ;; Seems to be some race condition, but I am unable to understand
+;; ;; how. I believed that nxml always left in a reliable state. Is
+;; ;; this a state problem in mumamo or nxml? I am unable to make it
+;; ;; happen again now.
+;; ;;
+;; ;; I saw one very strange thing: The error message got inserted in
+;; ;; the .phps buffer once. How could this happen? Is this an Emacs
+;; ;; bug? Can't see how this could happen since it is the message
+;; ;; function that outputs the message. A w32 race condition? Are
+;; ;; people aware that the message queue runs in parallell? (I have
+;; ;; tried to ask on the devel list, but got no answer at that time.)
+;; (backward-char 2)
+;; )
+
+
+(defvar msgtrc-buffer
+ "*Messages*"
+ ;;"*trace-output*"
+ "Buffer or name of buffer for trace messages.
+See `msgtrc'."
+ )
+
+(defun msgtrc (format-string &rest args)
+ "Print message to `msgtrc-buffer'.
+Arguments FORMAT-STRING and ARGS are like for `message'."
+ (if nil
+ nil ;;(apply 'message format-string args)
+ ;; bug#3350 prevents use of this:
+ (let ((trc-buffer (get-buffer-create msgtrc-buffer))
+ ;; Cure 3350: Stop insert from deactivating the mark
+ (deactivate-mark))
+ (with-current-buffer trc-buffer
+ (goto-char (point-max))
+ (insert "MU:" (apply 'format format-string args) "\n")
+ ;;(insert "constant string\n")
+ (when buffer-file-name (write-region nil nil buffer-file-name))))))
+
+(defvar mumamo-message-file-buffer nil)
+(defsubst mumamo-msgtrc-to-file ()
+ "Start writing message to file. Erase `msgtrc-buffer' first."
+ (unless mumamo-message-file-buffer
+ (setq mumamo-message-file-buffer (find-file-noselect "c:/emacs/bugs/temp-messages.txt"))
+ (setq msgtrc-buffer mumamo-message-file-buffer)
+ (with-current-buffer mumamo-message-file-buffer
+ (erase-buffer))))
+
+(defvar mumamo-display-error-lwarn nil
+ "Set to t to call `lwarn' on fontification errors.
+If this is t then `*Warnings*' buffer will popup on fontification
+errors.")
+(defvar mumamo-display-error-stop nil
+ "Set to t to stop fontification on errors.")
+
+(defun mumamo-message-with-face (msg face)
+ "Put MSG with face FACE in *Messages* buffer."
+ (let ((start (+ (with-current-buffer msgtrc-buffer
+ (point-max))
+ 1))
+ ;; This is for the echo area:
+ (msg-with-face (propertize (format "%s" msg)
+ 'face face)))
+
+ (msgtrc "%s" msg-with-face)
+ ;; This is for the buffer:
+ (with-current-buffer msgtrc-buffer
+ (goto-char (point-max))
+ (backward-char)
+ (put-text-property start (point)
+ 'face face))))
+
+;;(run-with-idle-timer 1 nil 'mumamo-show-report-message)
+(defun mumamo-show-report-message ()
+ "Tell the user there is a long error message."
+ (save-match-data ;; runs in timer
+ (mumamo-message-with-face
+ "MuMaMo error, please look in the *Messages* buffer"
+ 'highlight)))
+
+;; This code can't be used now because `debugger' is currently not
+;; useable in timers. I keep it here since I hope someone will make it
+;; possible in the future.
+;;
+;; (defmacro mumamo-get-backtrace-if-error (bodyform)
+;; "Evaluate BODYFORM, return a list with error message and backtrace.
+;; If there is an error in BODYFORM then return a list with the
+;; error message and the backtrace as a string. Otherwise return
+;; nil."
+;; `(let* ((debugger
+;; (lambda (&rest debugger-args)
+;; (let ((debugger-ret (with-output-to-string (backtrace))))
+;; ;; I believe we must put the result in a buffer,
+;; ;; otherwise `condition-case' might erase it:
+;; (with-current-buffer (get-buffer-create "TEMP GET BACKTRACE")
+;; (erase-buffer)
+;; (insert debugger-ret)))))
+;; (debug-on-error t)
+;; (debug-on-signal t))
+;; (mumamo-condition-case err
+;; (progn
+;; ,bodyform
+;; nil)
+;; (error
+;; (let* ((errmsg (error-message-string err))
+;; (dbg1-ret
+;; (with-current-buffer
+;; (get-buffer "TEMP GET BACKTRACE") (buffer-string)))
+;; ;; Remove lines from this routine:
+;; (debugger-lines (split-string dbg1-ret "\n"))
+;; (dbg-ret (mapconcat 'identity (nthcdr 6 debugger-lines) "\n"))
+;; )
+;; (list errmsg (concat errmsg "\n" dbg-ret)))))))
+
+;;(mumamo-display-error 'test-lwarn-type "testing 1=%s, 2=%s" "one" 'two)
+(defun mumamo-display-error (lwarn-type format-string &rest args)
+ "Display a message plus traceback in the *Messages* buffer.
+Use this for errors that happen during fontification or when
+running a timer.
+
+LWARN-TYPE is used as the type argument to `lwarn' if warnings
+are displayed. FORMAT-STRING and ARGS are used as the
+corresponding arguments to `message' and `lwarn'.
+
+All the output from this function in the *Messages* buffer is
+displayed with the highlight face. After the message printed by
+`message' is traceback from where this function was called.
+Note: There is no error generated, just a traceback that is put
+in *Messages* as above.
+
+Display an error message using `message' and colorize it using
+the `highlight' face to make it more prominent. Add a backtrace
+colored with the `highlight' face to the buffer *Messages*. Then
+display the error message once again after this so that the user
+can see it.
+
+If `mumamo-display-error-lwarn' is non-nil, indicate the error by
+calling `lwarn'. This will display the `*Warnings*' buffer and
+thus makes it much more easy to spot that there was an error.
+
+If `mumamo-display-error-stop' is non-nil raise an error that may
+stop fontification."
+
+ ;; Warnings are sometimes disturbning, make it optional:
+ (when mumamo-display-error-lwarn
+ (apply 'lwarn lwarn-type :error format-string args))
+
+ (let ((format-string2 (concat "%s: " format-string))
+ (bt (with-output-to-string (backtrace))))
+
+ (mumamo-message-with-face
+ (concat
+ (apply 'format format-string2 lwarn-type args)
+ "\n"
+ (format "** In buffer %s\n" (current-buffer))
+ bt)
+ 'highlight)
+
+ ;; Output message once again so the user can see it:
+ (apply 'message format-string2 lwarn-type args)
+ ;; But ... there might be more messages so wait until things has
+ ;; calmed down and then show a message telling that there was an
+ ;; error and that there is more information in the *Messages*
+ ;; buffer.
+ (run-with-idle-timer 1 nil 'mumamo-show-report-message)
+
+ ;; Stop fontifying:
+ (when mumamo-display-error-stop
+ ;;(font-lock-mode -1)
+ (setq font-lock-mode nil)
+ (when (timerp jit-lock-context-timer)
+ (cancel-timer jit-lock-context-timer))
+ (when (timerp jit-lock-defer-timer)
+ (cancel-timer jit-lock-defer-timer))
+ (apply 'error format-string2 lwarn-type args))))
+
+
+(defun mumamo-debug-to-backtrace (&rest debugger-args)
+ "This function should give a backtrace during fontification errors.
+The variable `debugger' should then be this function. See the
+function `debug' for an explanation of DEBUGGER-ARGS.
+
+Fix-me: Can't use this function yet since the display routines
+uses safe_eval and safe_call."
+ (mumamo-display-error 'mumamo-debug-to-backtrace
+ "%s"
+ (nth 1 debugger-args)))
+
+;; (defun my-test-err3 ()
+;; (interactive)
+;; (let ((debugger 'mumamo-debug-to-backtrace)
+;; (debug-on-error t))
+;; (my-err)
+;; ))
+;;(my-test-err3()
+
+;;(set-default 'mumamo-use-condition-case nil)
+;;(set-default 'mumamo-use-condition-case t)
+(defvar mumamo-use-condition-case t)
+(make-variable-buffer-local 'mumamo-use-condition-case)
+(put 'mumamo-use-condition-case 'permanent-local t)
+
+(defvar mumamo-debugger 'mumamo-debug-to-backtrace)
+(make-variable-buffer-local 'mumamo-debugger)
+(put 'mumamo-debugger 'permanent-local t)
+
+;; (defun my-test-err4 ()
+;; (interactive)
+;; (mumamo-condition-case err
+;; (my-errx)
+;; (arith-error (message "here"))
+;; (error (message "%s, %s" err (error-message-string err)))
+;; ))
+
+(defvar mumamo-warned-once nil)
+(make-variable-buffer-local 'mumamo-warned-once)
+(put 'mumamo-warned-once 'permanent-local t)
+
+ ; (append '(0 1) '(a b))
+(defun mumamo-warn-once (type message &rest args)
+ "Warn only once with TYPE, MESSAGE and ARGS.
+If the same problem happens again then do not warn again."
+ (let ((msgrec (append (list type message) args)))
+ (unless (member msgrec mumamo-warned-once)
+ (setq mumamo-warned-once
+ (cons msgrec mumamo-warned-once))
+ ;;(apply 'lwarn type :warning message args)
+ (apply 'message (format "%s: %s" type message) args)
+ )))
+
+(defun mumamo-add-help-tabs ()
+ "Add key bindings for moving between buttons.
+Add bindings similar to those in `help-mode' for moving between
+text buttons."
+ (local-set-key [tab] 'forward-button)
+ (local-set-key [(meta tab)] 'backward-button)
+ (local-set-key [(shift tab)] 'backward-button)
+ (local-set-key [backtab] 'backward-button))
+
+(defun mumamo-insert-describe-button (symbol type)
+ "Insert a text button that describes SYMBOL of type TYPE."
+ (let ((func `(lambda (btn)
+ (funcall ',type ',symbol))))
+ (mumamo-add-help-tabs)
+ (insert-text-button
+ (symbol-name symbol)
+ :type 'help-function
+ 'face 'link
+ 'action func)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Custom group
+
+;;;###autoload
+(defgroup mumamo nil
+ "Customization group for multiple major modes in a buffer."
+ :group 'editing
+ :group 'languages
+ :group 'sgml
+ :group 'nxhtml
+ )
+
+;;(setq mumamo-set-major-mode-delay -1)
+;;(setq mumamo-set-major-mode-delay 5)
+(defcustom mumamo-set-major-mode-delay idle-update-delay
+ "Delay this number of seconds before setting major mode.
+When point enters a region where the major mode should be
+different than the current major mode, wait until Emacs has been
+idle this number of seconds before switching major mode.
+
+If negative switch major mode immediately.
+
+Ideally the switching of major mode should occur immediately when
+entering a region. However this can make movements a bit unsmooth
+for some major modes on a slow computer. Therefore on a slow
+computer use a short delay.
+
+If you have a fast computer and want to use mode specific
+movement commands then set this variable to -1.
+
+I tried to measure the time for switching major mode in mumamo.
+For most major modes it took 0 ms, but for `nxml-mode' and its
+derivate it took 20 ms on a 3GHz CPU."
+ :type 'number
+ :group 'mumamo)
+
+
+(defgroup mumamo-display nil
+ "Customization group for mumamo chunk display."
+ :group 'mumamo)
+
+(defun mumamo-update-this-buffer-margin-use ()
+ (mumamo-update-buffer-margin-use (current-buffer)))
+
+(define-minor-mode mumamo-margin-info-mode
+ "Display chunk info in margin when on.
+Display chunk depth and major mode where a chunk begin in left or
+right margin. \(The '-mode' part of the major mode is stripped.)
+
+See also `mumamo-margin-use'.
+
+Note: When `linum-mode' is on the right margin is always used
+now \(since `linum-mode' uses the left)."
+ :group 'mumamo-display
+ (mumamo-update-this-buffer-margin-use)
+ (if mumamo-margin-info-mode
+ (progn
+ ;;(add-hook 'window-configuration-change-hook 'mumamo-update-this-buffer-margin-use nil t)
+ (add-hook 'linum-mode-hook 'mumamo-update-this-buffer-margin-use nil t)
+ )
+ ;;(remove-hook 'window-configuration-change-hook 'mumamo-update-this-buffer-margin-use t)
+ (remove-hook 'linum-mode-hook 'mumamo-update-this-buffer-margin-use t)
+ ))
+;;(put 'mumamo-margin-info-mode 'permanent-local t)
+
+(defun mumamo-margin-info-mode-turn-off ()
+ (mumamo-margin-info-mode -1))
+(put 'mumamo-margin-info-mode-turn-off 'permanent-local-hook t)
+
+(define-globalized-minor-mode mumamo-margin-info-global-mode mumamo-margin-info-mode
+ (lambda () (when (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)
+ (mumamo-margin-info-mode 1)))
+ :group 'mumamo-display)
+
+(defcustom mumamo-margin-use '(left-margin 13)
+ "Display chunk info in left or right margin if non-nil."
+ :type '(list (radio (const :tag "Display chunk info in left margin" left-margin)
+ (const :tag "Display chunk info in right margin" right-margin))
+ (integer :tag "Margin width (when used)" :value 13))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (fboundp 'mumamo-update-all-buffers-margin-use)
+ (mumamo-update-all-buffers-margin-use)))
+ :group 'mumamo-display)
+
+(defun mumamo-update-all-buffers-margin-use ()
+ (dolist (buf (buffer-list))
+ (mumamo-update-buffer-margin-use buf)))
+
+(define-minor-mode mumamo-no-chunk-coloring
+ "Use no background colors to distinguish chunks.
+When this minor mode is on in a buffer no chunk coloring is done
+in that buffer. This is overrides `mumamo-chunk-coloring'. It
+is meant for situations when you temporarily need to remove the
+background colors."
+ :lighter " ø"
+ :group 'mumamo-display
+ (font-lock-mode -1)
+ (font-lock-mode 1))
+(put 'mumamo-no-chunk-coloring 'permanent-local t)
+
+
+;; (setq mumamo-chunk-coloring 4)
+(defcustom mumamo-chunk-coloring 0
+ "Color chunks with depth greater than or equal to this.
+When 0 all chunks will be colored. If 1 all sub mode chunks will
+be colored, etc."
+ :type '(integer :tag "Color chunks with depth greater than this")
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-major
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "MidnightBlue")
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "cornsilk")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue4")
+ (((class color) (min-colors 16) (background light))
+ :background "cornsilk")
+ (((class color) (min-colors 8))
+ :background "blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in sub modes.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-submode1
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "DarkGreen"
+ ;;:background "#081010"
+ )
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "Azure")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "azure")
+ (((class color) (min-colors 8))
+ :background "Blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in major mode.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-submode2
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "dark green")
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "#e6ff96")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "azure")
+ (((class color) (min-colors 8))
+ :background "blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in major mode.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-submode3
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "dark green")
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "#f7d1f4")
+ ;;:background "green")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "azure")
+ (((class color) (min-colors 8))
+ :background "blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in major mode.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-submode4
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "dark green")
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "orange")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "azure")
+ (((class color) (min-colors 8))
+ :background "blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in major mode.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-major 'mumamo-background-chunk-major
+ "Background colors for chunks in major mode.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-submode1 'mumamo-background-chunk-submode1
+ "Background colors for chunks in sub modes.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-submode2 'mumamo-background-chunk-submode2
+ "Background colors for chunks in sub modes.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-submode3 'mumamo-background-chunk-submode3
+ "Background colors for chunks in sub modes.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-submode4 'mumamo-background-chunk-submode4
+ "Background colors for chunks in sub modes.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+;; Fix-me: use and enhance this
+(defcustom mumamo-background-colors '(mumamo-background-chunk-major
+ mumamo-background-chunk-submode1
+ mumamo-background-chunk-submode2
+ mumamo-background-chunk-submode3
+ mumamo-background-chunk-submode4
+ )
+ "List of background colors in order of use.
+First color is for main major mode chunks, then for submode
+chunks, sub-submode chunks etc. Colors are reused in cyclic
+order.
+
+The default colors are choosen so that inner chunks has a more
+standing out color the further in you get. This is supposed to
+be helpful when you make mistakes and the chunk nesting is not
+what you intended.
+
+Note: Only the light background colors have been set by me. The
+dark background colors might currently be unuseful.
+Contributions and suggestions are welcome!
+
+The values in the list should be symbols. Each symbol should either be
+
+ 1: a variable symbol pointing to a face (or beeing nil)
+ 2: a face symbol
+ 3: a function with one argument (subchunk depth) returning a
+ face symbol"
+ :type '(repeat symbol)
+ :group 'mumamo-display)
+
+;;(mumamo-background-color 0)
+;;(mumamo-background-color 1)
+;;(mumamo-background-color 2)
+(defun mumamo-background-color (sub-chunk-depth)
+ (when (and (not mumamo-no-chunk-coloring)
+ (or (not (integerp mumamo-chunk-coloring)) ;; Old values
+ (>= sub-chunk-depth mumamo-chunk-coloring)))
+ (let* ((idx (when mumamo-background-colors
+ (mod sub-chunk-depth (length mumamo-background-colors))))
+ (sym (when idx (nth idx mumamo-background-colors)))
+ fac)
+ (when sym
+ (when (boundp sym)
+ (setq fac (symbol-value sym))
+ (unless (facep fac) (setq fac nil)))
+ (unless fac
+ (when (facep sym)
+ (setq fac sym)))
+ (unless fac
+ (when (fboundp sym)
+ (setq fac (funcall sym sub-chunk-depth))))
+ (when fac
+ (unless (facep fac)
+ (setq fac nil)))
+ fac
+ ))))
+
+(defface mumamo-border-face-in
+ '((t (:inherit font-lock-preprocessor-face :bold t :italic t :underline t)))
+ "Face for marking borders."
+ :group 'mumamo-display)
+
+(defface mumamo-border-face-out
+ '((t (:inherit font-lock-preprocessor-face :bold t :italic t :underline t)))
+ "Face for marking borders."
+ :group 'mumamo-display)
+
+
+(defgroup mumamo-indentation nil
+ "Customization group for mumamo chunk indentation."
+ :group 'mumamo)
+
+(defcustom mumamo-submode-indent-offset 2
+ "Indentation of submode relative outer major mode.
+If this is nil then indentation first non-empty line in a
+subchunk will \(normally) be 0. See however
+`mumamo-indent-line-function-1' for special handling of first
+line in subsequent subchunks.
+
+See also `mumamo-submode-indent-offset-0'."
+ :type '(choice integer
+ (const :tag "No special"))
+ :group 'mumamo-indentation)
+
+(defcustom mumamo-submode-indent-offset-0 0
+ "Indentation of submode at column 0.
+This value overrides `mumamo-submode-indent-offset' when the
+outer major mode above has indentation 0."
+ :type '(choice integer
+ (const :tag "No special"))
+ :group 'mumamo-indentation)
+
+(defcustom mumamo-indent-major-to-use
+ '(
+ ;;(nxhtml-mode html-mode)
+ (html-mode nxhtml-mode)
+ )
+ "Major mode to use for indentation.
+This is normally the major mode specified for the chunk. Here you
+can make exceptions."
+ :type '(repeat
+ (list (symbol :tag "Major mode symbol specified")
+ (command :tag "Major mode to use")))
+ :group 'mumamo-indentation)
+
+;;(mumamo-indent-get-major-to-use 'nxhtml-mode)
+;;(mumamo-indent-get-major-to-use 'html-mode)
+(defun mumamo-indent-get-major-to-use (major depth)
+ (or (and (= depth 0)
+ (cadr (assq major mumamo-indent-major-to-use)))
+ major))
+
+(defcustom mumamo-indent-widen-per-major
+ '(
+ (php-mode (use-widen))
+ (nxhtml-mode (use-widen (html-mumamo-mode nxhtml-mumamo-mode)))
+ (html-mode (use-widen (html-mumamo-mode nxhtml-mumamo-mode)))
+ )
+ "Wether do widen buffer during indentation.
+If not then the buffer is narrowed to the current chunk when
+indenting a line in a chunk."
+ :type '(repeat
+ (list (symbol :tag "Major mode symbol")
+ (set
+ (const :tag "Widen buffer during indentation" use-widen)
+ (repeat (command :tag "Widen if multi major is any of those"))
+ )))
+ :group 'mumamo-indentation)
+
+
+;;;###autoload
+(defgroup mumamo-hi-lock-faces nil
+ "Faces for hi-lock that are visible in mumamo multiple modes.
+This is a workaround for the problem that text properties are
+always hidden behind overlay dito.
+
+This faces are not as visible as those that defines background
+colors. However they use underlining so they are at least
+somewhat visible."
+ :group 'hi-lock
+ :group 'mumamo-display
+ :group 'faces)
+
+(defface hi-mumamo-yellow
+ '((((min-colors 88) (background dark))
+ (:underline "yellow1"))
+ (((background dark)) (:underline "yellow"))
+ (((min-colors 88)) (:underline "yellow1"))
+ (t (:underline "yellow")))
+ "Default face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-pink
+ '((((background dark)) (:underline "pink"))
+ (t (:underline "pink")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-green
+ '((((min-colors 88) (background dark))
+ (:underline "green1"))
+ (((background dark)) (:underline "green"))
+ (((min-colors 88)) (:underline "green1"))
+ (t (:underline "green")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-blue
+ '((((background dark)) (:underline "light blue"))
+ (t (:underline "light blue")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-black-b
+ '((t (:weight bold :underline t)))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-blue-b
+ '((((min-colors 88)) (:weight bold :underline "blue1"))
+ (t (:weight bold :underline "blue")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-green-b
+ '((((min-colors 88)) (:weight bold :underline "green1"))
+ (t (:weight bold :underline "green")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-red-b
+ '((((min-colors 88)) (:weight bold :underline "red1"))
+ (t (:weight bold :underline "red")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+
+;; (defcustom mumamo-check-chunk-major-same nil
+;; "Check if main major mode is the same as normal mode."
+;; :type 'boolean
+;; :group 'mumamo)
+
+;; (customize-option 'mumamo-major-modes)
+;;(require 'django)
+
+(defgroup mumamo-modes nil
+ "Customization group for mumamo chunk modes."
+ :group 'mumamo)
+
+(defcustom mumamo-major-modes
+ '(
+ (asp-js-mode
+ js-mode ;; Not autoloaded in the pretest
+ javascript-mode
+ espresso-mode
+ ecmascript-mode)
+ (asp-vb-mode
+ visual-basic-mode)
+ ;;(css-mode fundamental-mode)
+ (javascript-mode
+ js-mode ;; Not autoloaded in the pretest
+ javascript-mode
+ espresso-mode
+ ;;js2-fl-mode
+ ecmascript-mode)
+ (java-mode
+ jde-mode
+ java-mode)
+ (groovy-mode
+ groovy-mode)
+ ;; For Emacs 22 that do not have nxml by default
+ ;; Fix me: fallback when autoload fails!
+ (nxhtml-mode
+ nxhtml-mode
+ html-mode)
+ )
+ "Alist for conversion of chunk major mode specifier to major mode.
+Each entry has the form
+
+ \(MAJOR-SPEC MAJORMODE ...)
+
+where the symbol MAJOR-SPEC specifies the code type and should
+match the value returned from `mumamo-find-possible-chunk'. The
+MAJORMODE symbols are major modes that can be used for editing
+that code type. The first available MAJORMODE is the one that is
+used.
+
+The MAJOR-SPEC symbols are used by the chunk definitions in
+`define-mumamo-multi-major-mode'.
+
+The major modes are not specified directly in the chunk
+definitions. Instead a chunk definition contains a symbol that
+is looked up in this list to find the chunk's major mode.
+
+The reason for doing it this way is to make it possible to use
+new major modes with existing multi major modes. If for example
+someone writes a new CSS mode that could easily be used instead
+of the current one in `html-mumamo-mode'.
+
+Lookup in this list is done by `mumamo-major-mode-from-modespec'."
+ :type '(alist
+ :key-type (symbol :tag "Symbol for major mode spec in chunk")
+ :value-type (repeat (choice
+ (command :tag "Major mode")
+ (symbol :tag "Major mode (not yet loaded)")))
+ )
+ :group 'mumamo-modes)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; JIT lock functions
+
+(defun mumamo-jit-lock-function (start)
+ "This function is added to `fontification-functions' by mumamo.
+START is a parameter given to functions in that hook."
+ (mumamo-msgfntfy "mumamo-jit-lock-function %s, ff=%s, just-changed=%s"
+ start
+ (when start
+ (save-restriction
+ (widen)
+ (get-text-property start 'fontified)))
+ mumamo-just-changed-major)
+ ;;(msgtrc "jit-lock-function %s, ff=%s, just-changed=%s" start (get-text-property start 'fontified) mumamo-just-changed-major)
+ ;;(msgtrc "mumamo-jit-lock-function enter: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ (if mumamo-just-changed-major
+ (setq mumamo-just-changed-major nil))
+ (let ((ret (jit-lock-function start)))
+ (mumamo-msgfntfy "mumamo-jit-lock-function EXIT %s, ff=%s, just-changed=%s"
+ start
+ (when start
+ (save-restriction
+ (widen)
+ (get-text-property start 'fontified)))
+ mumamo-just-changed-major)
+ ;;(msgtrc "mumamo-jit-lock-function exit: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ ret))
+
+(defun mumamo-jit-lock-register (fun &optional contextual)
+ "Replacement for `jit-lock-register'.
+Avoids refontification, otherwise same. FUN and CONTEXTUAL has
+the some meaning as there."
+ (add-hook 'jit-lock-functions fun nil t)
+ (when (and contextual jit-lock-contextually)
+ (set (make-local-variable 'jit-lock-contextually) t))
+
+ ;;(jit-lock-mode t)
+ ;;
+ ;; Replace this with the code below from jit-lock-mode t part:
+ (setq jit-lock-mode t)
+
+ ;; Mark the buffer for refontification.
+ ;; This is what we want to avoid in mumamo:
+ ;;(jit-lock-refontify)
+
+ ;; Install an idle timer for stealth fontification.
+ (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
+ (setq jit-lock-stealth-timer
+ (run-with-idle-timer jit-lock-stealth-time t
+ 'jit-lock-stealth-fontify)))
+
+ ;; Create, but do not activate, the idle timer for repeated
+ ;; stealth fontification.
+ (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
+ (setq jit-lock-stealth-repeat-timer (timer-create))
+ (timer-set-function jit-lock-stealth-repeat-timer
+ 'jit-lock-stealth-fontify '(t)))
+
+ ;; Init deferred fontification timer.
+ (when (and jit-lock-defer-time (null jit-lock-defer-timer))
+ (setq jit-lock-defer-timer
+ (run-with-idle-timer jit-lock-defer-time t
+ 'jit-lock-deferred-fontify)))
+
+ ;; Initialize contextual fontification if requested.
+ (when (eq jit-lock-contextually t)
+ (unless jit-lock-context-timer
+ (setq jit-lock-context-timer
+ (run-with-idle-timer jit-lock-context-time t
+ 'jit-lock-context-fontify)))
+ (setq jit-lock-context-unfontify-pos
+ (or jit-lock-context-unfontify-pos (point-max))))
+
+ ;; Setup our hooks.
+ ;;(add-hook 'after-change-functions 'jit-lock-after-change t t)
+ ;;(add-hook 'after-change-functions 'mumamo-jit-lock-after-change t t)
+ (add-hook 'after-change-functions 'mumamo-after-change t t)
+ ;; Set up fontification to call jit:
+ (let ((ff (reverse fontification-functions)))
+ (mapc (lambda (f)
+ ;;(unless (eq f 'jit-lock-function)
+ (remove-hook 'fontification-functions f t))
+ ;;)
+ ff))
+ (add-hook 'fontification-functions 'mumamo-jit-lock-function nil t)
+ )
+
+;; Fix-me: integrate this with fontify-region!
+(defvar mumamo-find-chunks-timer nil)
+(make-variable-buffer-local 'mumamo-find-chunks-timer)
+(put 'mumamo-find-chunks-timer 'permanent-local t)
+
+(defvar mumamo-find-chunk-delay idle-update-delay)
+(make-variable-buffer-local 'mumamo-find-chunk-delay)
+(put 'mumamo-find-chunk-delay 'permanent-local t)
+
+(defun mumamo-stop-find-chunks-timer ()
+ "Stop timer that find chunks."
+ (when (and mumamo-find-chunks-timer
+ (timerp mumamo-find-chunks-timer))
+ (cancel-timer mumamo-find-chunks-timer))
+ (setq mumamo-find-chunks-timer nil))
+
+(defun mumamo-start-find-chunks-timer ()
+ "Start timer that find chunks."
+ (mumamo-stop-find-chunks-timer)
+ ;; (setq mumamo-find-chunks-timer
+ ;; (run-with-idle-timer mumamo-find-chunk-delay nil
+ ;; 'mumamo-find-chunks-in-timer (current-buffer)))
+ )
+
+(defun mumamo-find-chunks-in-timer (buffer)
+ "Run `mumamo-find-chunks' in buffer BUFFER in a timer."
+ (mumamo-msgfntfy "mumamo-find-chunks-in-timer %s" buffer)
+ ;;(message "mumamo-find-chunks-in-timer %s" buffer)
+ (condition-case err
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (mumamo-find-chunks nil "mumamo-find-chunks-in-timer")))
+ (error (message "mumamo-find-chunks error: %s" err))))
+
+
+(defvar mumamo-last-chunk nil)
+(make-variable-buffer-local 'mumamo-last-chunk)
+(put 'mumamo-last-chunk 'permanent-local t)
+
+(defvar mumamo-last-change-pos nil)
+(make-variable-buffer-local 'mumamo-last-change-pos)
+(put 'mumamo-last-change-pos 'permanent-local t)
+
+;; Fix-me: maybe this belongs to contextual fontification? Eh,
+;; no. Unfortunately there is not way to make that handle more than
+;; multiple lines.
+(defvar mumamo-find-chunk-is-active nil
+ "Protect from recursive calls.")
+
+;; Fix-me: temporary things for testing new chunk routines.
+(defvar mumamo-find-chunks-level 0)
+(setq mumamo-find-chunks-level 0)
+
+(defvar mumamo-old-tail nil)
+(make-variable-buffer-local 'mumamo-old-tail)
+(put 'mumamo-old-tail 'permanent-local t)
+
+(defun mumamo-update-obscure (chunk pos)
+ "Update obscure cache."
+ (let ((obscured (overlay-get chunk 'obscured))
+ region-info)
+ (unless (and obscured (= (car obscured) pos))
+ (setq region-info (mumamo-get-region-from pos))
+ ;;(msgtrc "update-obscure:region-info=%s" region-info)
+ ;; This should not be a chunk here
+ (mumamo-put-obscure chunk pos region-info))))
+
+(defun mumamo-put-obscure (chunk pos region-or-chunk)
+ "Cache obscure info."
+ (assert (overlayp chunk) t)
+ (when pos (assert (or (markerp pos) (integerp pos)) t))
+ (let* ((region-info (if (overlayp region-or-chunk)
+ (cons (overlay-start region-or-chunk)
+ (overlay-end region-or-chunk))
+ region-or-chunk))
+ (obscured (when pos (list pos region-info))))
+ ;;(msgtrc "put-obscure:region-info=%s, obscured=%s" region-info obscured)
+ (when region-info (assert (consp region-info) t))
+ (assert (not (overlayp region-info)) t)
+ (overlay-put chunk 'obscured obscured)
+ (setq obscured (overlay-get chunk 'obscured))
+ ;;(msgtrc " obscured=%s" obscured)
+ ))
+
+(defun mumamo-get-region-from (point)
+ "Return mumamo region values for POINT."
+ ;; Note: `mumamo-get-region-from-1' is defined in mumamo-regions.el
+ (when (fboundp 'mumamo-get-region-from-1)
+ (mumamo-get-region-from-1 point)))
+
+(defun mumamo-clear-chunk-ppss-cache (chunk)
+ (overlay-put chunk 'mumamo-ppss-cache nil)
+ (overlay-put chunk 'mumamo-ppss-last nil)
+ (overlay-put chunk 'mumamo-ppss-stats nil))
+
+(defun mumamo-find-chunks (end tracer)
+ "Find or create chunks from last known chunk.
+Ie, start from the end of `mumamo-last-chunk' if this is
+non-nil, otherwise 1.
+
+If END is nil then continue till end of buffer or until any input
+is available. In this case the return value is undefined.
+
+Otherwise END must be a position in the buffer. Return the
+mumamo chunk containing the position. If `mumamo-last-chunk'
+ends before END then create chunks upto END."
+ (when mumamo-multi-major-mode
+ (let ((chunk (mumamo-find-chunks-1 end tracer))
+ region-info)
+ (when (and end chunk (featurep 'mumamo-regions))
+ (setq region-info (mumamo-get-region-from end))
+ ;;(msgtrc "find-chunks:region-info=%s" region-info)
+ (if (overlayp region-info)
+ (setq chunk region-info)
+ ;;(overlay-put chunk 'obscured (list end region-info))))
+ (mumamo-put-obscure chunk end region-info)))
+ ;;(msgtrc "find-chunks ret chunk=%s" chunk)
+ chunk)))
+
+(defun mumamo-move-to-old-tail (first-check-from)
+ "Divide the chunk list.
+Make it two parts. The first, before FIRST-CHECK-FROM is still
+correct but we want to check those after. Put thosie in
+`mumamo-old-tail'."
+ (let ((while-n0 0))
+ (while (and (mumamo-while 500 'while-n0 "mumamo-last-chunk first-check-from")
+ mumamo-last-chunk
+ first-check-from
+ (< first-check-from (overlay-end mumamo-last-chunk)))
+ (overlay-put mumamo-last-chunk 'mumamo-next-chunk mumamo-old-tail)
+ (setq mumamo-old-tail mumamo-last-chunk)
+ (overlay-put mumamo-old-tail 'mumamo-is-new nil)
+ (when nil ;; For debugging
+ (overlay-put mumamo-old-tail
+ 'face
+ (list :background
+ (format "red%d" (overlay-get mumamo-old-tail 'mumamo-depth)))))
+ (setq mumamo-last-chunk
+ (overlay-get mumamo-last-chunk 'mumamo-prev-chunk)))))
+
+(defun mumamo-delete-empty-chunks-at-end ()
+ ;; fix-me: later? Delete empty chunks at end, will be recreated if really needed
+ (let ((while-n1 0))
+ (while (and (mumamo-while 500 'while-n1 "mumamo-last-chunk del empty chunks")
+ mumamo-last-chunk
+ ;;(= (point-max) (overlay-end mumamo-last-chunk))
+ (= (overlay-end mumamo-last-chunk) (overlay-start mumamo-last-chunk)))
+ ;;(msgtrc "delete-overlay at end")
+ (delete-overlay mumamo-last-chunk)
+ (setq mumamo-last-chunk (overlay-get mumamo-last-chunk 'mumamo-prev-chunk))
+ (when mumamo-last-chunk (overlay-put mumamo-last-chunk 'mumamo-next-chunk nil)))))
+
+
+(defun mumamo-delete-chunks-upto (ok-pos)
+ "Delete old chunks upto OK-POS."
+ (or (not mumamo-old-tail)
+ (overlay-buffer mumamo-old-tail)
+ (setq mumamo-old-tail nil))
+ (let ((while-n2 0))
+ (while (and (mumamo-while 500 'while-n2 "mumamo-old-tail")
+ (and mumamo-old-tail (< (overlay-start mumamo-old-tail) ok-pos)))
+ (mumamo-mark-for-refontification (overlay-start mumamo-old-tail) (overlay-end mumamo-old-tail))
+ ;;(msgtrc "find-chunks:ok-pos=%s, not eq delete %s" ok-pos mumamo-old-tail)
+ (delete-overlay mumamo-old-tail)
+ (setq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk))
+ (or (not mumamo-old-tail)
+ (overlay-buffer mumamo-old-tail)
+ (setq mumamo-old-tail nil)))))
+
+(defun mumamo-reuse-old-tail-head ()
+ ;;(msgtrc "reusing %S" mumamo-old-tail)
+ (setq mumamo-last-chunk mumamo-old-tail)
+ (overlay-put mumamo-last-chunk 'mumamo-is-new t)
+ (mumamo-clear-chunk-ppss-cache mumamo-last-chunk)
+ (overlay-put mumamo-last-chunk 'face (mumamo-background-color (overlay-get mumamo-last-chunk 'mumamo-depth)))
+ (setq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk)))
+
+(defun mumamo-old-tail-fits (this-new-values)
+ (and mumamo-old-tail
+ (overlay-buffer mumamo-old-tail)
+ (mumamo-new-chunk-equal-chunk-values mumamo-old-tail this-new-values)))
+
+(defun mumamo-find-chunks-1 (end tracer) ;; min max)
+ ;; Note: This code must probably be reentrant. The globals changed
+ ;; here are `mumamo-last-chunk' and `mumamo-old-tail'. They must be
+ ;; handled as a pair.
+ (mumamo-msgfntfy "")
+ (setq mumamo-find-chunks-level (1+ mumamo-find-chunks-level))
+ (unless (and (overlayp mumamo-last-chunk) (overlay-buffer mumamo-last-chunk)) (setq mumamo-last-chunk nil))
+ (save-restriction
+ (widen)
+ (let* ((mumamo-find-chunks-1-active t)
+ (here (point))
+ ;; Any changes?
+ (change-min (car mumamo-last-change-pos))
+ (change-max (cdr mumamo-last-change-pos))
+ (chunk-at-change-min (when change-min (mumamo-get-existing-new-chunk-at change-min nil)))
+ (chunk-at-change-min-start (when chunk-at-change-min (overlay-start chunk-at-change-min)))
+ ;; Check if change is near border
+ (this-syntax-min-max
+ (when chunk-at-change-min
+ (mumamo-update-obscure chunk-at-change-min chunk-at-change-min-start)
+ (mumamo-chunk-syntax-min-max chunk-at-change-min nil)))
+ (this-syntax-min (car this-syntax-min-max))
+ (in-min-border (when this-syntax-min (>= this-syntax-min change-min)))
+ (first-check-from (if chunk-at-change-min
+ (if (or in-min-border
+ ;; Fix-me: 20?
+ (> 20 (- change-min chunk-at-change-min-start)))
+ (max 1
+ (- chunk-at-change-min-start 1))
+ chunk-at-change-min-start)
+ (when change-min
+ (goto-char change-min)
+ (skip-chars-backward "^\n")
+ (unless (bobp) (backward-char))
+ (prog1 (point) (goto-char here))))))
+ (when (and chunk-at-change-min (= 0 (- (overlay-end chunk-at-change-min)
+ (overlay-start chunk-at-change-min))))
+ (assert in-min-border)) ;; 0 len must be in border
+ (setq mumamo-last-change-pos nil)
+ (when chunk-at-change-min
+ (mumamo-move-to-old-tail first-check-from)
+ (mumamo-delete-empty-chunks-at-end))
+ ;; Now mumamo-last-chunk is the last in the top chain and
+ ;; mumamo-old-tail the first in the bottom chain.
+
+ (let* (
+ ;;(last-chunk-is-closed (when mumamo-last-chunk (overlay-get mumamo-last-chunk 'mumamo-is-closed)))
+ (last-chunk-is-closed t)
+ (ok-pos (or (and mumamo-last-chunk
+ (- (overlay-end mumamo-last-chunk)
+ ;;(or (and last-chunk-is-closed 1)
+ (or (and (/= (overlay-end mumamo-last-chunk)
+ (1+ (buffer-size)))
+ 1)
+ 0)))
+ 0))
+ (end-param end)
+ (end (or end (point-max)))
+ this-new-values
+ this-new-chunk
+ prev-chunk
+ first-change-pos
+ interrupted
+ (while-n3 0))
+ (when (>= ok-pos end)
+ (setq this-new-chunk (mumamo-get-existing-new-chunk-at end nil))
+ (unless this-new-chunk
+ (error "Could not find new chunk ok-pos-new=%s > end=%s (ovls at end=%s), level=%d, old-tail=%s, %S"
+ ok-pos end (overlays-in end end)
+ mumamo-find-chunks-level mumamo-old-tail tracer)))
+ (unless this-new-chunk
+ (save-match-data
+ (unless mumamo-find-chunk-is-active
+ ;;(setq mumamo-find-chunk-is-active t)
+ (mumamo-stop-find-chunks-timer)
+ (mumamo-save-buffer-state nil
+ (progn
+
+ ;; Loop forward until end or buffer end ...
+ (while (and (mumamo-while 1500 'while-n3 "until end")
+ (or (not end)
+ (<= ok-pos end))
+ ;;(prog1 t (msgtrc "ok-pos=%s in while" ok-pos))
+ (< ok-pos (point-max))
+ (not (setq interrupted (and (not end)
+ (input-pending-p)))))
+ ;; Narrow to speed up. However the chunk divider may be
+ ;; before ok-pos here. Assume that the marker is not
+ ;; longer than 200 chars. fix-me.
+ (narrow-to-region (max (- ok-pos 200) 1)
+ (1+ (buffer-size)))
+ ;; If this was after a change within one chunk then tell that:
+ (let ((use-change-max (when (and change-max
+ chunk-at-change-min
+ (overlay-buffer chunk-at-change-min)
+ (< change-max
+ (overlay-end chunk-at-change-min))
+ (or (not mumamo-last-chunk)
+ (> change-max (overlay-end mumamo-last-chunk))))
+ change-max))
+ (use-chunk-at-change-min (when (or (not mumamo-last-chunk)
+ (not (overlay-buffer mumamo-last-chunk))
+ (not chunk-at-change-min)
+ (not (overlay-buffer chunk-at-change-min))
+ (> (overlay-end chunk-at-change-min)
+ (overlay-end mumamo-last-chunk)))
+ chunk-at-change-min
+ )))
+ (setq this-new-values (mumamo-find-next-chunk-values
+ mumamo-last-chunk
+ first-check-from
+ use-change-max
+ use-chunk-at-change-min)))
+ (if (not this-new-values)
+ (setq ok-pos (point-max))
+ (setq first-check-from nil)
+ (setq ok-pos (or (mumamo-new-chunk-value-max this-new-values) ;;(overlay-end this-chunk)
+ (point-max)))
+ ;;(msgtrc "ok-pos=%s, point-max=%s max=%s" ok-pos (point-max) (mumamo-new-chunk-value-max this-new-values))
+ ;; With the new organization all chunks are created here.
+ (if (mumamo-old-tail-fits this-new-values)
+ (mumamo-reuse-old-tail-head)
+ (mumamo-delete-chunks-upto ok-pos)
+ ;; Create chunk and chunk links
+ (setq mumamo-last-chunk (mumamo-new-create-chunk this-new-values))
+ ;;(setq last-chunk-is-closed (overlay-get mumamo-last-chunk 'mumamo-is-closed))
+ (unless first-change-pos
+ (setq first-change-pos (mumamo-new-chunk-value-min this-new-values))))))
+ (setq this-new-chunk mumamo-last-chunk)))
+ (widen)
+ (when (or interrupted
+ (and mumamo-last-chunk
+ (overlayp mumamo-last-chunk)
+ (overlay-buffer mumamo-last-chunk)
+ (buffer-live-p (overlay-buffer mumamo-last-chunk))
+ (< (overlay-end mumamo-last-chunk) (point-max))))
+ (mumamo-start-find-chunks-timer)
+ )
+ (when first-change-pos
+ (setq jit-lock-context-unfontify-pos
+ (if jit-lock-context-unfontify-pos
+ (min jit-lock-context-unfontify-pos first-change-pos)
+ first-change-pos))))
+ (goto-char here)
+ (setq mumamo-find-chunk-is-active nil)))
+
+ ;; fix-me: continue here
+ (when chunk-at-change-min (mumamo-clear-chunk-ppss-cache chunk-at-change-min))
+ (setq mumamo-find-chunks-level (1- mumamo-find-chunks-level))
+ ;; Avoid empty overlays at the end of the buffer. Those can
+ ;; come from for example deleting to the end of the buffer.
+ (when this-new-chunk
+ ;; Fix-me: can this happen now?
+ (setq prev-chunk (overlay-get this-new-chunk 'mumamo-prev-chunk))
+ (when (and prev-chunk
+ (overlay-buffer prev-chunk)
+ (= (overlay-start this-new-chunk) (overlay-end this-new-chunk))
+ (= (overlay-start prev-chunk) (overlay-end prev-chunk)))
+ (overlay-put prev-chunk 'mumamo-next-chunk nil)
+ (overlay-put prev-chunk 'mumamo-prev-chunk nil)
+ ;;(msgtrc "find-chunks:deleting this-new-chunk %s" this-new-chunk)
+ (delete-overlay this-new-chunk)
+ (setq this-new-chunk prev-chunk)
+ )
+ (while (and mumamo-old-tail
+ (overlay-buffer mumamo-old-tail)
+ (= (overlay-start mumamo-old-tail) (overlay-end mumamo-old-tail)))
+ (assert (not (eq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk))) t)
+ (setq prev-chunk mumamo-old-tail)
+ (setq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk))
+ ;;(msgtrc "mumamo-find-chunks-1:after mumamo-old-tail=%s" mumamo-old-tail)
+ (delete-overlay prev-chunk)
+ )
+ )
+ ;;(unless (overlay-get mumamo-last-chunk 'mumamo-is-closed)
+ (unless t ;(= (overlay-end mumamo-last-chunk) (save-restriction (widen) (point-max)))
+ ;; Check that there are no left-over old chunks
+ (save-restriction
+ (widen)
+ (dolist (o (overlays-in (point-min) (point-max)))
+ (when (and (overlay-get o 'mumamo-depth)
+ (not (overlay-get o 'mumamo-is-new)))
+ (error "mumamo-find-chunks: left over chunk: %s end=%s, last-chunk=%s" o end mumamo-last-chunk)))))
+ (when end-param
+ ;;(msgtrc "find-chunks:Exit.end-param=%s, this-new-chunk=%s, point-max=%s, last=%s" end-param this-new-chunk (point-max) mumamo-last-chunk)
+ (let* ((ret this-new-chunk)
+ (ret-beg (overlay-start ret))
+ (ret-end (overlay-end ret)))
+ (unless (and (<= ret-beg end-param)
+ (<= end-param ret-end))
+ (error "mumamo-find-chunks: Bad ret=%s, end=%s" ret end-param))
+ ;;(msgtrc "find-chunks=>%S" ret)
+ ret))))))
+
+(defun mumamo-find-chunk-after-change (min max)
+ "Save change position after a buffer change.
+This should be run after a buffer change. For MIN see
+`after-change-functions'."
+ ;; Fix-me: Maybe use a list of all min, max instead?
+ (mumamo-start-find-chunks-timer)
+ ;;(msgtrc "(mumamo-find-chunk-after-change %s %s)" min max)
+ (setq min (copy-marker min nil))
+ (setq max (copy-marker max t))
+ (setq mumamo-last-change-pos
+ (if mumamo-last-change-pos
+ (let* ((old-min (car mumamo-last-change-pos))
+ (old-max (cdr mumamo-last-change-pos))
+ (new-min (min min old-min))
+ (new-max (max max old-max)))
+ (cons new-min new-max))
+ (cons min max))))
+
+(defun mumamo-after-change (min max old-len)
+ "Everything that needs to be done in mumamo after a change.
+This is run in the `after-change-functions' hook. For MIN, MAX
+and OLD-LEN see that variable."
+ ;;(msgtrc "mumamo-after-change BEGIN min/max/old-len=%s/%s/%s" min max old-len)
+ ;;(msgtrc "mumamo-after-change BEGIN")
+ (mumamo-find-chunk-after-change min max)
+ (mumamo-jit-lock-after-change min max old-len)
+ (mumamo-msgfntfy "mumamo-after-change EXIT")
+ ;;(msgtrc "mumamo-after-change EXIT mumamo-last-change-pos=%s" mumamo-last-change-pos)
+ )
+
+(defun mumamo-jit-lock-after-change (min max old-len)
+ ;; Fix-me: Should not this be on
+ ;; jit-lock-after-change-externd-region-functions??
+ "Replacement for `jit-lock-after-change'.
+Does the nearly the same thing as that function, but takes
+care of that there might be different major modes at MIN and MAX.
+It also marks for refontification only in the current mumamo chunk.
+
+OLD-LEN is the pre-change length.
+
+Jit-lock after change functions is organized this way:
+
+`jit-lock-after-change' (doc: Mark the rest of the buffer as not
+fontified after a change) is added locally to the hook
+`after-change-functions'. This function runs
+`jit-lock-after-change-extend-region-functions'."
+ (when (and jit-lock-mode (not memory-full))
+ (mumamo-msgfntfy "mumamo-jit-lock-after-change ENTER %s %s %s" min max old-len)
+ ;; Why is this nil?:
+ (mumamo-msgfntfy " mumamo-jit-lock-after-change: font-lock-extend-after-change-region-function=%s" font-lock-extend-after-change-region-function)
+ (let* ((ovl-min (mumamo-get-existing-new-chunk-at min nil))
+ (ovl-max (when (or (not ovl-min)
+ (< (overlay-end ovl-min) max))
+ (mumamo-get-existing-new-chunk-at max nil)))
+ (major-min (when ovl-min (mumamo-chunk-major-mode ovl-min)))
+ (major-max (when ovl-max (mumamo-chunk-major-mode ovl-max)))
+ (r-min nil)
+ (r-max nil)
+ (new-min min)
+ (new-max max))
+ (if (and major-min (eq major-min major-max))
+ (setq r-min
+ (when major-min
+ (mumamo-jit-lock-after-change-1 min max old-len major-min)))
+ (setq r-min
+ (when major-min
+ (mumamo-jit-lock-after-change-1 min max old-len major-min)))
+ (setq r-max
+ (when major-max
+ (mumamo-jit-lock-after-change-1 min max old-len major-max))))
+ (mumamo-msgfntfy "mumamo-jit-lock-after-change r-min,max=%s,%s major-min,max=%s,%s" r-min r-max major-min major-max)
+ (when r-min
+ (setq new-min (min new-min (car r-min)))
+ (setq new-max (max new-max (cdr r-min))))
+ (when r-max
+ (setq new-min (min new-min (car r-max)))
+ (setq new-max (max new-max (cdr r-max))))
+ (setq new-min (max new-min (point-min)))
+ (setq new-max (min new-max (point-max)))
+ ;; Make sure we change at least one char (in case of deletions).
+ (setq new-max (min (max new-max (1+ new-min)) (point-max)))
+ (mumamo-msgfntfy "mumamo-jit-lock-after-change new-min,max=%s,%s" new-min new-max)
+ (mumamo-mark-for-refontification new-min new-max)
+
+ ;; Mark the change for deferred contextual refontification.
+ ;;(setq jit-lock-context-unfontify-pos nil) (setq message-log-max t)
+ (when jit-lock-context-unfontify-pos
+ (setq jit-lock-context-unfontify-pos
+ ;; Here we use `start' because nothing guarantees that the
+ ;; text between start and end will be otherwise refontified:
+ ;; usually it will be refontified by virtue of being
+ ;; displayed, but if it's outside of any displayed area in the
+ ;; buffer, only jit-lock-context-* will re-fontify it.
+ (min jit-lock-context-unfontify-pos new-min))
+ ;;(with-current-buffer (get-buffer "*Messages*") (erase-buffer))
+ (mumamo-msgfntfy "mumamo-jit-lock-after-change EXIT unfontify-pos=%s" jit-lock-context-unfontify-pos)
+ ;;(message "mumamo-jit-lock-after-change.unfontify-pos=%s" jit-lock-context-unfontify-pos)
+ ))))
+;;(min jit-lock-context-unfontify-pos jit-lock-start))))))
+;;(put 'mumamo-jit-lock-after-change 'permanent-local-hook t)
+(put 'mumamo-after-change 'permanent-local-hook t)
+
+(defun mumamo-jit-lock-after-change-1 (min max old-len major)
+ "Extend the region the same way jit-lock does it.
+This function tries to extend the region between MIN and MAX the
+same way jit-lock does it after a change. OLD-LEN is the
+pre-change length.
+
+The extending of the region is done as if MAJOR was the major
+mode."
+ (mumamo-with-major-mode-fontification major
+ `(progn
+ (let ((jit-lock-start ,min)
+ (jit-lock-end ,max))
+ ;;(mumamo-msgfntfy "mumamo-mumamo-jit-lock-after-change-1 jlacer=%s" ,jit-lock-after-change-extend-region-functions)
+ (mumamo-with-buffer-prepared-for-jit-lock
+ ;;(font-lock-extend-jit-lock-region-after-change ,min ,max ,old-len)
+ (run-hook-with-args 'jit-lock-after-change-extend-region-functions min max old-len)
+ ;;(setq jit-lock-end (min (max jit-lock-end (1+ min)) (point-max)))
+
+;;; ;; Just run the buffer local function:
+;;; (dolist (extend-fun jit-lock-after-change-extend-region-functions)
+;;; (when (fboundp extend-fun)
+;;; (funcall extend-fun ,min ,max ,old-len)))
+ )
+ (setq min jit-lock-start)
+ (setq max jit-lock-end)
+ ;;(syntax-ppss-flush-cache min)
+ )))
+ (mumamo-msgfntfy "mumamo-mumamo-jit-lock-after-change-1 EXIT %s" (cons min max))
+ (cons min max))
+
+(defun mumamo-mark-chunk ()
+ "Mark chunk and move point to beginning of chunk."
+ (interactive)
+ (let ((chunk (mumamo-find-chunks (point) "mumamo-mark-chunk")))
+ (unless chunk (error "There is no MuMaMo chunk here"))
+ (goto-char (overlay-start chunk))
+ (push-mark (overlay-end chunk) t t)))
+
+(defun mumamo-narrow-to-chunk-inner ()
+ (interactive)
+ (let* ((chunk (mumamo-find-chunks (point) "mumamo-narrow-to-chunk-innner"))
+ (syntax-min-max (mumamo-chunk-syntax-min-max chunk t))
+ (syntax-min (car syntax-min-max))
+ (syntax-max (cdr syntax-min-max)))
+ (narrow-to-region syntax-min syntax-max)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Font lock functions
+
+(defadvice hi-lock-set-pattern (around use-overlays activate)
+ (if mumamo-multi-major-mode
+ (let ((font-lock-fontified nil))
+ ad-do-it)
+ ad-do-it))
+
+;;;###autoload
+(defun mumamo-mark-for-refontification (min max)
+ "Mark region between MIN and MAX for refontification."
+ ;;(msgtrc "mark-for-refontification A min,max=%s,%s point-min,max=%s,%s modified=%s" min max (point-min) (point-max) (buffer-modified-p) )
+ ;;(mumamo-backtrace "mark-for-refontification")
+ (mumamo-msgfntfy "mumamo-mark-for-refontification A min,max=%s,%s point-min,max=%s,%s modified=%s" min max (point-min) (point-max) (buffer-modified-p) )
+ (assert (<= min max))
+ (when (< min max)
+ (save-restriction
+ (widen)
+ (mumamo-msgfntfy "mumamo-mark-for-refontification B min,max=%s,%s point-min,max=%s,%s modified=%s" min max (point-min) (point-max) (buffer-modified-p) )
+ ;;(mumamo-with-buffer-prepared-for-jit-lock
+ (mumamo-save-buffer-state nil
+ (put-text-property min max 'fontified nil)
+ ))))
+
+
+;; Fix me: The functions in this list must be replaced by variables
+;; pointing to anonymous functions for buffer local values of
+;; fontification keywords to be supported. And that is of course
+;; necessary for things like hi-lock etc. (Or..., perhaps some kind of
+;; with-variable-values... as RMS suggested once... but that will not
+;; help here...)
+;;
+;; Seems like font-lock-add-keywords must be advised...
+(defvar mumamo-internal-major-modes-alist nil
+ "Alist with info for different major modes.
+Internal use only. This is automatically set up by
+`mumamo-get-major-mode-setup'.")
+(setq mumamo-internal-major-modes-alist nil)
+(put 'mumamo-internal-major-modes-alist 'permanent-local t)
+
+(defvar mumamo-ppss-last-chunk nil
+ "Internal variable used to avoid unnecessary flushing.")
+(defvar mumamo-ppss-last-major nil
+ "Internal variable used to avoid unnecessary flushing.")
+
+;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'fontification)
+;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'indentation)
+;;(mumamo-get-major-mode-substitute 'css-mode 'fontification)
+;;(mumamo-get-major-mode-substitute 'css-mode 'indentation)
+;; (assq 'nxml-mode mumamo-major-mode-substitute)
+(defconst mumamo-major-mode-substitute
+ '(
+ (nxhtml-mode (html-mode nxhtml-mode))
+ ;;(nxhtml-mode (html-mode))
+ (nxhtml-genshi-mode (html-mode nxhtml-mode))
+ (nxhtml-mjt-mode (html-mode nxhtml-mode))
+ (nxml-mode (sgml-mode))
+ )
+ "Major modes substitute to use for fontification and indentation.
+The entries in this list has either of the formats
+
+ \(MAJOR (FONT-MODE INDENT-MODE))
+ \(MAJOR (FONT-MODE))
+
+where major is the major mode in a mumamo chunk and FONT-MODE is
+the major mode for fontification of that chunk and INDENT-MODE is
+dito for indentation. In the second form the same mode is used
+for indentation as for fontification.")
+
+;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'indentation)
+;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'fontification)
+(defun mumamo-get-major-mode-substitute (major for-what)
+ "For major mode MAJOR return major mode to use for FOR-WHAT.
+FOR-WHAT can be either 'fontification or indentation.
+
+mumamo must handle fontification and indentation for `major-mode'
+by using other major mode if the functions for this in
+`major-mode' are not compatible with mumamo. This functions
+looks in the table `mumamo-major-mode-substitute' for get major
+mode to use."
+ ;;(when (eq for-what 'indentation) (message "subst.major=%s" major))
+ (let ((m (assq major mumamo-major-mode-substitute))
+ ret-major)
+ (if (not m)
+ (setq ret-major major)
+ (setq m (nth 1 m))
+ (setq ret-major
+ (cond
+ ((eq for-what 'fontification)
+ (nth 0 m))
+ ((eq for-what 'indentation)
+ (nth 1 m))
+ (t
+ (mumamo-display-error 'mumamo-get-major-mode-substitute
+ "Bad parameter, for-what=%s" for-what))))
+ (unless ret-major (setq ret-major major)))
+ (unless (commandp ret-major) (setq ret-major 'mumamo-bad-mode))
+ ;;(when (eq for-what 'indentation) (message "ret.ind=%s, major=%s, m=%s" ret major m))
+ ret-major))
+
+(defun mumamo-assert-fontified-t (start end)
+ "Assert that the region START to END has 'fontified t."
+ (let ((start-ok (get-text-property start 'fontified))
+ (first-not-ok
+ (next-single-property-change (1+ start) 'fontified nil end)))
+ (when (not start-ok)
+ (message "==== mumamo-assert-fontified-t %s-%s start not ok" start end))
+ (when (not (= first-not-ok end))
+ (message "==== mumamo-assert-fontified-t %s-%s first not ok=%s" start end first-not-ok))))
+
+;; Keep this separate for easier debugging.
+(defun mumamo-do-fontify (start end verbose chunk-syntax-min chunk-syntax-max chunk-major)
+ "Fontify region between START and END.
+If VERBOSE is non-nil then print status messages during
+fontification.
+
+CHUNK-SYNTAX-MIN, CHUNK-SYNTAX-MAX and CHUNK-MAJOR are the
+chunk's min point, max point and major mode.
+
+During fontification narrow the buffer to the chunk to make
+syntactic fontification work. If chunks starts or end with \"
+then the first respective last char then exclude those chars from
+from the narrowed part, since otherwise the syntactic
+fontification can't find out where strings start and stop.
+
+Note that this function is run under
+`mumamo-with-major-mode-fontification'.
+
+This function takes care of `font-lock-dont-widen' and
+`font-lock-extend-region-functions'. Normally
+`font-lock-default-fontify-region' does this, but that function
+is not called when mumamo is used!
+
+PS: `font-lock-fontify-syntactically-region' is the main function
+that does syntactic fontification."
+ ;;(msgtrc "mumamo-do-fontify enter: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ ;;(msgtrc "mumamo-do-fontify <<<<<<< %s %s %s %s %s %s" start end verbose chunk-syntax-min chunk-syntax-max chunk-major)
+ ;;(msgtrc "font-lock-keywords=%S" font-lock-keywords)
+ ;;(mumamo-assert-fontified-t start end)
+ (mumamo-condition-case err
+ (let* ((font-lock-dont-widen t)
+ (font-lock-extend-region-functions
+ ;; nil
+ font-lock-extend-region-functions
+ )
+ ;; Extend like in `font-lock-default-fontify-region':
+ (funs font-lock-extend-region-functions)
+ (font-lock-beg (max chunk-syntax-min start))
+ (font-lock-end (min chunk-syntax-max end))
+ (while-n1 0))
+ ;;(while (and (> 500 (setq while-n1 (1+ while-n1)))
+ (while (and (mumamo-while 500 'while-n1 "funs")
+ funs)
+ (setq funs (if (or (not (funcall (car funs)))
+ (eq funs font-lock-extend-region-functions))
+ (cdr funs)
+ ;; If there's been a change, we should go through
+ ;; the list again since this new position may
+ ;; warrant a different answer from one of the fun
+ ;; we've already seen.
+ font-lock-extend-region-functions)))
+ ;; But we must restrict to the chunk here:
+ (let ((new-start (max chunk-syntax-min font-lock-beg))
+ (new-end (min chunk-syntax-max font-lock-end)))
+ ;;(msgtrc "do-fontify %s %s, chunk-syntax-min,max=%s,%s, new: %s %s" start end chunk-syntax-min chunk-syntax-max new-start new-end)
+ ;; A new condition-case just to catch errors easier:
+ (when (< new-start new-end)
+ (mumamo-condition-case err
+ (save-restriction
+ ;;(when (and (>= 625 (point-min)) (<= 625 (point-max))) (msgtrc "multi at 625=%s" (get-text-property 625 'font-lock-multiline)))
+ ;;(msgtrc "(narrow-to-region %s %s)" chunk-syntax-min chunk-syntax-max)
+ (when (< chunk-syntax-min chunk-syntax-max)
+ (narrow-to-region chunk-syntax-min chunk-syntax-max)
+ ;; Now call font-lock-fontify-region again but now
+ ;; with the chunk font lock parameters:
+ (setq font-lock-syntactically-fontified (1- new-start))
+ (mumamo-msgfntfy "ENTER font-lock-fontify-region %s %s %s" new-start new-end verbose)
+ ;;(msgtrc "mumamo-do-fontify: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
+ (let (font-lock-extend-region-functions)
+ (font-lock-fontify-region new-start new-end verbose))
+ (mumamo-msgfntfy "END font-lock-fontify-region %s %s %s" new-start new-end verbose)
+ )
+ )
+ (error
+ (mumamo-display-error 'mumamo-do-fontify-2
+ "mumamo-do-fontify m=%s, s/e=%s/%s syn-min/max=%s/%s: %s"
+ chunk-major
+ start end
+ chunk-syntax-min chunk-syntax-max
+ (error-message-string err)))))))
+ (error
+ (mumamo-display-error 'mumamo-do-fontify
+ "mumamo-do-fontify m=%s, s=%s, e=%s: %s"
+ chunk-major start end (error-message-string err)))
+ )
+ (mumamo-msgfntfy "mumamo-do-fontify exit >>>>>>> %s %s %s %s %s %s" start end verbose chunk-syntax-min chunk-syntax-max chunk-major)
+ ;;(msgtrc "mumamo-do-fontify exit: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ )
+
+(defun mumamo-do-unfontify (start end)
+ "Unfontify region between START and END."
+ (mumamo-condition-case err
+ (font-lock-unfontify-region start end)
+ (error
+ (mumamo-display-error 'mumamo-do-unfontify "%s"
+ (error-message-string err)))))
+
+(defun mumamo-fontify-region-with (start end verbose major chunk-syntax-min chunk-syntax-max)
+ "Fontify from START to END.
+If VERBOSE is non-nil then print status messages during
+fontification.
+
+Do the fontification as in major mode MAJOR.
+
+Narrow to region CHUNK-SYNTAX-MIN and CHUNK-SYNTAX-MAX during
+fontification."
+ ;; The text property 'fontified is always t here due to the way
+ ;; jit-lock works!
+
+ ;;(msgtrc "fontify-region-with %s %s %s %s, ff=%s" start end verbose major (get-text-property start 'fontified))
+ ;;(mumamo-assert-fontified-t start end)
+ ;;(msgtrc "mumamo-fontify-region-with enter: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ (mumamo-condition-case err
+ (progn
+ ;;(msgtrc "mumamo-fontify-region-with: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
+ (mumamo-with-major-mode-fontification major
+ `(mumamo-do-fontify ,start ,end ,verbose ,chunk-syntax-min ,chunk-syntax-max major))
+ )
+ (error
+ (mumamo-display-error 'mumamo-fontify-region-with "%s"
+ (error-message-string err))))
+ ;;(msgtrc "mumamo-fontify-region-with exit: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ )
+
+(defun mumamo-unfontify-region-with (start end major)
+ "Unfontify from START to END as in major mode MAJOR."
+ (mumamo-msgfntfy "mumamo-unfontify-region-with %s %s %s, ff=%s"
+ start
+ end
+ major
+ (when start
+ (save-restriction
+ (widen)
+ (get-text-property start 'fontified))))
+ (mumamo-with-major-mode-fontification major
+ `(mumamo-do-unfontify ,start ,end)))
+
+
+
+(defun mumamo-backtrace (label)
+ (msgtrc "%s:backtrace in START buffer %s <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n%s"
+ label (current-buffer) (with-output-to-string (backtrace)))
+ (msgtrc "%s:backtrace in END buffer %s >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" label (current-buffer)))
+
+(defun mumamo-unfontify-buffer ()
+ "Unfontify buffer.
+This function is called when the minor mode function
+`font-lock-mode' is turned off. \(It is the value of
+`font-lock-unfontify-uffer-function')."
+ (when (and mumamo-multi-major-mode
+ (not (and (boundp 'mumamo-find-chunks-1-active)
+ mumamo-find-chunks-1-active)))
+ ;;(mumamo-backtrace "unfontify-buffer")
+ ;;(msgtrc "mumamo-unfontify-buffer:\n%s" (with-output-to-string (backtrace)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((ovls (overlays-in (point-min) (point-max)))
+ (main-major (mumamo-main-major-mode)))
+ (dolist (o ovls)
+ (when (overlay-get o 'mumamo-is-new)
+ (let ((major (mumamo-chunk-major-mode o)))
+ (when major
+ (unless (mumamo-fun-eq major main-major)
+ (mumamo-unfontify-chunk o))
+ ;;(msgtrc "delete-overlay 1")
+ (delete-overlay o)
+ ))))
+ (mumamo-unfontify-region-with (point-min) (point-max)
+ (mumamo-main-major-mode)))))))
+
+
+(defun mumamo-fontify-buffer ()
+ "For `font-lock-fontify-buffer-function' call.
+Not sure when this normally is done. However some functions call
+this to ensure that the whole buffer is fontified."
+ (mumamo-msgfntfy "===> mumamo-fontify-buffer-function called")
+ ;;(font-lock-default-fontify-buffer)
+ (unless mumamo-set-major-running
+ ;; This function is normally not called, but when new patterns
+ ;; have been added by hi-lock it will be called. In this case we
+ ;; need to make buffer local fontification variables:
+ (set (make-local-variable 'mumamo-internal-major-modes-alist) nil)
+ (jit-lock-refontify)))
+
+
+(defun mumamo-unfontify-chunk (chunk) ; &optional start end)
+ "Unfontify mumamo chunk CHUNK."
+ (let* ((major (mumamo-chunk-major-mode chunk))
+ ;;(start (overlay-start chunk))
+ ;;(end (overlay-end chunk))
+ (syntax-min-max (mumamo-chunk-syntax-min-max chunk t))
+ (syntax-min (car syntax-min-max))
+ (syntax-max (cdr syntax-min-max))
+ (font-lock-dont-widen t))
+ (when (< syntax-min syntax-max)
+ (save-restriction
+ (narrow-to-region syntax-min syntax-max)
+ (mumamo-unfontify-region-with syntax-min syntax-max major)))))
+
+(defun mumamo-fontify-region (start end &optional verbose)
+ "Fontify between START and END.
+Take the major mode chunks into account while doing this.
+
+If VERBOSE do the verbously.
+
+The value of `font-lock-fontify-region-function' when
+mumamo is used is this function."
+ (mumamo-msgfntfy "++++++ mumamo-fontify-regionX %s %s %s, skip=%s" start end verbose mumamo-just-changed-major)
+ ;;(msgtrc "mumamo-fontify-region: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
+ ;;(mumamo-assert-fontified-t start end)
+ ;; If someone else tries to fontify the buffer ...
+ (if (and mumamo-just-changed-major
+ ;; The above variable is reset in `post-command-hook' so
+ ;; check if we are in a recursive search. (Note: There are
+ ;; other situation when this can occur. It might be best to
+ ;; remove this test later, or make it optional.)
+ ;;
+ ;; skip the test for now:
+ nil
+ (= 0 (recursion-depth)))
+ (mumamo-display-error 'mumamo-fontify-region
+ "Just changed major, should not happen")
+ (mumamo-condition-case err
+ (mumamo-fontify-region-1 start end verbose)
+ (error
+ (mumamo-display-error 'mumamo-fontify-region "%s"
+ (error-message-string err))))))
+
+(defconst mumamo-dbg-pretend-fontified nil
+ "Set this to t to be able to debug more easily.
+This is for debugging `mumamo-fontify-region-1' more easily by
+just calling it. It will make that function believe that the text
+has a non-nil 'fontified property.")
+
+(defun mumamo-exc-mode (chunk)
+ "Return sub major mode for CHUNK.
+If chunk is a main major mode chunk return nil, otherwise return
+the major mode for the chunk."
+ (let ((major (mumamo-chunk-major-mode chunk)))
+ (unless (mumamo-fun-eq major (mumamo-main-major-mode))
+ major)))
+
+;;; Chunk in chunk needs push/pop relative prev chunk
+(defun mumamo-chunk-push (chunk prop val)
+ (let* ((prev-chunk (overlay-get chunk 'mumamo-prev-chunk))
+ (prev-val (when prev-chunk (overlay-get prev-chunk prop))))
+ (overlay-put chunk prop (cons val prev-val))))
+(defun mumamo-chunk-pop (chunk prop)
+ (overlay-put chunk prop (cdr (overlay-get (overlay-get chunk 'mumamo-prev-chunk)
+ prop))))
+
+;; (defvar mumamo-chunks-to-remove nil
+;; "Internal. Chunk overlays marked for removal.")
+;; (make-variable-buffer-local 'mumamo-chunks-to-remove)
+
+(defun mumamo-flush-chunk-syntax (chunk chunk-min chunk-max)
+ "Flush syntax cache for chunk CHUNK.
+This includes removing text property 'syntax-table between
+CHUNK-MIN and CHUNK-MAX."
+ ;; syntax-ppss-flush-cache
+ (overlay-put chunk 'syntax-ppss-last nil)
+ (overlay-put chunk 'syntax-ppss-cache nil)
+ (overlay-put chunk 'syntax-ppss-stats nil)
+ (mumamo-save-buffer-state nil
+ (remove-list-of-text-properties chunk-min chunk-max '(syntax-table))))
+
+;; Fix-me: If I open nxhtml-changes.html and then go to the bottom of
+;; the file at once syntax-ppss seems to be upset. It is however cured
+;; by doing some change above the region that is badly fontified.
+(defun mumamo-fontify-region-1 (start end verbose)
+ "Fontify region between START and END.
+If VERBOSE is non-nil then print status messages during
+fontification.
+
+This is called from `mumamo-fontify-region' which is the value of
+`font-lock-fontify-region-function' when mumamo is used. \(This
+means that it ties into the normal font lock framework in Emacs.)
+
+Note: The purpose of extracting this function from
+`mumamo-fontify-region' \(which is the only place where it is
+called) is to make debugging easier. Edebug will without this
+function just step over the `condition-case' in
+`mumamo-fontify-region'.
+
+The fontification is done in steps:
+
+- First a mumamo chunk is found or created at the start of the
+ region with `mumamo-get-chunk-at'.
+- Then this chunk is fontified according to the major mode for
+ that chunk.
+- If the chunk did not encompass the whole region then this
+ procedure is repeated with the rest of the region.
+
+If some mumamo chunk in the region between START and END has been
+marked for removal \(for example by `mumamo-jit-lock-after-change') then
+they are removed by this function.
+
+For some main major modes \(see `define-mumamo-multi-major-mode') the
+main major modes is first used to fontify the whole region. This
+is because otherwise the fontification routines for that mode may
+have trouble finding the correct starting state in a chunk.
+
+Special care has been taken for chunks that are strings, ie
+surrounded by \"...\" since they are fontified a bit special in
+most major modes."
+ ;; Fix-me: unfontifying should be done using the correct syntax table etc.
+ ;; Fix-me: refontify when new chunk
+ ;;(msgtrc "fontify-region-1: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
+ (save-match-data
+ (let* ((old-point (point))
+ (here start)
+ (main-major (mumamo-main-major-mode))
+ (fontified-t ;;(or mumamo-dbg-pretend-fontified
+ ;; (get-text-property here 'fontified))
+ t)
+ after-change-functions ;; Fix-me: tested adding this to avoid looping
+ (first-new-ovl nil)
+ (last-new-ovl nil)
+ (chunk-at-start-1 (mumamo-find-chunks start "mumamo-fontify-region-1"))
+ (while-n1 0)
+ )
+ (when chunk-at-start-1
+ (unless (= start (1- (overlay-end chunk-at-start-1)))
+ (setq chunk-at-start-1 nil)))
+ ;;(while (and (> 500 (setq while-n1 (1+ while-n1)))
+ (while (and (mumamo-while 9000 'while-n1 "fontified-t")
+ fontified-t
+ (< here end))
+ ;;(msgtrc "mumamo-fontify-region-1 heree 1, here=%s, end=%s" here end)
+ ;;(mumamo-assert-fontified-t here end)
+ ;;(mumamo-assert-fontified-t start end)
+ ;; Check where new chunks should be, adjust old chunks as
+ ;; necessary. Refontify inside end-start and outside of
+ ;; start-end mark for refontification when major-mode has
+ ;; changed or there was no old chunk.
+ ;;
+ ;; Fix-me: Join chunks!
+ (let* ((chunk (mumamo-find-chunks here "mumamo-fontify-region-1 2"))
+ (chunk-min (when chunk (overlay-start chunk)))
+ (chunk-max (when chunk (overlay-end chunk)))
+ (chunk-min-1 (when chunk (if (> chunk-min (point-min)) (1- chunk-min) (point-min))))
+ (chunk-max-1 (when chunk (if (< chunk-max (point-max)) (1+ chunk-max) (point-max))))
+ (chunk-min-face (when chunk (get-text-property chunk-min-1 'face)))
+ (chunk-max-face (when chunk (get-text-property chunk-max-1 'face)))
+ (chunk-major (when chunk (mumamo-chunk-major-mode chunk)))
+ max ; (min chunk-max end))
+ )
+ (assert chunk)
+
+ (setq chunk-min (when chunk (overlay-start chunk)))
+ (setq chunk-max (when chunk (overlay-end chunk)))
+ (setq chunk-min-1
+ (when chunk
+ (if (> chunk-min (point-min)) (1- chunk-min) (point-min)))) ;chunk-min
+ (setq chunk-max-1
+ (when chunk
+ (if (< chunk-max (point-max)) (1+ chunk-max) (point-max)))) ;chunk-max
+ (setq chunk-min-face
+ (when chunk (get-text-property chunk-min-1 'face)))
+ (setq chunk-max-face
+ (when chunk (get-text-property chunk-max-1 'face)))
+ (setq chunk-major (when chunk (mumamo-chunk-major-mode chunk)))
+
+ (if (and first-new-ovl (overlay-buffer first-new-ovl))
+ (setq last-new-ovl chunk)
+ (setq last-new-ovl chunk)
+ (setq first-new-ovl chunk))
+ ;;(mumamo-assert-fontified-t chunk-min chunk-max)
+
+ (setq max (min chunk-max end))
+
+ (assert chunk) (assert (overlay-buffer chunk)) (assert chunk-min)
+ (assert chunk-max) (assert chunk-major)
+ ;; Fix-me: The next assertion sometimes fails. Could it be
+ ;; that this loop is continuing even after a change in the
+ ;; buffer? How do I stop that? When?:
+ ;;(assert (or (= here start) (= here chunk-min)) nil "h=%s, s=%s, cm=%s-%s, e=%s, chunk-major=%s" here start chunk-min chunk-max end chunk-major)
+ ;;(assert (not (mumamo-fun-eq prev-major chunk-major)))
+ ;;(when prev-chunk
+ ;; (assert (= (overlay-end prev-chunk) (overlay-start chunk))))
+
+ ;; Fontify
+ ;;(msgtrc "\nmumamo-fontify-region-1 before chunk=%s" chunk)
+ (mumamo-update-obscure chunk here)
+ (let* ((syntax-min-max (mumamo-chunk-syntax-min-max chunk nil))
+ (syntax-min (car syntax-min-max))
+ (syntax-max (cdr syntax-min-max))
+ (chunk-min (overlay-start chunk))
+ (chunk-max (overlay-end chunk))
+ (border-min-max (mumamo-chunk-syntax-min-max chunk t))
+ (border-min (car border-min-max))
+ (border-max (cdr border-min-max))
+ )
+ ;;(msgtrc "fontify-region-1:syntax-min-max=%S, chunk=%S" syntax-min-max chunk)
+ ;;(msgtrc "chunk mumamo-border-face: %s" chunk)
+ (mumamo-msgfntfy "mumamo-fontify-region-1, here=%s chunk-min=%s syn-mn/mx=%s/%s" here chunk-min syntax-min syntax-max)
+ (when (<= here syntax-min)
+ (mumamo-flush-chunk-syntax chunk syntax-min syntax-max))
+ (when (and (<= here syntax-min)
+ (< chunk-min border-min))
+ ;;(msgtrc "face-in: %s-%s" chunk-min border-min)
+ (put-text-property chunk-min border-min 'face 'mumamo-border-face-in)
+ )
+ (when (and (<= chunk-max max)
+ ;;(< (1+ border-max) chunk-max))
+ (< border-max chunk-max))
+ ;;(put-text-property (1+ border-max) chunk-max
+ (put-text-property border-max chunk-max
+ 'face 'mumamo-border-face-out))
+ (mumamo-fontify-region-with here max verbose chunk-major
+ syntax-min syntax-max))
+
+ ;;(setq prev-major chunk-major)
+ ;;(setq prev-chunk chunk)
+ (setq here (if (= max here) (1+ max) max))
+ ;;(setq fontified-t (or mumamo-dbg-pretend-fontified (get-text-property (1- here) 'fontified)))
+ )
+ ;;(msgtrc "ft here end=%s %s %s" fontified-t here end)
+ )
+ (goto-char old-point)
+ ;;(msgtrc "b first-new-ovl=%s last-new-ovl=%s" first-new-ovl last-new-ovl)
+ (unless fontified-t
+ ;; Fix-me: I am not sure what to do here. Probably just
+ ;; refontify the rest between start and end. But does not
+ ;; this lead to unnecessary refontification?
+ ;;(msgtrc "not sure, here=%s, end=%s" here end)
+ (unless (= here (point-max))
+ (mumamo-mark-for-refontification here end)))
+ ))
+ ;;(msgtrc "EXIT mumamo-fontify-region-1")
+ )
+
+
+(defvar mumamo-known-buffer-local-fontifications
+ '(
+ font-lock-mode-hook
+ ;;
+ css-color-mode
+ hi-lock-mode
+ hi-lock-file-patterns
+ hi-lock-interactive-patterns
+ wrap-to-fill-column-mode
+ ))
+
+(defconst mumamo-irrelevant-buffer-local-vars
+ '(
+ ;; This list was fetched with
+ ;; emacs-Q, fundamental-mode
+ after-change-functions
+ ;;auto-composition-function
+ ;;auto-composition-mode
+ ;;auto-composition-mode-major-mode
+ buffer-auto-save-file-format
+ buffer-auto-save-file-name
+ buffer-backed-up
+ buffer-display-count
+ buffer-display-time
+ buffer-file-format
+ buffer-file-name
+ buffer-file-truename
+ buffer-invisibility-spec
+ buffer-read-only
+ buffer-saved-size
+ buffer-undo-list
+ change-major-mode-hook
+ ;;char-property-alias-alist
+ cursor-type
+ default-directory
+ delay-mode-hooks
+ enable-multibyte-characters
+ ;;font-lock-mode
+ ;;font-lock-mode-major-mode
+ ;;major-mode
+ mark-active
+ mark-ring
+ mode-name
+ point-before-scroll
+ ;; Handled by font lock etc
+ font-lock-defaults
+ font-lock-fontified
+ font-lock-keywords
+ ;;font-lock-keywords-only
+ font-lock-keywords-case-fold-search
+ font-lock-mode
+ ;;font-lock-mode-major-mode
+ font-lock-set-defaults
+ font-lock-syntax-table
+ font-lock-beginning-of-syntax-function
+ fontification-functions
+ jit-lock-context-unfontify-pos
+ jit-lock-mode
+ ;; Mumamo
+ font-lock-fontify-buffer-function
+ jit-lock-contextually
+ jit-lock-functions
+ ;; More symbols from visual inspection
+ before-change-functions
+ delayed-mode-hooks
+ isearch-mode
+ line-move-ignore-invisible
+ local-abbrev-table
+ ;;syntax-ppss-last
+ ;;syntax-ppss-cache
+
+ ;; Cua
+ cua--explicit-region-start
+ ;; Viper
+ viper--intercept-key-maps
+ viper--key-maps
+ viper-ALPHA-char-class
+ viper-current-state
+ viper-emacs-global-user-minor-mode
+ viper-emacs-intercept-minor-mode
+ viper-emacs-kbd-minor-mode
+ viper-emacs-local-user-minor-mode
+ viper-emacs-state-modifier-minor-mode
+ viper-insert-basic-minor-mode
+ viper-insert-diehard-minor-mode
+ viper-insert-global-user-minor-mode
+ viper-insert-intercept-minor-mode
+ viper-insert-kbd-minor-mode
+ viper-insert-local-user-minor-mode
+ viper-insert-minibuffer-minor-mode
+ viper-insert-point
+ viper-insert-state-modifier-minor-mode
+ viper-intermediate-command
+ viper-last-posn-while-in-insert-state
+ viper-minibuffer-current-face
+ viper-mode-string
+ viper-non-word-characters
+ viper-replace-minor-mode
+ viper-replace-overlay
+ viper-undo-functions
+ viper-undo-needs-adjustment
+ viper-vi-basic-minor-mode
+ viper-vi-diehard-minor-mode
+ viper-vi-global-user-minor-mode
+ viper-vi-intercept-minor-mode
+ viper-vi-kbd-minor-mode
+ viper-vi-local-user-minor-mode
+ viper-vi-minibuffer-minor-mode
+ viper-vi-state-modifier-minor-mode
+ ;; hs minor mode
+ hs-adjust-block-beginning
+ hs-block-start-mdata-select
+ hs-block-start-regexp
+ hs-c-start-regexp
+ hs-forward-sexp-func
+ hs-minor-mode
+ ;; Imenu
+ imenu-case-fold-search
+ imenu-generic-expression
+ ;; Fix-me: add more here
+ ))
+
+(defun mumamo-get-relevant-buffer-local-vars ()
+ "Get list of buffer local variables to save.
+Like `buffer-local-variables', but remove variables that are
+known to not be necessary to save for fontification, indentation
+or filling \(or that can even disturb things)."
+ (let (var-vals)
+ (dolist (vv (buffer-local-variables))
+ (unless (or (not (listp vv))
+ (memq (car vv) mumamo-irrelevant-buffer-local-vars)
+ (let* ((sym (car vv))
+ (val (symbol-value sym)))
+ (or (markerp val)
+ (overlayp val))))
+ (let ((ent (list (car vv) (custom-quote (cdr vv)))))
+ (setq var-vals (cons ent var-vals)))))
+ ;; Sorting is for debugging/testing
+ (setq var-vals (sort var-vals
+ (lambda (a b)
+ (string< (symbol-name (car a))
+ (symbol-name (car b))))))
+ var-vals))
+
+(defvar mumamo-major-modes-local-maps nil
+ "An alist with major mode and local map.
+An entry in the list looks like
+
+ \(MAJOR-MODE LOCAL-KEYMAP)")
+
+;; (defun mumamo-font-lock-keyword-hook-symbol (major)
+;; "Return hook symbol for adding font-lock keywords to MAJOR."
+;; (intern (concat "mumamo-" (symbol-name major) "-font-lock-keyword-hook")))
+
+;; (defun mumamo-remove-font-lock-hook (major setup-fun)
+;; "For mode MAJOR remove function SETUP-FUN.
+;; See `mumamo-add-font-lock-hook' for more information."
+;; (remove-hook (mumamo-font-lock-keyword-hook-symbol major) setup-fun))
+
+(defun mumamo-refresh-multi-font-lock (major)
+ "Refresh font lock information for mode MAJOR in chunks.
+If multi fontification functions for major mode MAJOR is already
+setup up they will be refreshed.
+
+If MAJOR is nil then all font lock information for major modes
+used in chunks will be refreshed.
+
+After calling font-lock-add-keywords or changing the
+fontification in other ways you must call this function for the
+changes to take effect. However already fontified buffers will
+not be refontified. You can use `normal-mode' to refontify
+them.
+
+Fix-me: Does not work yet."
+
+ (setq mumamo-internal-major-modes-alist
+ (if (not major)
+ nil
+ (assq-delete-all major mumamo-internal-major-modes-alist))))
+
+;; RMS had the following idea:
+;;
+;; Suppose we add a Lisp primitive to bind a set of variables under
+;; the control of an alist. Would it be possible to eliminate these
+;; helper functions and use that primitive instead?
+;;
+;;; But wouldn't it be better to test this version first? There is
+;;; no hurry, this version works and someone might find that there
+;;; is a better way to do this than with helper functions.
+;;
+;; OK with me, as long as this point doesn't get forgotten.
+(defun mumamo-fetch-major-mode-setup (major keywords mode-keywords add-keywords how)
+ "Return a helper function to do fontification etc like in major mode MAJOR.
+Fetch the variables affecting font locking, indentation and
+filling by calling the major mode MAJOR in a temporary buffer.
+
+Make a function with one parameter BODY which is elisp code to
+eval. The function should let bind the variables above, sets the
+syntax table temporarily to the one used by the major mode
+\(using the mode symbol name to find it) and then evaluates body.
+
+Name this function mumamo-eval-in-MAJOR. Put the code for this
+function in the property `mumamo-defun' on this function symbol.
+
+
+** Some notes about background etc.
+
+The function made here is used in `mumamo-with-major-mode-setup'.
+The code in the function parameter BODY is typically involved in
+fontification, indentation or filling.
+
+The main reasons for doing it this way is:
+
+- It is faster and than setting the major mode directly.
+- It does not affect buffer local variables."
+ ;; (info "(elisp) Other Font Lock Variables")
+ ;; (info "(elisp) Syntactic Font Lock)
+ ;;(msgtrc "fetch-major 1: font-lock-keywords-only =%s" font-lock-keywords-only)
+ (let ((func-sym (intern (concat "mumamo-eval-in-" (symbol-name major))))
+ (func-def-sym (intern (concat "mumamo-def-eval-in-" (symbol-name major))))
+ ;;(add-keywords-hook (mumamo-font-lock-keyword-hook-symbol major))
+ byte-compiled-fun
+ (fetch-func-definition `(lambda (body))) ;;`(defun ,func-sym (body)))
+ temp-buf-name
+ temp-buf)
+ ;; font-lock-mode can't be turned on in buffers whose names start
+ ;; with a char with white space syntax. Temp buffer names are
+ ;; such and it is not possible to change name of a temp buffer.
+ (setq temp-buf-name (concat "mumamo-fetch-major-mode-setup-" (symbol-name major)))
+ (setq temp-buf (get-buffer temp-buf-name))
+ (when temp-buf (kill-buffer temp-buf))
+ (setq temp-buf (get-buffer-create temp-buf-name))
+ ;;(msgtrc "fetch-major-mode-setup in buffer %s, after-chunk=%s, before with-current-buffer" (current-buffer) (when (boundp 'after-chunk) after-chunk))
+ (with-current-buffer temp-buf
+
+ (mumamo-msgfntfy "mumamo-fetch-major-mode-setup %s" major)
+ (let ((mumamo-fetching-major t)
+ mumamo-multi-major-mode)
+ ;;(msgtrc "fetch-major-mode-setup in buffer %s, before (funcall %s)" (current-buffer) major)
+ (funcall major)
+ )
+
+ (mumamo-msgfntfy ">>> mumamo-fetch-major-mode-setup A font-lock-mode=%s" font-lock-mode)
+ (font-lock-mode 1)
+ (mumamo-msgfntfy "<<< mumamo-fetch-major-mode-setup B font-lock-mode=%s" font-lock-mode)
+ (mumamo-msgfntfy "mumamo-fetch-major-mode-setup: fetching jit-lock-after-change-extend-region-functions A=%s" jit-lock-after-change-extend-region-functions)
+
+ ;; Note: font-lock-set-defaults must be called before adding
+ ;; keywords. Otherwise Emacs loops. I have no idea why. Hm,
+ ;; probably wrong, it is likely to be nxhtml-mumamo that is the
+ ;; problem. Does not loop in html-mumamo.
+ ;;(msgtrc "\n--------------------")
+ (font-lock-set-defaults)
+ ;; Fix-me: but hi-lock still does not work... what have I
+ ;; forgotten??? font-lock-keywords looks ok...
+ (when keywords
+ (if add-keywords
+ (progn
+ ;;(msgtrc "fetch:font-lock-add-keywords %S %S %S" (if mode-keywords major nil) keywords how)
+ (font-lock-add-keywords (if mode-keywords major nil) keywords how)
+ ;;(font-lock-add-keywords major keywords how)
+ ;;(msgtrc "fetch:font-lock-keywords=%S" font-lock-keywords)
+ )
+ (font-lock-remove-keywords (if mode-keywords major nil) keywords)
+ ;;(font-lock-remove-keywords major keywords)
+ )
+ (unless mode-keywords (font-lock-mode -1) (font-lock-mode 1))
+ ;;(msgtrc "fetch-major-mode-setup:font-lock-keywords=%S" font-lock-keywords)
+ )
+ ;;(run-hooks add-keywords-hook)
+
+ (add-to-list 'mumamo-major-modes-local-maps
+ (let ((local-map (current-local-map)))
+ (cons major-mode (if local-map
+ (copy-keymap local-map)
+ 'no-local-map))))
+
+ (mumamo-msgfntfy "mumamo-fetch-major-mode-setup: fetching jit-lock-after-change-extend-region-functions B=%s" jit-lock-after-change-extend-region-functions)
+ (let* ((syntax-sym (intern-soft (concat (symbol-name major) "-syntax-table")))
+ (fetch-func-definition-let
+ ;; Be XML compliant:
+ (list
+ (list 'sgml-xml-mode
+ ;;(when (mumamo-derived-from-mode ',major 'sgml-mode) t))
+ (when (mumamo-derived-from-mode major 'sgml-mode) t))
+
+ ;; We need to copy the variables that we need and
+ ;; that are not automatically buffer local, but
+ ;; could be it. Arguably it is a bug if they are not
+ ;; buffer local though we have to adapt.
+
+ ;; From cc-mode.el:
+ (list 'indent-line-function (custom-quote indent-line-function))
+ (list 'indent-region-function (custom-quote indent-region-function))
+ (list 'normal-auto-fill-function (custom-quote normal-auto-fill-function))
+ (list 'comment-start (custom-quote comment-start))
+ (list 'comment-end (custom-quote comment-end))
+ (list 'comment-start-skip (custom-quote comment-start-skip))
+ (list 'comment-end-skip (custom-quote comment-end-skip))
+ (list 'comment-multi-line (custom-quote comment-multi-line))
+ (list 'comment-line-break-function (custom-quote comment-line-break-function))
+ (list 'paragraph-start (custom-quote paragraph-start))
+ (list 'paragraph-separate (custom-quote paragraph-separate))
+ (list 'paragraph-ignore-fill-prefix (custom-quote paragraph-ignore-fill-prefix))
+ (list 'adaptive-fill-mode (custom-quote adaptive-fill-mode))
+ (list 'adaptive-fill-regexp (custom-quote adaptive-fill-regexp))
+
+ ;;; Try doing the font lock things last, keywords really last
+ (list 'font-lock-multiline (custom-quote font-lock-multiline))
+ (list 'font-lock-extend-after-change-region-function (custom-quote font-lock-extend-after-change-region-function))
+ (list 'font-lock-extend-region-functions (custom-quote font-lock-extend-region-functions))
+ (list 'font-lock-comment-start-skip (custom-quote font-lock-comment-start-skip))
+ (list 'font-lock-comment-end-skip (custom-quote font-lock-comment-end-skip))
+ (list 'font-lock-syntactic-keywords (custom-quote font-lock-syntactic-keywords))
+
+ (list 'font-lock-keywords (custom-quote font-lock-keywords))
+ ;;(list 'font-lock-keywords-alist (custom-quote font-lock-keywords-alist))
+ ;;(list 'font-lock-removed-keywords-alist (custom-quote font-lock-removed-keywords-alist))
+
+ ;; Fix-me: uncommenting this line (as it should be)
+ ;; sets font-lock-keywords-only to t globally...: bug 3467
+ (list 'font-lock-keywords-only (custom-quote font-lock-keywords-only))
+
+ (list 'font-lock-keywords-case-fold-search (custom-quote font-lock-keywords-case-fold-search))
+
+ (list 'font-lock-set-defaults t) ; whether we have set up defaults.
+
+ ;; Set from font-lock-defaults normally:
+ (list 'font-lock-defaults (custom-quote (copy-tree font-lock-defaults)))
+ ;; Syntactic Font Lock
+ (list 'font-lock-syntax-table (custom-quote font-lock-syntax-table)) ;; See nXhtml bug 400415
+ (list 'font-lock-beginning-of-syntax-function (custom-quote font-lock-beginning-of-syntax-function))
+ (list 'font-lock-syntactic-face-function (custom-quote font-lock-syntactic-face-function))
+
+ ;; Other Font Lock Variables
+ (list 'font-lock-mark-block-function (custom-quote font-lock-mark-block-function))
+ (list 'font-lock-extra-managed-props (custom-quote font-lock-extra-managed-props))
+ ;; This value is fetched from font-lock:
+ (list 'font-lock-fontify-buffer-function (custom-quote font-lock-fontify-buffer-function))
+ (list 'font-lock-unfontify-buffer-function (custom-quote font-lock-unfontify-buffer-function))
+ (list 'font-lock-fontify-region-function (custom-quote font-lock-fontify-region-function))
+ (list 'font-lock-unfontify-region-function (custom-quote font-lock-unfontify-region-function))
+
+ ;; Jit Lock Variables
+ (list 'jit-lock-after-change-extend-region-functions (custom-quote jit-lock-after-change-extend-region-functions))
+
+ ;;(list 'syntax-table (custom-quote (copy-syntax-table (syntax-table))))
+ ;;(list 'mumamo-original-syntax-begin-function (custom-quote syntax-begin-function))
+ (list 'syntax-begin-function (custom-quote syntax-begin-function))
+ (list 'fill-paragraph-function (custom-quote fill-paragraph-function))
+ (list 'fill-forward-paragraph-function
+ (when (boundp 'fill-forward-paragraph-function)
+ (custom-quote fill-forward-paragraph-function)))
+
+ ;; newcomment
+ (list 'comment-use-global-state (custom-quote (when (boundp 'comment-use-global-state) comment-use-global-state)))
+
+ ;; parsing sexps
+ (list 'multibyte-syntax-as-symbol (custom-quote multibyte-syntax-as-symbol))
+ (list 'parse-sexp-ignore-comments (custom-quote parse-sexp-ignore-comments))
+ (list 'parse-sexp-lookup-properties (custom-quote parse-sexp-lookup-properties))
+ ;; fix-me: does not the next line work?
+ (list 'forward-sexp-function (custom-quote forward-sexp-function))
+ ))
+ (relevant-buffer-locals (mumamo-get-relevant-buffer-local-vars))
+ )
+ ;;(append '(1 2) '(3 4) '((eval body)))
+ (mumamo-msgfntfy "===========> before setq fetch-func-definition %s" func-sym)
+ ;; Avoid doublets
+ (dolist (fetched fetch-func-definition-let)
+ (let ((fvar (car fetched)))
+ (setq relevant-buffer-locals (assq-delete-all fvar relevant-buffer-locals))))
+ (setq fetch-func-definition
+ (append fetch-func-definition
+ `((let ,(append fetch-func-definition-let
+ relevant-buffer-locals)
+ (with-syntax-table ,(if syntax-sym
+ syntax-sym
+ '(standard-syntax-table));;'syntax-table
+ ;; fix-me: Protect against font-lock-keywords-only to t globally...: bug 3467
+ ;;(msgtrc "%s enter 1: font-lock-keywords-only def=%s, body=%S" ',major (default-value 'font-lock-keywords-only) body)
+ (let (;(font-lock-keywords-only font-lock-keywords-only)
+ ret)
+ ;;(msgtrc "%s enter 2: font-lock-keywords-only def=%s" ',major (default-value 'font-lock-keywords-only))
+ (setq ret (eval body))
+ ;;(msgtrc "%s exit 1: font-lock-keywords-only def=%s" ',major (default-value 'font-lock-keywords-only))
+ ret))
+ ;;(msgtrc "in %s 1: font-lock-keywords-only =%s in buffer %s, def=%s" ',func-sym font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
+ )
+ ;;(msgtrc "in %s 2: font-lock-keywords-only =%s in buffer %s, def=%s" ',func-sym font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
+ ;;(message "backtrace there:\n%s" (with-output-to-string (backtrace)))
+ )))
+
+ (setq byte-compiled-fun (let ((major-syntax-table))
+ (byte-compile fetch-func-definition)))
+ (assert (functionp byte-compiled-fun))
+ (unless keywords
+ (eval `(defvar ,func-sym nil))
+ (eval `(defvar ,func-def-sym ,fetch-func-definition))
+ (set func-sym byte-compiled-fun) ;; Will be used as default
+ (assert (functionp (symbol-value func-sym)) t)
+ (funcall (symbol-value func-sym) nil)
+ (put func-sym 'permanent-local t)
+ (put func-def-sym 'permanent-local t))))
+ (kill-buffer temp-buf)
+ ;; Use the new value in current buffer.
+ (when keywords
+ ;;(set (make-local-variable func-sym) (symbol-value func-sym))
+ ;;(msgtrc "fetch: major=%s func-def-sym=%s cb=%s fetch-func-definition=%s" major func-def-sym (current-buffer) fetch-func-definition)
+ ;;(msgtrc "fetch: major=%s func-def-sym=%s cb=%s fetch-func-definition" major func-def-sym (current-buffer))
+ (set (make-local-variable func-sym) byte-compiled-fun)
+ (set (make-local-variable func-def-sym) fetch-func-definition)
+ (put func-sym 'permanent-local t)
+ (put func-def-sym 'permanent-local t))
+ (assert (functionp (symbol-value func-sym)) t)
+ ;; return a list def + fun
+ (cons func-sym func-def-sym)))
+
+;; Fix-me: maybe a hook in font-lock-add-keywords??
+(defun mumamo-ad-font-lock-keywords-helper (major keywords how add-keywords)
+ ;;(msgtrc "ad-font-lock-keywords-helper %s %s %s %s" major keywords how add-keywords)
+ (if major
+ (mumamo-fetch-major-mode-setup major keywords t t how)
+ ;; Fix-me: Can't do that, need a list of all
+ ;; mumamo-current-chunk-family chunk functions major
+ ;; modes. But this is impossible since the major modes might
+ ;; be determined dynamically. As a work around look in current
+ ;; chunks.
+ (let ((majors (list (mumamo-main-major-mode))))
+ (dolist (entry mumamo-internal-major-modes-alist)
+ (let ((major (car entry))
+ (fun-var-sym (caadr entry)))
+ (when (local-variable-p fun-var-sym)
+ (setq majors (cons (car entry) majors)))))
+ (dolist (major majors)
+ (setq major (mumamo-get-major-mode-substitute major 'fontification))
+ ;;(msgtrc "(fetch-major-mode-setup %s %s %s %s %s)" major keywords nil t how)
+ (mumamo-fetch-major-mode-setup major keywords nil add-keywords how))
+ ;;(font-lock-mode -1) (font-lock-mode 1)
+ )))
+
+;; Fix-me: This has stopped working again 2009-11-04, but I do not know when it began...
+(defadvice font-lock-add-keywords (around
+ mumamo-ad-font-lock-add-keywords
+ activate
+ compile)
+ (if (or (boundp 'mumamo-fetching-major) (boundp 'mumamo-add-font-lock-called) (not mumamo-multi-major-mode))
+ ad-do-it
+ (let (mumamo-multi-major-mode
+ mumamo-add-font-lock-called
+ (major (ad-get-arg 0))
+ (keywords (ad-get-arg 1))
+ (how (ad-get-arg 2)))
+ (mumamo-ad-font-lock-keywords-helper major keywords how t))))
+
+(defadvice font-lock-remove-keywords (around
+ mumamo-ad-font-lock-remove-keywords
+ activate
+ compile)
+ (if (or (boundp 'mumamo-fetching-major) (boundp 'mumamo-add-font-lock-called) (not mumamo-multi-major-mode))
+ ad-do-it
+ (let (mumamo-multi-major-mode
+ mumamo-add-font-lock-called
+ (major (ad-get-arg 0))
+ (keywords (ad-get-arg 1)))
+ (mumamo-ad-font-lock-keywords-helper major keywords nil nil))))
+
+(defun mumamo-bad-mode ()
+ "MuMaMo replacement for a major mode that could not be loaded."
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'mumamo-bad-mode)
+ (setq mode-name
+ (propertize "Mumamo Bad Mode"
+ 'face 'font-lock-warning-face)))
+
+;;(mumamo-get-major-mode-setup 'css-mode)
+;;(mumamo-get-major-mode-setup 'fundamental-mode)
+(defun mumamo-get-major-mode-setup (use-major)
+ "Return function for evaluating code in major mode USE-MAJOR.
+Fix-me: This doc string is wrong, old:
+
+Get local variable values for major mode USE-MAJOR. These
+variables are used for indentation and fontification. The
+variables are returned in a list with the same format as
+`mumamo-fetch-major-mode-setup'.
+
+The list of local variable values which is returned by this
+function is cached in `mumamo-internal-major-modes-alist'. This
+avoids calling the major mode USE-MAJOR for each chunk during
+fontification and speeds up fontification significantly."
+ ;; Fix-me: Problems here can cause mumamo to loop badly when this
+ ;; function is called over and over again. To avoid this add a
+ ;; temporary entry using mumamo-bad-mode while trying to fetch the
+ ;; correct mode.
+
+ ;;(assq 'mumamo-bad-mode mumamo-internal-major-modes-alist)
+ (let ((use-major-entry (assq use-major mumamo-internal-major-modes-alist))
+ bad-mode-entry
+ dummy-entry
+ fun-var-sym
+ fun-var-def-sym)
+ (unless use-major-entry
+ ;; Get mumamo-bad-mode entry and add a dummy entry based on
+ ;; this to avoid looping.
+ (setq bad-mode-entry
+ (assq 'mumamo-bad-mode mumamo-internal-major-modes-alist))
+ (unless bad-mode-entry
+ ;; Assume it is safe to get the mumamo-bad-mode entry ;-)
+ (add-to-list 'mumamo-internal-major-modes-alist
+ (list 'mumamo-bad-mode
+ (mumamo-fetch-major-mode-setup 'mumamo-bad-mode nil nil nil nil)))
+ (setq bad-mode-entry
+ (assq 'mumamo-bad-mode mumamo-internal-major-modes-alist)))
+ (setq dummy-entry (list use-major (cadr bad-mode-entry)))
+ ;; Before fetching setup add the dummy entry and then
+ ;; immediately remove it.
+ (add-to-list 'mumamo-internal-major-modes-alist dummy-entry)
+ (setq use-major-entry (list use-major
+ (mumamo-fetch-major-mode-setup use-major nil nil nil nil)))
+ (setq mumamo-internal-major-modes-alist
+ (delete dummy-entry
+ mumamo-internal-major-modes-alist))
+ (add-to-list 'mumamo-internal-major-modes-alist use-major-entry))
+ (setq fun-var-sym (caadr use-major-entry))
+ (setq fun-var-def-sym (cdadr use-major-entry))
+ (assert (functionp (symbol-value fun-var-sym)) t)
+ (assert (eq 'lambda (car (symbol-value fun-var-def-sym))) t)
+ ;; Always make a buffer local value for keywords.
+ (unless (local-variable-p fun-var-sym)
+ (set (make-local-variable fun-var-sym) (symbol-value fun-var-sym))
+ (set (make-local-variable fun-var-def-sym) (symbol-value fun-var-def-sym)))
+ (caadr (or (assq use-major mumamo-internal-major-modes-alist)
+ ))))
+;; (assq use-major
+;; (add-to-list 'mumamo-internal-major-modes-alist
+;; (list use-major
+;; (mumamo-fetch-major-mode-setup
+;; use-major nil nil nil))))))))
+
+(defun mumamo-remove-all-chunk-overlays ()
+ "Remove all CHUNK overlays from the current buffer."
+ (save-restriction
+ (widen)
+ (mumamo-delete-new-chunks)))
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Creating and accessing chunks
+
+(defun mumamo-define-no-mode (mode-sym)
+ "Fallback major mode when no major mode for MODE-SYM is found."
+ (let ((mumamo-repl4 (intern (format "mumamo-4-%s" mode-sym)))
+ (lighter (format "No %s" mode-sym))
+ (doc (format "MuMaMo replacement for %s which was not found."
+ mode-sym)))
+ (if (commandp mumamo-repl4)
+ mumamo-repl4
+ (eval `(defun ,mumamo-repl4 ()
+ ,doc
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode ',mumamo-repl4)
+ (setq mode-name
+ (propertize ,lighter
+ 'face 'font-lock-warning-face)))))))
+;;(mumamo-define-no-mode 'my-ownB-mode)
+
+;;(mumamo-major-mode-from-modespec 'javascript-mode)
+(defun mumamo-major-mode-from-modespec (major-spec)
+ "Translate MAJOR-SPEC to a major mode.
+Translate MAJOR-SPEC used in chunk definitions of multi major
+modes to a major mode.
+
+See `mumamo-major-modes' for an explanation."
+ (mumamo-major-mode-from-spec major-spec mumamo-major-modes))
+
+(defun mumamo-major-mode-from-spec (major-spec table)
+ (unless major-spec
+ (mumamo-backtrace "mode-from-modespec, major-spec is nil"))
+ (let ((modes (cdr (assq major-spec table)))
+ (mode 'mumamo-bad-mode))
+ (setq mode
+ (catch 'mode
+ (dolist (m modes)
+ (when (functionp m)
+ (let ((def (symbol-function m)))
+ (when (and (listp def)
+ (eq 'autoload (car def)))
+ (mumamo-condition-case err
+ (load (nth 1 def))
+ (error (setq m nil)))))
+ (when m (throw 'mode m))))
+ nil))
+ (unless mode
+ (if (functionp major-spec)
+ ;; As a last resort allow spec to be a major mode too:
+ (setq mode major-spec)
+ (if modes
+ (mumamo-warn-once '(mumamo-major-mode-from-modespec)
+ "Couldn't find an available major mode for specification %s,\n alternatives are:\n %s"
+ major-spec modes)
+ (mumamo-warn-once '(mumamo-major-mode-from-modespec)
+ "Couldn't find an available major mode for spec %s"
+ major-spec))
+ ;;(setq mode 'fundamental-mode)
+ (setq mode (mumamo-define-no-mode major-spec))
+ ))
+ (mumamo-msgfntfy " mumamo-major-mode-from-modespec %s => %s" major-spec mode)
+ mode))
+
+(defun mumamo-get-existing-new-chunk-at (pos &optional first)
+ "Return last existing chunk at POS if any.
+However if FIRST get first existing chunk at POS instead."
+ ;;(msgtrc "(mumamo-get-existing-new-chunk-at %s)" pos)
+ (let ((chunk-ovl)
+ (orig-pos pos))
+ (when (= pos (point-max))
+ (setq pos (1- pos)))
+ (when (= pos 0) (setq pos 1))
+ (dolist (o (overlays-in pos (1+ pos)))
+ (when (and (overlay-get o 'mumamo-is-new)
+ ;; Because overlays-in need to have a range of length
+ ;; > 0 we might have got overlays that is after our
+ ;; orig-pos:
+ (<= (overlay-start o) orig-pos))
+ ;; There can be two, choose the last or first depending on
+ ;; FIRST.
+ (if chunk-ovl
+ ;; (when (or (> (overlay-end o) (overlay-start o))
+ ;; (overlay-get o 'mumamo-prev-chunk))
+ (when (if first
+ (< (overlay-end o) (overlay-end chunk-ovl))
+ (> (overlay-end o) (overlay-end chunk-ovl))
+ )
+ (setq chunk-ovl o))
+ (setq chunk-ovl o))))
+ chunk-ovl))
+
+(defun mumamo-get-chunk-save-buffer-state (pos)
+ "Return chunk overlay at POS. Preserve state."
+ (let (chunk)
+ ;;(mumamo-save-buffer-state nil
+ ;;(setq chunk (mumamo-get-chunk-at pos)))
+ (setq chunk (mumamo-find-chunks pos "mumamo-get-chunk-save-buffer-state"))
+ ;;)
+ chunk))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Chunk and chunk family properties
+
+(defun mumamo-syntax-maybe-completable (pnt)
+ "Return non-nil if at point PNT non-printable characters may occur.
+This just considers existing chunks."
+ (let* ((chunk (mumamo-find-chunks pnt "mumamo-syntax-maybe-completable"))
+ syn-min-max)
+ (if (not chunk)
+ t
+ (mumamo-update-obscure chunk pnt)
+ (setq syn-min-max (mumamo-chunk-syntax-min-max chunk nil))
+ ;;(and (> pnt (1+ (mumamo-chunk-syntax-min chunk)))
+ (and (> pnt (1+ (car syn-min-max)))
+ ;;(< pnt (1- (mumamo-chunk-syntax-max chunk)))))))
+ (< pnt (1- (cdr syn-min-max)))))))
+
+(defvar mumamo-current-chunk-family nil
+ "The currently used chunk family.")
+(make-variable-buffer-local 'mumamo-current-chunk-family)
+(put 'mumamo-current-chunk-family 'permanent-local t)
+
+;; (defvar mumamo-main-major-mode nil)
+;; (make-variable-buffer-local 'mumamo-main-major-mode)
+;; (put 'mumamo-main-major-mode 'permanent-local t)
+
+(defun mumamo-main-major-mode ()
+ "Return major mode used when there are no chunks."
+ (let ((mm (cadr mumamo-current-chunk-family)))
+ (if mm mm
+ (msgtrc "main-major-mode => nil, mumamo-current-chunk-family=%s" mumamo-current-chunk-family))))
+;;; (let ((main (cadr mumamo-current-chunk-family)))
+;;; (if main
+;;; main
+;;; mumamo-main-major-mode)))
+
+;; (defun mumamo-unset-chunk-family ()
+;; "Set chunk family to nil, ie undecided."
+;; (interactive)
+;; (setq mumamo-current-chunk-family nil))
+
+;; (defun mumamo-define-chunks (chunk-family)
+;; "Set the CHUNK-FAMILY used to divide the buffer."
+;; (setq mumamo-current-chunk-family chunk-family))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; General chunk search routines
+
+;; search start forward
+
+;;(defun mumamo-search-fw-exc-start-str (pos max marker)
+(defun mumamo-chunk-start-fw-str (pos max marker)
+ "General chunk function helper.
+A chunk function helper like this can be used in
+`mumamo-find-possible-chunk' to find the borders of a chunk.
+There are several functions like this that comes with mumamo.
+Their names tell what they do. Lets look at the parts of the
+name of this function:
+
+ mumamo-chunk: All this helper functions begins so
+ -start-: Search for the start of a chunk
+ -fw-: Search forward
+ -str: Search for a string
+
+Instead of '-start-' there could be '-end-', ie end.
+Instead of '-fw-' there could be '-bw-', ie backward.
+Instead of '-str' there could be '-re', ie regular expression.
+
+There could also be a '-inc' at the end of the name. If the name
+ends with this then the markers should be included in the chunks,
+otherwise not.
+
+The argument POS means where to start the search. MAX means how
+far to search (when searching backwards the argument is called
+'min' instead). MARKER is a string or regular expression (see
+the name) to search for."
+ (assert (stringp marker))
+ (let ((pm (point-min))
+ (cb (current-buffer)))
+ (message "cb=%s" cb)
+ (goto-char (max pm (- pos (length marker)))))
+ (search-forward marker max t))
+
+(defun mumamo-chunk-start-fw-re (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ (goto-char (- pos (length marker)))
+ (re-search-forward marker max t))
+
+(defun mumamo-chunk-start-fw-str-inc (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ (goto-char pos)
+ (let ((start (search-forward marker max t)))
+ (when start (setq start (- start (length marker))))))
+
+;; search start backward
+
+;; (defun mumamo-chunk-start-bw-str (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; ;;(assert (stringp marker))
+;; (let (start-in)
+;; (goto-char pos)
+;; (setq start-in (search-backward marker min t))
+;; (when start-in
+;; ;; do not include the marker
+;; (setq start-in (+ start-in (length marker))))
+;; start-in))
+
+;; (defun mumamo-chunk-start-bw-re (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; (assert (stringp marker))
+;; (let (start-in)
+;; (goto-char pos)
+;; (setq start-in (re-search-backward marker min t))
+;; (when start-in
+;; ;; do not include the marker
+;; (setq start-in (match-end 0)))
+;; start-in))
+
+;; (defun mumamo-chunk-start-bw-str-inc (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; (assert (stringp marker))
+;; (goto-char (+ pos (length marker)))
+;; (search-backward marker min t))
+
+;; search end forward
+
+(defun mumamo-chunk-end-fw-str (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ ;;(goto-char (1+ pos)) ;; 1+ cause otherwise ?> is at point
+ (goto-char pos)
+ (let (end-in)
+ (setq end-in (search-forward marker max t))
+ (when end-in
+ ;; do not include the marker
+ (setq end-in (- end-in (length marker))))
+ end-in))
+
+(defun mumamo-chunk-end-fw-re (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ (goto-char (1+ pos)) ;; 1+ cause otherwise ?> is at point
+ (let (end-in)
+ (setq end-in (re-search-forward marker max t))
+ (when end-in
+ ;; do not include the marker
+ (setq end-in (match-beginning 0)))
+ end-in))
+
+(defun mumamo-chunk-end-fw-str-inc (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ ;;(goto-char (1+ pos)) ;; 1+ cause otherwise ?> is at point
+ (goto-char (1+ (- pos (length marker))))
+ ;;(msgtrc "mumamo-chunk-end-fw-str-inc %s %s %s, point=%s point-max=%s" pos max marker (point) (point-max))
+ (search-forward marker max t))
+
+;; search end backward
+
+;; (defun mumamo-chunk-end-bw-str (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; (assert (stringp marker))
+;; (goto-char (+ pos (length marker)))
+;; (search-backward marker min t))
+
+;; (defun mumamo-chunk-end-bw-re (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; (assert (stringp marker))
+;; (goto-char (+ pos (length marker)))
+;; (re-search-backward marker min t))
+
+(defun mumamo-chunk-end-bw-str-inc (pos min marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MIN and MARKER."
+ (assert (stringp marker))
+ (goto-char pos)
+ (let ((end (search-backward marker min t)))
+ (when end (setq end (+ end (length marker))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; General chunk routines
+
+;; (defvar mumamo-known-chunk-start nil "Internal use only!.")
+
+(defconst mumamo-string-syntax-table
+ (let ((tbl (copy-syntax-table)))
+ (modify-syntax-entry ?\" "\"" tbl)
+ (modify-syntax-entry ?\' "\"" tbl)
+ tbl)
+ "Just for \"..\" and '...'.")
+
+;; "..." '...' "..'.." '.."..'
+(defun mumamo-guess-in-string (pos)
+ "If POS is in a string then return string start position.
+Otherwise return nil."
+ (when (and (>= pos (point-min)))
+ (let ((here (point))
+ (inhibit-field-text-motion t)
+ line-beg
+ parsed
+ str-char
+ str-pos)
+ (goto-char pos)
+ (setq line-beg (line-beginning-position))
+ (setq parsed (with-syntax-table mumamo-string-syntax-table
+ (parse-partial-sexp line-beg pos)))
+ (setq str-char (nth 3 parsed))
+ (when str-char
+ (skip-chars-backward (string ?^ str-char))
+ (setq str-pos (point)))
+ (goto-char here)
+ str-pos)))
+
+;;; The main generic chunk routine
+
+;; Fix-me: new routine that really search forward only. Rewrite
+;; `mumamo-quick-static-chunk' first with this.
+(defun mumamo-possible-chunk-forward (pos
+ max
+ chunk-start-fun
+ chunk-end-fun
+ &optional borders-fun)
+ "Search forward from POS to MAX for possible chunk.
+Return as a list with values
+
+ \(START END CHUNK-MAJOR BORDERS PARSEABLE-BY CHUNK-END-FUN BORDERS-FUN)
+
+START and END are start and end of the possible chunk.
+CHUNK-MAJOR is the major mode specifier for this chunk. \(Note
+that this specifier is translated to a major mode through
+`mumamo-major-modes'.)
+
+START-BORDER and END-BORDER may be nil. Otherwise they should be
+the position where the border ends respectively start at the
+corresponding end of the chunk.
+
+BORDERS is the return value of the optional BORDERS-FUN which
+takes three parameters, START, END and EXCEPTION-MODE in the
+return values above. BORDERS may be nil and otherwise has this
+format:
+
+ \(START-BORDER END-BORDER CHUNK-MAJOR CHUNK-END-FUN)
+
+PARSEABLE-BY is a list of major modes with parsers that can parse
+the chunk.
+
+CHUNK-START-FUN and CHUNK-END-FUN should be functions that
+searches forward from point for start and end of chunk. They
+both take two parameters, POS and MAX above. If no possible
+chunk is found both these functions should return nil, otherwise
+see below.
+
+CHUNK-START-FUN should return a list of the form below if a
+possible chunk is found:
+
+ (START CHUNK-MAJOR PARSEABLE-BY)
+
+CHUNK-END-FUN should return the end of the chunk.
+
+"
+ ;;(msgtrc "possible-chunk-forward %s %s" pos max)
+ (let ((here (point))
+ start-rec
+ start
+ end
+ chunk-major
+ parseable-by
+ borders
+ ret
+ )
+ (goto-char pos)
+ ;; Fix-me: check valid. Should this perhaps be done in the
+ ;; function calling this instead?
+ ;;(mumamo-end-in-code syntax-min syntax-max curr-major)
+ (setq start-rec (funcall chunk-start-fun (point) max))
+ (when start-rec
+ (setq start (nth 0 start-rec))
+ (setq chunk-major (nth 1 start-rec))
+ (setq parseable-by (nth 2 start-rec))
+ (goto-char start)
+ ;; Fix-me: check valid
+ ;;(setq end (funcall chunk-end-fun (point) max))
+ (when borders-fun
+ (let ((start-border (when start (unless (and (= 1 start)
+ (not chunk-major))
+ start)))
+ (end-border (when end (unless (and (= (point-max) end)
+ (not chunk-major))
+ end))))
+ (setq borders (funcall borders-fun start-border end-border chunk-major))))
+ (setq ret (list start end chunk-major borders parseable-by chunk-end-fun borders-fun)))
+ (goto-char here)
+ ret))
+
+;; Fix-me: This routine has some difficulties. One of the more
+;; problematic things is that chunk borders may depend on the
+;; surrounding chunks syntax. Patterns that possibly could be chunk
+;; borders might instead be parts of comments or strings in cases
+;; where they should not be valid borders there.
+(defun mumamo-find-possible-chunk (pos
+ min max
+ bw-exc-start-fun ;; obsolete
+ bw-exc-end-fun
+ fw-exc-start-fun
+ fw-exc-end-fun
+ &optional find-borders-fun)
+ (mumamo-find-possible-chunk-new pos
+ ;;min
+ max
+ bw-exc-start-fun
+ ;;bw-exc-end-fun
+ fw-exc-start-fun
+ fw-exc-end-fun
+ find-borders-fun))
+
+(defun mumamo-find-possible-chunk-new (pos
+ ;;min
+ max
+ bw-exc-start-fun
+ ;;bw-exc-end-fun
+ fw-exc-start-fun
+ fw-exc-end-fun
+ &optional find-borders-fun)
+ ;; This should return no end value!
+ "Return list describing a possible chunk that starts after POS.
+No notice is taken about existing chunks and no chunks are
+created. The description returned is for the smallest possible
+chunk which is delimited by the function parameters.
+
+POS must be less than MAX.
+
+The function BW-EXC-START-FUN takes two parameters, POS and
+MIN. It should search backward from POS, bound by MIN, for
+exception start and return a cons or a list:
+
+ \(FOUND-POS . EXCEPTION-MODE)
+ \(FOUND-POS EXCEPTION-MODE PARSEABLE-BY)
+
+Here FOUND-POS is the start of the chunk. EXCEPTION-MODE is the
+major mode specifier for this chunk. \(Note that this specifier
+is translated to a major mode through `mumamo-major-modes'.)
+
+PARSEABLE-BY is a list of parsers that can handle the chunk
+beside the one that may be used by the chunks major mode.
+Currently only the XML parser in `nxml-mode' is recognized. In
+this list it should be the symbol `nxml-mode'.
+
+The functions FW-EXC-START-FUN and FW-EXC-END-FUN should search
+for exception start or end, forward resp backward. Those two
+takes two parameters, start position POS and max position MAX,
+and should return just the start respectively the end of the
+chunk.
+
+For all three functions the position returned should be nil if
+search fails.
+
+
+Return as a list with values
+
+ \(START END EXCEPTION-MODE BORDERS PARSEABLE-BY FR-EXC-FUN FIND-BORDERS-FUN)
+
+**Fix-me: FIND-BORDERS-FUN must be split for chunks-in-chunks!
+
+The bounds START and END are where the exception starts or stop.
+Either of them may be nil, in which case this is equivalent to
+`point-min' respectively `point-max'.
+
+If EXCEPTION-MODE is non-nil that is the submode for this
+range. Otherwise the main major mode should be used for this
+chunk.
+
+BORDERS is the return value of the optional FIND-BORDERS-FUN
+which takes three parameters, START, END and EXCEPTION-MODE in
+the return values above. BORDERS may be nil and otherwise has
+this format:
+
+ \(START-BORDER END-BORDER EXCEPTION-MODE FW-EXC-FUN)
+
+START-BORDER and END-BORDER may be nil. Otherwise they should be
+the position where the border ends respectively start at the
+corresponding end of the chunk.
+
+PARSEABLE-BY is a list of major modes with parsers that can parse
+the chunk.
+
+FW-EXC-FUN is the function that finds the end of the chunk. This
+is either FW-EXC-START-FUN or FW-EXC-END-FUN.
+
+---- * Note: This routine is used by to create new members for
+chunk families. If you want to add a new chunk family you could
+most often do that by writing functions for this routine. Please
+see the many examples in mumamo-fun.el for how this can be done.
+See also `mumamo-quick-static-chunk'."
+ ;;(msgtrc "====")
+ ;;(msgtrc "find-poss-new %s %s %s %s %s %s" pos max bw-exc-start-fun fw-exc-start-fun fw-exc-end-fun find-borders-fun)
+
+ ;;(mumamo-condition-case err
+ (progn
+ (assert (and (<= pos max)) nil
+ "mumamo-chunk: pos=%s, max=%s, bt=%S"
+ pos max (with-output-to-string (backtrace)))
+ ;; "in" refers to "in exception" and "out" is then in main
+ ;; major mode.
+ (let (start-in-cons
+ exc-mode
+ fw-exc-mode
+ fw-exc-fun
+ parseable-by
+ start-in start-out
+ end-in end-out
+ start end
+ ;;end-of-exception
+ wants-end-type
+ found-valid-end
+ (main-major (mumamo-main-major-mode))
+ borders
+ border-beg
+ border-end)
+ ;;;; find start of range
+ ;;
+ ;; start normal
+ ;;
+ ;;(setq start-out (funcall bw-exc-end-fun pos min))
+ ;; Do not check end here!
+ ;;(setq start-out (funcall fw-exc-end-fun pos max))
+ ;;(msgtrc "find-poss-new.start-out=%s" start-out)
+ ;; start exception
+ (setq start-in (funcall fw-exc-start-fun pos max))
+ ;;(msgtrc "find-poss-new.start-in=%s" start-in)
+ (when (listp start-in)
+ (setq fw-exc-mode (nth 1 start-in))
+ (setq start-in (car start-in)))
+ ;; compare
+ (when (and start-in start-out)
+ (if (> start-in start-out)
+ (setq start-in nil)
+ (setq start-out nil)))
+ (cond
+ (start-in
+ (setq start-in-cons (funcall bw-exc-start-fun start-in pos))
+ ;;(msgtrc "find-poss-new.start-in=%s start-in-cons=%s" start-in start-in-cons)
+ (when start-in-cons
+ (assert (= start-in (car start-in-cons)))
+ (setq exc-mode (cdr start-in-cons)))
+ (setq start start-in))
+ (start-out
+ (setq start start-out))
+ )
+ (when (and exc-mode
+ (listp exc-mode))
+ (setq parseable-by (cadr exc-mode))
+ (setq exc-mode (car exc-mode)))
+ ;; borders
+ (when find-borders-fun
+ (let ((start-border (when start (unless (and (= 1 start)
+ (not exc-mode))
+ start)))
+ (end-border (when end (unless (and (= (point-max) end)
+ (not exc-mode))
+ end))))
+ (setq borders (funcall find-borders-fun start-border end-border exc-mode))))
+ ;; check
+ (setq border-beg (nth 0 borders))
+ (setq border-end (nth 1 borders))
+ ;;(when start (assert (<= start pos)))
+ ;;(assert (or (not start) (= start pos)))
+ (when border-beg
+ (assert (<= start border-beg)))
+ ;; Fix-me: This is just totally wrong in some pieces and a
+ ;; desperate try after seeing the problems with wp-app.php
+ ;; around line 1120. Maybe this can be used when cutting chunks
+ ;; from top to bottom however.
+ (when nil ;end
+ (let ((here (point))
+ end-line-beg
+ end-in-string
+ start-in-string
+ (start-border (or (nth 0 borders) start))
+ (end-border (or (nth 1 borders) end)))
+ ;; Check if in string
+ ;; Fix-me: add comments about why and examples + tests
+ ;; Fix-me: must loop to find good borders ....
+ (when end
+ ;; Fix-me: more careful positions for guess
+ (setq end-in-string
+ (mumamo-guess-in-string
+ ;;(+ end 2)
+ (1+ end-border)
+ ))
+ (when end-in-string
+ (when start
+ (setq start-in-string
+ (mumamo-guess-in-string
+ ;;(- start 2)
+ (1- start-border)
+ )))
+ (if (not start-in-string)
+ (setq end nil)
+ (if exc-mode
+ (if (and start-in-string end-in-string)
+ ;; If both are in a string and on the same line then
+ ;; guess this is actually borders, otherwise not.
+ (unless (= start-in-string end-in-string)
+ (setq start nil)
+ (setq end nil))
+ (when start-in-string (setq start nil))
+ (when end-in-string (setq end nil)))
+ ;; Fix-me: ???
+ (when start-in-string (setq start nil))
+ ))
+ (unless (or start end)
+ (setq exc-mode nil)
+ (setq borders nil)
+ (setq parseable-by nil))))))
+
+ (when (or start end exc-mode borders parseable-by)
+ (setq fw-exc-fun (if exc-mode
+ ;; Fix-me: this is currently correct,
+ ;; but will change if exc mode in exc
+ ;; mode is allowed.
+ fw-exc-end-fun
+ ;; Fix-me: these should be collected later
+ ;;fw-exc-start-fun
+ nil
+ ))
+ (mumamo-msgfntfy "--- mumamo-find-possible-chunk-new %s" (list start end exc-mode borders parseable-by fw-exc-fun))
+ ;;(message "--- mumamo-find-possible-chunk-new %s" (list start end exc-mode borders parseable-by fw-exc-fun))
+ (when fw-exc-mode
+ (unless (eq fw-exc-mode exc-mode)
+ ;;(message "fw-exc-mode=%s NEQ exc-mode=%s" fw-exc-mode exc-mode)
+ ))
+ ;;(msgtrc "find-poss-new returns %s" (list start end exc-mode borders parseable-by fw-exc-fun find-borders-fun))
+ (when fw-exc-fun
+ (list start end exc-mode borders parseable-by fw-exc-fun find-borders-fun)))))
+ ;;(error (mumamo-display-error 'mumamo-chunk "%s" (error-message-string err)))
+
+ ;;)
+ )
+
+;; (defun temp-overlays-here ()
+;; (interactive)
+;; (let* ((here (point))
+;; (ovl-at (overlays-at here))
+;; (ovl-in (overlays-in here (1+ here)))
+;; (ovl-in0 (overlays-in here here))
+;; )
+;; (with-output-to-temp-buffer (help-buffer)
+;; (help-setup-xref (list #'temp-overlays-at) (interactive-p))
+;; (with-current-buffer (help-buffer)
+;; (insert (format "overlays-at %s:\n%S\n\n" here ovl-at))
+;; (insert (format "overlays-in %s-%s:\n%S\n\n" here (1+ here) ovl-in))
+;; (insert (format "overlays-in %s-%s:\n%S\n\n" here here ovl-in0))
+;; ))))
+;; (defun temp-cursor-pos ()
+;; (interactive)
+;; (what-cursor-position t))
+;; ;;(global-set-key [f9] 'temp-cursor-pos)
+;; (defun temp-test-new-create-chunk ()
+;; (interactive)
+;; (mumamo-delete-new-chunks)
+;; ;;(setq x1 nil)
+;; (let (x1
+;; (first t))
+;; (while (or first x1)
+;; (setq first nil)
+;; (setq x1 (mumamo-new-create-chunk (mumamo-find-next-chunk-values x1 nil nil nil)))))
+;; )
+
+;; (defun temp-create-last-chunk ()
+;; (interactive)
+;; (mumamo-new-create-chunk (mumamo-find-next-chunk-values mumamo-last-chunk nil nil nil)))
+
+(defun mumamo-delete-new-chunks ()
+ (setq mumamo-last-chunk nil)
+ (save-restriction
+ (widen)
+ (let ((ovls (overlays-in (point-min) (point-max))))
+ (dolist (ovl ovls)
+ (when (overlay-get ovl 'mumamo-is-new)
+ ;;(msgtrc "delete-overlay %s delete-new-chunks" ovl)
+ (delete-overlay ovl))))))
+
+(defun mumamo-new-create-chunk (new-chunk-values)
+ "Create and return a chunk from NEW-CHUNK-VALUES.
+When doing this store the functions for creating the next chunk
+after this in the properties below of the now created chunk:
+
+- 'mumamo-next-major: is nil or the next chunk's major mode.
+- 'mumamo-next-end-fun: function that searches for end of AFTER-CHUNK
+- 'mumamo-next-border-fun: functions that finds borders"
+ ;;((1 696 nxhtml-mode nil nil nil nil) (696 nil php-mode nil nil nil nil))
+ ;;(current (list curr-min curr-max curr-major curr-border-min curr-border-max curr-parseable curr-fw-exc-fun))
+ ;;(msgtrc "######new-create.chunk.new-chunk-values=%s" new-chunk-values)
+ (when new-chunk-values
+ (let* ((this-values (nth 0 new-chunk-values))
+ (next-values (nth 1 new-chunk-values))
+ (next-major (nth 0 next-values))
+ (next-end-fun (nth 1 next-values))
+ (next-border-fun (nth 2 next-values))
+ (next-depth-diff (nth 3 next-values))
+ (next-indent (nth 4 next-values))
+ (this-beg (nth 0 this-values))
+ (this-end (nth 1 this-values))
+ (this-maj (nth 2 this-values))
+ (this-bmin (nth 3 this-values))
+ (this-bmax (nth 4 this-values))
+ (this-pable (nth 5 this-values))
+ (this-after-chunk (nth 7 this-values))
+ ;;(this-is-closed (nth 8 this-values))
+ (this-insertion-type-beg (nth 8 this-values))
+ (this-insertion-type-end (nth 9 this-values))
+ ;;(this-is-closed (and this-end (< 1 this-end)))
+ (this-after-chunk-depth (when this-after-chunk
+ (overlay-get this-after-chunk 'mumamo-depth)))
+ (depth-diff (if this-after-chunk
+ (overlay-get this-after-chunk 'mumamo-next-depth-diff)
+ 1))
+ (depth (if this-after-chunk-depth
+ (+ this-after-chunk-depth depth-diff)
+ 0))
+ ;;(fw-funs (nth 6 this-values))
+ ;;(borders-fun (nth 7 this-values))
+ ;;(this-is-closed (when (or this-end (mumamo-fun-eq this-maj (mumamo-main-major-mode))) t))
+ (use-this-end (if this-end this-end (1+ (buffer-size)))) ;(save-restriction (widen) (point-max))))
+ (this-chunk (when (and (<= this-beg use-this-end)
+ ;; Avoid creating two empty overlays
+ ;; at the this-end - but what if we are
+ ;; not creating, just changing the
+ ;; last overlay ...
+ ;;
+ ;; (not (and (= this-beg use-this-end)
+ ;; (= use-this-end (1+ (buffer-size)))
+ ;; this-after-chunk
+ ;; (= 0 (- (overlay-end this-after-chunk) (overlay-start this-after-chunk)))
+ ;; ))
+ )
+ (when (= this-beg 1)
+ (if (= use-this-end 1)
+ (assert (mumamo-fun-eq (mumamo-main-major-mode) this-maj) t)
+ (if this-after-chunk ;; not first
+ (assert (not (mumamo-fun-eq (mumamo-main-major-mode) this-maj)) t)
+ (assert (mumamo-fun-eq (mumamo-main-major-mode) this-maj) t))))
+ ;;(message "Create chunk %s - %s" this-beg use-this-end)
+ ;;(make-overlay this-beg use-this-end nil nil (not this-is-closed))
+ (make-overlay this-beg use-this-end nil this-insertion-type-beg this-insertion-type-end)
+ ))
+ ;; Fix-me: move to mumamo-find-next-chunk-values
+ (this-border-fun (when (and this-chunk this-after-chunk)
+ ;;(overlay-get this-after-chunk 'mumamo-next-border-fun)
+ (mumamo-chunk-car this-after-chunk 'mumamo-next-border-fun)
+ ))
+ (this-borders (when this-border-fun
+ ;;(msgtrc "(funcall %s %s %s %s)" this-border-fun this-beg this-end this-maj)
+ (funcall this-border-fun this-beg this-end this-maj)))
+ ;; Fix-me, check: there is no first border when moving out.
+ (this-borders-min (when (= 1 depth-diff)
+ (nth 0 this-borders)))
+ ;; Fix-me, check: there is no bottom border when we move
+ ;; further "in" since borders are now always inside
+ ;; sub-chunks (if I remember correctly...).
+ ;;(this-borders-max (when (and this-is-closed
+ (this-borders-max (when (and (not this-insertion-type-end)
+ (/= 1 next-depth-diff))
+ (nth 1 this-borders)))
+ )
+ ;;(msgtrc "created %s, major=%s" this-chunk this-maj)
+ (when (> depth 4) (error "Chunk depth > 4"))
+ (setq this-bmin nil)
+ (setq this-bmax nil)
+ (when this-borders-min (setq this-bmin (- this-borders-min this-beg)))
+ (when this-borders-max (setq this-bmax (- this-end this-borders-max)))
+ ;;(when this-after-chunk (message "this-after-chunk.this-end=%s, this-beg=%s, this-end=%s" (overlay-end this-after-chunk) this-beg this-end))
+ ;;(message "fw-funs=%s" fw-funs)
+ (when this-chunk
+ (overlay-put this-chunk 'mumamo-is-new t)
+ (overlay-put this-chunk 'face (mumamo-background-color depth))
+ (overlay-put this-chunk 'mumamo-depth depth)
+ ;; Values for next chunk
+ (overlay-put this-chunk 'mumamo-next-depth-diff next-depth-diff)
+ (assert (symbolp next-major) t)
+ (overlay-put this-chunk 'mumamo-next-major next-major)
+ ;; Values for this chunk
+ ;;(overlay-put this-chunk 'mumamo-is-closed this-is-closed)
+ (overlay-put this-chunk 'mumamo-insertion-type-end this-insertion-type-end)
+ (overlay-put this-chunk 'mumamo-syntax-min-d this-bmin)
+ (overlay-put this-chunk 'mumamo-syntax-max-d this-bmax)
+ (overlay-put this-chunk 'mumamo-prev-chunk this-after-chunk)
+ (overlay-put this-chunk 'mumamo-next-indent next-indent)
+ (when this-after-chunk (overlay-put this-after-chunk 'mumamo-next-chunk this-chunk))
+
+ ;;(msgtrc "\n<<<<<<<<<<<<<<<<< next-depth-diff/depth-diff=%s/%s, this-maj=%s, this-after-chunk=%s" next-depth-diff depth-diff this-maj this-after-chunk)
+ ;;(overlay-put this-chunk 'mumamo-next-end-fun next-end-fun)
+ (cond
+ ((= 1 next-depth-diff)
+ (mumamo-chunk-push this-chunk 'mumamo-next-border-fun next-border-fun)
+ (mumamo-chunk-push this-chunk 'mumamo-next-end-fun next-end-fun))
+ ((= -1 next-depth-diff)
+ (mumamo-chunk-pop this-chunk 'mumamo-next-border-fun)
+ (mumamo-chunk-pop this-chunk 'mumamo-next-end-fun))
+ ((= 0 next-depth-diff)
+ nil)
+ (t (error "next-depth-diff=%s" next-depth-diff)))
+ ;;(msgtrc "mumamo-next-end-fun=%S" (overlay-get this-chunk 'mumamo-next-end-fun))
+
+ ;; Fix-me: replace 'mumamo-major-mode with multi major mode to make it more flexible.
+ (cond
+ ((= 1 depth-diff)
+ (mumamo-chunk-push this-chunk 'mumamo-major-mode this-maj))
+ ((= -1 depth-diff)
+ (mumamo-chunk-pop this-chunk 'mumamo-major-mode)
+ )
+ (t (error "depth-diff=%s" depth-diff)))
+
+ (overlay-put this-chunk 'mumamo-parseable-by this-pable)
+ (overlay-put this-chunk 'created (current-time-string))
+ (mumamo-update-chunk-margin-display this-chunk)
+ (setq mumamo-last-chunk this-chunk) ;; Use this chunk!!!!
+ ;; Get syntax-begin-function for syntax-ppss:
+ (let* ((syntax-begin-function
+ (mumamo-with-major-mode-fontification this-maj
+ ;; Do like in syntax.el:
+ '(if syntax-begin-function
+ (progn
+ syntax-begin-function)
+ (when (and (not syntax-begin-function)
+ ;; fix-me: How to handle boundp here?
+ (boundp 'font-lock-beginning-of-syntax-function)
+ font-lock-beginning-of-syntax-function)
+ font-lock-beginning-of-syntax-function)))))
+ (mumamo-msgfntfy "Got syntax-begin-function, modified=%s" (buffer-modified-p))
+ (overlay-put this-chunk 'syntax-begin-function syntax-begin-function))
+ )
+ ;;(msgtrc "Created %s, this=%s, next=%s" this-chunk this-values next-values)
+ this-chunk
+ )
+ ))
+
+(defun mumamo-update-chunk-margin-display (chunk)
+ "Set before-string of CHUNK as spec by `mumamo-margin-use'."
+ ;; Fix-me: This is not displayed. Emacs bug?
+ ;;(overlay-put this-chunk 'before-string `((margin left-margin) ,(format "%d %s" depth maj)))
+ (if (not mumamo-margin-info-mode)
+ (overlay-put chunk 'before-string nil)
+ (let* ((depth (overlay-get chunk 'mumamo-depth))
+ (maj (mumamo-chunk-car chunk 'mumamo-major-mode))
+ (strn (propertize (format "%d" depth)
+ 'face (list :inherit (or (mumamo-background-color depth)
+ 'default)
+ :foreground "#505050"
+ :underline t
+ :slant 'normal
+ :weight 'normal
+ )))
+ (maj-name (substring (symbol-name maj) 0 -5))
+ (strm (propertize maj-name 'face
+ (list :foreground "#a0a0a0" :underline nil
+ :background (frame-parameter nil 'background-color)
+ :weight 'normal
+ :slant 'normal)))
+ str
+ (margin (mumamo-margin-used)))
+ (when (> (length strm) 5) (setq strm (substring strm 0 5)))
+ (setq str (concat strn
+ strm
+ (propertize " " 'face 'default)
+ ))
+ (overlay-put chunk 'before-string
+ (propertize " " 'display
+ `((margin ,margin) ,str))))))
+
+(defun mumamo-update-chunks-margin-display (buffer)
+ "Apply `update-chunk-margin-display' to all chunks in BUFFER."
+ (with-current-buffer buffer
+ (save-restriction
+ (widen)
+ (let ((chunk (mumamo-find-chunks 1 "margin-disp"))
+ (while-n0 0))
+ (while (and (mumamo-while 1500 'while-n0 "chunk")
+ chunk)
+ (mumamo-update-chunk-margin-display chunk)
+ (setq chunk (overlay-get chunk 'mumamo-next-chunk)))))))
+
+(defvar mumamo-margin-used nil)
+(make-variable-buffer-local 'mumamo-margin-used)
+(put 'mumamo-margin-used 'permanent-local t)
+
+(defun mumamo-margin-used ()
+ (setq mumamo-margin-used
+ (if (and (boundp 'linum-mode) linum-mode) 'right-margin (nth 0 mumamo-margin-use))))
+
+;; (defun mumamo-set-window-margins-used (win)
+;; "Set window margin according to `mumamo-margin-use'."
+;; ;; Fix-me: old-margin does not work, break it up
+;; (let* ((old-margin-used mumamo-margin-used)
+;; (margin-used (mumamo-margin-used))
+;; (width (nth 1 mumamo-margin-use))
+;; (both-widths (window-margins win))
+;; (old-left (eq old-margin-used 'left-margin))
+;; (left (eq margin 'left-margin)))
+;; ;; Change only the margin we used!
+;; (if (not mumamo-margin-info-mode)
+;; (progn
+;; (set-window-margins win
+;; (if left nil (car both-widths))
+;; (if (not left) nil (cdr both-widths)))
+;; )
+;; ;;(msgtrc "set-window-margins-used margin-info-mode=t")
+;; (case margin-used
+;; ('left-margin (set-window-margins win width (when old-left (cdr both-widths))))
+;; ('right-margin (set-window-margins win (car both-widths) width))))))
+
+(defun mumamo-update-buffer-margin-use (buffer)
+ ;;(msgtrc "update-buffer-margin-use %s" buffer)
+ (when (fboundp 'mumamo-update-chunks-margin-display)
+ (with-current-buffer buffer
+ (when mumamo-multi-major-mode
+ (let* ((old-margin-used mumamo-margin-used)
+ (margin-used (mumamo-margin-used))
+ (old-is-left (eq old-margin-used 'left-margin))
+ (is-left (eq margin-used 'left-margin))
+ (width (nth 1 mumamo-margin-use))
+ (need-update nil))
+ (if (not mumamo-margin-info-mode)
+ (when old-margin-used
+ (setq need-update t)
+ (setq old-margin-used nil)
+ (if old-is-left
+ (setq left-margin-width 0)
+ (setq right-margin-width 0)))
+ (unless (and (eq old-margin-used margin-used)
+ (= width (if old-is-left left-margin-width right-margin-width)))
+ (setq need-update t)
+ (if is-left
+ (setq left-margin-width width)
+ (setq right-margin-width width))
+ (unless (eq old-margin-used margin-used)
+ (if old-is-left
+ (setq left-margin-width 0)
+ (setq right-margin-width 0)))))
+ (when need-update
+ (mumamo-update-chunks-margin-display buffer)
+ (dolist (win (get-buffer-window-list buffer))
+ (set-window-buffer win buffer)))
+ )
+ ;; Note: window update must be before buffer update because it
+ ;; uses old-margin from the call to function margin-used.
+ ;; (dolist (win (get-buffer-window-list buffer))
+ ;; (mumamo-set-window-margins-used win))
+ ;; (mumamo-update-chunks-margin-display buffer)
+ ))))
+
+(defun mumamo-new-chunk-value-min (values)
+ (let ((this-values (nth 0 values)))
+ (nth 0 this-values)))
+
+(defun mumamo-new-chunk-value-max (values)
+ (let ((this-values (nth 0 values)))
+ (nth 1 this-values)))
+
+(defun mumamo-new-chunk-equal-chunk-values (chunk values)
+ ;;(msgtrc "eq? chunk=%S, values=%S" chunk values)
+ (let* (;; Chunk
+ (chunk-is-new (overlay-get chunk 'mumamo-is-new))
+ ;;(chunk-is-closed (overlay-get chunk 'mumamo-is-closed))
+ (chunk-insertion-type-end (overlay-get chunk 'mumamo-insertion-type-end))
+ (chunk-next-major (overlay-get chunk 'mumamo-next-major))
+ (chunk-next-end-fun (mumamo-chunk-car chunk 'mumamo-next-end-fun))
+ (chunk-next-border-fun (mumamo-chunk-car chunk 'mumamo-next-border-fun))
+ (chunk-next-chunk-diff (overlay-get chunk 'mumamo-next-depth-diff))
+ (chunk-beg (overlay-start chunk))
+ (chunk-end (overlay-end chunk))
+ (chunk-bmin (overlay-get chunk 'mumamo-syntax-min-d))
+ (chunk-bmax (overlay-get chunk 'mumamo-syntax-max-d))
+ (chunk-prev-chunk (overlay-get chunk 'mumamo-prev-chunk))
+ (chunk-major-mode (mumamo-chunk-car chunk 'mumamo-major-mode))
+ (chunk-pable (overlay-get chunk 'mumamo-parseable-by))
+ (chunk-depth-diff (if chunk-prev-chunk
+ (overlay-get chunk-prev-chunk 'mumamo-next-depth-diff)
+ 0))
+ ;; Values
+ (this-values (nth 0 values))
+ (next-values (nth 1 values))
+ (values-next-major (nth 0 next-values))
+ (values-next-end-fun (nth 1 next-values))
+ (values-next-border-fun (nth 2 next-values))
+ (values-next-depth-diff (nth 3 next-values))
+ (values-beg (nth 0 this-values))
+ (values-end (nth 1 this-values))
+ (values-major-mode (nth 2 this-values))
+ (values-bmin (nth 3 this-values))
+ (values-bmax (nth 4 this-values))
+ (values-pable (nth 5 this-values))
+ (values-prev-chunk (nth 7 this-values))
+ (values-insertion-type-beg (nth 8 this-values))
+ (values-insertion-type-end (nth 9 this-values))
+ ;;(values-is-closed (when values-end t))
+ )
+ ;;(msgtrc "values=%S" values)
+ (and t ;chunk-is-new
+ (eq chunk-next-major values-next-major)
+
+ ;; Can't check chunk-next-end-fun or chunk-next-border-fun
+ ;; here since they are fetched from prev chunk:
+ ;;(progn (message "eq-c-v: here b: %s /= %s" chunk-next-end-fun values-next-end-fun) t)
+ ;;(eq chunk-next-end-fun values-next-end-fun)
+ ;;(progn (message "eq-c-v: here c, %s /= %s" chunk-next-border-fun values-next-border-fun) t)
+ ;;(eq chunk-next-border-fun values-next-border-fun)
+
+ (= chunk-next-chunk-diff values-next-depth-diff)
+ (= chunk-beg values-beg)
+ ;;(progn (message "eq-c-v: here b") t)
+ ;; (and (equal chunk-is-closed values-is-closed)
+ ;; (or (not chunk-is-closed)
+ (and (equal chunk-insertion-type-end values-insertion-type-end)
+ (or ;;chunk-insertion-type-end
+ (= chunk-end values-end)))
+ ;;(progn (message "eq-c-v: here c, %s /= %s" chunk-major-mode values-major-mode) t)
+ (or (= -1 chunk-depth-diff)
+ (eq chunk-major-mode values-major-mode))
+ ;;(progn (message "eq-c-v: here d") t)
+ (equal chunk-pable values-pable)
+ ;;(progn (message "eq-c-v: here e") t)
+ (eq chunk-prev-chunk values-prev-chunk)
+ ;;(progn (message "eq-c-v: here f") t)
+ ;;(eq chunk-is-closed values-is-closed)
+ (eq chunk-insertion-type-end values-insertion-type-end)
+ ;; fix-me: bmin bmax
+ ;;(and chunk-bmin values-bmin (= chunk-bmin values-bmin))
+ ;;(and chunk-bmax values-bmax (= chunk-bmax values-bmax))
+ )
+ ))
+
+(defvar mumamo-sub-chunk-families nil
+ "Chunk dividing routines for sub chunks.
+A major mode in a sub chunk can inherit chunk dividing routines
+from multi major modes. This is the way chunks in chunks is
+implemented.
+
+This variable is an association list with entries of the form
+
+ \(CHUNK-MAJOR CHUNK-FAMILY)
+
+where CHUNK-MAJOR is the major mode in a chunk and CHUNK-FAMILY
+is a chunk family \(ie the third argument to
+`define-mumamo-multi-major-mode'.
+
+You can use the function `mumamo-inherit-sub-chunk-family' to add
+to this list.")
+
+(defvar mumamo-multi-local-sub-chunk-families nil
+ "Multi major mode local chunk dividing rourines for sub chunks.
+Like `mumamo-sub-chunk-families' specific additions for multi
+major modes. The entries have the form
+
+ \((CHUNK-MAJOR . MULTI-MAJOR) CHUNK-FAMILY)
+
+Use the function `mumamo-inherit-sub-chunk-family-locally' to add
+to this list.")
+
+;;(mumamo-get-sub-chunk-funs 'html-mode)
+(defun mumamo-get-sub-chunk-funs (major)
+ "Get chunk family sub chunk with major mode MAJOR."
+ (let ((rec (or
+ (assoc (cons major mumamo-multi-major-mode) mumamo-multi-local-sub-chunk-families)
+ (assoc major mumamo-sub-chunk-families))))
+ (caddr (cadr rec))))
+
+(defun mumamo-inherit-sub-chunk-family-locally (multi-major multi-using)
+ "Add chunk dividing routines from MULTI-MAJOR locally.
+The dividing routines from multi major mode MULTI-MAJOR can then
+be used in sub chunks in buffers using multi major mode
+MULTI-USING."
+ (let* ((chunk-family (get multi-major 'mumamo-chunk-family))
+ (major (nth 1 chunk-family)))
+ (let ((major-mode major))
+ (when (derived-mode-p 'nxml-mode)
+ (error "Major mode %s major can't be used in sub chunks" major)))
+ (add-to-list 'mumamo-multi-local-sub-chunk-families
+ (list (cons major multi-using) chunk-family))))
+
+(defun mumamo-inherit-sub-chunk-family (multi-major)
+ "Inherit chunk dividing routines from multi major modes.
+Add chunk family from multi major mode MULTI-MAJOR to
+`mumamo-sub-chunk-families'.
+
+Sub chunks with major mode the same as MULTI-MAJOR mode will use
+this chunk familyu to find subchunks."
+ (let* ((chunk-family (get multi-major 'mumamo-chunk-family))
+ (major (nth 1 chunk-family)))
+ (let ((major-mode major))
+ (when (derived-mode-p 'nxml-mode)
+ (error "Major mode %s major can't be used in sub chunks" major)))
+ (add-to-list 'mumamo-sub-chunk-families (list major chunk-family))))
+
+(defun mumamo-find-next-chunk-values (after-chunk from after-change-max chunk-at-after-change)
+ "Search forward for start of next chunk.
+Return a list with chunk values for next chunk after AFTER-CHUNK
+and some values for the chunk after it.
+
+For the first chunk AFTER-CHUNK is nil. Otherwise the values in stored in AFTER-CHUNK
+is used to find the new chunk, its border etc.
+
+
+See also `mumamo-new-create-chunk' for more information."
+ ;;(msgtrc "(find-next-chunk-values %s %s %s %s)" after-chunk from after-change-max chunk-at-after-change)
+ ;;(mumamo-backtrace "find-next")
+ (when after-chunk
+ (unless (eq (overlay-buffer after-chunk)
+ (current-buffer))
+ (error "mumamo-find-next-chunk-values: after-chunk=%S, cb=%S" after-chunk (current-buffer))))
+ (let* ((here (point))
+ (max (point-max))
+ ;;(after-chunk-is-closed (when after-chunk-valid (overlay-get after-chunk 'mumamo-is-closed)))
+ (after-chunk-insertion-type-end (when after-chunk (overlay-get after-chunk 'mumamo-insertion-type-end)))
+ ;; Note that "curr-*" values are fetched from "mumamo-next-*" values in after-chunk
+ (curr-min (if after-chunk (overlay-end after-chunk) 1))
+ (curr-end-fun (when after-chunk
+ (mumamo-chunk-car after-chunk 'mumamo-next-end-fun)))
+ (curr-border-fun (when curr-end-fun (mumamo-chunk-car after-chunk 'mumamo-next-border-fun)))
+ (curr-syntax-min-max (when curr-border-fun (funcall curr-border-fun
+ (overlay-end after-chunk)
+ nil nil)))
+ (curr-syntax-min (or (car curr-syntax-min-max)
+ (when after-chunk (overlay-end after-chunk))
+ 1))
+ (search-from (or nil ;from
+ curr-syntax-min))
+ ;;(dummy (msgtrc "search-from=%s" search-from))
+ (main-chunk-funs (let ((chunk-info (cdr mumamo-current-chunk-family)))
+ (cadr chunk-info)))
+ (curr-major (if after-chunk
+ (or
+ ;; 'mumamo-next-major is used when we are going into a sub chunk.
+ (overlay-get after-chunk 'mumamo-next-major)
+ ;; We are going out of a sub chunk.
+ (mumamo-chunk-cadr after-chunk 'mumamo-major-mode))
+ (mumamo-main-major-mode)))
+ ;;(dummy (msgtrc "curr-major=%s" curr-major))
+ (curr-chunk-funs
+ (if (or (not after-chunk)
+ (= 0 (+ (overlay-get after-chunk 'mumamo-depth)
+ (overlay-get after-chunk 'mumamo-next-depth-diff))))
+ main-chunk-funs
+ (mumamo-get-sub-chunk-funs curr-major)))
+ curr-max
+ next-max
+ curr-max-found
+ next-min
+ curr-border-min
+ curr-border-max
+ curr-parseable
+ next-fw-exc-fun
+ next-indent
+ next-major
+ curr-end-fun-end
+ next-border-fun
+ ;; The insertion types for the new chunk
+ (curr-insertion-type-beg (when after-chunk after-chunk-insertion-type-end))
+ curr-insertion-type-end
+ next-depth-diff
+ r-point
+ )
+ (unless (and after-chunk-insertion-type-end
+ (= (1+ (buffer-size)) ;; ie point-max
+ (overlay-end after-chunk)))
+ (when (>= max search-from)
+ (when curr-end-fun
+ ;; If after-change-max is non-nil here then this function has
+ ;; been called after changes that are all in one chunk. We
+ ;; need to check if the chunk right border have been changed,
+ ;; but we do not have to look much longer than the max point
+ ;; of the change.
+ ;;(message "set after-change-max nil") (setq after-change-max nil)
+ (let* ((use-max (if nil ;;after-change-max
+ (+ after-change-max 100)
+ max))
+ (chunk-end (and chunk-at-after-change
+ (overlay-end chunk-at-after-change)))
+ ;;(use-min (max (- search-from 2) (point-min)))
+ (use-min curr-syntax-min)
+ (possible-end-fun-end t)
+ (end-search-pos use-min))
+ ;; The code below takes care of the case when to subsequent
+ ;; chunks have the same ending delimiter. (Maybe a while
+ ;; loop is bit overkill here.)
+ (while (and possible-end-fun-end
+ (not curr-end-fun-end)
+ (< end-search-pos use-max))
+ (setq curr-end-fun-end (funcall curr-end-fun end-search-pos use-max))
+ (if (not curr-end-fun-end)
+ (setq possible-end-fun-end nil)
+ (cond ((and t ;after-chunk-is-closed
+ (< curr-end-fun-end (overlay-end after-chunk)))
+ (setq curr-end-fun-end nil)
+ (setq end-search-pos (1+ end-search-pos)))
+ ;; See if the end is in code
+ ((let* ((syn2-min-max (when curr-border-fun
+ (funcall curr-border-fun
+ (overlay-end after-chunk)
+ curr-end-fun-end
+ nil)))
+ (syn2-max (or (cadr syn2-min-max)
+ curr-end-fun-end)))
+ (not (mumamo-end-in-code use-min syn2-max curr-major)))
+ (setq end-search-pos (1+ curr-end-fun-end))
+ (setq curr-end-fun-end nil)
+ ))))
+ (unless curr-end-fun-end
+ ;; Use old end if valid
+ (and after-change-max
+ chunk-end
+ (= -1 (overlay-get chunk-at-after-change 'mumamo-next-depth-diff))
+ (< after-change-max chunk-end)
+ chunk-end))
+ ;; Fix-me: Check if old chunk is valid. It is not valid if
+ ;; depth-diff = -1 and curr-end-fun-end is not the same as
+ ;; before.
+
+ ;; Fix-me: this test should also be made for other chunks
+ ;; searches, but this catches most problems I think.
+ ;; (or (not curr-end-fun-end)
+ ;; ;; Fix-me: The bug in wiki-090804-js.html indicates that
+ ;; ;; we should not subtract 1 here. The subchunk there
+ ;; ;; ends with </script> and this can't be in column 1
+ ;; ;; when the line before ends with a // style js comment
+ ;; ;; unless we don't subtract 1.
+ ;; ;;
+ ;; ;; However wiki-strange-hili-080629.html does not work
+ ;; ;; then because then the final " in style="..." is
+ ;; ;; included in the scan done in mumamo-end-in-code.
+ ;; ;;
+ ;; ;; The solution is to check for the syntax borders here.
+ ;; (let* ((syn2-min-max (when curr-border-fun
+ ;; (funcall curr-border-fun
+ ;; (overlay-end after-chunk)
+ ;; curr-end-fun-end
+ ;; nil)))
+ ;; (syntax-max (or (cadr syn2-min-max)
+ ;; curr-end-fun-end)))
+ ;; ;;(mumamo-end-in-code syntax-min (- curr-end-fun-end 1) curr-major)
+ ;; ;;
+ ;; ;; fix-me: This should be really in the individual
+ ;; ;; routines that finds possible chunks. Mabye this is
+ ;; ;; possible to fix now when just looking forward for
+ ;; ;; chunks?
+ ;; (mumamo-end-in-code curr-syntax-min syntax-max curr-major)
+ ;; )
+ ;; (setq curr-end-fun-end nil))
+ ;; Use old result if valid
+ ;; (and nil ;(not curr-end-fun-end)
+ ;; chunk-at-after-change
+ ;; (= -1 (overlay-get chunk-at-after-change 'mumamo-next-depth-diff))
+ ;; (setq curr-end-fun-end (overlay-end chunk-at-after-change)))
+ ;;(msgtrc "find-next-chunk-values:curr-end-fun-end after end-in-code=%s" curr-end-fun-end)
+ ))
+ ;;(msgtrc "find-next-chunk-values:here d, curr-min=%s, after-chunk=%s" curr-min after-chunk)
+ (when (listp curr-chunk-funs)
+ ;;(msgtrc "find-next-chunk-values:curr-chunk-funs=%s" curr-chunk-funs)
+ (setq r-point (point))
+ (dolist (fn curr-chunk-funs)
+ ;;(msgtrc "find-next-chunk-values:before (r (funcall fn search-from search-from max)), fn=%s search-from=%s, max=%s" fn search-from max)
+ (assert (= r-point (point)) t)
+ (let* ((r (funcall fn search-from search-from max))
+ (rmin (nth 0 r))
+ (rmax (nth 1 r))
+ (rmajor-sub (nth 2 r))
+ (rborder (nth 3 r))
+ (rparseable (nth 4 r))
+ (rfw-exc-fun (nth 5 r))
+ (rborder-fun (nth 6 r))
+ (rindent (nth 7 r))
+ (rborder-min (when rborder (nth 0 rborder)))
+ (rborder-max (when rborder (nth 1 rborder)))
+ ;;(rmin-found rmin)
+ )
+ ;;(msgtrc "find-next-chunk-values:fn=%s, r=%s" fn r)
+ (goto-char r-point)
+ (when r
+ (when rmax (message "mumamo warning: Bad r=%s, nth 1 should be nil" r))
+ (unless (or rmin rmax)
+ (error "Bad r=%s, fn=%s" r fn))
+ (unless rfw-exc-fun
+ (error "No fw-exc-fun returned from fn=%s, r=%s" fn r))
+ (unless rmajor-sub
+ (error "No major mode for sub chunk, fn=%s, r=%s" fn r)))
+ (when r
+ (mumamo-msgfntfy " fn=%s, r=%s" fn r)
+ (unless rmin (setq rmin (point-max)))
+ ;;(unless rmax (setq rmax (point-min)))
+ ;; Do not allow zero length chunks
+ (unless rmax (setq rmax (point-max)))
+ (unless (and (> rmin 1)
+ rmax
+ (= rmin rmax))
+ ;; comparision have to be done differently if we are in an
+ ;; exception part or not. since we are doing this from top to
+ ;; bottom the rules are:
+ ;;
+ ;; - exception parts always outrules non-exception part. when
+ ;; in exception part the min start point should be used.
+ ;; - when in non-exception part the max start point and the
+ ;; min end point should be used.
+ ;;
+ ;; check if first run:
+
+ ;; Fix-me: there is some bug here when borders are not
+ ;; included and are not 0 width.
+ (if (not next-min)
+ (progn
+ (setq next-min rmin)
+ (setq curr-border-min rborder-min)
+ (setq next-max rmax)
+ (setq curr-border-max rborder-max)
+ ;;(setq curr-max-found rmin-found)
+ (setq curr-parseable rparseable)
+ (setq next-fw-exc-fun rfw-exc-fun)
+ (setq next-border-fun rborder-fun)
+ (setq next-indent rindent)
+ (setq next-major rmajor-sub))
+ (if rmajor-sub
+ (if next-major
+ (when (or (not next-min)
+ (< rmin next-min))
+ (setq next-min rmin)
+ (setq curr-border-min rborder-min)
+ (when rmax (setq max rmax))
+ (setq curr-border-max rborder-max)
+ ;;(when rmin-found (setq curr-max-found t))
+ (setq curr-parseable rparseable)
+ (setq next-fw-exc-fun rfw-exc-fun)
+ (setq next-border-fun rborder-fun)
+ (setq next-indent rindent)
+ (setq next-major rmajor-sub))
+ (setq next-min rmin)
+ (setq curr-border-min rborder-min)
+ (when rmax (setq max rmax))
+ (setq curr-border-max rborder-max)
+ ;;(when rmin-found (setq curr-max-found t))
+ (setq curr-parseable rparseable)
+ (setq next-fw-exc-fun rfw-exc-fun)
+ (setq next-border-fun rborder-fun)
+ (setq next-indent rindent)
+ (setq next-major rmajor-sub))
+ (unless next-major
+ (when (> next-min rmin)
+ (setq next-min rmin)
+ (setq curr-border-min rborder-min))
+ (when (and rmax max
+ (> rmax max))
+ ;;(setq max-found rmin-found)
+ ;;(when rmin-found (setq curr-max-found t))
+ (when rmax (setq max rmax))
+ (setq curr-border-max rborder-max))
+ ))))
+ (mumamo-msgfntfy "next-min/max=%s/%s border=%s/%s search-from=%s" next-min max curr-border-min curr-border-max search-from)
+ ;; check!
+ (when (and next-min max)
+ ;;(assert (>= next-min search-from) t)
+ (assert (<= search-from max) t)
+ (when curr-border-min
+ (assert (<= next-min curr-border-min) t)
+ (assert (<= curr-border-min max) t))
+ (when curr-border-max
+ (assert (<= next-min curr-border-max) t)
+ (assert (<= curr-border-max max) t))))
+ )))
+ (goto-char here)
+ (setq curr-max-found (or curr-max-found curr-end-fun-end))
+ (when t ;curr-max-found
+ (setq curr-max (if max max (point-max)))
+ (setq curr-max (min (if next-min next-min curr-max)
+ (if curr-end-fun-end curr-end-fun-end curr-max))))
+ ;;(setq curr-max nil)
+ (setq next-depth-diff (cond
+ ( (and curr-max curr-end-fun-end
+ (= curr-max curr-end-fun-end))
+ -1)
+ ( (= curr-max (1+ (buffer-size)))
+ 0)
+ ( t 1)))
+ (when (= -1 next-depth-diff) ;; We will pop it from 'mumamo-major-mode
+ (setq next-major nil))
+ (when curr-max
+ (unless (>= curr-max curr-min)
+ (error "curr-max is not >= curr-min")))
+ ;;(setq curr-is-closed (and curr-max (< 1 curr-max)))
+ (when (and curr-max (= 1 curr-max))
+ (assert (mumamo-fun-eq curr-major (mumamo-main-major-mode)) t)
+ )
+ (assert (symbolp next-major) t)
+ ;; Fix-me: see for example rr-min8.php
+ (when (or ;;(not after-chunk)
+ (= curr-max (1+ (buffer-size)))
+ (cond
+ ((= next-depth-diff 1)
+ next-border-fun)
+ ((= next-depth-diff -1)
+ next-border-fun)
+ ((= next-depth-diff 0)
+ t)
+ (t (error "next-depth-diff=%s" next-depth-diff))))
+ (setq curr-insertion-type-end t))
+ (let ((current (list curr-min curr-max curr-major curr-border-min curr-border-max curr-parseable
+ curr-chunk-funs after-chunk
+ ;;curr-is-closed
+ curr-insertion-type-beg
+ curr-insertion-type-end
+ ))
+ (next (list next-major next-fw-exc-fun next-border-fun next-depth-diff next-indent)))
+ ;;(msgtrc "find-next-chunk-values=> current=%s, next=%s" current next)
+ (list current next))))))
+
+;; Fix-me: This should check if the new chunk should be
+;; parsed or not
+;; (defsubst mumamo-chunk-nxml-parseable (chunk)
+;; (mumamo-fun-eq (mumamo-main-major-mode)
+;; (mumamo-chunk-major-mode xml-chunk)))
+
+(defun mumamo-valid-nxml-point (pos)
+ "Return non-nil if position POS is in an XML chunk."
+ (memq 'nxml-mode (get-text-property pos 'mumamo-parseable-by)))
+
+(defun mumamo-valid-nxml-chunk (chunk)
+ "Return t if chunk CHUNK should be valid XML."
+ (when chunk
+ (let ((major-mode (mumamo-chunk-major-mode chunk))
+ (region (overlay-get chunk 'mumamo-region))
+ (parseable-by (overlay-get chunk 'mumamo-parseable-by)))
+ ;;(message "mumamo-valid-nxml-chunk: major-mode=%s, parseble-by=%s" major-mode parseable-by)
+ (or region
+ (derived-mode-p 'nxml-mode)
+ (memq 'nxml-mode parseable-by)))))
+
+;; A good test case for the use of this is the troublesome code in the
+;; first line of xml-as-string.php in nxml/nxhtml/bug-tests. Currently
+;; this test code is however splitted and it looks like the code below
+;; can't handle the line above if the line looks like below. The ?> is
+;; still thought to be a border. Does this mean that ' is not treated
+;; as a string separator?
+;;
+;; <?php header("Content-type:application/xml; charset=utf-8"); echo '<?xml version="1.0" encoding="utf-8"?>'; ?>
+;;
+;; However there are the reverse cases also, in lines like
+;;
+;; href="<?php $this->url($url); ?>"
+;; <!-- <td><?php insert_a_lot_of_html(); ?>
+;;
+;; These are supposedly handled by using this test at the right
+;; place... However it is not very clear in all cases whether chunk
+;; dividers in comments and strings should be valid or not...
+;;
+;; For example in the first case above the php divider should be
+;; valid. Probably it should be that in the second case too, but how
+;; should mumamo know that?
+;;
+;; Fix-me: I think a per "chunk divider function + context" flag is
+;; needed to handle this. Probably this will work the same for all web
+;; dev things, ie the opening sub chunk divider is ALWAYS
+;; valid. However that is not true for things like CSS, Javascript etc
+;; in (X)HTML.
+
+(defun mumamo-end-in-code (syntax-start syntax-end major)
+ "Return t if possible syntax end is not in a string or comment.
+Assume that the sexp syntax is nil at SYNTAX-START return t if
+position SYNTAX-END is not in a string or comment according to
+the sexp syntax using major mode MAJOR."
+ ;; Fix-me: This can't always detect html comments: <!--
+ ;; ... -->. Could this be solved by RMS suggestion with a
+ ;; function/defmacro that binds variables to their global values?
+ (mumamo-msgfntfy "point-min,max=%s,%s syntax-start,end=%s,%s, major=%s" (point-min) (point-max) syntax-start syntax-end major)
+ ;;(msgtrc "end-in-code:here a after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
+ (assert (and syntax-start syntax-end) t)
+ (let ((doesnt-here (point))
+ doesnt-ret)
+ (save-restriction
+ (widen)
+ ;;(msgtrc "end-in-code:here a2 after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
+ (mumamo-with-major-mode-fontification major
+ `(let (ppss)
+ ;; fix-me: Use main major mode, and `syntax-ppss'. Change the
+ ;; defadvice of this to make that possible.
+ ;;(msgtrc "end-in-code:here b after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
+ (setq ppss (parse-partial-sexp ,syntax-start (+ ,syntax-end 0)))
+ ;;(msgtrc "end-in-code %s %s %s:ppss=%S" ,syntax-start ,syntax-end ',major ppss)
+ ;;(msgtrc "end-in-code:here c after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
+ ;; If inside a string or comment then the end marker is
+ ;; invalid:
+ ;;(msgtrc "mumamo-end-in-code:ppss=%s" ppss)
+ (if (or (nth 3 ppss)
+ (nth 4 ppss))
+ (progn
+ ;;(msgtrc "invalid end, syntax-end =%s" syntax-end)
+ (setq doesnt-ret nil)
+ (if (nth 4 ppss) ;; in comment, check if single line comment
+ (let ((here (point))
+ eol-pos)
+ ;;(msgtrc "end-in-code, was in comment, ppss=%S" ppss)
+ (goto-char ,syntax-end)
+ (setq eol-pos (line-end-position))
+ (goto-char here)
+ (setq ppss (parse-partial-sexp ,syntax-start (+ eol-pos 1)))
+ ;;(msgtrc "end-in-code, in comment, new ppss %s %s=%S" ,syntax-start (+ eol-pos 1) ppss)
+ (unless (nth 4 ppss)
+ (setq doesnt-ret t)))))
+ (setq doesnt-ret t)
+ ;;(msgtrc "valid end, syntax-end =%s" syntax-end)
+ ))))
+ (goto-char doesnt-here)
+ ;;(msgtrc "end-in-code:ret=%s" doesnt-ret)
+ doesnt-ret))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Easy chunk defining
+
+(defun mumamo-quick-chunk-forward (pos
+ min max
+ begin-mark end-mark inc mode
+ mark-is-border)
+ ;;(msgtrc "quick-chunk-forward %s %s %s" pos min max)
+ (let ((search-fw-exc-start
+ `(lambda (pos max)
+ (let ((exc-start
+ (if ,inc
+ (mumamo-chunk-start-fw-str-inc pos max ,begin-mark)
+ (mumamo-chunk-start-fw-str pos max ,begin-mark))))
+ (when exc-start
+ (list exc-start mode nil)))))
+ (search-fw-exc-end
+ `(lambda (pos max)
+ ;;(msgtrc "search-fw-exc-end %s %s, inc=%s, end-mark=%s" pos max ,inc ,end-mark)
+ (save-match-data
+ (let ((ret (if ,inc
+ (mumamo-chunk-end-fw-str-inc pos max ,end-mark)
+ (mumamo-chunk-end-fw-str pos max ,end-mark))))
+ ;;(msgtrc "search-fw-exc-end ret=%s" ret)
+ ret))))
+ (find-borders
+ (when mark-is-border
+ `(lambda (start end exc-mode)
+ (let ((start-border)
+ (end-border))
+ (if (and ,inc);; exc-mode)
+ (progn
+ (when start
+ (setq start-border
+ (+ start (length ,begin-mark))))
+ (when end
+ (setq end-border
+ (- end (length ,end-mark)))))
+ (if (and (not ,inc) (not exc-mode))
+ (progn
+ (when start
+ (setq start-border
+ (+ start (length ,end-mark))))
+ (when end
+ (setq end-border
+ (- end (length ,begin-mark)))))))
+ (when (or start-border end-border)
+ (mumamo-msgfntfy "quick.start-border/end=%s/%s, start/end=%s/%s exc-mode=%s" start-border end-border start end exc-mode)
+ (list start-border end-border)))))))
+ (mumamo-possible-chunk-forward pos max
+ search-fw-exc-start
+ search-fw-exc-end
+ find-borders)))
+
+(defun mumamo-quick-static-chunk (pos
+ min max
+ begin-mark end-mark inc mode
+ mark-is-border)
+ (if t
+ (mumamo-quick-chunk-forward pos min max begin-mark end-mark inc mode mark-is-border)
+ ;; (let ((old (mumamo-quick-static-chunk-old pos min max begin-mark end-mark inc mode mark-is-border))
+ ;; (new (mumamo-quick-chunk-forward pos min max begin-mark end-mark inc mode mark-is-border)))
+ ;; (unless (equal old new) (msgtrc "equal=%s\n\told=%S\n\tnew=%S" (equal old new) old new))
+ ;; (if nil old new))
+ ))
+
+;; (defun mumamo-quick-static-chunk-old (pos
+;; min max
+;; begin-mark end-mark inc mode
+;; mark-is-border)
+;; "Quick way to make a chunk function with static dividers.
+;; Here is an example of how to use it:
+
+;; (defun mumamo-chunk-embperl-<- (pos min max)
+;; \"Find [- ... -], return range and perl-mode.\"
+;; (mumamo-quick-static-chunk pos min max \"[-\" \"-]\" nil 'perl-mode))
+
+;; As you can see POS, MIN and MAX comes from argument of the
+;; function you define.
+
+;; BEGIN-MARK should be a string that begins the chunk.
+;; END-MARK should be a string that ends the chunk.
+
+;; If INC is non-nil then the dividers are included in the chunk.
+;; Otherwise they are instead made parts of the surrounding chunks.
+
+;; MODE should be the major mode for the chunk.
+
+;; If MARK-IS-BORDER is non-nil then the marks are just borders and
+;; not supposed to have the same syntax as the inner part of the
+
+;; Fix-me: This can only be useful if the marks are included in the
+;; chunk, ie INC is non-nil. Should not these two arguments be
+;; mixed then?
+;; "
+;; (mumamo-msgfntfy "quick.pos=%s min,max=%s,%s begin-mark/end=%s/%s mark-is-border=%s" pos min max begin-mark end-mark mark-is-border)
+;; (let ((search-bw-exc-start
+;; `(lambda (pos min)
+;; (let ((exc-start
+;; (if ,inc
+;; (mumamo-chunk-start-bw-str-inc pos min begin-mark)
+;; (mumamo-chunk-start-bw-str pos min begin-mark))))
+;; (when (and exc-start
+;; (<= exc-start pos))
+;; (cons exc-start mode)))))
+;; (search-bw-exc-end
+;; `(lambda (pos min)
+;; (if ,inc
+;; (mumamo-chunk-end-bw-str-inc pos min ,end-mark)
+;; (mumamo-chunk-end-bw-str pos min ,end-mark))))
+;; (search-fw-exc-start
+;; `(lambda (pos max)
+;; (if ,inc
+;; (mumamo-chunk-start-fw-str-inc pos max ,begin-mark)
+;; (mumamo-chunk-start-fw-str pos max ,begin-mark))))
+;; (search-fw-exc-end
+;; `(lambda (pos max)
+;; (save-match-data
+;; (if ,inc
+;; (mumamo-chunk-end-fw-str-inc pos max ,end-mark)
+;; (mumamo-chunk-end-fw-str pos max ,end-mark)))))
+;; (find-borders
+;; (when mark-is-border
+;; `(lambda (start end exc-mode)
+;; (let ((start-border)
+;; (end-border))
+;; (if (and ,inc exc-mode)
+;; (progn
+;; (when start
+;; (setq start-border
+;; (+ start (length ,begin-mark))))
+;; (when end
+;; (setq end-border
+;; (- end (length ,end-mark)))))
+;; (if (and (not ,inc) (not exc-mode))
+;; (progn
+;; (when start
+;; (setq start-border
+;; (+ start (length ,end-mark))))
+;; (when end
+;; (setq end-border
+;; (- end (length ,begin-mark)))))))
+;; (when (or start-border end-border)
+;; (mumamo-msgfntfy "quick.start-border/end=%s/%s, start/end=%s/%s exc-mode=%s" start-border end-border start end exc-mode)
+;; (list start-border end-border)))))))
+;; (mumamo-find-possible-chunk pos min max
+;; search-bw-exc-start
+;; search-bw-exc-end
+;; search-fw-exc-start
+;; search-fw-exc-end
+;; find-borders)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Changing the major mode that the user sees
+
+(defvar mumamo-unread-command-events-timer nil)
+(make-variable-buffer-local 'mumamo-unread-command-events-timer)
+
+(defun mumamo-unread-command-events (command-keys new-major old-last-command)
+ "Sync new keymaps after changing major mode in a timer.
+Also tell new major mode.
+
+COMMAND-KEYS is the keys entered after last command and the call
+to `mumamo-idle-set-major-mode' \(which is done in an idle
+timer). Those keys are added to `unread-command-events' so they
+can be used in the new keymaps. They should be in the format
+returned by
+
+ \(listify-key-sequence (this-command-keys-vector))
+
+NEW-MAJOR mode is the new major mode.
+
+OLD-LAST-COMMAND is the value of `last-command' after switching
+major mode. \(This is cleared by the function `top-level' so
+this function will not see it since it is run in a timer.)"
+ (mumamo-condition-case err
+ (progn
+ ;; last-command seems to be cleared by top-level so set it
+ ;; back here.
+ (unless last-command
+ (setq last-command old-last-command))
+ (when (< 0 (length command-keys))
+ ;;(setq last-command-char nil) ;; For `viper-command-argument'
+ (setq unread-command-events (append command-keys nil)))
+ (message "Switched to %s" new-major))
+ (error
+ (let ((mumamo-display-error-lwarn t))
+ (mumamo-display-error 'mumamo-unread-command-events "err=%s" err)))))
+
+(defvar mumamo-idle-set-major-mode-timer nil)
+(make-variable-buffer-local 'mumamo-idle-set-major-mode-timer)
+(put 'mumamo-idle-set-major-mode-timer 'permanent-local t)
+
+(defun mumamotemp-pre-command ()
+ "Temporary command for debugging."
+ (message "mumamotemp-pre 1: modified=%s %s" (buffer-modified-p) (current-buffer)))
+(defun mumamotemp-post-command ()
+ "Temporary command for debugging."
+ (message "mumamotemp-post 1: modified=%s %s" (buffer-modified-p) (current-buffer)))
+(put 'mumamotemp-pre-command 'permanent-local-hook t)
+(put 'mumamotemp-post-command 'permanent-local-hook t)
+(defun mumamotemp-start ()
+ "Temporary command for debugging."
+ (add-hook 'post-command-hook 'mumamotemp-post-command nil t)
+ (add-hook 'pre-command-hook 'mumamotemp-pre-command nil t))
+
+(defsubst mumamo-cancel-idle-set-major-mode ()
+ (when (timerp mumamo-idle-set-major-mode-timer)
+ (cancel-timer mumamo-idle-set-major-mode-timer))
+ (setq mumamo-idle-set-major-mode-timer nil))
+
+(defun mumamo-request-idle-set-major-mode ()
+ "Setup to change major mode from chunk when Emacs is idle."
+ (mumamo-cancel-idle-set-major-mode)
+ (setq mumamo-idle-set-major-mode-timer
+ (run-with-idle-timer
+ mumamo-set-major-mode-delay
+ nil
+ 'mumamo-idle-set-major-mode (current-buffer) (selected-window))))
+
+(defvar mumamo-done-first-set-major nil)
+(make-variable-buffer-local 'mumamo-done-first-set-major)
+(put 'mumamo-done-first-set-major 'permanent-local t)
+
+;; Fix-me: Add a property to the symbol instead (like in CUA).
+(defvar mumamo-safe-commands-in-wrong-major
+ '(self-insert-command
+ fill-paragraph ;; It changes major mode
+ forward-char
+ viper-forward-char
+ backward-char
+ viper-backward-char
+ next-line
+ viper-next-line
+ previous-line
+ viper-previous-line
+ scroll-down
+ cua-scroll-down
+ scroll-up
+ cua-scroll-up
+ move-beginning-of-line
+ move-end-of-line
+ nonincremental-search-forward
+ nonincremental-search-backward
+ mumamo-backward-chunk
+ mumamo-forward-chunk
+ ;; Fix-me: add more
+ )
+ )
+
+(defun mumamo-fetch-local-map (major)
+ "Fetch local keymap for major mode MAJOR.
+Do that by turning on the major mode in a new buffer. Add the
+keymap to `mumamo-major-modes-local-maps'.
+
+Return the fetched local map."
+ (let (temp-buf-name
+ temp-buf
+ local-map)
+ (setq temp-buf-name (concat "mumamo-fetch-major-mode-local-"
+ (symbol-name major)))
+ (setq temp-buf (get-buffer temp-buf-name))
+ (when temp-buf (kill-buffer temp-buf))
+ (setq temp-buf (get-buffer-create temp-buf-name))
+ (with-current-buffer temp-buf
+ (let ((mumamo-fetching-major t))
+ (funcall major))
+ (setq local-map (current-local-map))
+ (when local-map (setq local-map (copy-keymap (current-local-map))))
+ (add-to-list 'mumamo-major-modes-local-maps
+ (cons major-mode local-map)))
+ (kill-buffer temp-buf)
+ local-map))
+
+(defvar mumamo-post-command-chunk nil)
+(make-variable-buffer-local 'mumamo-post-command-chunk)
+
+(defun mumamo-post-command-get-chunk (pos)
+ "Get chunk at POS fast."
+ (let ((have-regions (and (boundp 'mumamo-regions)
+ mumamo-regions)))
+ (when have-regions (setq mumamo-post-command-chunk nil))
+ (if (and mumamo-post-command-chunk
+ (overlayp mumamo-post-command-chunk)
+ ;;(progn (message "here a=%s" mumamo-post-command-chunk) t)
+ (overlay-buffer mumamo-post-command-chunk)
+ ;;(progn (message "here b=%s" mumamo-post-command-chunk) t)
+ (< pos (overlay-end mumamo-post-command-chunk))
+ ;;(progn (message "here c=%s" mumamo-post-command-chunk) t)
+ (>= pos (overlay-start mumamo-post-command-chunk))
+ ;;(progn (message "here d=%s" mumamo-post-command-chunk) t)
+ (mumamo-chunk-major-mode mumamo-post-command-chunk)
+ ;;(progn (msgtrc "here e=%s" mumamo-post-command-chunk) t)
+ )
+ mumamo-post-command-chunk
+ ;;(msgtrc "--------------- new post-command-chunk")
+ (setq mumamo-post-command-chunk
+ (or (unless have-regions (mumamo-get-existing-new-chunk-at (point) nil))
+ (mumamo-find-chunks (point) "post-command-get-chunk"))))))
+
+;; (setq mumamo-set-major-mode-delay 10)
+(defun mumamo-set-major-post-command ()
+ "Change major mode if necessary after a command.
+If the major mode for chunk at `window-point' differ from current
+major mode then change major mode to that for the chunk. If
+however `mumamo-set-major-mode-delay' is greater than 0 just
+request a change of major mode when Emacs is idle that long.
+
+See the variable above for an explanation why a delay might be
+needed \(and is the default)."
+ ;;(msgtrc "set-major-post-command here")
+ (let* ((in-pre-hook (memq 'mumamo-set-major-pre-command pre-command-hook))
+ (ovl (unless in-pre-hook (mumamo-post-command-get-chunk (point))))
+ (major (when ovl (mumamo-chunk-major-mode ovl)))
+ (set-it-now (not (or in-pre-hook (mumamo-fun-eq major major-mode)))))
+ ;;(msgtrc "set-major-post-command ovl=%s, in-pre-hook=%s" ovl in-pre-hook)
+ (if (not set-it-now)
+ (unless (mumamo-fun-eq major major-mode)
+ (when mumamo-idle-set-major-mode-timer
+ (mumamo-request-idle-set-major-mode)))
+ (if mumamo-done-first-set-major
+ (if (<= 0 mumamo-set-major-mode-delay)
+ ;; Window point has been moved to a new chunk with a new
+ ;; major mode. Major mode will not be changed directly,
+ ;; but in an idle timer or in pre-command-hook. To avoid
+ ;; that the user get the wrong key bindings for the new
+ ;; chunk fetch the local map directly and apply that.
+ (let* ((map-rec (assoc major mumamo-major-modes-local-maps))
+ (map (cdr map-rec)))
+ (unless map
+ (setq map (mumamo-fetch-local-map major)))
+ (unless (eq map 'no-local-map)
+ (use-local-map map))
+ (add-hook 'pre-command-hook 'mumamo-set-major-pre-command nil t)
+ (mumamo-request-idle-set-major-mode))
+ (mumamo-set-major major ovl)
+ (message "Switched to %s" major-mode))
+ (mumamo-set-major major ovl)))))
+
+(defun mumamo-set-major-pre-command ()
+ "Change major mode if necessary before a command.
+When the key sequence that invoked the command is in current
+local map and major mode is not the major mode for the current
+mumamo chunk then set major mode to that for the chunk."
+ (mumamo-condition-case err
+ ;; First see if we can avoid changing major mode
+ (if (memq this-command mumamo-safe-commands-in-wrong-major)
+ (mumamo-request-idle-set-major-mode)
+ ;;(message "pre point=%s" (point))
+ (let* ((ovl (mumamo-find-chunks (point) "mumamo-set-major-pre-command"))
+ (major (mumamo-chunk-major-mode ovl)))
+ ;;(message "pre point=%s" (point))
+ (if (not major)
+ (lwarn '(mumamo-set-major-pre-command) :error "major=%s" major)
+ (when (or (not (mumamo-fun-eq major-mode major))
+ (not (mumamo-set-major-check-keymap)))
+ (setq major-mode nil)
+ (mumamo-set-major major ovl)
+ ;; Unread the last command key sequence
+ (setq unread-command-events
+ (append (listify-key-sequence (this-command-keys-vector))
+ unread-command-events))
+ ;; Some commands, like `viper-command-argument' need to
+ ;; know the last command, so tell them.
+ (setq this-command (lambda ()
+ (interactive)
+ (setq this-command last-command)))))))
+ (error
+ (mumamo-display-error 'mumamo-set-major-pre-command
+ "cb:%s, %s" (current-buffer) (error-message-string err)))))
+
+(defun mumamo-idle-set-major-mode (buffer window)
+ "Set major mode from mumamo chunk when Emacs is idle.
+Do this only if current buffer is BUFFER and then do it in window
+WINDOW.
+
+See the variable `mumamo-set-major-mode-delay' for an
+explanation."
+ (save-match-data ;; runs in idle timer
+ (mumamo-msgfntfy "mumamo-idle-set-major-mode b=%s, window=%s" buffer window)
+ (with-selected-window window
+ ;; According to Stefan Monnier we need to set the buffer too.
+ (with-current-buffer (window-buffer window)
+ (when (eq buffer (current-buffer))
+ (mumamo-condition-case err
+ ;;(let* ((ovl (mumamo-get-chunk-at (point)))
+ ;;(message "idle point=%s" (point))
+ (let* ((ovl (mumamo-find-chunks (point) "mumamo-idle-set-major-mode"))
+ (major (mumamo-chunk-major-mode ovl))
+ (modified (buffer-modified-p)))
+ ;;(message "idle point=%s" (point))
+ (unless (mumamo-fun-eq major major-mode)
+ ;;(message "mumamo-set-major at A")
+ (mumamo-set-major major ovl)
+ ;; Fix-me: This is a bug workaround. Possibly in Emacs.
+ (when (and (buffer-modified-p)
+ (not modified))
+ (set-buffer-modified-p nil))
+ ;; sync keymap
+ (when (timerp mumamo-unread-command-events-timer)
+ (cancel-timer mumamo-unread-command-events-timer))
+ (when unread-command-events
+ ;; Save unread keys before calling `top-level' which
+ ;; will clear them.
+ (setq mumamo-unread-command-events-timer
+ (run-with-idle-timer
+ 0 nil
+ 'mumamo-unread-command-events
+ unread-command-events
+ major last-command))
+ (top-level)
+ )))
+ (error
+ (mumamo-display-error 'mumamo-idle-set-major-mode
+ "cb=%s, err=%s" (current-buffer) err))))))))
+
+(defun mumamo-post-command-1 (&optional no-debug)
+ "See `mumamo-post-command'.
+Turn on `debug-on-error' unless NO-DEBUG is nil."
+ (unless no-debug (setq debug-on-error t))
+ (setq mumamo-find-chunks-level 0)
+ (mumamo-msgfntfy "mumamo-post-command-1 ENTER: font-lock-mode=%s" font-lock-mode)
+ (if font-lock-mode
+ (mumamo-set-major-post-command)
+ ;;(mumamo-on-font-lock-off)
+ )
+ ;;(msgtrc "mumamo-post-command-1 EXIT: font-lock-keywords-only =%s" (default-value 'font-lock-keywords-only))
+ )
+
+
+
+
+(defvar mumamo-bug-3467-w14 41)
+(defvar mumamo-bug-3467-w15 51)
+;;(mumamo-check-has-bug3467 t)
+;;(kill-local-variable 'mumamo-bug-3467-w14)
+(defun mumamo-check-has-bug3467 (verbose)
+ (let ((has-bug nil))
+ (with-temp-buffer
+ (let ((mumamo-bug-3467-w14 42)
+ (mumamo-bug-3467-w15 52))
+ (when verbose (message "mumamo-bug-3467-w14 maybe let: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w14 (default-value 'mumamo-bug-3467-w14)))
+ (when verbose (message "mumamo-bug-3467-w15 maybe let: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w15 (default-value 'mumamo-bug-3467-w15)))
+ (set (make-local-variable 'mumamo-bug-3467-w14) 43)
+ (set-default 'mumamo-bug-3467-w14 44)
+ (set-default 'mumamo-bug-3467-w15 54)
+ (when verbose (message "mumamo-bug-3467-w14 maybe let: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w14 (default-value 'mumamo-bug-3467-w14)))
+ (when verbose (message "mumamo-bug-3467-w15 maybe let: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w15 (default-value 'mumamo-bug-3467-w15))))
+ (when verbose (message "mumamo-bug-3467-w14 top level: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w14 (default-value 'mumamo-bug-3467-w14)))
+ (when (/= mumamo-bug-3467-w14 43) (setq has-bug t))
+ (when (/= (default-value 'mumamo-bug-3467-w14) 41) (setq has-bug t))
+ (when verbose (message "mumamo-bug-3467-w15 top level: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w15 (default-value 'mumamo-bug-3467-w15)))
+ )
+ (when verbose (message "mumamo-bug-3467-w14 top level: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w14 (default-value 'mumamo-bug-3467-w14)))
+ (when verbose (message "mumamo-bug-3467-w15 top level: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w15 (default-value 'mumamo-bug-3467-w15)))
+ (or has-bug
+ (local-variable-p 'mumamo-bug-3467-w14)
+ (/= (default-value 'mumamo-bug-3467-w14) 41)
+ )
+ ))
+
+(defvar mumamo-has-bug3467 (mumamo-check-has-bug3467 nil))
+
+(defun mumamo-emacs-start-bug3467-timer-if-needed ()
+ "Work around for Emacs bug 3467. The only one I have found."
+ (when mumamo-has-bug3467
+ (run-with-idle-timer 0 nil 'mumamo-emacs-bug3467-workaround)))
+
+(defun mumamo-emacs-bug3467-workaround ()
+ "Work around for Emacs bug 3467. The only one I have found."
+ (set-default 'font-lock-keywords-only nil))
+
+
+
+
+(defun mumamo-post-command ()
+ "Run this in `post-command-hook'.
+Change major mode if necessary."
+ ;;(msgtrc "mumamo-post-command")
+ (when mumamo-multi-major-mode
+ (mumamo-condition-case err
+ (mumamo-post-command-1 t)
+ (error
+ (mumamo-msgfntfy "mumamo-post-command %S" err)
+ ;; Warnings are to disturbing when run in post-command-hook,
+ ;; but this message is important so show it with an highlight.
+ (message
+ (propertize
+ "%s\n- Please try M-: (mumamo-post-command-1) to see what happened."
+ 'face 'highlight)
+ (error-message-string err))))))
+
+(defun mumamo-change-major-function ()
+ "Function added to `change-major-mode-hook'.
+Remove mumamo when changing to a new major mode if the change is
+not done because point was to a new chunk."
+ (unless mumamo-set-major-running
+ (mumamo-turn-off-actions)))
+
+(defun mumamo-derived-from-mode (major from-mode)
+ "Return t if major mode MAJOR is derived from FROM-MODE."
+ (let ((major-mode major))
+ (derived-mode-p from-mode)))
+
+;; This is the new version of add-hook. For its origin see
+;; http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg00169.html
+;;
+;;(unless (> emacs-major-version 22)
+(defvar mumamo-test-add-hook nil
+ "Internal use.")
+(unless (and t
+ (let ((has-it nil))
+ ;;(add-hook 'mumamo-test-add-hook 'mumamo-jit-lock-after-change nil t)
+ (add-hook 'mumamo-test-add-hook 'mumamo-after-change nil t)
+ (setq has-it (eq 'permanent-local-hook
+ (get 'mumamo-test-add-hook 'permanent-local)))
+ has-it))
+ (defun add-hook (hook function &optional append local)
+ "Add to the value of HOOK the function FUNCTION.
+FUNCTION is not added if already present.
+FUNCTION is added (if necessary) at the beginning of the hook list
+unless the optional argument APPEND is non-nil, in which case
+FUNCTION is added at the end.
+
+The optional fourth argument, LOCAL, if non-nil, says to modify
+the hook's buffer-local value rather than its default value.
+This makes the hook buffer-local if needed, and it makes t a member
+of the buffer-local value. That acts as a flag to run the hook
+functions in the default value as well as in the local value.
+
+HOOK should be a symbol, and FUNCTION may be any valid function. If
+HOOK is void, it is first set to nil. If HOOK's value is a single
+function, it is changed to a list of functions."
+ (or (boundp hook) (set hook nil))
+ (or (default-boundp hook) (set-default hook nil))
+ (if local (unless (local-variable-if-set-p hook)
+ (set (make-local-variable hook) (list t)))
+ ;; Detect the case where make-local-variable was used on a hook
+ ;; and do what we used to do.
+ (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
+ (setq local t)))
+ (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+ ;; If the hook value is a single function, turn it into a list.
+ (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+ (setq hook-value (list hook-value)))
+ ;; Do the actual addition if necessary
+ (unless (member function hook-value)
+ (setq hook-value
+ (if append
+ (append hook-value (list function))
+ (cons function hook-value))))
+ ;; Set the actual variable
+ (if local
+ (progn
+ ;; If HOOK isn't a permanent local,
+ ;; but FUNCTION wants to survive a change of modes,
+ ;; mark HOOK as partially permanent.
+ (and (symbolp function)
+ (get function 'permanent-local-hook)
+ (not (get hook 'permanent-local))
+ (put hook 'permanent-local 'permanent-local-hook))
+ (set hook hook-value))
+ (set-default hook hook-value))))
+ )
+
+
+(defvar mumamo-survive-hooks
+ '(
+ ;; activate-mark-hook after-change-functions after-save-hook
+ ;; before-save-functions auto-save-hook before-revert-hook
+ ;; buffer-access-fontify-functions calendar-load-hook
+ ;; command-line-functions compilation-finish-function
+ ;; deactivate-mark-hook find-file-hook
+ ;; find-file-not-found-functions first-change-hook
+ ;; kbd-macro-termination-hook kill-buffer-hook
+ ;; kill-buffer-query-functions menu-bar-update-hook
+ ;; post-command-hook pre-abbrev-expand-hook pre-command-hook
+ ;; write-contents-functions write-file-functions
+ ;; write-region-annotate-functions
+ ;; c-special-indent-hook
+ ))
+
+;;
+;; Emulation modes
+;;
+;; These variables should have 'permanant-local t set in their
+;; packages IMO, but now they do not have that.
+(eval-after-load 'viper-cmd
+ (progn
+ (put 'viper-after-change-functions 'permanent-local t)
+ (put 'viper-before-change-functions 'permanent-local t)
+ ))
+(eval-after-load 'viper
+ (progn
+ (put 'viper-post-command-hooks 'permanent-local t)
+ (put 'viper-pre-command-hooks 'permanent-local t)
+ ;;minor-mode-map-alist
+ ;; viper-mode-string -- is already buffer local, globally void
+ (put 'viper-mode-string 'permanent-local t)
+ ))
+;;viper-tut--part
+(eval-after-load 'viper-init
+ (progn
+ (put 'viper-d-com 'permanent-local t)
+ (put 'viper-last-insertion 'permanent-local t)
+ (put 'viper-command-ring 'permanent-local t)
+ (put 'viper-vi-intercept-minor-mode 'permanent-local t)
+ (put 'viper-vi-basic-minor-mode 'permanent-local t)
+ (put 'viper-vi-local-user-minor-mode 'permanent-local t)
+ (put 'viper-vi-global-user-minor-mode 'permanent-local t)
+ (put 'viper-vi-state-modifier-minor-mode 'permanent-local t)
+ (put 'viper-vi-diehard-minor-mode 'permanent-local t)
+ (put 'viper-vi-kbd-minor-mode 'permanent-local t)
+ (put 'viper-insert-intercept-minor-mode 'permanent-local t)
+ (put 'viper-insert-basic-minor-mode 'permanent-local t)
+ (put 'viper-insert-local-user-minor-mode 'permanent-local t)
+ (put 'viper-insert-global-user-minor-mode 'permanent-local t)
+ (put 'viper-insert-state-modifier-minor-mode 'permanent-local t)
+ (put 'viper-insert-diehard-minor-mode 'permanent-local t)
+ (put 'viper-insert-kbd-minor-mode 'permanent-local t)
+ (put 'viper-replace-minor-mode 'permanent-local t)
+ (put 'viper-emacs-intercept-minor-mode 'permanent-local t)
+ (put 'viper-emacs-local-user-minor-mode 'permanent-local t)
+ (put 'viper-emacs-global-user-minor-mode 'permanent-local t)
+ (put 'viper-emacs-kbd-minor-mode 'permanent-local t)
+ (put 'viper-emacs-state-modifier-minor-mode 'permanent-local t)
+ (put 'viper-vi-minibuffer-minor-mode 'permanent-local t)
+ (put 'viper-insert-minibuffer-minor-mode 'permanent-local t)
+ (put 'viper-automatic-iso-accents 'permanent-local t)
+ (put 'viper-special-input-method 'permanent-local t)
+ (put 'viper-intermediate-command 'permanent-local t)
+ ;; already local: viper-undo-needs-adjustment
+ (put 'viper-began-as-replace 'permanent-local t)
+ ;; already local: viper-replace-overlay
+ ;; already local: viper-last-posn-in-replace-region
+ ;; already local: viper-last-posn-while-in-insert-state
+ ;; already local: viper-sitting-in-replace
+ (put 'viper-replace-chars-to-delete 'permanent-local t)
+ (put 'viper-replace-region-chars-deleted 'permanent-local t)
+ (put 'viper-current-state 'permanent-local t)
+ (put 'viper-cted 'permanent-local t)
+ (put 'viper-current-indent 'permanent-local t)
+ (put 'viper-preserve-indent 'permanent-local t)
+ (put 'viper-auto-indent 'permanent-local t)
+ (put 'viper-electric-mode 'permanent-local t)
+ ;; already local: viper-insert-point
+ ;; already local: viper-pre-command-point
+ (put 'viper-com-point 'permanent-local t)
+ (put 'viper-ex-style-motion 'permanent-local t)
+ (put 'viper-ex-style-editing 'permanent-local t)
+ (put 'viper-ESC-moves-cursor-back 'permanent-local t)
+ (put 'viper-delete-backwards-in-replace 'permanent-local t)
+ ;; already local: viper-related-files-and-buffers-ring
+ (put 'viper-local-search-start-marker 'permanent-local t)
+ (put 'viper-search-overlay 'permanent-local t)
+ (put 'viper-last-jump 'permanent-local t)
+ (put 'viper-last-jump-ignore 'permanent-local t)
+ (put 'viper-minibuffer-current-face 'permanent-local t)
+ ;; already local: viper-minibuffer-overlay
+ (put 'viper-command-ring 'permanent-local t)
+ (put 'viper-last-insertion 'permanent-local t)
+ ))
+(eval-after-load 'viper-keym
+ (progn
+ ;; already local: viper-vi-local-user-map
+ ;; already local: viper-insert-local-user-map
+ ;; already local: viper-emacs-local-user-map
+ (put 'viper--key-maps 'permanent-local t)
+ (put 'viper--intercept-key-maps 'permanent-local t)
+ ;; already local: viper-need-new-vi-local-map
+ ;; already local: viper-need-new-insert-local-map
+ ;; already local: viper-need-new-emacs-local-map
+ ))
+(eval-after-load 'viper-mous
+ (progn
+ (put 'viper-mouse-click-search-noerror 'permanent-local t)
+ (put 'viper-mouse-click-search-limit 'permanent-local t)
+ ))
+(eval-after-load 'viper-util
+ (progn
+ (put 'viper-syntax-preference 'permanent-local t)
+ (put 'viper-non-word-characters 'permanent-local t)
+ (put 'viper-ALPHA-char-class 'permanent-local t)
+ ))
+
+(eval-after-load 'cua-base
+ (progn
+ (put 'cua-inhibit-cua-keys 'permanent-local t)
+ (put 'cua--explicit-region-start 'permanent-local t)
+ (put 'cua--status-string 'permanent-local t)
+ ))
+;; This is for the defvar in ido.el:
+(eval-after-load 'ido
+ (progn
+ (put 'cua-inhibit-cua-keys 'permanent-local t)
+ ))
+(eval-after-load 'cua-rect
+ (progn
+ (put 'cua--rectangle 'permanent-local t)
+ (put 'cua--rectangle-overlays 'permanent-local t)
+ ))
+(eval-after-load 'edt
+ (progn
+ (put 'edt-select-mode 'permanent-local t)
+ ))
+(eval-after-load 'tpu-edt
+ (progn
+ (put 'tpu-newline-and-indent-p 'permanent-local t)
+ (put 'tpu-newline-and-indent-string 'permanent-local t)
+ (put 'tpu-saved-delete-func 'permanent-local t)
+ (put 'tpu-buffer-local-map 'permanent-local t)
+ (put 'tpu-mark-flag 'permanent-local t)
+ ))
+(eval-after-load 'vi
+ (progn
+ (put 'vi-add-to-mode-line 'permanent-local t)
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-scroll-amount
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-shift-width
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-point
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-length
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-repetition
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-overwrt-p
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-prefix-code
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-last-change-command
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-last-shell-command
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-last-find-char
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mark-alist
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-insert-state
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-local-map
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-mode-name
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-major-mode
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-case-fold
+ ;;
+ ))
+(eval-after-load 'vi
+ (progn
+ (put 'vip-emacs-local-map 'permanent-local t)
+ (put 'vip-insert-local-map 'permanent-local t)
+ (put 'vip-insert-point 'permanent-local t)
+ (put 'vip-com-point 'permanent-local t)
+ (put 'vip-current-mode 'permanent-local t)
+ (put 'vip-emacs-mode-line-buffer-identification 'permanent-local t)
+ (put 'vip-current-major-mode 'permanent-local t)
+ ))
+
+(eval-after-load 'hi-lock
+ (progn
+ (put 'hi-lock-mode 'permanent-local t)
+ ))
+
+;;
+;; Minor modes that are not major mode specific
+;;
+
+(put 'visual-line-mode 'permanent-local t)
+
+(eval-after-load 'flymake
+ (progn
+ ;; hook functions:
+ (put 'flymake-after-change-function 'permanent-local-hook t)
+ (put 'flymake-after-save-hook 'permanent-local-hook t)
+ (put 'flymake-kill-buffer-hook 'permanent-local-hook t)
+ ;; hooks:
+;;; (put 'after-change-functions 'permanent-local 'permanent-local-hook)
+;;; (put 'after-save-hook 'permanent-local 'permanent-local-hook)
+;;; (put 'kill-buffer-hook 'permanent-local 'permanent-local-hook)
+ ;; vars:
+ (put 'flymake-mode 'permanent-local t)
+ (put 'flymake-is-running 'permanent-local t)
+ (put 'flymake-timer 'permanent-local t)
+ (put 'flymake-last-change-time 'permanent-local t)
+ (put 'flymake-check-start-time 'permanent-local t)
+ (put 'flymake-check-was-interrupted 'permanent-local t)
+ (put 'flymake-err-info 'permanent-local t)
+ (put 'flymake-new-err-info 'permanent-local t)
+ (put 'flymake-output-residual 'permanent-local t)
+ (put 'flymake-mode-line 'permanent-local t)
+ (put 'flymake-mode-line-e-w 'permanent-local t)
+ (put 'flymake-mode-line-status 'permanent-local t)
+ (put 'flymake-temp-source-file-name 'permanent-local t)
+ (put 'flymake-master-file-name 'permanent-local t)
+ (put 'flymake-temp-master-file-name 'permanent-local t)
+ (put 'flymake-base-dir 'permanent-local t)))
+
+;; (eval-after-load 'imenu
+;; (progn
+;; ;; Fix-me: imenu is only useful for main major mode. The menu
+;; ;; disappears in sub chunks because it is tighed to
+;; ;; local-map. Don't know what to do about that. I do not
+;; ;; understand the reason for binding it to local-map, but I
+;; ;; suspect the intent is to have different menu items for
+;; ;; different modes. Could not that be achieved by deleting the
+;; ;; menu and creating it again when changing major mode? (That must
+;; ;; be implemented in imenu.el of course.)
+;; ;;
+;; ;; hook functions:
+;; ;;; (put 'imenu-update-menubar 'permanent-local-hook t)
+;; ;; hooks:
+;; (put 'menu-bar-update-hook 'permanent-local 'permanent-local-hook)
+;; ;; vars:
+;; (put 'imenu-generic-expression 'permanent-local t)
+;; (put 'imenu-create-index-function 'permanent-local t)
+;; (put 'imenu-prev-index-position-function 'permanent-local t)
+;; (put 'imenu-extract-index-name-function 'permanent-local t)
+;; (put 'imenu-name-lookup-function 'permanent-local t)
+;; (put 'imenu-default-goto-function 'permanent-local t)
+;; (put 'imenu--index-alist 'permanent-local t)
+;; (put 'imenu--last-menubar-index-alist 'permanent-local t)
+;; (put 'imenu-syntax-alist 'permanent-local t)
+;; (put 'imenu-case-fold-search 'permanent-local t)
+;; (put 'imenu-menubar-modified-tick 'permanent-local t)
+;; ))
+
+(eval-after-load 'longlines
+ (progn
+ ;; Fix-me: take care of longlines-mode-off
+ (put 'longlines-mode 'permanent-local t)
+ (put 'longlines-wrap-beg 'permanent-local t)
+ (put 'longlines-wrap-end 'permanent-local t)
+ (put 'longlines-wrap-point 'permanent-local t)
+ (put 'longlines-showing 'permanent-local t)
+ (put 'longlines-decoded 'permanent-local t)
+ ;;
+ (put 'longlines-after-change-function 'permanent-local-hook t)
+ (put 'longlines-after-revert-hook 'permanent-local-hook t)
+ (put 'longlines-before-revert-hook 'permanent-local-hook t)
+ (put 'longlines-decode-buffer 'permanent-local-hook t)
+ (put 'longlines-decode-region 'permanent-local-hook t)
+ (put 'longlines-mode-off 'permanent-local-hook t)
+ (put 'longlines-post-command-function 'permanent-local-hook t)
+ (put 'longlines-window-change-function 'permanent-local-hook t)
+ ;;(put 'mail-indent-citation 'permanent-local-hook t)
+ ))
+
+
+;; Fix-me: Rails, many problematic things:
+
+;;; Fix-me: No idea about these, where are they used?? Add them to
+;;; mumamo-per-buffer-local-vars?:
+;; predictive-main-dict
+;; predictive-prog-mode-main-dict
+;; predictive-use-auto-learn-cache
+;; predictive-dict-autosave-on-kill-buffer
+(eval-after-load 'inf-ruby
+ (progn
+ (put 'inferior-ruby-first-prompt-pattern 'permanent-local t)
+ (put 'inferior-ruby-prompt-pattern 'permanent-local t)
+ ))
+
+;;; These are for the output buffer (no problems):
+;; font-lock-keywords-only
+;; font-lock-defaults -- always buffer local
+;; scroll-margin
+;; scroll-preserve-screen-position
+
+(eval-after-load 'rails-script
+ (progn
+ (put 'rails-script:run-after-stop-hook 'permanent-local t)
+ (put 'rails-script:show-buffer-hook 'permanent-local t)
+ (put 'rails-script:output-mode-ret-value 'permanent-local t)
+ ))
+
+;;; No problems I believe (it is in output buffer):
+;; compilation-error-regexp-alist-alist
+;; compilation-error-regexp-alist
+
+;;; Fix-me: This is in the minor mode, what to do? Looks like it
+;;; should have 'permanent-local t - in this case. I have added it to
+;;; mumamo-per-buffer-local-vars for now.
+;; tags-file-name
+
+(eval-after-load 'rails
+ (progn
+ (put 'rails-primary-switch-func 'permanent-local t)
+ (put 'rails-secondary-switch-func 'permanent-local t)
+ ))
+
+;; (defun test-js-perm ()
+;; (put 'js--quick-match-re 'permanent-local t)
+;; (put 'js--quick-match-re-func 'permanent-local t)
+;; (put 'js--cache-end 'permanent-local t)
+;; (put 'js--last-parse-pos 'permanent-local t)
+;; (put 'js--state-at-last-parse-pos 'permanent-local t)
+;; (put 'js--tmp-location 'permanent-local t))
+;; (test-js-perm)
+
+(defvar mumamo-per-buffer-local-vars
+ '(
+ buffer-file-name
+ left-margin-width
+ right-margin-width
+ ;; Fix-me: This is to prevent font-lock-mode turning off/on, but
+ ;; is it necessary?
+ ;;font-lock-mode-major-mode
+ tags-file-name
+ nxhtml-menu-mode
+ ;; Fix-me: adding rng timers here stops Emacs from looping after
+ ;; indenting in ind-0-error.php, but I have no clue why. Hm. This
+ ;; problem is gone, but I forgot why.
+ rng-c-current-token ;;rng-cmpct.el:132:(make-variable-buffer-local 'rng-c-current-token)
+ rng-c-escape-positions ;;rng-cmpct.el:341:(make-variable-buffer-local 'rng-c-escape-positions)
+ rng-c-file-name ;;rng-cmpct.el:344:(make-variable-buffer-local 'rng-c-file-name)
+ rng-current-schema-file-name ;;rng-loc.el:37:(make-variable-buffer-local 'rng-current-schema-file-name)
+ rng-current-schema ;;rng-pttrn.el:71:(make-variable-buffer-local 'rng-current-schema)
+ ;;rng-validate-timer is permanent-local t
+ ;;rng-validate-timer ;;rng-valid.el:141:(make-variable-buffer-local 'rng-validate-timer)
+ ;;rng-validate-quick-timer is permanent-local t
+ ;;rng-validate-quick-timer ;;rng-valid.el:146:(make-variable-buffer-local 'rng-validate-quick-timer)
+ rng-error-count ;;rng-valid.el:153:(make-variable-buffer-local 'rng-error-count)
+ rng-message-overlay ;;rng-valid.el:158:(make-variable-buffer-local 'rng-message-overlay)
+ rng-message-overlay-inhibit-point ;;rng-valid.el:165:(make-variable-buffer-local 'rng-message-overlay-inhibit-point)
+ rng-message-overlay-current ;;rng-valid.el:169:(make-variable-buffer-local 'rng-message-overlay-current)
+ rng-validate-up-to-date-end ;;rng-valid.el:188:(make-variable-buffer-local 'rng-validate-up-to-date-end)
+ rng-conditional-up-to-date-start ;;rng-valid.el:199:(make-variable-buffer-local 'rng-conditional-up-to-date-start)
+ rng-conditional-up-to-date-end ;;rng-valid.el:205:(make-variable-buffer-local 'rng-conditional-up-to-date-end)
+ rng-validate-mode ;;rng-valid.el:212:(make-variable-buffer-local 'rng-validate-mode)
+ rng-dtd ;;rng-valid.el:215:(make-variable-buffer-local 'rng-dtd)
+
+ nxml-syntax-highlight-flag ;; For pre-Emacs nxml
+ ;;nxml-ns-state - not buffer local currently
+ nxml-prolog-regions ;;snxml-mode.el:362:(make-variable-buffer-local 'nxml-prolog-regions)
+ nxml-last-fontify-end ;;dnxml-mode.el:367:(make-variable-buffer-local 'nxml-last-fontify-end)
+ nxml-degraded ;;dnxml-mode.el:373:(make-variable-buffer-local 'nxml-degraded)
+ nxml-char-ref-extra-display ;;ynxml-mode.el:397:(make-variable-buffer-local 'nxml-char-ref-extra-display)
+ nxml-prolog-end ;;dnxml-rap.el:92:(make-variable-buffer-local 'nxml-prolog-end)
+ nxml-scan-end ;;dnxml-rap.el:107:(make-variable-buffer-local 'nxml-scan-end)
+
+ ;;buffer-invisibility-spec
+ ;;header-line-format
+
+ ;; Fix-me: These must be handled with 'permanent-local since they may be changed:
+ line-move-visual ;;simple.el:4537: (kill-local-variable 'line-move-visual)
+ word-wrap ;;simple.el:4538: (kill-local-variable 'word-wrap)
+ truncate-lines ;;simple.el:4539: (kill-local-variable 'truncate-lines)
+ truncate-partial-width-windows ;;simple.el:4540: (kill-local-variable 'truncate-partial-width-windows)
+ fringe-indicator-alist ;;simple.el:4541: (kill-local-variable 'fringe-indicator-alist)
+ visual-line--saved-state ;;simple.el:4544: (kill-local-variable 'visual-line--saved-state)))
+ vis-mode-saved-buffer-invisibility-spec ;;simple.el:6237: (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
+
+ )
+ "Per buffer local variables.
+See also `mumamo-per-main-major-local-vars'.")
+
+;; Fix-me: use this, but how exactly? I think the var values must be
+;; picked up at every change from main major mode. And restored after
+;; changing to the new major mode - but maybe a bit differently if
+;; this is the main major mode.
+(defvar mumamo-per-main-major-local-vars
+ '(
+ buffer-invisibility-spec
+ header-line-format
+ )
+ "Per main major local variables.
+Like `mumamo-per-buffer-local-vars', but this is fetched from the
+main major mode.")
+
+;; (when nil
+;; (make-variable-buffer-local 'mumamo-survive-minor-modes)
+;; (put 'mumamo-survive-minor-modes 'permanent-local t)
+;; (defvar mumamo-survive-minor-modes nil
+;; "Hold local minor mode variables specific major modes.
+;; Those values are saved when leaving a chunk with a certain
+;; major mode and restored when entering a chunk with the same
+;; major mode again.
+
+;; The value of this variable is an associative list where the key
+;; is a list with
+
+;; \(MAJOR-MODE MINOR-MODE)
+
+;; and the value is a stored value for the minor mode.")
+;; )
+
+(defun mumamo-make-variable-buffer-permanent (var)
+ "Make buffer local value of VAR survive when moving point to a new chunk.
+When point is moved between chunks in a multi major mode the
+major mode will be changed. This will by default kill all local
+variables unless they have a non-nil `permanent-local' property
+\(see info node `(elisp)Creating Buffer-Local').
+
+If you do not want to put a `permanent-local' property on a
+variable you can instead use this function to make variable VAR
+survive chunk switches in all mumamo multi major mode buffers."
+ ;; If you want it to survive chunk switches only in the current
+ ;; buffer then use `mumamo-make-local-permanent' instead."
+ (pushnew var (default-value 'mumamo-per-buffer-local-vars)))
+
+;; ;; Fix-me: use local value
+;; ;; Fix-me: delelete local value when exiting mumamo
+;; (defun mumamo-make-local-permanent (var)
+;; "Make buffer local value of VAR survive when moving point to a new chunk.
+;; This is for the current buffer only.
+;; In most cases you almost certainly want to use
+;; `mumamo-make-variable-buffer-permanent' instead."
+;; (pushnew var mumamo-per-buffer-local-vars))
+
+(defvar mumamo-per-buffer-local-vars-done-by-me nil
+ "Variables set by mumamo already.
+Used to avoid unnecessary warnings if setting major mode fails.")
+
+;; (mumamo-hook-p 'viper-pre-command-hooks)
+;; (mumamo-hook-p 'viper-before-change-functions)
+;; (mumamo-hook-p 'c-special-indent-hook)
+(defun mumamo-hook-p (sym)
+ "Try to detect if SYM is a hook variable.
+Just check the name."
+ (let ((name (symbol-name sym)))
+ (or (string= "-hook" (substring name -5))
+ (string= "-hooks" (substring name -6))
+ (string= "-functions" (substring name -10)))))
+
+(defvar mumamo-major-mode nil)
+(make-variable-buffer-local 'mumamo-major-mode)
+(put 'mumamo-major-mode 'permanent-local t)
+
+(defvar mumamo-change-major-mode-no-nos
+ '((font-lock-change-mode t)
+ (longlines-mode-off t)
+ global-font-lock-mode-cmhh
+ (nxml-cleanup t)
+ (turn-off-hideshow t))
+ "Avoid running these in `change-major-mode-hook'.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Remove things from hooks temporarily
+
+;; Fix-me: This is a bit disorganized, could not decide which level I
+;; wanted this on.
+
+(defvar mumamo-after-change-major-mode-no-nos
+ '(;;nxhtml-global-minor-mode-enable-in-buffers
+ global-font-lock-mode-enable-in-buffers)
+ "Avoid running these in `after-change-major-mode-hook'.")
+
+(defvar mumamo-removed-from-hook nil)
+
+(defun mumamo-remove-from-hook (hook remove)
+ "From hook HOOK remove functions in list REMOVE.
+Save HOOK and the list of functions removed to
+`mumamo-removed-from-hook'."
+ (let (did-remove
+ removed)
+ (dolist (rem remove)
+ ;;(message "rem.rem=%s" rem)
+ (setq did-remove nil)
+ (if (listp rem)
+ (when (memq (car rem) (symbol-value hook))
+ (setq did-remove t)
+ (remove-hook hook (car rem) t))
+ (when (memq rem (symbol-value hook))
+ (setq did-remove t)
+ (remove-hook hook rem)))
+ (when did-remove
+ (setq removed (cons rem removed))))
+ (setq mumamo-removed-from-hook
+ (cons (cons hook removed)
+ mumamo-removed-from-hook))))
+
+(defun mumamo-addback-to-hooks ()
+ "Add back what was removed by `mumamo-remove-from-hook'."
+ ;;(message "mumamo-removed-from-hook=%s" mumamo-removed-from-hook)
+ (dolist (rem-rec mumamo-removed-from-hook)
+ (mumamo-addback-to-hook (car rem-rec) (cdr rem-rec))))
+
+(defun mumamo-addback-to-hook (hook removed)
+ "Add to hook HOOK the list of functions in REMOVED."
+ ;;(message "addback: hook=%s, removed=%s" hook removed)
+ (dolist (rem removed)
+ ;;(message "add.rem=%s" rem)
+ (if (listp rem)
+ (add-hook hook (car rem) nil t)
+ (add-hook hook rem))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Compare mumamo-irrelevant-buffer-local-vars
+(defvar mumamo-buffer-locals-dont-set
+ '(
+ adaptive-fill-mode
+ adaptive-fill-first-line-regexp
+ adaptive-fill-regexp
+ add-log-current-defun-header-regexp
+ auto-composition-function
+ auto-composition-mode
+ auto-composition-mode-major-mode
+ auto-fill-chars
+
+ beginning-of-defun-function
+ buffer-auto-save-file-format
+ buffer-auto-save-file-name
+ buffer-backed-up
+ buffer-display-count
+ buffer-display-time
+ buffer-file-coding-system
+ buffer-file-format
+ buffer-file-name
+ buffer-file-truename
+ buffer-invisibility-spec
+ buffer-read-only
+ buffer-saved-size
+ buffer-undo-list
+
+ c++-template-syntax-table
+ c-<-op-cont-regexp
+ c-<>-multichar-token-regexp
+ c->-op-cont-regexp
+ c-after-suffixed-type-decl-key
+ c-after-suffixed-type-maybe-decl-key
+ c-anchored-cpp-prefix
+ c-assignment-op-regexp
+ c-at-vsemi-p-fn
+ c-backslash-column
+ c-backslash-max-column
+ ;;c-basic-offset
+ c-before-font-lock-function
+ c-block-comment-prefix
+ c-block-comment-start-regexp
+ c-block-prefix-charset
+ c-block-stmt-1-key
+ c-block-stmt-2-key
+ c-brace-list-key
+ c-cast-parens
+ c-class-key
+ c-cleanup-list
+ c-colon-type-list-re
+ c-comment-only-line-offset
+ c-comment-prefix-regexp
+ c-comment-start-regexp
+ c-current-comment-prefix
+ c-decl-block-key
+ c-decl-hangon-key
+ c-decl-prefix-or-start-re
+ c-decl-prefix-re
+ c-decl-start-re
+ c-doc-comment-start-regexp
+ c-doc-comment-style
+ c-found-types
+ c-get-state-before-change-function
+ c-hanging-braces-alist
+ c-hanging-colons-alist
+ c-hanging-semi&comma-criteria
+ c-identifier-key
+ c-identifier-start
+ c-identifier-syntax-modifications
+ c-identifier-syntax-table
+ ;;c-indent-comment-alist
+ ;;c-indent-comments-syntactically-p
+ ;;c-indentation-style
+ c-keywords-obarray
+ c-keywords-regexp
+ c-known-type-key
+ c-label-kwds-regexp
+ c-label-minimum-indentation
+ c-label-prefix-re
+ c-line-comment-starter
+ c-literal-start-regexp
+ c-multiline-string-start-char
+ c-nonlabel-token-key
+ c-nonsymbol-chars
+ c-nonsymbol-token-regexp
+ c-not-decl-init-keywords
+ ;;c-offsets-alist
+ c-old-BOM
+ c-old-EOM
+ c-opt-<>-arglist-start
+ c-opt-<>-arglist-start-in-paren
+ c-opt-<>-sexp-key
+ c-opt-asm-stmt-key
+ c-opt-bitfield-key
+ c-opt-block-decls-with-vars-key
+ c-opt-block-stmt-key
+ c-opt-cpp-macro-define-id
+ c-opt-cpp-macro-define-start
+ c-opt-cpp-prefix
+ c-opt-cpp-start
+ c-opt-extra-label-key
+ c-opt-friend-key
+ c-opt-identifier-concat-key
+ c-opt-inexpr-brace-list-key
+ c-opt-method-key
+ c-opt-op-identifier-prefix
+ c-opt-postfix-decl-spec-key
+ c-opt-type-component-key
+ c-opt-type-concat-key
+ c-opt-type-modifier-key
+ c-opt-type-suffix-key
+ c-other-decl-block-key
+ c-other-decl-block-key-in-symbols-alist
+ c-overloadable-operators-regexp
+ c-paragraph-separate
+ c-paragraph-start
+ c-paren-stmt-key
+ c-prefix-spec-kwds-re
+ c-primary-expr-regexp
+ c-primitive-type-key
+ c-recognize-<>-arglists
+ c-recognize-colon-labels
+ c-recognize-knr-p
+ c-recognize-paren-inexpr-blocks
+ c-recognize-paren-inits
+ c-recognize-typeless-decls
+ c-regular-keywords-regexp
+ c-simple-stmt-key
+ c-special-brace-lists
+ c-special-indent-hook
+ c-specifier-key
+ c-stmt-delim-chars
+ c-stmt-delim-chars-with-comma
+ c-string-escaped-newlines
+ c-symbol-key
+ c-symbol-start
+ c-syntactic-eol
+ c-syntactic-ws-end
+ c-syntactic-ws-start
+ c-type-decl-end-used
+ c-type-decl-prefix-key
+ c-type-decl-suffix-key
+ c-type-prefix-key
+ c-vsemi-status-unknown-p-fn
+
+ case-fold-search
+ comment-end
+ comment-end-skip
+ comment-indent-function
+ comment-line-break-function
+ comment-multi-line
+ comment-start
+ comment-start-skip
+ cursor-type
+
+ default-directory
+ defun-prompt-regexp
+ delay-mode-hooks
+
+ enable-multibyte-characters
+ end-of-defun-function
+
+ fill-paragraph-function
+ font-lock-beginning-of-syntax-function
+ font-lock-defaults
+ font-lock-extend-after-change-region-function
+ font-lock-extend-region-functions
+ font-lock-fontified
+ font-lock-fontify-buffer-function
+ font-lock-fontify-region-function
+ font-lock-keywords
+ ;;font-lock-keywords-only
+ font-lock-keywords-case-fold-search
+ font-lock-mode
+ font-lock-mode-hook
+ font-lock-mode-major-mode
+ font-lock-multiline
+ font-lock-set-defaults
+ font-lock-syntactic-keywords
+ font-lock-syntactically-fontified
+ font-lock-syntax-table
+ font-lock-unfontify-buffer-function
+ font-lock-unfontify-region-function
+ fontification-functions
+ forward-sexp-function
+
+ indent-line-function
+ indent-region-function
+ imenu--index-alist
+ imenu--last-menubar-index-alist
+ imenu-create-index-function
+ imenu-menubar-modified-tick
+ isearch-mode
+
+ jit-lock-after-change-extend-region-functions
+ jit-lock-context-unfontify-pos
+ jit-lock-contextually
+ jit-lock-functions
+ jit-lock-mode
+
+ line-move-ignore-invisible
+ local-abbrev-table
+
+ major-mode
+ mark-active
+ ;;mark-ring
+ mode-line-process
+ mode-name
+
+ normal-auto-fill-function
+ ;;nxhtml-menu-mode-major-mode
+
+ open-paren-in-column-0-is-defun-start
+ outline-level
+ outline-regexp
+
+ paragraph-ignore-fill-prefix
+ paragraph-separate
+ paragraph-start
+ parse-sexp-ignore-comments
+ parse-sexp-lookup-properties
+ php-mode-pear-hook
+ point-before-scroll
+
+ ;; More symbols from visual inspection
+ ;;before-change-functions
+ ;;delayed-mode-hooks
+ ;;imenu-case-fold-search
+ ;;imenu-generic-expression
+ rngalt-completing-read-tag
+ rngalt-completing-read-attribute-name
+ rngalt-completing-read-attribute-value
+ rngalt-complete-first-try
+ rngalt-complete-last-try
+ rngalt-complete-tag-hooks
+
+ syntax-begin-function
+ )
+ "Buffer local variables that is not saved/set per chunk.
+This is supposed to contain mostly buffer local variables
+specific to major modes and that are not meant to be customized
+by the user.
+")
+
+(when (< emacs-major-version 23)
+ (defadvice c-after-change (around
+ mumamo-ad-c-after-change
+ activate
+ compile
+ )
+ ;;(msgtrc "c-after-change: major-mode=%s c-nonsymbol-token-regexp=%s" major-mode c-nonsymbol-token-regexp)
+ (when (or (not mumamo-multi-major-mode)
+ (derived-mode-p 'c-mode))
+ ad-do-it))
+ )
+
+(defun mumamo-save-per-major-local-vars (major)
+ "Save some per major local variables for major mode MAJOR.
+This should be called before switching to a new chunks major
+mode."
+ ;;(message "mumamo-save-per-major-local-vars %s %s" major (current-buffer))
+ (let ((locals (buffer-local-variables)))
+ (setq locals (mapcar (lambda (local)
+ (unless
+ (or (memq (car local) mumamo-buffer-locals-dont-set)
+ (memq (car local) mumamo-per-buffer-local-vars)
+ (memq (car local) mumamo-per-main-major-local-vars)
+ (get (car local) 'permanent-local))
+ local))
+ locals))
+ (setq locals (delq nil locals))
+ (setq locals (sort locals (lambda (sym-a sym-b)
+ (string< (symbol-name (car sym-a))
+ (symbol-name (car sym-b))))))
+ (setq mumamo-buffer-locals-per-major
+ (assq-delete-all major mumamo-buffer-locals-per-major))
+ (setq mumamo-buffer-locals-per-major
+ (cons (cons major-mode locals)
+ mumamo-buffer-locals-per-major))))
+
+;; (benchmark 1000 '(mumamo-save-per-major-local-vars major-mode))
+;; (benchmark 1000 '(mumamo-restore-per-major-local-vars major-mode))
+(defvar mumamo-restore-per-major-local-vars-in-hook-major nil)
+(defun mumamo-restore-per-major-local-vars-in-hook ()
+ "Restore some per major mode local variables.
+Call `mumamo-restore-per-major-local-vars'.
+Use `mumamo-restore-per-major-local-vars-in-hook-major' as the
+major mode.
+
+This should be called in the major mode setup hook."
+ (mumamo-restore-per-major-local-vars
+ mumamo-restore-per-major-local-vars-in-hook-major)
+ (setq mumamo-restore-per-major-local-vars-in-hook-major nil))
+(put 'mumamo-restore-per-major-local-vars-in-hook 'permanent-local-hook t)
+
+(defun mumamo-restore-per-major-local-vars (major)
+ "Restore some per major local variables for major mode MAJOR.
+This should be called after switching to a new chunks major
+mode."
+ (let ((locals (cdr (assq major mumamo-buffer-locals-per-major)))
+ var
+ perm)
+ (dolist (rec locals)
+ (setq var (car rec))
+ (setq perm (get var 'permanent-local))
+ (unless (or perm
+ (memq var mumamo-buffer-locals-dont-set))
+ (set (make-local-variable var) (cdr rec))))))
+
+;; (defun mumamo-testing-new ()
+;; (let ((locals (buffer-local-variables))
+;; var
+;; perm
+;; )
+;; (dolist (rec locals)
+;; (setq var (car rec))
+;; (setq perm (get var 'permanent-local))
+;; (unless (or perm
+;; (memq var mumamo-buffer-locals-dont-set))
+;; (setq var (cdr rec))))
+;; ))
+;; ;;(benchmark 1000 '(mumamo-testing-new))
+
+(defun mumamo-get-hook-value (hook remove)
+ "Return hook HOOK value with entries in REMOVE removed.
+Remove also t. The value returned is a list of both local and
+default values."
+ (let ((value (append (symbol-value hook) (default-value hook) nil)))
+ (dolist (rem remove)
+ (setq value (delq rem value)))
+ (delq t value)))
+
+;; FIX-ME: Clean up the different ways of surviving variables during
+;; change of major mode.
+(defvar mumamo-set-major-keymap-checked nil)
+(make-variable-buffer-local 'mumamo-set-major-keymap-checked)
+
+(defvar mumamo-org-startup-done nil)
+(make-variable-buffer-local 'mumamo-org-startup-done)
+(put 'mumamo-org-startup-done 'permanent-local t)
+
+
+(defun mumamo-font-lock-fontify-chunk ()
+ "Like `font-lock-default-fontify-buffer' but for a chunk.
+Buffer must be narrowed to inner part of chunk when this function
+is called."
+ (let ((verbose (if (numberp font-lock-verbose)
+ (and (> font-lock-verbose 0)
+ (> (- (point-max) (point-min)) font-lock-verbose))
+ font-lock-verbose))
+ font-lock-extend-region-functions ;; accept narrowing
+ (font-lock-unfontify-region-function 'ignore))
+ ;;(setq verbose t)
+ (with-temp-message
+ (when verbose
+ (format "Fontifying %s part %s-%s (%s)..." (buffer-name) (point-min) (point-max) font-lock-verbose))
+ (condition-case err
+ (save-excursion
+ (save-match-data
+ (font-lock-fontify-region (point-min) (point-max) verbose)
+ (font-lock-after-fontify-buffer)
+ (setq font-lock-fontified t)))
+ (msgtrc "font-lock-fontify-chunk: %s" (error-message-string err))
+ ;; We don't restore the old fontification, so it's best to unfontify.
+ (quit (mumamo-font-lock-unfontify-chunk))))))
+
+
+(defun mumamo-font-lock-unfontify-chunk ()
+ "Like `font-lock-default-unfontify-buffer' for .
+Buffer must be narrowed to chunk when this function is called."
+ ;; Make sure we unfontify etc. in the whole buffer.
+ (save-restriction
+ ;;(widen)
+ (font-lock-unfontify-region (point-min) (point-max))
+ (font-lock-after-unfontify-buffer)
+ (setq font-lock-fontified nil)))
+
+(defun mumamo-set-major (major chunk)
+ "Set major mode to MAJOR for mumamo."
+ (mumamo-msgfntfy "mumamo-set-major %s, %s" major (current-buffer))
+ (mumamo-cancel-idle-set-major-mode)
+ (remove-hook 'pre-command-hook 'mumamo-set-major-pre-command t)
+ ;;(mumamo-backtrace "mumamo-set-major")
+ (remove-hook 'text-mode-hook 'viper-mode) ;; Fix-me: maybe add it back...
+ (let ((start-time (get-internal-run-time))
+ end-time
+ used-time
+ ;; Viper
+ viper-vi-state-mode-list
+ viper-emacs-state-mode-list
+ viper-insert-state-mode-list
+ ;; Org-Mode
+ (org-inhibit-startup mumamo-org-startup-done)
+ ;; Tell `mumamo-change-major-function':
+ (mumamo-set-major-running major)
+ ;; Fix-me: Take care of the new values added to these hooks!
+ ;; That looks difficult. We may after this have changes to
+ ;; both buffer local value and global value. The global
+ ;; changes are in this variable, but the buffer local values
+ ;; have been set once again.
+ (change-major-mode-hook (mumamo-get-hook-value
+ 'change-major-mode-hook
+ mumamo-change-major-mode-no-nos))
+ (after-change-major-mode-hook (mumamo-get-hook-value
+ 'after-change-major-mode-hook
+ mumamo-after-change-major-mode-no-nos))
+ ;; Some major modes deactivates the mark, we do not want that:
+ deactivate-mark
+ ;; Font lock
+ (font-lock-mode font-lock-mode)
+ ;; We have to save and reset the cursor type, at least when
+ ;; Viper is used
+ (old-cursor-type cursor-type)
+ ;; Protect last-command: fix-me: probably remove
+ (last-command last-command)
+ ;; Fix-me: remove this
+ (old-rng-schema-file (when (boundp 'rng-current-schema-file-name) rng-current-schema-file-name))
+ ;; Local vars, per buffer and per major mode
+ per-buffer-local-vars-state
+ per-main-major-local-vars-state
+ )
+ ;; We are not changing mode from font-lock's point of view, so do
+ ;; not tell font-lock (let binding these hooks is probably not a
+ ;; good choice since they may contain other stuff too):
+ (setq mumamo-removed-from-hook nil)
+ (mumamo-remove-from-hook 'change-major-mode-hook mumamo-change-major-mode-no-nos)
+
+ ;;;;;;;;;;;;;;;;
+ ;; Save per buffer local variables
+ (dolist (sym (reverse mumamo-per-buffer-local-vars))
+ (when (boundp sym)
+ (when (and (get sym 'permanent-local)
+ (not (memq sym mumamo-per-buffer-local-vars-done-by-me))
+ (not (mumamo-hook-p sym)))
+ (delq sym mumamo-per-buffer-local-vars)
+ (lwarn 'mumamo-per-buffer-local-vars :warning
+ "Already 'permanent-local t: %s" sym))))
+ (dolist (var mumamo-per-buffer-local-vars)
+ (if (local-variable-p var)
+ (push (cons var (symbol-value var))
+ per-buffer-local-vars-state)))
+
+ ;;;;;;;;;;;;;;;;
+ ;; Save per main major local variables
+ (when (mumamo-fun-eq major-mode (mumamo-main-major-mode))
+ (dolist (var mumamo-per-main-major-local-vars)
+ (if (local-variable-p var)
+ (push (cons var (symbol-value var))
+ per-main-major-local-vars-state))))
+
+ ;; For all hooks that probably can have buffer local values, go
+ ;; through the buffer local values and look for a permanent-local
+ ;; property on each function. Remove those functions that does not
+ ;; have it. Then make the buffer local value of the hook survive
+ ;; by putting a permanent-local property on it.
+ (unless (> emacs-major-version 22)
+ (dolist (hk mumamo-survive-hooks)
+ (put hk 'permanent-local t)
+ (when (local-variable-p hk)
+ (let ((hkv (copy-sequence (symbol-value hk))))
+ (dolist (v hkv)
+ (unless (or (eq v t)
+ (get v 'permanent-local-hook))
+ (remove-hook hk v t)
+ ))))))
+
+ (run-hooks 'mumamo-change-major-mode-hook)
+
+ (setq mumamo-major-mode major)
+
+ ;;;;;;;;;;;;;;;;
+ ;; Save per major mode local variables before switching major
+ (mumamo-save-per-major-local-vars major-mode)
+ ;; Prepare to restore per major mode local variables after
+ ;; switching back to major-mode, but do it in the greatest
+ ;; ancestor's mode hook (see `run-mode-hooks'):
+ (let (ancestor-hook-sym
+ parent-hook-sym
+ (parent major))
+ ;; We want the greatest ancestor's mode hook:
+ (setq parent-hook-sym (intern-soft (concat (symbol-name parent) "-hook")))
+ (when parent-hook-sym (setq ancestor-hook-sym parent-hook-sym))
+ (while (get parent 'derived-mode-parent)
+ (setq parent (get parent 'derived-mode-parent))
+ (setq parent-hook-sym (intern-soft (concat (symbol-name parent) "-hook")))
+ (when parent-hook-sym (setq ancestor-hook-sym parent-hook-sym)))
+ (when ancestor-hook-sym
+ ;; Put first in local hook to run it first:
+ (setq mumamo-restore-per-major-local-vars-in-hook-major major)
+ (add-hook ancestor-hook-sym
+ 'mumamo-restore-per-major-local-vars-in-hook
+ nil t))
+
+ ;;(msgtrc "set-major A: buffer-invisibility-spec=%S" buffer-invisibility-spec)
+ ;;(msgtrc "set-major A: word-wrap=%S, cb=%s" word-wrap (current-buffer))
+ ;;(mumamo-backtrace "set-major")
+ (let ((here (point)))
+ (unwind-protect
+ (save-restriction
+ (let* ((minmax (mumamo-chunk-syntax-min-max chunk t))
+ (min (car minmax))
+ (max (cdr minmax))
+ (here (point))
+ ;; Fix-me: For some reason let binding did not help. Is this a bug or?
+ ;;
+ ;;(font-lock-fontify-buffer-function 'mumamo-font-lock-fontify-chunk)
+ (old-bf (buffer-local-value 'font-lock-fontify-buffer-function (current-buffer)))
+ (inhibit-redisplay t) ;; Fix-me: said to be for internal purposes only
+ )
+ (narrow-to-region min max)
+ (set (make-local-variable 'font-lock-fontify-buffer-function) 'mumamo-font-lock-fontify-chunk)
+ ;;(message "funcall major=%s, %s" major font-lock-fontify-buffer-function)
+ ;;(message "before funcall: function=%s" font-lock-fontify-buffer-function)
+ (put 'font-lock-fontify-buffer-function 'permanent-local t)
+ (funcall major) ;; <-----------------------------------------------
+ (put 'font-lock-fontify-buffer-function 'permanent-local nil)
+ (when old-bf
+ (set (make-local-variable 'font-lock-fontify-buffer-function) old-bf))
+ ))
+ (goto-char here)))
+ ;;(msgtrc "set-major B: buffer-invisibility-spec=%S" buffer-invisibility-spec)
+ ;;(msgtrc "set-major B: word-wrap=%S, cb=%s" word-wrap (current-buffer))
+
+ (setq font-lock-mode-major-mode major) ;; Tell font-lock it is ok
+ (set (make-local-variable 'font-lock-function) 'mumamo-font-lock-function)
+ (if (not ancestor-hook-sym)
+ (mumamo-restore-per-major-local-vars major)
+ (remove-hook ancestor-hook-sym
+ 'mumamo-restore-per-major-local-vars-in-hook
+ t)))
+ ;;(msgtrc "set-major c: buffer-invisibility-spec=%S" buffer-invisibility-spec)
+
+ (when (mumamo-fun-eq major 'org-mode) (setq mumamo-org-startup-done t))
+
+ (setq mumamo-major-mode-indent-line-function (cons major-mode indent-line-function))
+ (make-local-variable 'indent-line-function)
+
+ (setq mode-name (concat (format-mode-line mode-name)
+ (save-match-data
+ (replace-regexp-in-string
+ "-mumamo-mode$" ""
+ (format "/%s" mumamo-multi-major-mode)))))
+
+ (dolist (hk mumamo-survive-hooks) (put hk 'permanent-local nil))
+
+ ;; (when (and (featurep 'flymake)
+ ;; flymake-mode)
+ ;; (add-hook 'after-change-functions 'flymake-after-change-function nil t)
+ ;; (add-hook 'after-save-hook 'flymake-after-save-hook nil t)
+ ;; (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t))
+
+ ;;;;;;;;;;;;;;;;
+ ;; Restore per buffer local variables
+
+ ;; (dolist (sym mumamo-per-buffer-local-vars)
+ ;; (when (boundp sym)
+ ;; (put sym 'permanent-local nil)))
+ ;;(msgtrc "per-buffer-local-vars-state=%S" per-buffer-local-vars-state)
+ (dolist (saved per-buffer-local-vars-state)
+ ;;(msgtrc "restore p buffer: %s, local=%s" (car saved) (local-variable-p (car saved)))
+ (unless (local-variable-p (car saved))
+ (set (make-local-variable (car saved)) (cdr saved))))
+
+ ;;;;;;;;;;;;;;;;
+ ;; Restore per main major local variables
+ (unless (mumamo-fun-eq major-mode (mumamo-main-major-mode))
+ (dolist (saved per-main-major-local-vars-state)
+ (set (make-local-variable (car saved)) (cdr saved))))
+
+ (mumamo-addback-to-hooks)
+
+ (setq cursor-type old-cursor-type)
+ (run-hooks 'mumamo-after-change-major-mode-hook)
+
+ (when (derived-mode-p 'nxml-mode)
+ (when (and old-rng-schema-file
+ (not (string= old-rng-schema-file rng-current-schema-file-name)))
+ (let ((rng-schema-change-hook nil)) ;(list 'rng-alidate-clear)))
+ (condition-case err
+ (progn
+ (rng-set-schema-file-1 old-rng-schema-file)
+ (rng-what-schema))
+ (nxml-file-parse-error
+ (nxml-display-file-parse-error err)))
+ (when rng-validate-mode
+ ;; Fix-me: Change rng-validate variables so that this is
+ ;; not necessary any more.
+ (rng-validate-mode 0)
+ (rng-validate-mode 1))
+ )))
+ ;; The nxml-parser should not die:
+ (when (mumamo-derived-from-mode (mumamo-main-major-mode) 'nxml-mode)
+ (add-hook 'after-change-functions 'rng-after-change-function nil t)
+ (add-hook 'after-change-functions 'nxml-after-change nil t)
+ ;; Added these for Emacs 22:
+ (unless nxml-prolog-end (setq nxml-prolog-end 1))
+ (unless nxml-scan-end (setq nxml-scan-end (copy-marker 1))))
+
+;;; (when (and global-font-lock-mode
+;;; font-lock-global-modes
+;;; font-lock-mode)
+;;; (when global-font-lock-mode
+;;; (add-hook 'change-major-mode-hook 'global-font-lock-mode-cmhh))
+;;; (add-hook 'change-major-mode-hook 'font-lock-change-mode nil t)
+
+ (mumamo-set-fontification-functions)
+
+ ;; If user has used M-x flyspell-mode then we need to correct it:
+ ;; Fix-me: This is inflexible. Need flyspell to cooperate.
+ (when (featurep 'flyspell)
+ (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify))
+
+ (if mumamo-done-first-set-major
+ (setq mumamo-just-changed-major t)
+ (mumamo-msgfntfy "mumamo-set-major: ----- removing 'fontified")
+ ;; Set up to fontify buffer
+ (mumamo-save-buffer-state nil
+ (remove-list-of-text-properties (point-min) (point-max) '(fontified)))
+ (setq mumamo-done-first-set-major t))
+
+ ;; Timing, on a 3ghz cpu:
+ ;;
+ ;; used-time=(0 0 0), major-mode=css-mode
+ ;; used-time=(0 0 0), major-mode=ecmascript-mode
+ ;; used-time=(0 0 0), major-mode=html-mode
+ ;; used-time=(0 0 203000), major-mode=nxhtml-mode
+ ;;
+ ;; After some changes 2007-04-25:
+ ;;
+ ;; used-time=(0 0 15000), major-mode=nxhtml-mode
+ ;;
+ ;; which is 15 ms. That seems acceptable though I am not sure
+ ;; everything is correct when switching to nxhtml-mode yet. I
+ ;; will have to wait for bug reports ;-)
+ ;;
+ ;; The delay is clearly noticeable and disturbing IMO unless you
+ ;; change major mode in an idle timer.
+ ;;
+ ;;(setq end-time (get-internal-run-time))
+ ;;(setq used-time (time-subtract end-time start-time))
+ )
+ (setq mumamo-set-major-keymap-checked nil)
+ ;; Fix-me: Seems like setting/checking the keymap in a timer is
+ ;; problematc. This is an Emacs bug.
+ ;;(run-with-idle-timer 1 nil 'mumamo-set-major-check-keymap)
+ ;;(force-mode-line-update) (message "force-mode-line-update called")
+ )
+
+(defun mumamo-set-major-check-keymap ()
+ "Helper to work around an Emacs bug when setting local map in a timer."
+ (or mumamo-set-major-keymap-checked
+ (setq mumamo-set-major-keymap-checked
+ (let ((map-sym (intern-soft (concat (symbol-name major-mode) "-map"))))
+ (if (not map-sym)
+ t ;; Don't know what to do
+ (equal (current-local-map)
+ (symbol-value map-sym)))))))
+
+(defvar mumamo-original-fill-paragraph-function nil)
+(make-variable-buffer-local 'mumamo-original-fill-paragraph-function)
+
+(defun mumamo-setup-local-fontification-vars ()
+ "Set up buffer local variables for mumamo style fontification."
+ (make-local-variable 'font-lock-fontify-region-function)
+ (setq font-lock-fontify-region-function 'mumamo-fontify-region)
+
+ ;; Like font-lock-turn-on-thing-lock:
+ (make-local-variable 'font-lock-fontify-buffer-function)
+ (setq font-lock-fontify-buffer-function 'jit-lock-refontify)
+ (setq font-lock-fontify-buffer-function 'mumamo-fontify-buffer)
+ ;; Don't fontify eagerly (and don't abort if the buffer is large).
+ (set (make-local-variable 'font-lock-fontified) t)
+
+ (make-local-variable 'font-lock-unfontify-buffer-function)
+ (setq font-lock-unfontify-buffer-function 'mumamo-unfontify-buffer)
+
+ (set (make-local-variable 'indent-line-function) 'mumamo-indent-line-function)
+
+ ;;(setq mumamo-original-fill-paragraph-function fill-paragraph-function)
+ ;;(set (make-local-variable 'fill-paragraph-function) 'mumamo-fill-paragraph-function)
+ ;;(set (make-local-variable 'fill-forward-paragraph-function 'forward-paragraph)
+
+ (make-local-variable 'indent-region-function)
+ (setq indent-region-function 'mumamo-indent-region-function)
+
+ ;;(set (make-local-variable 'syntax-begin-function) 'mumamo-beginning-of-syntax)
+
+ ;;(put 'font-lock-function 'permanent-local t)
+
+ ;; FIX-ME: Not sure about this one, but it looks like it must be
+ ;; set:
+ (make-local-variable 'jit-lock-contextually)
+ (setq jit-lock-contextually t)
+ )
+
+(defun mumamo-font-lock-function (mode)
+ ;;(mumamo-backtrace "font-lock-function")
+ (font-lock-default-function mode))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Turning on/off multi major modes
+
+(defun mumamo-set-fontification-functions ()
+ "Let mumamo take over fontification.
+This is run after changing major mode so that jit-lock will get
+the major mode specific values. \(There are currently no such
+values.)"
+ ;; Give the jit machinery a starting point:
+ (mumamo-jit-lock-register 'font-lock-fontify-region t)
+ ;; Set the functions that font-lock should use:
+ (mumamo-setup-local-fontification-vars)
+ ;; Need some hook modifications to keep things together too:
+ (add-hook 'change-major-mode-hook 'mumamo-change-major-function nil t)
+ (add-hook 'post-command-hook 'mumamo-post-command nil t)
+ (remove-hook 'change-major-mode-hook 'nxml-change-mode t)
+ (remove-hook 'change-major-mode-hook 'nxhtml-change-mode t)
+ )
+
+(defun mumamo-initialize-state ()
+ "Initialize some mumamo state variables."
+ (setq mumamo-done-first-set-major nil)
+ (setq mumamo-just-changed-major nil))
+
+(defun mumamo-turn-on-actions (old-major-mode)
+ "Do what is necessary to turn on mumamo.
+Turn on minor mode function `font-lock-mode'.
+Set up for mumamo style fontification.
+Create a mumamo chunk at point.
+Run `mumamo-turn-on-hook'.
+
+OLD-MAJOR-MODE is used for the main major mode if the main major
+mode in the chunk family is nil."
+ ;;(unless font-lock-mode (font-lock-mode 1))
+ (mumamo-msgfntfy "mumamo-turn-on-actions")
+ (unless mumamo-current-chunk-family (error "Internal error: Chunk family is not set"))
+ (if (not mumamo-current-chunk-family)
+ (progn
+ (lwarn '(mumamo) :warning
+ "Could not turn on mumamo because chunk family was not set\n\tin buffer %s."
+ (current-buffer))
+ (with-current-buffer "*Warnings*"
+ (insert "\tFor more information see `")
+ (mumamo-insert-describe-button 'define-mumamo-multi-major-mode 'describe-function)
+ (insert "'.\n")))
+ ;; Load major mode:
+ (setq mumamo-org-startup-done nil)
+ (let ((main-major-mode (mumamo-major-mode-from-modespec (mumamo-main-major-mode))))
+ (unless main-major-mode
+ (setcar (cdr mumamo-current-chunk-family) old-major-mode)
+ (setq main-major-mode (mumamo-main-major-mode)))
+ ;;(with-temp-buffer (funcall main-major-mode))
+ (setq mumamo-major-mode main-major-mode)
+ (when (boundp 'nxml-syntax-highlight-flag)
+ (when (mumamo-derived-from-mode main-major-mode 'nxml-mode)
+ (set (make-local-variable 'nxml-syntax-highlight-flag) nil)))
+ ;; Init fontification
+ (mumamo-initialize-state)
+ (mumamo-set-fontification-functions)
+ (mumamo-save-buffer-state nil
+ (remove-list-of-text-properties (point-min) (point-max)
+ (list 'fontified)))
+ ;; For validation header etc:
+ (when (mumamo-derived-from-mode main-major-mode 'nxhtml-mode)
+ (require 'rngalt nil t)
+ (when (featurep 'rngalt)
+ (setq rngalt-major-mode (mumamo-main-major-mode))
+ (rngalt-update-validation-header-overlay))
+ (when (featurep 'rng-valid)
+ (setq rng-get-major-mode-chunk-function 'mumamo-find-chunks)
+ (setq rng-valid-nxml-major-mode-chunk-function 'mumamo-valid-nxml-chunk)
+ (setq rng-end-major-mode-chunk-function 'overlay-end))))
+ ;;(mumamo-set-major-post-command)
+ ;;(add-hook 'change-major-mode-hook 'mumamo-change-major-function nil t)
+ (when (boundp 'flyspell-generic-check-word-predicate)
+ (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify))
+ (run-hooks 'mumamo-turn-on-hook)
+ ;;(mumamo-get-chunk-save-buffer-state (point))
+ (let ((buffer-windows (get-buffer-window-list (current-buffer))))
+ (if (not buffer-windows)
+ (let* ((ovl (mumamo-find-chunks (point) "mumamo-turn-on-actions"))
+ (major (when ovl (mumamo-chunk-major-mode ovl))))
+ (when major
+ (mumamo-set-major major ovl)))
+ (dolist (win (get-buffer-window-list (current-buffer) nil t))
+ (let ((wp (or (window-end win)
+ (window-point win)
+ (window-start win))))
+ (mumamo-get-chunk-save-buffer-state wp)
+ (when (eq win (selected-window))
+ (let* ((ovl (mumamo-find-chunks wp "mumamo-turn-on-actions"))
+ (major (when ovl (mumamo-chunk-major-mode ovl))))
+ (when major
+ (mumamo-set-major major ovl))))))))
+ ;;(msgtrc "mumamo-turn-on-action exit: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
+ ;; This did not help for Emacs bug 3467:
+ ;;(set-default 'font-lock-keywords-only nil)
+ ;;(setq font-lock-keywords-only nil)
+ )
+ (set (make-local-variable 'font-lock-function) 'mumamo-font-lock-function)
+ (mumamo-emacs-start-bug3467-timer-if-needed)
+ )
+
+;; (defun mumamo-on-font-lock-off ()
+;; "The reverse of `mumamo-turn-on-actions'."
+;; (let ((mumamo-main-major-mode (mumamo-main-major-mode)))
+;; (mumamo-turn-off-actions)
+;; ;; Turning off `font-lock-mode' also turns off `mumamo-mode'. It is
+;; ;; quite tricky to not turn on `font-lock-mode' again in case we got
+;; ;; here because it was turned off. We must first remove the cmhh
+;; ;; function and then also run the internal font lock turn off.
+;; (let* ((flm font-lock-mode)
+;; (flgm global-font-lock-mode)
+;; (remove-cmhh (and (not flm) flgm)))
+;; ;; If remove-cmhh is non-nil then we got here because
+;; ;; `font-lock-mode' was beeing turned off in the buffer, but
+;; ;; `global-font-lock-mode' is still on.
+;; (when remove-cmhh
+;; (remove-hook 'change-major-mode-hook 'global-font-lock-mode-cmhh))
+
+;; (if mumamo-main-major-mode
+;; (funcall mumamo-main-major-mode)
+;; (fundamental-mode))
+
+;; (unless flm
+;; (setq font-lock-mode nil)
+;; (font-lock-mode-internal nil))
+;; (when remove-cmhh
+;; (add-hook 'change-major-mode-hook 'global-font-lock-mode-cmhh)))))
+
+(defun mumamo-turn-off-actions ()
+ "The reverse of `mumamo-turn-on-actions'."
+ (mumamo-msgfntfy "mumamo-turn-off-actions")
+ (when (fboundp 'nxhtml-validation-header-mode)
+ (nxhtml-validation-header-mode -1))
+ (when (mumamo-derived-from-mode
+ (nth 1 mumamo-current-chunk-family) 'nxml-mode)
+ (when (fboundp 'nxml-change-mode)
+ (nxml-change-mode)))
+ (when (and (boundp 'rng-validate-mode)
+ rng-validate-mode)
+ (rng-validate-mode 0))
+ (when (featurep 'rng-valid)
+ (setq rng-get-major-mode-chunk-function nil)
+ (setq rng-valid-nxml-major-mode-chunk-function nil)
+ (setq rng-end-major-mode-chunk-function nil)
+ )
+ ;; Remove nxml for Emacs 22
+ (remove-hook 'after-change-functions 'rng-after-change-function t)
+ (remove-hook 'after-change-functions 'nxml-after-change t)
+ (when (boundp 'rngalt-major-mode)
+ (setq rngalt-major-mode nil))
+ (remove-hook 'change-major-mode-hook 'mumamo-change-major-function t)
+ ;;(mumamo-unfontify-chunks)
+ ;;(remove-hook 'after-change-functions 'mumamo-jit-lock-after-change t)
+ (remove-hook 'after-change-functions 'mumamo-after-change t)
+ (remove-hook 'post-command-hook 'mumamo-post-command t)
+ ;;(remove-hook 'c-special-indent-hook 'mumamo-c-special-indent t)
+ (mumamo-margin-info-mode -1)
+ (when (fboundp 'mumamo-clear-all-regions) (mumamo-clear-all-regions))
+ (save-restriction
+ (widen)
+ (mumamo-save-buffer-state nil
+ (set-text-properties (point-min) (point-max) nil)))
+ (setq mumamo-current-chunk-family nil)
+ (setq mumamo-major-mode nil)
+ (setq mumamo-multi-major-mode nil) ;; for minor-mode-map-alist
+ (setq mumamo-multi-major-mode nil)
+ (mumamo-remove-all-chunk-overlays)
+ (when (fboundp 'rng-cancel-timers) (rng-cancel-timers))
+ )
+
+(defvar mumamo-turn-on-hook nil
+ "Normal hook run after turning on `mumamo-mode'.")
+(put 'mumamo-turn-on-hook 'permanent-local t)
+
+(defvar mumamo-change-major-mode-hook nil
+ "Normal hook run before internal change of major mode.")
+(put 'mumamo-change-major-mode-hook 'permanent-local t)
+
+(defvar mumamo-after-change-major-mode-hook nil
+ "Normal hook run after internal change of major mode.")
+(put 'mumamo-after-change-major-mode-hook 'permanent-local t)
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Defining multi major modes
+
+(defvar mumamo-defined-multi-major-modes nil
+ "List of functions defined for turning on mumamo.
+Those functions should be called instead of calling a major mode
+function when you want to use multiple major modes in a buffer.
+They may be added to for example `auto-mode-alist' to
+automatically have the major mode support turned on when opening
+a file.
+
+Each of these functions defines how to mix certain major modes in
+a buffer.
+
+All functions defined by `define-mumamo-multi-major-mode' are
+added to this list. See this function for a general description
+of how the functions work.
+
+If you want to quickly define a new mix of major modes you can
+use `mumamo-quick-static-chunk'.")
+
+;;;###autoload
+(defun mumamo-list-defined-multi-major-modes (show-doc show-chunks match)
+ "List currently defined multi major modes.
+If SHOW-DOC is non-nil show the doc strings added when defining
+them. \(This is not the full doc string. To show the full doc
+string you can click on the multi major mode in the list.)
+
+If SHOW-CHUNKS is non-nil show the names of the chunk dividing
+functions each multi major mode uses.
+
+If MATCH then show only multi major modes whos names matches."
+ (interactive (list (y-or-n-p "Include short doc string? ")
+ (y-or-n-p "Include chunk function names? ")
+ (read-string "List only multi major mode matching regexp (emtpy for all): ")))
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'mumamo-list-defined-multi-major-modes) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert "The currently defined multi major modes in your Emacs are:\n\n")
+ (let ((mmms (reverse mumamo-defined-multi-major-modes))
+ (here (point)))
+ (setq mmms (sort mmms (lambda (a b)
+ (string< (symbol-name (cdr a))
+ (symbol-name (cdr b))))))
+ (when (string= match "") (setq match nil))
+ (while mmms
+ (let* ((mmm (car mmms))
+ (sym (cdr mmm))
+ (desc (car mmm))
+ (auto (get sym 'autoload))
+ (auto-desc (when auto (nth 1 auto)))
+ (family (get sym 'mumamo-chunk-family))
+ (chunks (nth 2 family)))
+ (when (or (not match)
+ (string-match-p match (symbol-name sym)))
+ (insert " `" (symbol-name sym) "'"
+ " (" desc ")\n"
+ (if (and show-doc auto-desc)
+ (concat " " auto-desc "\n")
+ "")
+ (if show-chunks
+ (format " Chunks:%s\n"
+ (let ((str "")
+ (nn 0))
+ (mapc (lambda (c)
+ (if (< nn 2)
+ (setq str (concat str " "))
+ (setq nn 0)
+ (setq str (concat str "\n ")))
+ (setq nn (1+ nn))
+ (setq str (concat str (format "%-30s" (format "`%s'" c))))
+ )
+ chunks)
+ str))
+ "")
+ (if (or show-doc show-chunks) "\n\n" "")
+ ))
+ (setq mmms (cdr mmms))))
+ ))))
+
+(defun mumamo-describe-chunks (chunks)
+ "Return text describing CHUNKS."
+ (let* ((desc
+ (concat "* Main major mode: `" (symbol-name (nth 1 chunks)) "'\n"
+ "\n* Functions for dividing into submodes:\n")))
+ (dolist (divider (nth 2 chunks))
+ (setq desc
+ (concat
+ desc
+ "\n`" (symbol-name divider)
+ "'\n "
+ (let ((doc (if (functionp divider)
+ (documentation divider t)
+ "(Function not compiled when building doc)")))
+ (if (not doc)
+ "(Not documented)"
+ (substring doc 0 (string-match "\n" doc)))))))
+ (setq desc
+ (concat
+ desc
+ "\n\n(Note that the functions for dividing into chunks returns\n"
+ "a major mode specifier which may be translated into a major mode\n"
+ "by `mumamo-main-major-mode'.)\n"))
+ desc))
+
+(defun mumamo-add-multi-keymap (toggle keymap)
+ "Add TOGGLE and KEYMAP to `minor-mode-map-alist'.
+This is used to add a keymap to multi major modes since the local
+keymap is occupied by the major modes.
+
+It is also used to add the `mumamo-map' keymap to every buffer
+with a multi major mode."
+ ;; Copied from add-minor-mode
+ ;; Add the map to the minor-mode-map-alist.
+ (when keymap
+ (let ((existing (assq toggle minor-mode-map-alist))
+ (after t))
+ (if existing
+ (setcdr existing keymap)
+ (let ((tail minor-mode-map-alist) found)
+ (while (and tail (not found))
+ (if (eq after (caar tail))
+ (setq found tail)
+ (setq tail (cdr tail))))
+ (if found
+ (let ((rest (cdr found)))
+ (setcdr found nil)
+ (nconc found (list (cons toggle keymap)) rest))
+ (setq minor-mode-map-alist (cons (cons toggle keymap)
+ minor-mode-map-alist))))))))
+
+(defvar mumamo-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control meta prior)] 'mumamo-backward-chunk)
+ (define-key map [(control meta next)] 'mumamo-forward-chunk)
+ ;; Use mumamo-indent-line-function:
+ ;;(define-key map [tab] 'indent-for-tab-command)
+ (define-key map [(meta ?q)] 'fill-paragraph)
+ map)
+ "Keymap that is active in all mumamo buffers.
+It has the some priority as minor mode maps.")
+;;(make-variable-buffer-local 'mumamo-map)
+(put 'mumamo-map 'permanent-local t)
+
+(mumamo-add-multi-keymap 'mumamo-multi-major-mode mumamo-map)
+
+;;;###autoload
+(defun mumamo-multi-major-modep (value)
+ "Return t if VALUE is a multi major mode function."
+ (and (fboundp value)
+ (rassq value mumamo-defined-multi-major-modes)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Indenting, filling, moving etc
+
+;; FIX-ME: Indentation in perl here doc indents the ending mark which
+;; corrupts the perl here doc.
+
+(defun mumamo-indent-line-function ()
+ "Function to indent the current line.
+This is the buffer local value of `indent-line-function' when
+mumamo is used."
+ (let ((here (point-marker))
+ fontification-functions
+ rng-nxml-auto-validate-flag
+ (before-text (<= (current-column) (current-indentation))))
+ (mumamo-indent-line-function-1 nil nil nil)
+ ;; If the marker was in the indentation part strange things happen
+ ;; if we try to go back to the marker, at least in php-mode parts.
+ (if before-text
+ (back-to-indentation)
+ (goto-char here))))
+
+(defun mumamo-indent-current-line-chunks (last-chunk-prev-line)
+ "Return a list of chunks to consider when indenting current line.
+This list consists of four chunks at these positions:
+- Beginning of line - 1
+- Beginning of line
+- End of line
+- End of line + 1"
+ ;; Fix-me: must take markers into account too when a submode
+ ;; includes the markers.
+ (setq last-chunk-prev-line nil)
+ ;;(msgtrc "indent-current-line-chunks: last-chunk-prev-line=%S" last-chunk-prev-line)
+ (save-restriction
+ (widen)
+ (let* ((lb-pos (line-beginning-position))
+ (le-pos (line-end-position))
+ (pos0 (if (> lb-pos (point-min))
+ (1- lb-pos)
+ (point-min)))
+ (pos1 lb-pos)
+ (pos2 le-pos)
+ (pos3 (if (< le-pos (point-max))
+ (+ 1 le-pos)
+ (point-max)))
+ ;; Create all chunks on this line first, then grab them
+ (ovl3 (mumamo-find-chunks pos3 "mumamo-indent-current-line-chunks"))
+ (ovl2 (if (>= pos2 (overlay-start ovl3))
+ ovl3
+ (mumamo-get-existing-new-chunk-at pos2)))
+ (ovl1 (if (>= pos1 (overlay-start ovl2))
+ ovl2
+ (mumamo-get-existing-new-chunk-at pos1)))
+ (ovl0 (if (> pos0 (overlay-start ovl1))
+ ovl1
+ (mumamo-get-existing-new-chunk-at pos0 t))))
+ (list ovl0 ovl1 ovl2 ovl3))))
+
+;; Fix-me: need to back up past comments in for example <style> /* comment */
+;; fix-me: clean up
+(put 'mumamo-error-ind-0 'error-conditions '(error mumamo-error-ind-0))
+(put 'mumamo-error-ind-0 'error-message "indentation 0 in sub chunk")
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+;; Template indentation
+;;; Contact Marc Bowes when I've finished this.
+
+(defvar mumamo-template-indent-buffer nil)
+(make-variable-buffer-local 'mumamo-template-indent-buffer)
+(put 'mumamo-template-indent-buffer 'permanent-local t)
+
+(defvar mumamo-template-indent-change-min nil)
+(make-variable-buffer-local 'mumamo-template-indent-change-min)
+(put 'mumamo-template-indent-hange-min 'permanent-local t)
+
+(defun mumamo-template-indent-after-change (beg end len)
+ (setq mumamo-template-indent-change-min
+ (if mumamo-template-indent-change-min
+ (min mumamo-template-indent-change-min beg)
+ beg)))
+
+;; (defun mumamo-get-indentor-create (indentor-chunk prev-indentor)
+;; (let ((indentor (overlay-get indentor-chunk 'mumamo-indentor))
+;; (indentor-buffer (when indentor (overlay-buffer indentor)))
+;; (chunk-str (with-current-buffer (overlay-buffer indentor-chunk)
+;; (buffer-substring-no-properties (overlay-start indentor-chunk)
+;; (overlay-end indentor-chunk))))
+;; )
+;; (unless (and indentor
+;; (eq indentor-buffer mumamo-template-indent-buffer)
+;; (string= chunk-str (overlay-get indentor 'indentor-chunk-string)))
+;; (when indentor
+;; (when (buffer-live-p
+;; indentor
+;; ))
+(defun mumamo-indentor-valid (indentor chunk chunk-string)
+ (and indentor
+ chunk
+ (buffer-live-p (overlay-buffer chunk))
+ (string= chunk-string (overlay-get indentor 'indentor-chunk-string))
+ ))
+
+(defun mumamo-template-indent-get-chunk-shift (indentor-chunk)
+ "Return indentation shift for INDENTOR-CHUNK row and line after.
+;; Fix-me: Handle changes better.
+
+Indentation shift has two parts: shift for current line and for next line.
+This function returns a cons with these two parts.
+"
+ (assert (overlayp indentor-chunk) t)
+ (assert (buffer-live-p (overlay-buffer indentor-chunk)) t)
+ (let ((indentor (overlay-get indentor-chunk 'mumamo-indentor))
+ (prev-chunk (overlay-get indentor-chunk 'mumamo-prev-chunk))
+ prev-indentor prev-indentor-chunk)
+ (when indentor (assert (eq indentor-chunk (overlay-get indentor 'indentor-chunk)) t))
+ (unless (and mumamo-template-indent-buffer
+ (buffer-live-p mumamo-template-indent-buffer))
+ (setq indentor nil)
+ (setq mumamo-template-indent-buffer
+ (get-buffer-create (concat (buffer-name)
+ "-template-indent-buffer")))
+ (with-current-buffer mumamo-template-indent-buffer
+ (setq buffer-undo-list t)
+ (let ((major (car (overlay-get indentor-chunk 'mumamo-major-mode))))
+ (funcall major))))
+ (when indentor
+ (unless (eq (overlay-buffer indentor) mumamo-template-indent-buffer)
+ (setq indentor nil)))
+ ;; We need the prev indentor to indent relative to.
+ (while (and prev-chunk (not prev-indentor-chunk))
+ (setq prev-chunk (overlay-get prev-chunk 'mumamo-prev-chunk))
+ (when prev-chunk
+ (when (eq (overlay-get prev-chunk 'mumamo-next-indent)
+ 'mumamo-template-indentor)
+ (setq prev-indentor-chunk (overlay-get prev-chunk 'mumamo-next-chunk)))))
+ (when prev-indentor-chunk
+ (setq prev-indentor (overlay-get prev-indentor-chunk 'mumamo-indentor)))
+ (when prev-indentor
+ (unless (buffer-live-p (overlay-buffer prev-indentor))
+ (setq prev-indentor nil)))
+ (when prev-indentor (assert (eq (overlay-buffer prev-indentor) mumamo-template-indent-buffer) t))
+ (with-current-buffer mumamo-template-indent-buffer
+ (save-restriction
+ (widen)
+ ;; Insert a blank line to be able to go to start of first
+ ;; overlay -1. Do it here in case the user erases the buffer.
+ (when (= 0 (buffer-size)) (insert "\n"))
+ (let ((i-str (when indentor
+ (buffer-substring-no-properties (overlay-start indentor) (overlay-end indentor))))
+ (i-beg (when indentor (overlay-start indentor)))
+ (c-str (with-current-buffer (overlay-buffer indentor-chunk)
+ (buffer-substring-no-properties (overlay-start indentor-chunk)
+ (overlay-end indentor-chunk))))
+ (p-str (when prev-indentor-chunk
+ (with-current-buffer (overlay-buffer prev-indentor-chunk)
+ (buffer-substring-no-properties (overlay-start prev-indentor-chunk)
+ (overlay-end prev-indentor-chunk)))))
+ (c-beg (overlay-start indentor-chunk))
+ (p-beg (when prev-indentor-chunk (overlay-start prev-indentor-chunk))))
+ ;; Check if `indentor' and `prev-indentor' are valid
+ (when indentor
+ ;;(unless (string= c-str (overlay-get indentor 'indentor-chunk-string))
+ (unless (mumamo-indentor-valid indentor indentor-chunk c-str)
+ (mumamo-remove-indentor indentor)))
+ (when prev-indentor
+ ;;(unless (string= p-str (overlay-get prev-indentor 'indentor-chunk-string))
+ (unless (mumamo-indentor-valid prev-indentor prev-indentor-chunk p-str)
+ (mumamo-remove-indentor prev-indentor)))
+ (unless indentor
+ (setq i-beg
+ (or i-beg
+ (when prev-indentor
+ ;; We just put `indentor' after this, but we
+ ;; must also remove old stuff.
+ (goto-char (overlay-end prev-indentor))
+ (forward-char 1)
+ (let* ((next-indentor (mumamo-indentor-at (point)))
+ (next-indentor-chunk (when next-indentor
+ (overlay-get next-indentor 'indentor-chunk)))
+ n-beg
+ (new-i-beg (unless next-indentor-chunk (point))))
+ (while (not new-i-beg)
+ (setq n-beg (when (buffer-live-p (overlay-buffer next-indentor-chunk))
+ (overlay-start next-indentor-chunk)))
+ (if (or (not n-beg) (< n-beg c-beg))
+ (progn
+ (mumamo-remove-indentor next-indentor)
+ (goto-char (overlay-end prev-indentor))
+ (forward-char 1)
+ (setq next-indentor (mumamo-indentor-at (point)))
+ (if next-indentor
+ (setq next-indentor-chunk (overlay-get next-indentor 'indentor-chunk))
+ (setq new-i-beg (point))))
+ (setq new-i-beg (point))))
+ new-i-beg))
+ ;; Fix-me: Find out where to insert indentor:
+ (let* ((ll 1)
+ (rr (point-max))
+ mm new-i-beg m-ovl m-ovl-old m-chunk m-beg)
+ (while (< ll rr)
+ (setq mm (+ ll (/ (- rr ll) 2)))
+ (setq m-ovl-old m-ovl)
+ (setq m-ovl (mumamo-indentor-at mm))
+ (if (or (not m-ovl) (eq m-ovl m-ovl-old))
+ (setq rr ll)
+ (setq m-chunk (overlay-get m-ovl 'indentor-chunk))
+ (setq m-beg (when (buffer-live-p (overlay-buffer m-chunk))
+ (overlay-start m-chunk)))
+ (cond ((not m-beg)
+ (mumamo-remove-indentor m-ovl)
+ (setq rr (min rr (point-max))))
+ ((> m-beg c-beg)
+ (setq ll (1+ mm)))
+ ((< m-beg c-beg)
+ (setq rr (1- mm)))
+ (t (error "Found old indentor at %s belonging to %S" mm m-chunk)))))
+ ;;(1+ (if m-ovl (overlay-end m-ovl) 0))
+ (if m-ovl (1+ (overlay-end m-ovl)) 2)
+ )))
+ (goto-char i-beg)
+ (setq indentor (mumamo-make-indentor indentor-chunk c-str)))
+ (unless prev-indentor
+ (when prev-indentor-chunk
+ (goto-char (overlay-start indentor))
+ (goto-char (point-at-bol))
+ (setq prev-indentor (mumamo-make-indentor prev-indentor-chunk p-str))))
+ (when prev-indentor (mumamo-indent-indentor prev-indentor))
+ (mumamo-indent-indentor indentor)
+ (let (prev-ind this-ind next-ind shift-in shift-out)
+ (when prev-indentor
+ (goto-char (overlay-end prev-indentor))
+ (setq prev-ind (current-indentation)))
+ (goto-char (overlay-start indentor))
+ (setq this-ind (current-indentation))
+ (goto-char (overlay-end indentor))
+ (setq next-ind (current-indentation))
+ (when prev-ind (setq shift-in (- this-ind prev-ind)))
+ (setq shift-out (- next-ind this-ind))
+ (msgtrc "template-indent-get-shunk-shift => (%s . %s)" shift-in shift-out)
+ (cons shift-in shift-out)))))))
+
+
+(defun mumamo-ruby-beginning-of-indent ()
+ "TODO: document"
+ ;; I don't understand this function.
+ ;; It seems like it should move to the line where indentation should deepen,
+ ;; but ruby-indent-beg-re only accounts for whitespace before class, module and def,
+ ;; so this will only match other block beginners at the beginning of the line.
+ (and
+ (prog1
+ (re-search-backward (concat "^\\(" ruby-indent-beg-re "\\)\\b") nil 'move)
+ (skip-chars-forward " \t\n\r"))
+ (beginning-of-line)))
+
+(defadvice ruby-beginning-of-indent (around
+ mumamo-ad-ruby-beginning-of-indent
+ activate
+ compile
+ )
+ (if t
+ (mumamo-ruby-beginning-of-indent)
+ ad-do-it)
+ )
+
+(defun mumamo-indentor-at (pos)
+ "Return indentor overlay at POS."
+ (let ((here (point))
+ eol-pos)
+ (goto-char pos)
+ (setq eol-pos (line-end-position))
+ (goto-char here)
+ (catch 'ind
+ (dolist (ovl (or (overlays-at eol-pos)
+ (when (> eol-pos 1)
+ (overlays-at (1- eol-pos)))))
+ (when (overlay-get ovl 'indentor-chunk)
+ (throw 'ind ovl))))))
+
+(defun mumamo-remove-indentor (indentor)
+ (let (beg end)
+ (goto-char (overlay-start indentor))
+ (setq beg (point-at-bol))
+ (goto-char (overlay-end indentor))
+ (setq end (1+ (point-at-eol)))
+ (delete-region beg end)
+ (delete-overlay indentor)
+ (setq indentor nil)))
+
+(defun mumamo-indent-indentor (indentor)
+ (goto-char (overlay-start indentor))
+ (if (= 2 (point-at-bol))
+ (progn
+ (back-to-indentation)
+ (delete-region 2 (point))
+ (insert " "))
+ (indent-according-to-mode))
+ (goto-char (overlay-end indentor))
+ (indent-according-to-mode))
+
+(defun mumamo-make-indentor (indentor-chunk chunk-string)
+ (let* ((beg (point))
+ (syntax-min-max (mumamo-chunk-syntax-min-max indentor-chunk t))
+ (inner (with-current-buffer (overlay-buffer indentor-chunk)
+ (buffer-substring-no-properties (cdr syntax-min-max)
+ (car syntax-min-max))))
+ indentor)
+ (insert inner)
+ (insert "\n\n")
+ (setq indentor (make-overlay beg (1- (point)) nil t t))
+ (overlay-put indentor 'indentor-chunk indentor-chunk)
+ (overlay-put indentor 'face 'secondary-selection)
+ (overlay-put indentor 'indentor-chunk-string chunk-string)
+ (overlay-put indentor-chunk 'mumamo-indentor indentor)
+ indentor))
+
+;;(mumamo-fun-eq 'js-mode 'javascript-mode)
+(defun mumamo-fun-eq (fun1 fun2)
+ "Return non-nil if same functions or aliases."
+ (or (eq fun1 fun2)
+ (progn
+ (while (and (fboundp fun1)
+ (symbolp (symbol-function fun1)))
+ (setq fun1 (symbol-function fun1)))
+ (while (and (fboundp fun2)
+ (symbolp (symbol-function fun2)))
+ (setq fun2 (symbol-function fun2)))
+ (eq fun1 fun2))))
+
+(defun mumamo-indent-line-function-1 (prev-line-chunks
+ last-parent-major-indent
+ entering-submode-arg)
+ ;; Fix-me: error indenting in xml-as-string at <?\n?>
+ ;; Fix-me: clean up, use depth diff. go back to sibling not to main etc.
+ ;; Fix-me: Add indentation hints to chunks, for example heredocs and rhtml.
+ ;; Fix-me: maybe use special indentation functions for certain multi major modes? rhtml?
+ "Indent current line.
+When doing that care must be taken if this line's major modes at
+the start and end are different from previous line major modes.
+The latter may be known through the parameter PREV-LINE-CHUNKS.
+
+Also the indentation of the last previous main major line may be
+necessary to know. This may be known through the parameter
+LAST-PARENT-MAJOR-INDENT.
+
+If the two parameters above are nil then this function will
+search backwards in the buffer to try to determine their values.
+
+The following rules are used when indenting:
+
+- If the major modes are the same in this and the previous line
+ then indentation is done using that major mode.
+
+- Exception: If the chunks are not the same AND there is
+ precisely one chunk between them which have the property value
+ of 'mumamo-next-indent equal to 'mumamo-template-indentor then
+ a special indent using the content of the middle chunk is
+ done. An example of this is eRuby where a middle chunk could
+ look like:
+
+ <% 3.times do %>
+
+ This example will increase indentation for the next line the
+ same way as the chunk content would do in single major mode
+ ruby-mode.
+
+ FIXE-ME: IMPLEMENT THE ABOVE!
+
+- Otherwise if going into a submode indentation is increased by
+ `mumamo-submode-indent-offset' (if this is nil then indentation
+ will instead be 0).
+
+- However first non-empty line indentation in a chunk when going
+ in is special if prev-prev chunk is on same mumamo-depth and
+ have the same major mode. Then indent relative last non-empty
+ line in prev-prev chunk.
+
+- When going out of a submode indentation is reset to
+ LAST-PARENT-MAJOR-INDENT.
+
+- At the border the 'dividers' should be indented as the parent
+ chunk. There are the following typical situations regarding
+ inner/outer major modes:
+
+ 1) <style type='text/css'>
+ Going in next line; first char outer; line end inner;
+
+ 2) </style>
+ Going out this line; First char inner or outer; line end outer;
+
+ 3) <?php
+ Going in next line; first char outer or inner; line end inner;
+
+ 4) ?>
+ Going out this line; first char inner; line end outer;
+
+ From this we deduce the following way to compute if we are
+ going in or out:
+
+ - Odd above (going in): Compare prev line end's mumamo-depth
+ with current line end's dito. Set flag for first line in
+ chunk.
+
+ - Even above (going out): Same test as for going in, but going
+ out happens on current line.
+"
+ ;;(msgtrc "indent-line-function-1 blp=%s" (line-beginning-position))
+ (setq prev-line-chunks nil)
+ ;;(setq last-parent-major-indent nil)
+ ;;(setq entering-submode-arg nil)
+ (unless prev-line-chunks
+ (save-excursion
+ (goto-char (line-beginning-position 1))
+ (unless (= (point) 1)
+ (skip-chars-backward "\n\t ")
+ (goto-char (line-beginning-position 1))
+ (setq prev-line-chunks (mumamo-indent-current-line-chunks nil))
+ ;;(msgtrc "%d:prev-line-chunks=%S" (save-restriction (widen) (line-number-at-pos)) prev-line-chunks )
+ )))
+ (let* ((prev-line-chunk0 (nth 0 prev-line-chunks))
+ (prev-line-chunk2 (nth 2 prev-line-chunks))
+ (prev-line-chunk3 (nth 3 prev-line-chunks))
+ (prev-line-major0 (mumamo-chunk-major-mode (nth 0 prev-line-chunks)))
+ (prev-line-major1 (mumamo-chunk-major-mode (nth 1 prev-line-chunks)))
+ (prev-line-major2 (mumamo-chunk-major-mode (nth 2 prev-line-chunks)))
+ (prev-line-major3 (mumamo-chunk-major-mode (nth 3 prev-line-chunks)))
+ (prev-depth2 (if prev-line-chunk2
+ (overlay-get prev-line-chunk2 'mumamo-depth)
+ 0))
+ (prev-depth3 (if prev-line-chunk3
+ (overlay-get prev-line-chunk3 'mumamo-depth)
+ 0))
+
+ (this-line-chunks (mumamo-indent-current-line-chunks (nth 3 prev-line-chunks)))
+ ;;(dummy (msgtrc "%d:this-line-chunks=%S" (save-restriction (widen) (line-number-at-pos)) this-line-chunks))
+ (this-line-chunk0 (nth 0 this-line-chunks))
+ (this-line-chunk2 (nth 2 this-line-chunks))
+ (this-line-chunk3 (nth 3 this-line-chunks))
+ (this-line-major0 (mumamo-chunk-major-mode (nth 0 this-line-chunks)))
+ (this-line-major1 (mumamo-chunk-major-mode (nth 1 this-line-chunks)))
+ (this-line-major2 (mumamo-chunk-major-mode (nth 2 this-line-chunks)))
+ (this-line-major3 (mumamo-chunk-major-mode (nth 3 this-line-chunks)))
+ (this-depth2 (overlay-get this-line-chunk2 'mumamo-depth))
+ (this-depth3 (overlay-get this-line-chunk3 'mumamo-depth))
+
+ ;;(dummy (msgtrc "a\t this=%S" this-line-chunks))
+ this-line-indent-major
+ major-indent-line-function
+ (main-major (mumamo-main-major-mode))
+ (old-indent (current-indentation))
+ (next-entering-submode (if (< prev-depth3 this-depth3) 'yes 'no))
+ (entering-submode
+ ;; Fix-me
+ (progn
+ (unless nil ;entering-submode-arg
+ (let* ((prev-prev-line-chunks
+ (save-excursion
+ (goto-char (line-beginning-position 0))
+ (unless (bobp)
+ (skip-chars-backward "\n\t ")
+ (goto-char (line-beginning-position 1))
+ (let ((chunks (mumamo-indent-current-line-chunks nil)))
+ ;;(msgtrc "%d:prev-prev-line-chunks=%S" (save-restriction (widen) (line-number-at-pos)) chunks)
+ chunks))))
+ (prev-prev-line-chunk2 (nth 2 prev-prev-line-chunks))
+ (prev-prev-line-chunk3 (nth 3 prev-prev-line-chunks))
+ (prev-prev-depth2 (when prev-prev-line-chunk2
+ (overlay-get prev-prev-line-chunk2 'mumamo-depth)))
+ (prev-prev-depth3 (when prev-prev-line-chunk3
+ (overlay-get prev-prev-line-chunk3 'mumamo-depth))))
+ ;;(msgtrc "depths 2=%s/%s/%s 3=%s/%s/%s" prev-prev-depth2 prev-depth2 this-depth2 prev-prev-depth3 prev-depth3 this-depth3)
+ (setq entering-submode-arg
+ (if prev-prev-depth2
+ (if (and (eq prev-prev-line-chunk2
+ (overlay-get prev-line-chunk2 'mumamo-prev-chunk))
+ (< prev-prev-depth2 prev-depth2))
+ 'yes
+ 'no)
+ (if (> this-depth2 0) 'yes 'no)
+ ))
+ ))
+ (eq 'yes entering-submode-arg)
+ )) ;; fix-me
+ ;; Fix-me
+ (leaving-submode (> prev-depth2 this-depth2))
+ want-indent ;; The indentation we desire
+ got-indent
+ (here-on-line (point-marker))
+ this-pending-undo-list
+ (while-n1 0)
+ (while-n2 0)
+ (while-n3 0)
+ ;; Is there a possible indentor chunk on this line?:
+ (this-line-indentor-chunk (when (> (overlay-start this-line-chunk2)
+ (point-at-bol))
+ (overlay-get this-line-chunk2 'mumamo-prev-chunk)))
+ ;;(dummy (msgtrc "this-line-indentor-chunk=%S" this-line-indentor-chunk))
+ ;; Check if this really is an indentor chunk:
+ ;; Fix-me: 'mumamo-indentor is not put on the chunk yet since
+ ;; it is done in mumamo-template-indent-get-chunk-shift ... -
+ ;; and now it is calle too often ...
+ (this-line-indentor-prev (when this-line-indentor-chunk
+ (overlay-get this-line-indentor-chunk 'mumamo-prev-chunk)))
+ (this-line-is-indentor (and this-line-indentor-prev
+ (eq (overlay-get this-line-indentor-prev 'mumamo-next-indent)
+ 'mumamo-template-indentor)
+ (progn
+ (goto-char (overlay-start this-line-indentor-chunk))
+ (back-to-indentation)
+ (= (point) (overlay-start this-line-indentor-chunk)))))
+ ;; Fix-me: rewrite and reorder. We do not need both shift-in and shift-out
+ (this-template-shift (when this-line-is-indentor
+ (mumamo-template-indent-get-chunk-shift this-line-indentor-chunk)))
+ ;;(dummy (msgtrc "this-line-indentor=%s, %S" this-template-shift this-line-is-indentor))
+ ;; Fix-me: skip over blank lines backward here:
+ (prev-template-indentor (when prev-line-chunk0
+ (unless (eq this-line-chunk0 prev-line-chunk0)
+ (let* ((prev (overlay-get this-line-chunk0 'mumamo-prev-chunk))
+ (prev-prev (overlay-get prev 'mumamo-prev-chunk)))
+ (when (and (eq prev-prev prev-line-chunk0)
+ (eq (overlay-get prev-prev 'mumamo-next-indent)
+ 'mumamo-template-indentor))
+ prev)))))
+ (prev-template-shift-rec (when prev-template-indentor
+ (mumamo-template-indent-get-chunk-shift prev-template-indentor)
+ ))
+ (template-shift (if (and (car this-template-shift) (/= 0 (car this-template-shift)))
+ (car this-template-shift)
+ (when prev-template-shift-rec
+ (cdr prev-template-shift-rec))))
+ (template-indent-abs (when (and template-shift
+ (/= 0 template-shift))
+ (+ template-shift
+ (let ((here (point)))
+ (if prev-template-indentor
+ (goto-char (overlay-start prev-template-indentor))
+ (goto-char (overlay-start this-line-indentor-chunk))
+ (skip-chars-backward " \t\r\n\f"))
+ (prog1
+ (current-indentation)
+ (goto-char here))))))
+ )
+ (when (and leaving-submode entering-submode)
+ (message "Do not know how to indent here (both leaving and entering sub chunks)")
+ )
+ ;; Fix-me: indentation
+ ;;(error "Leaving=%s, entering=%s this0,1,2,3=%s,%s,%s,%s" leaving-submode entering-submode this-line-major0 this-line-major1 this-line-major2 this-line-major3)
+ (when (or leaving-submode entering-submode)
+ (unless last-parent-major-indent
+ (save-excursion
+ ;;(while (and (> 500 (setq while-n1 (1+ while-n1)))
+ (while (and (mumamo-while 500 'while-n1 "last-parent-major-indent")
+ (not last-parent-major-indent))
+ (if (bobp)
+ (setq last-parent-major-indent 0)
+ (goto-char (line-beginning-position 0))
+ (when (mumamo-fun-eq main-major
+ (mumamo-chunk-major-mode
+ (car
+ (mumamo-indent-current-line-chunks nil)))
+ )
+ (skip-chars-forward " \t")
+ (if (eolp)
+ (setq last-parent-major-indent 0)
+ (setq last-parent-major-indent (current-column)))))))))
+ (mumamo-msgindent " leaving-submode=%s, entering-submode=%s" leaving-submode entering-submode)
+ ;;(msgtrc " leaving-submode=%s, entering-submode=%s, template-indentor=%s" leaving-submode entering-submode template-indentor)
+
+ ;; Fix-me: use this.
+ ;; - clean up after chunk deletion
+ ;; - next line after a template-indentor, what happens?
+ ;;(setq template-indentor nil) ;; fix-me
+ (cond
+ ( template-indent-abs
+ (setq want-indent (max 0 template-indent-abs)))
+ ( leaving-submode
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;;;; First line after submode
+ (mumamo-msgindent " leaving last-parent-major-indent=%s" last-parent-major-indent)
+ (if (eq (overlay-get (overlay-get this-line-chunk0 'mumamo-prev-chunk)
+ 'mumamo-next-indent)
+ 'heredoc)
+ (setq want-indent 0)
+ (setq want-indent last-parent-major-indent)))
+
+ ( entering-submode
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;;;; First line in submode
+ ;;(setq this-line-indent-major this-line-major0)
+ (setq this-line-indent-major (mumamo-indent-get-major-to-use this-line-major0 this-depth3))
+ ;;(when (and prev-line-major0 (not (mumamo-fun-eq this-line-major0 prev-line-major0))) (setq this-line-indent-major prev-line-major0))
+ (mumamo-msgindent " this-line-indent-major=%s, major-mode=%s this0=%s" this-line-indent-major major-mode this-line-major0)
+ (mumamo-msgindent " mumamo-submode-indent-offset=%s" mumamo-submode-indent-offset)
+ (unless (mumamo-fun-eq this-line-indent-major major-mode)
+ (mumamo-set-major this-line-indent-major this-line-chunk0))
+ (setq want-indent (+ last-parent-major-indent
+ (if (= 0 last-parent-major-indent)
+ (if mumamo-submode-indent-offset-0
+ mumamo-submode-indent-offset-0
+ -1000)
+ (if mumamo-submode-indent-offset
+ mumamo-submode-indent-offset
+ -1000))))
+ (unless (< 0 want-indent) (setq want-indent nil))
+ (when (and want-indent (mumamo-indent-use-widen major-mode))
+ ;; In this case only use want-indent if it is bigger than the
+ ;; indentation calling indent-line-function would give.
+ (condition-case nil
+ (atomic-change-group
+ (mumamo-call-indent-line (nth 0 this-line-chunks))
+ (when (> want-indent (current-indentation))
+ (signal 'mumamo-error-ind-0 nil))
+ (setq want-indent nil))
+ (mumamo-error-ind-0)))
+ (unless want-indent
+ (mumamo-call-indent-line (nth 0 this-line-chunks)))
+ (mumamo-msgindent " enter sub.want-indent=%s, curr=%s, last-main=%s" want-indent (current-indentation)
+ last-parent-major-indent)
+ ;;(unless (> want-indent (current-indentation)) (setq want-indent nil))
+ )
+
+ ( t
+ ;; We have to change major mode, because we know nothing
+ ;; about the requirements of the indent-line-function:
+ ;; Fix-me: This may be cured by RMS suggestion to
+ ;; temporarily set all variables back to global values?
+ (setq this-line-indent-major (mumamo-indent-get-major-to-use this-line-major0 this-depth3))
+ (mumamo-msgindent " this-line-indent-major=%s" this-line-indent-major)
+ (unless (mumamo-fun-eq this-line-indent-major major-mode) (mumamo-set-major this-line-indent-major this-line-chunk0))
+ ;; Use the major mode at the beginning of since a sub chunk may
+ ;; start at start of line.
+ (if (mumamo-fun-eq this-line-major1 main-major)
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;;;; In main major mode
+ ;;
+ ;; Take care of the case when all the text is in a
+ ;; sub chunk. In that case use the same indentation as if
+ ;; the code all belongs to the surrounding major mode.
+ (let ((here (point))
+ (use-widen (mumamo-indent-use-widen main-major)))
+ ;; If we can't indent indent using the main major mode
+ ;; because it is only blanks and we should not widen,
+ ;; then use the indentation on the line where it starts.
+ (mumamo-msgindent " In main major mode")
+ (forward-line 0)
+ (skip-chars-backward " \t\n\r\f")
+ (forward-line 0)
+ (if (or use-widen (>= (point) (overlay-start this-line-chunk0)))
+ (progn
+ (goto-char here)
+ (mumamo-call-indent-line this-line-chunk0))
+ (setq want-indent (current-indentation))
+ (goto-char here))
+ (mumamo-msgindent " In main major mode B")
+ (setq last-parent-major-indent (current-indentation)))
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;;;; In sub major mode
+ ;;
+ ;; Get the indentation the major mode alone would use:
+ ;;(setq got-indent (mumamo-get-major-mode-indent-column))
+ ;; Since this line has another major mode than the
+ ;; previous line we instead want to indent relative to
+ ;; that line in a way decided in mumamo:
+ (mumamo-msgindent " In sub major mode")
+ (let ((chunk (mumamo-get-chunk-save-buffer-state (point)))
+ (font-lock-dont-widen t)
+ ind-zero
+ (here (point))
+ ind-on-first-sub-line)
+ (save-restriction
+ (mumamo-update-obscure chunk here)
+ (let ((syn-min-max (mumamo-chunk-syntax-min-max chunk nil)))
+ (narrow-to-region (car syn-min-max)
+ (cdr syn-min-max)))
+ (condition-case nil
+ (atomic-change-group
+ (mumamo-call-indent-line (nth 0 this-line-chunks))
+ (when (= 0 (current-indentation))
+ (setq ind-zero t)
+ ;; It is maybe ok if indentation on first sub
+ ;; line is 0 so check that:
+ (goto-char (point-min))
+ (widen)
+ (setq ind-on-first-sub-line (current-indentation))
+ (goto-char here)
+ (signal 'mumamo-error-ind-0 nil)))
+ (mumamo-error-ind-0))
+ ;; Unfortunately the indentation can sometimes get 0
+ ;; here even though it is clear it should not be 0. This
+ ;; happens when there are only comments or empty lines
+ ;; above.
+ ;;
+ ;; See c:/test/erik-lilja-index.php for an example.
+ (when ind-zero ;(and t (= 0 (current-indentation)))
+ (save-excursion
+ (setq want-indent 0)
+ (unless (= 0 ind-on-first-sub-line)
+ ;;(while (and (> 500 (setq while-n2 (1+ while-n2)))
+ (while (and (mumamo-while 500 'while-n2 "want-indent")
+ (= 0 want-indent)
+ (/= (point) (point-min)))
+ (beginning-of-line 0)
+ (setq want-indent (current-indentation)))
+ ;; Now if want-indent is still 0 we need to look further above
+ (when (= 0 want-indent)
+ (widen)
+ ;;(while (and (> 500 (setq while-n3 (1+ while-n3)))
+ (while (and (mumamo-while 500 'while-n3 "want-indent 2")
+ (= 0 want-indent)
+ (/= (point) (point-min)))
+ (beginning-of-line 0)
+ (setq want-indent (current-indentation)))
+ ;; If we got to the main major mode we need to add
+ ;; the special submode offset:
+ (let* ((ovl (mumamo-get-chunk-save-buffer-state (point)))
+ (major (mumamo-chunk-major-mode ovl)))
+ (when (mumamo-fun-eq major main-major)
+ (setq want-indent (+ want-indent
+ (if (= 0 want-indent)
+ mumamo-submode-indent-offset-0
+ mumamo-submode-indent-offset)))))))))
+ )))))
+ (when want-indent
+ ;;(msgtrc "indent-line-to %s at line-beginning=%s" want-indent (line-beginning-position))
+ (indent-line-to want-indent))
+ ;; (when (and template-shift (/= 0 template-shift))
+ ;; (let ((ind (+ (current-indentation) template-shift)))
+ ;; (indent-line-to ind)))
+ ;; (when template-indent-abs
+ ;; (indent-line-to template-indent-abs))
+ (goto-char here-on-line)
+ ;;(msgtrc "exit: %s" (list this-line-chunks last-parent-major-indent))
+ (list this-line-chunks last-parent-major-indent next-entering-submode)))
+
+;; Fix-me: use this for first line in a submode
+;; Fix-me: check more carefully for widen since it may lead to bad results.
+(defun mumamo-indent-use-widen (major-mode)
+ "Return non-nil if widen before indentation in MAJOR-MODE."
+ (let* ((specials (cadr (assoc major-mode mumamo-indent-widen-per-major)))
+ (use-widen (memq 'use-widen specials))
+ (use-widen-maybe (assq 'use-widen specials)))
+ (or use-widen
+ (memq mumamo-multi-major-mode (cadr use-widen-maybe)))))
+;;(mumamo-indent-use-widen 'php-mode)
+;;(mumamo-indent-use-widen 'nxhtml-mode)
+;;(mumamo-indent-use-widen 'html-mode)
+
+;; Fix-me: remove
+;; (defun mumamo-indent-special-or-default (default-indent)
+;; "Indent to DEFAULT-INDENT unless a special indent can be done."
+;; (mumamo-with-major-mode-indentation major-mode
+;; `(progn
+;; (if (mumamo-indent-use-widen major-mode)
+;; (save-restriction
+;; (widen)
+;; (mumamo-msgindent "=> special-or-default did widen, %s" major-mode)
+;; (funcall indent-line-function))
+;; (indent-to-column default-indent)))))
+
+(defun mumamo-call-indent-line (chunk)
+ "Call the relevant `indent-line-function'."
+ ;;(msgtrc "call-indent-line %s, lbp=%s" chunk (line-beginning-position))
+ (if nil
+ (mumamo-with-major-mode-indentation major-mode
+ `(save-restriction
+ (when (mumamo-indent-use-widen major-mode)
+ (mumamo-msgindent "=> indent-line did widen")
+ (widen))
+ (funcall indent-line-function)))
+ (let ((maj (car mumamo-major-mode-indent-line-function))
+ (fun (cdr mumamo-major-mode-indent-line-function)))
+ (assert (mumamo-fun-eq maj major-mode))
+ (save-restriction
+ ;; (unless (mumamo-indent-use-widen major-mode)
+ ;; (let ((syn-min-max (mumamo-chunk-syntax-min-max chunk nil)))
+ ;; (narrow-to-region (car syn-min-max) (cdr syn-min-max))))
+ (let ((mumamo-stop-widen (not (mumamo-indent-use-widen major-mode))))
+ (if (not mumamo-stop-widen)
+ (widen)
+ (let ((syn-min-max (mumamo-chunk-syntax-min-max chunk nil)))
+ (narrow-to-region (car syn-min-max) (cdr syn-min-max))))
+ ;;(msgtrc "call-indent-line fun=%s" fun)
+ ;;(funcall fun)
+ ;; Fix-me: Use mumamo-funcall-evaled to avoid (widen):
+ (mumamo-funcall-evaled fun)
+ )))))
+
+(defvar mumamo-stop-widen nil)
+(when nil
+ (let* ((fun 'describe-variable)
+ (lib (symbol-file fun 'defun)))
+ (find-function-search-for-symbol fun nil lib)))
+
+(defun mumamo-funcall-evaled (fun &rest args)
+ "Make sure FUN is evaled, then call it.
+This make sure (currently) that defadvice for primitives are
+called. They are not called in byte compiled code.
+
+See URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=5863' since
+this may change."
+ (when mumamo-stop-widen
+ (unless (get fun 'mumamo-evaled)
+ (let* ((lib (symbol-file fun 'defun))
+ (where (find-function-search-for-symbol fun nil lib))
+ (buf (car where))
+ (pos (cdr where)))
+ (with-current-buffer buf
+ (let ((close (and (not (buffer-modified-p))
+ (= 1 (point)))))
+ ;;(goto-char pos) (eval-defun nil)
+ (msgtrc "mumamo-funcall-evaled %s" (current-buffer))
+ (eval-buffer)
+ (when close (kill-buffer))))
+ (put fun 'mumamo-evaled t))))
+ (apply 'funcall fun args))
+
+;;(require 'advice)
+(defun mumamo-defadvice-widen ()
+ (defadvice widen (around
+ mumamo-ad-widen
+ activate
+ compile
+ )
+ (unless (and mumamo-multi-major-mode
+ mumamo-stop-widen)
+ ad-do-it)))
+(eval-after-load 'mumamo
+ '(mumamo-defadvice-widen))
+
+;; (defadvice font-lock-fontify-buffer (around
+;; mumam-ad-font-lock-fontify-buffer
+;; activate
+;; compile
+;; )
+;; (if mumamo-multi-major-mode
+;; (save-restriction
+;; (let* ((chunk (mumamo-find-chunks (point) "font-lock-fontify-buffer advice"))
+;; (syn-min-max (mumamo-chunk-syntax-min-max chunk nil))
+;; (syn-min (car syn-min-max))
+;; (syn-max (cdr syn-min-max))
+;; (mumamo-stop-widen t))
+;; (narrow-to-region syn-min syn-max)
+;; (font-lock-fontify-region syn-min syn-max)))
+;; ad-do-it))
+
+(defun mumamo-indent-region-function (start end)
+ "Indent the region between START and END."
+ (save-excursion
+ (setq end (copy-marker end))
+ (goto-char start)
+ (let ((old-point -1)
+ prev-line-chunks
+ last-parent-major-indent
+ entering-submode-arg
+ ;; Turn off validation during indentation
+ (old-rng-validate-mode (when (boundp 'rng-validate-mode) rng-validate-mode))
+ (rng-nxml-auto-validate-flag nil)
+ (nxhtml-use-imenu nil)
+ fontification-functions
+ rng-nxml-auto-validate-flag
+ (nxhtml-mode-hook (mumamo-get-hook-value
+ 'nxhtml-mode-hook
+ '(html-imenu-setup)))
+ ;;
+ (while-n1 0))
+ (when old-rng-validate-mode (rng-validate-mode -1))
+ ;;(while (and (> 3000 (setq while-n1 (1+ while-n1)))
+ (while (and (mumamo-while 3000 'while-n1 "indent-region")
+ (< (point) end)
+ (/= old-point (point)))
+ ;;(message "mumamo-indent-region-function, point=%s" (point))
+ (or (and (bolp) (eolp))
+ (let ((ret (mumamo-indent-line-function-1
+ prev-line-chunks
+ last-parent-major-indent
+ entering-submode-arg)))
+ (setq prev-line-chunks (nth 0 ret))
+ (setq last-parent-major-indent (nth 1 ret))
+ (setq entering-submode-arg (nth 2 ret))))
+ (setq old-point (point))
+ (forward-line 1))
+ (when old-rng-validate-mode (rng-validate-mode 1)))
+ (message "Ready indenting region")))
+
+
+(defun mumamo-fill-forward-paragraph-function(&optional arg)
+ "Function to move over paragraphs used by filling code.
+This is the buffer local value of
+`fill-forward-paragraph-function' when mumamo is used."
+ ;; fix-me: Do this chunk by chunk
+ ;; Fix-me: use this (but only in v 23)
+ (let* ((ovl (mumamo-get-chunk-save-buffer-state (point)))
+ (major (mumamo-chunk-major-mode ovl)))
+ (mumamo-with-major-mode-fontification major
+ fill-forward-paragraph-function)))
+
+(defun mumamo-fill-chunk (&optional justify)
+ "Fill each of the paragraphs in the current chunk.
+Narrow to chunk region trimmed white space at the ends. Then
+call `fill-region'.
+
+The argument JUSTIFY is the same as in `fill-region' and a prefix
+behaves the same way as there."
+ (interactive (progn
+ (barf-if-buffer-read-only)
+ (list (if current-prefix-arg 'full))))
+ (let* ((ovl (mumamo-get-chunk-save-buffer-state (point)))
+ (major (mumamo-chunk-major-mode ovl)))
+ ;; Fix-me: There must be some bug that makes it necessary to
+ ;; always change mode when fill-paragraph-function is
+ ;; c-fill-paragraph.
+
+ ;;(unless (mumamo-fun-eq major major-mode) (mumamo-set-major major ovl))
+ (mumamo-set-major major ovl)
+
+ (save-restriction
+ (mumamo-update-obscure ovl (point))
+ (let* ((syn-min-max (mumamo-chunk-syntax-min-max ovl nil))
+ (syn-min (car syn-min-max))
+ (syn-max (cdr syn-min-max))
+ use-min
+ (here (point-marker)))
+ (goto-char syn-min)
+ (skip-syntax-forward " ")
+ ;; Move back over chars that have whitespace syntax but have the p flag.
+ (backward-prefix-chars)
+ (setq use-min (point))
+ (goto-char syn-max)
+ (skip-syntax-backward " ")
+ (fill-region use-min (point) justify)))))
+
+;; (defvar mumamo-dont-widen)
+;; (defadvice widen (around
+;; mumamo-ad-widen
+;; activate
+;; disable
+;; compile
+;; )
+;; "Make `widen' do nothing.
+;; This is for `mumamo-fill-paragraph-function' and is necessary
+;; when `c-fill-paragraph' is the real function used."
+;; (unless (and (boundp 'mumamo-dont-widen)
+;; mumamo-dont-widen)
+;; ad-do-it))
+
+(defadvice flymake-display-warning (around
+ mumamo-ad-flymake-display-warning
+ activate
+ compile)
+ "Display flymake warnings in the usual Emacs way."
+ (let ((msg (ad-get-arg 0)))
+ ;; Fix-me: Can't get backtrace here. Report it.
+ ;;(setq msg (format (concat msg "\n%S" (with-output-to-string (backtrace)))))
+ (lwarn '(flymake) :error msg)))
+;;(lwarn '(flymake) :error "the warning")
+
+(defun mumamo-forward-chunk ()
+ "Move forward to next chunk."
+ (interactive)
+ (let* ((chunk (mumamo-get-chunk-save-buffer-state (point)))
+ (end-pos (overlay-end chunk)))
+ (goto-char (min end-pos
+ (point-max)))))
+
+(defun mumamo-backward-chunk ()
+ "Move backward to previous chunk."
+ (interactive)
+ (let* ((chunk (mumamo-get-chunk-save-buffer-state (point)))
+ (start-pos (overlay-start chunk)))
+ (goto-char (max (1- start-pos)
+ (point-min)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Spell checking
+
+(defun mumamo-flyspell-verify ()
+ "Function used for `flyspell-generic-check-word-predicate'."
+ (let* ((chunk (when mumamo-multi-major-mode
+ (mumamo-find-chunks (point) "mumamo-lyspell-verify")))
+ (chunk-major (when chunk (mumamo-chunk-major-mode chunk)))
+ (mode-predicate (when chunk-major
+ (let ((predicate (get chunk-major
+ 'flyspell-mode-predicate)))
+ (if predicate
+ predicate
+ (if (mumamo-derived-from-mode chunk-major
+ 'text-mode)
+ nil
+ 'flyspell-generic-progmode-verify)))))
+ )
+ (if mode-predicate
+ ;; Fix-me: (run-hooks 'flyspell-prog-mode-hook)
+ (funcall mode-predicate)
+ t)))
+
+;; (featurep 'cc-engine)
+(eval-after-load 'cc-engine
+ (progn
+ ;; From Alan's mail 2009-12-03: C Mode: acceleration in brace
+ ;; deserts.
+ ;; Fix-me: Should they be here, or...?
+ (put 'c-state-cache 'permanent-local t)
+ (put 'c-state-cache-good-pos 'permanent-local t)
+ (put 'c-state-nonlit-pos-cache 'permanent-local t)
+ (put 'c-state-nonlit-pos-cache-limit 'permanent-local t)
+ (put 'c-state-brace-pair-desert 'permanent-local t)
+ (put 'c-state-point-min 'permanent-local t)
+ (put 'c-state-point-min-lit-type 'permanent-local t)
+ (put 'c-state-point-min-lit-start 'permanent-local t)
+ (put 'c-state-min-scan-pos 'permanent-local t)
+ (put 'c-state-old-cpp-beg 'permanent-local t)
+ (put 'c-state-old-cpp-end 'permanent-local t)
+
+ ))
+
+;; Fix-me: Seems perhaps like c-state-point-min-lit-start is reset in
+;; c-state-mark-point-min-literal because c-state-literal-at returns
+;; nil. (Or is (car lit) nil?)
+
+(defvar mumamo-c-state-cache-init nil)
+(make-variable-buffer-local 'mumamo-c-state-cache-init)
+(put 'mumamo-c-state-cache-init 'permanent-local t)
+
+(defun mumamo-c-state-cache-init ()
+ (unless mumamo-c-state-cache-init
+ ;;(msgtrc "c-state-cache-init running")
+ (setq mumamo-c-state-cache-init t)
+ (setq c-state-cache (or c-state-cache nil))
+ (put 'c-state-cache 'permanent-local t)
+ (setq c-state-cache-good-pos (or c-state-cache-good-pos 1))
+ (put 'c-state-cache-good-pos 'permanent-local t)
+ (setq c-state-nonlit-pos-cache (or c-state-nonlit-pos-cache nil))
+ (put 'c-state-nonlit-pos-cache 'permanent-local t)
+ (setq c-state-nonlit-pos-cache-limit (or c-state-nonlit-pos-cache-limit 1))
+ (put 'c-state-nonlit-pos-cache-limit 'permanent-local t)
+ (setq c-state-brace-pair-desert (or c-state-brace-pair-desert nil))
+ (put 'c-state-brace-pair-desert 'permanent-local t)
+ (setq c-state-point-min (or c-state-point-min 1))
+ (put 'c-state-point-min 'permanent-local t)
+ (setq c-state-point-min-lit-type (or c-state-point-min-lit-type nil))
+ (put 'c-state-point-min-lit-type 'permanent-local t)
+ (setq c-state-point-min-lit-start (or c-state-point-min-lit-start nil))
+ (put 'c-state-point-min-lit-start 'permanent-local t)
+ (setq c-state-min-scan-pos (or c-state-min-scan-pos 1))
+ (put 'c-state-min-scan-pos 'permanent-local t)
+ (setq c-state-old-cpp-beg (or c-state-old-cpp-beg nil))
+ (put 'c-state-old-cpp-beg 'permanent-local t)
+ (setq c-state-old-cpp-end (or c-state-old-cpp-end nil))
+ (put 'c-state-old-cpp-end 'permanent-local t)
+ (c-state-mark-point-min-literal)))
+
+(defadvice c-state-cache-init (around
+ mumamo-ad-c-state-cache-init
+ activate
+ compile
+ )
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (mumamo-c-state-cache-init)))
+
+;; Fix-me: Have to add per chunk local majors for this one.
+(defun mumamo-c-state-literal-at (here)
+ ;; If position HERE is inside a literal, return (START . END), the
+ ;; boundaries of the literal (which may be outside the accessible bit of the
+ ;; buffer). Otherwise, return nil.
+ ;;
+ ;; This function is almost the same as `c-literal-limits'. It differs in
+ ;; that it is a lower level function, and that it rigourously follows the
+ ;; syntax from BOB, whereas `c-literal-limits' uses a "local" safe position.
+ (let* ((is-here (point))
+ (s (syntax-ppss here))
+ (ret (when (or (nth 3 s) (nth 4 s)) ; in a string or comment
+ (parse-partial-sexp (point) (point-max)
+ nil ; TARGETDEPTH
+ nil ; STOPBEFORE
+ s ; OLDSTATE
+ 'syntax-table) ; stop at end of literal
+ (cons (nth 8 s) (point)))))
+ (goto-char is-here)
+ ret))
+
+;; (save-restriction
+;; (widen)
+;; (let* ((chunk (mumamo-find-chunks (point) "mumamo-c-state-literal-at"))
+;; (syntax-min-max (mumamo-chunk-syntax-min-max chunk t)))
+;; (narrow-to-region (car syntax-min-max) (cdr syntax-min-max)))
+;; (save-excursion
+;; (let ((c c-state-nonlit-pos-cache)
+;; pos npos lit)
+;; ;; Trim the cache to take account of buffer changes.
+;; (while (and c (> (car c) c-state-nonlit-pos-cache-limit))
+;; (setq c (cdr c)))
+;; (setq c-state-nonlit-pos-cache c)
+
+;; (while (and c (> (car c) here))
+;; (setq c (cdr c)))
+;; (setq pos (or (car c) (point-min)))
+
+;; (while (<= (setq npos (+ pos c-state-nonlit-pos-interval))
+;; here)
+;; (setq lit (c-state-pp-to-literal pos npos))
+;; (setq pos (or (cdr lit) npos)) ; end of literal containing npos.
+;; (setq c-state-nonlit-pos-cache (cons pos c-state-nonlit-pos-cache)))
+
+;; (if (> pos c-state-nonlit-pos-cache-limit)
+;; (setq c-state-nonlit-pos-cache-limit pos))
+;; (if (< pos here)
+;; (setq lit (c-state-pp-to-literal pos here)))
+;; lit))))
+
+
+(defadvice c-state-literal-at (around
+ mumamo-ad-c-state-state-literal-at
+ activate
+ compile
+ )
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (mumamo-c-state-literal-at (ad-get-arg 0))))
+
+
+(defun mumamo-c-state-get-min-scan-pos ()
+ ;; Return the lowest valid scanning pos. This will be the end of the
+ ;; literal enclosing point-min, or point-min itself.
+ (save-restriction
+ (save-excursion
+ (widen)
+ (mumamo-narrow-to-chunk-inner)
+ (or (and c-state-min-scan-pos
+ (>= c-state-min-scan-pos (point-min))
+ c-state-min-scan-pos)
+ (if (not c-state-point-min-lit-start)
+ (goto-char (point-min))
+ (goto-char c-state-point-min-lit-start)
+ (if (eq c-state-point-min-lit-type 'string)
+ (forward-sexp)
+ (forward-comment 1)))
+ (setq c-state-min-scan-pos (point))))))
+
+(defadvice c-state-get-min-scan-pos (around
+ mumamo-ad-c-state-get-min-scan-pos-at
+ activate
+ compile
+ )
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (setq ad-return-value (mumamo-c-state-get-min-scan-pos))))
+
+(eval-after-load 'rng-match
+;;; (defun rng-match-init-buffer ()
+;;; (make-local-variable 'rng-compile-table)
+;;; (make-local-variable 'rng-ipattern-table)
+;;; (make-local-variable 'rng-last-ipattern-index))
+ (progn
+ (put 'rng-compile-table 'permanent-local t)
+ (put 'rng-ipattern-table 'permanent-local t)
+ (put 'rng-last-ipattern-index 'permanent-local t)
+ ))
+
+(eval-after-load 'flyspell
+ (progn
+ (put 'flyspell-mode 'permanent-local t)
+
+ (put 'flyspell-generic-check-word-predicate 'permanent-local t)
+
+ (put 'flyspell-casechars-cache 'permanent-local t)
+ (put 'flyspell-ispell-casechars-cache 'permanent-local t)
+
+ (put 'flyspell-not-casechars-cache 'permanent-local t)
+ (put 'flyspell-ispell-not-casechars-cache 'permanent-local t)
+
+ (put 'flyspell-auto-correct-pos 'permanent-local t)
+ (put 'flyspell-auto-correct-region 'permanent-local t)
+ (put 'flyspell-auto-correct-ring 'permanent-local t)
+ (put 'flyspell-auto-correct-word 'permanent-local t)
+
+ (put 'flyspell-consider-dash-as-word-delimiter-flag 'permanent-local t)
+
+ (put 'flyspell-dash-dictionary 'permanent-local t)
+
+ (put 'flyspell-dash-local-dictionary 'permanent-local t)
+
+ (put 'flyspell-word-cache-start 'permanent-local t)
+ (put 'flyspell-word-cache-end 'permanent-local t)
+ (put 'flyspell-word-cache-word 'permanent-local t)
+ (put 'flyspell-word-cache-result 'permanent-local t)
+
+ (put 'flyspell-word-cache-start 'permanent-local t)
+
+
+ (put 'flyspell-kill-ispell-hook 'permanent-local-hook t)
+ (put 'flyspell-post-command-hook 'permanent-local-hook t)
+ (put 'flyspell-pre-command-hook 'permanent-local-hook t)
+ (put 'flyspell-after-change-function 'permanent-local-hook t)
+ (put 'flyspell-hack-local-variables-hook 'permanent-local-hook t)
+ (put 'flyspell-auto-correct-previous-hook 'permanent-local-hook t)
+
+ (when mumamo-multi-major-mode
+ (when (featurep 'flyspell)
+ (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify)))
+ ))
+
+(defun flyspell-mumamo-mode ()
+ "Turn on function `flyspell-mode' for multi major modes."
+ (interactive)
+ (require 'flyspell)
+ (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify)
+ (flyspell-mode 1)
+ ;;(run-hooks 'flyspell-prog-mode-hook)
+ )
+
+(eval-after-load 'sgml-mode
+ (progn
+ (put 'sgml-tag-face-alist 'permanent-local t)
+ (put 'sgml-display-text 'permanent-local t)
+ (put 'sgml-tag-alist 'permanent-local t)
+ (put 'sgml-face-tag-alist 'permanent-local t)
+ (put 'sgml-tag-help 'permanent-local t)
+ ))
+
+(eval-after-load 'hl-line
+ (progn
+ (put 'hl-line-overlay 'permanent-local t)
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; New versions of syntax-ppss functions, temporary written as defadvice.
+
+(defadvice syntax-ppss-flush-cache (around
+ mumamo-ad-syntax-ppss-flush-cache
+ activate
+ compile
+ )
+ "Support for mumamo.
+See the defadvice for `syntax-ppss' for an explanation."
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (let ((pos (ad-get-arg 0)))
+ (let* ((chunk-at-pos (when (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)
+ (mumamo-find-chunks-1 pos "syntax-ppss-flush-cache"))))
+ (if chunk-at-pos
+ (let* ((syntax-ppss-last (overlay-get chunk-at-pos 'syntax-ppss-last))
+ (syntax-ppss-cache (overlay-get chunk-at-pos 'syntax-ppss-cache)))
+ ;;(setq ad-return-value ad-do-it)
+ ad-do-it
+ (overlay-put chunk-at-pos 'syntax-ppss-last syntax-ppss-last)
+ (overlay-put chunk-at-pos 'syntax-ppss-cache syntax-ppss-cache))
+ ;;(setq ad-return-value ad-do-it)
+ ad-do-it
+ )))))
+
+(defvar mumamo-syntax-chunk-at-pos nil
+ "Internal use.")
+(make-variable-buffer-local 'mumamo-syntax-chunk-at-pos)
+
+;; Fix-me: Is this really needed?
+;; See http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00374.html
+(defadvice syntax-ppss-stats (around
+ mumamo-ad-syntax-ppss-stats
+ activate
+ compile
+ )
+ "Support for mumamo.
+See the defadvice for `syntax-ppss' for an explanation."
+ (if mumamo-syntax-chunk-at-pos
+ (let* ((syntax-ppss-stats
+ (overlay-get mumamo-syntax-chunk-at-pos 'syntax-ppss-stats)))
+ ad-do-it
+ (overlay-put mumamo-syntax-chunk-at-pos 'syntax-ppss-stats syntax-ppss-stats))
+ ad-do-it))
+
+(defvar mumamo-syntax-ppss-major nil)
+
+;; FIX-ME: There is a problem with " in xhtml files, especially after
+;; syntax="...". Looks like it is the " entry in
+;; `sgml-font-lock-syntactic-keywords' that is jumping in! Dumping
+;; things in `font-lock-apply-syntactic-highlight' seems to show that.
+;;
+;; (I have put in some dump code in my patched version of
+;; Emacs+EmacsW32 there for that. This is commented out by default
+;; and it will only work for the file nxhtml-changes.html which is big
+;; enough for the problem to occur. It happens at point 1109.)
+;;
+;; It is this piece of code where the problem arise:
+;;
+;; (if (prog1
+;; (zerop (car (syntax-ppss (match-beginning 0))))
+;; (goto-char (match-end 0)))
+;; .)
+;;
+;;
+;; It comes from `sgml-font-lock-syntactic-keywords' in sgml-mode.el
+;; and is supposed to protect from " that is not inside a tag.
+;; However in this case for the second " in syntax="..." `syntax-ppss'
+;; returns 0 as the first element in its return value. That happen
+;; even though `major-mode' is correctly `html-mode'. It leads to
+;; that the property 'syntax with the value (1) is added to the "
+;; after the css-mode chunk in syntax="...". The problem persists
+;; even if the chunk has `fundamental-mode' instead of `css-mode'.
+;;
+;; Bypassing the cache for `syntax-pss' by calling
+;; `parse-partial-sexp' directly instead of doing ad-do-it (see
+;; by-pass-chache in the code below) solves the problem for now. It
+;; does not feel like the right solution however.
+;;
+;; One way of temporary solving the problem is perhaps to modify
+;; `mumamo-chunk-attr=' to make "" borders, but I am not sure that it
+;; works and it is the wrong solution.
+(defadvice syntax-ppss (around
+ mumamo-ad-syntax-ppss
+ activate
+ compile
+ )
+ "Support for mumamo chunks.
+For each chunk store as properties of the chunk the parse state
+that is normally hold in `syntax-ppss-last' and
+`syntax-ppss-cache'.
+
+Compute the beginning parse state for a chunk this way:
+
+- If the chunk major mode is the same as the main major mode for
+ the multi major mode then parse from the beginning of the file
+ to the beginning of the chunk using the main major mode. While
+ doing that jump over chunks that do not belong to the main
+ major mode and cache the state at the end and beginning of the
+ the main major mode chunks.
+
+FIX-ME: implement above. Solution?:
+ (parse-partial-sexp syntax-min (1+ syntax-max) nil nil state-at-syntax-min)
+Put this at next chunk's beginning.
+
+- Otherwise set the state at the beginning of the chunk to nil.
+
+Do here also other necessary adjustments for this."
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (let ((pos (ad-get-arg 0)))
+ (unless pos (setq pos (point)))
+ (let* ((chunk-at-pos (when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ (mumamo-find-chunks-1 pos "syntax-ppss")))
+ (dump2 (and (boundp 'dump-quote-hunt)
+ dump-quote-hunt
+ (boundp 'start)
+ ;;(= 1109 start)
+ )))
+ ;;(setq dump2 t)
+ (setq mumamo-syntax-chunk-at-pos chunk-at-pos)
+ (when dump2 (msgtrc "\npos=%s point-min=%s mumamo-syntax-ppss.chunk-at-pos=%s" pos (point-min) chunk-at-pos))
+ (if chunk-at-pos
+ (let* ((chunk-syntax-min-max (mumamo-chunk-syntax-min-max chunk-at-pos t))
+ (chunk-syntax-min (car chunk-syntax-min-max))
+ (chunk-major (mumamo-chunk-major-mode chunk-at-pos))
+ (syntax-ppss-last (overlay-get chunk-at-pos 'syntax-ppss-last))
+ (syntax-ppss-cache (overlay-get chunk-at-pos 'syntax-ppss-cache))
+ (syntax-ppss-last-min (overlay-get chunk-at-pos 'syntax-ppss-last-min))
+ (syntax-ppss-cache-min (list syntax-ppss-last-min))
+ ;; This must be fetch the same way as in syntax-ppss:
+ (syntax-begin-function (overlay-get chunk-at-pos 'syntax-begin-function))
+ (syntax-ppss-max-span (if chunk-syntax-min
+ (/ (- pos chunk-syntax-min -2) 2)
+ syntax-ppss-max-span))
+ (syntax-ppss-stats (let ((stats (overlay-get chunk-at-pos 'syntax-ppss-stats)))
+ (if stats
+ stats
+ (default-value 'syntax-ppss-stats))))
+ (last-min-pos (or (car syntax-ppss-last-min)
+ 1))
+ )
+ ;; If chunk has moved the cached values are invalid.
+ (unless (= chunk-syntax-min last-min-pos)
+ (setq syntax-ppss-last nil)
+ (setq syntax-ppss-last-min nil)
+ (setq syntax-ppss-cache nil)
+ (setq syntax-ppss-cache-min nil)
+ (setq syntax-ppss-stats (default-value 'syntax-ppss-stats)))
+ (when dump2
+ (msgtrc " get syntax-ppss-last-min=%s len=%s chunk=%s" syntax-ppss-last-min (length syntax-ppss-last-min) chunk-at-pos)
+ (msgtrc " prop syntax-ppss-last-min=%s" (overlay-properties chunk-at-pos))
+ (msgtrc " chunk-major=%s, %s, syntax-min=%s\n last-min=%s" chunk-major major-mode chunk-syntax-min syntax-ppss-last-min))
+ ;;(setq dump2 nil)
+ (when syntax-ppss-last-min
+ (unless (car syntax-ppss-last-min)
+ ;;(msgtrc "fix-me: emacs bug workaround, setting car of syntax-ppss-last-min")
+ ;;(setcar syntax-ppss-last-min (1- chunk-syntax-min))
+ ;;(msgtrc "fix-me: emacs bug workaround, need new syntax-ppss-last-min because car is nil")
+ (setq syntax-ppss-last-min nil)
+ ))
+ (unless syntax-ppss-last-min
+ (setq syntax-ppss-last nil)
+ (save-restriction
+ (widen)
+ (let* ((min-pos chunk-syntax-min)
+ (chunk-sub-major (mumamo-chunk-major-mode chunk-at-pos))
+ (main-major (mumamo-main-major-mode))
+ (is-main-mode-chunk (mumamo-fun-eq chunk-sub-major main-major)))
+ (when dump2 (msgtrc " min-pos=%s, is-main-mode-chunk=%s" min-pos is-main-mode-chunk))
+ ;; Looks like assert can not be used here for some reason???
+ ;;(assert (and min-pos) t)
+ (unless (and min-pos) (error "defadvice syntax-ppss: (and min-pos=%s)" min-pos))
+ (setq syntax-ppss-last-min
+ (cons min-pos ;;(1- min-pos)
+ (if nil ;is-main-mode-chunk
+ ;; Fix-me: previous chunks as a
+ ;; cache? The problem is updating
+ ;; this. Perhaps it is possible to
+ ;; prune how far back to go by
+ ;; going to the first chunk
+ ;; backwards where
+ ;; (pars-partial-sexp min max) is
+ ;; "nil"?
+ (mumamo-with-major-mode-fontification main-major
+ `(parse-partial-sexp 1 ,min-pos nil nil nil nil))
+ (parse-partial-sexp 1 1))))
+ (setq syntax-ppss-cache-min (list syntax-ppss-last-min))
+ (when dump2 (msgtrc " put syntax-ppss-last-min=%s len=%s chunk=%s" syntax-ppss-last-min (length syntax-ppss-last-min) chunk-at-pos))
+ (when dump2 (msgtrc " prop syntax-ppss-last-min=%s" (overlay-properties chunk-at-pos)))
+ (overlay-put chunk-at-pos 'syntax-ppss-last-min syntax-ppss-last-min)
+ (let ((test-syntax-ppss-last-min
+ (overlay-get chunk-at-pos 'syntax-ppss-last-min)))
+ (when dump2 (msgtrc " test syntax-ppss-last-min=%s len=%s" test-syntax-ppss-last-min (length test-syntax-ppss-last-min)))
+ (when dump2 (msgtrc " propt syntax-ppss-last-min=%s" (overlay-properties chunk-at-pos)))
+ ))))
+ (when dump2 (msgtrc " here 0, syntax-ppss-last=%s" syntax-ppss-last))
+ (unless syntax-ppss-last
+ (setq syntax-ppss-last syntax-ppss-last-min)
+ (setq syntax-ppss-cache syntax-ppss-cache-min))
+ ;;(syntax-ppss pos)
+ (when dump2 (msgtrc " at 1, syntax-ppss-last=%s" syntax-ppss-last))
+ (when dump2 (msgtrc " at 1, syntax-ppss-cache=%s" syntax-ppss-cache))
+ (let (ret-val
+ (by-pass-cache t)
+ (dump2 dump2))
+ (if (not by-pass-cache)
+ (progn
+ (when dump2
+ (let ((old-ppss (cdr syntax-ppss-last))
+ (old-pos (car syntax-ppss-last)))
+ ;;(assert (and old-pos pos) t)
+ (unless (and old-pos pos) (error "defadvice syntax-ppss: (and old-pos=%s pos=%s)" old-pos pos))
+ (msgtrc "parse-partial-sexp=>%s" (parse-partial-sexp old-pos pos nil nil old-ppss))))
+ (let (dump2)
+ (setq ret-val ad-do-it)))
+ (let ((old-ppss (cdr syntax-ppss-last))
+ (old-pos (car syntax-ppss-last)))
+ (when dump2
+ (msgtrc "Xparse-partial-sexp %s %s nil nil %s" old-pos pos old-ppss)
+ (let (dump2)
+ (msgtrc "ad-do-it=>%s" ad-do-it)))
+ (save-restriction
+ (widen)
+ ;;(assert (and old-pos pos) t)
+ (unless (and old-pos pos) (error "defadvice syntax-ppss 2 (and old-pos=%s pos=%s)" old-pos pos))
+ (when dump2
+ (msgtrc "parse-partial-sexp %s %s nil nil %s" old-pos pos old-ppss))
+ (setq ret-val (parse-partial-sexp old-pos pos nil nil old-ppss)))))
+ (when dump2 (msgtrc " ==>ret-val=%s" ret-val))
+ ;;(mumamo-backtrace "syntax-ppss")
+ (setq ad-return-value ret-val))
+ (overlay-put chunk-at-pos 'syntax-ppss-last syntax-ppss-last)
+ (overlay-put chunk-at-pos 'syntax-ppss-cache syntax-ppss-cache)
+ (overlay-put chunk-at-pos 'syntax-ppss-stats syntax-ppss-stats)
+ )
+ ad-do-it)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; rng-valid.el support
+
+;; Fix-me: The solution in this defadvice is temporary. The defadvice
+;; for rng-do-some-validation should be fixed instead.
+;; (ad-disable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
+;; (ad-ensable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
+(defadvice rng-mark-error (around
+ mumamo-ad-rng-mark-error
+ activate
+ compile)
+ "Adjust range for error to chunks."
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (let* ((beg (ad-get-arg 1))
+ (end (ad-get-arg 2))
+ (xml-parts nil)
+ (chunk (mumamo-find-chunks beg "rng-mark-error")))
+ (if (not chunk)
+ ad-do-it
+ (when (and (not (overlay-get chunk 'mumamo-region))
+ (mumamo-valid-nxml-chunk chunk))
+ ;; rng-error
+ (let ((part-beg (max (overlay-start chunk)
+ beg))
+ (part-end (min (overlay-end chunk)
+ end)))
+ (when (< part-beg part-end)
+ (ad-set-arg 1 part-beg)
+ (ad-set-arg 2 part-end)
+ ad-do-it)))))))
+
+(defadvice rng-do-some-validation-1 (around
+ mumamo-ad-rng-do-some-validation-1
+ activate
+ compile)
+ "Adjust validation to chunks."
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (let (major-mode-chunk
+ (point-max (1+ (buffer-size))) ;(save-restriction (widen) (point-max)))
+ end-major-mode-chunk
+ (limit (+ rng-validate-up-to-date-end
+ rng-validate-chunk-size))
+ (remove-start rng-validate-up-to-date-end)
+ (next-cache-point (+ (point) rng-state-cache-distance))
+ (continue t)
+ (xmltok-dtd rng-dtd)
+ have-remaining-chars
+ xmltok-type
+ xmltok-start
+ xmltok-name-colon
+ xmltok-name-end
+ xmltok-replacement
+ xmltok-attributes
+ xmltok-namespace-attributes
+ xmltok-dependent-regions
+ xmltok-errors
+ (while-n1 0)
+ (while-n2 0)
+ (old-point -1)
+ )
+ ;;(msgtrc "> > > > > enter rng-do-some-validation-1, continue-p-function=%s" continue-p-function)
+ (setq have-remaining-chars (< (point) point-max))
+ (when (and continue (= (point) 1))
+ (let ((regions (xmltok-forward-prolog)))
+ (rng-clear-overlays 1 (point))
+ (while regions
+ (when (eq (aref (car regions) 0) 'encoding-name)
+ (rng-process-encoding-name (aref (car regions) 1)
+ (aref (car regions) 2)))
+ (setq regions (cdr regions))))
+ (unless (equal rng-dtd xmltok-dtd)
+ (rng-clear-conditional-region))
+ (setq rng-dtd xmltok-dtd))
+ (setq while-n1 0)
+ (while (and (mumamo-while 2000 'while-n1 "continue")
+ (/= old-point (point))
+ continue)
+ (setq old-point (point))
+ ;; If mumamo (or something similar) is used then jump over parts
+ ;; that can not be parsed by nxml-mode.
+ (when (and rng-get-major-mode-chunk-function
+ rng-valid-nxml-major-mode-chunk-function
+ rng-end-major-mode-chunk-function)
+ (let ((here (point))
+ next-non-space-pos)
+ (skip-chars-forward " \t\r\n")
+ (setq next-non-space-pos (point))
+ (goto-char here)
+ (unless (and end-major-mode-chunk
+ ;; Remaining chars in this chunk?
+ (< next-non-space-pos end-major-mode-chunk))
+ (setq end-major-mode-chunk nil)
+ (setq major-mode-chunk (funcall rng-get-major-mode-chunk-function next-non-space-pos "rng-do-some-validation-1 A"))
+ (setq while-n2 0)
+ (while (and (mumamo-while 500 'while-n2 "major-mode-chunk")
+ major-mode-chunk
+ (not (funcall rng-valid-nxml-major-mode-chunk-function major-mode-chunk))
+ (< next-non-space-pos (point-max)))
+ ;;(msgtrc "next-non-space-pos=%s, cb=%s" next-non-space-pos (current-buffer))
+ (let ((end-pos (funcall rng-end-major-mode-chunk-function major-mode-chunk)))
+ ;; fix-me: The problem here is that
+ ;; mumamo-find-chunks can return a 0-length chunk.
+ ;;(goto-char (+ end-pos 0))
+ (goto-char (+ end-pos (if (= end-pos (point)) 1 0)))
+ (setq major-mode-chunk (funcall rng-get-major-mode-chunk-function (point) "rng-do-some-validation-1 B"))
+ ;;(message "---> here 3, point=%s, ep=%s, mm-chunk=%s" (point) end-pos major-mode-chunk)
+ )
+ (setq next-non-space-pos (point))))
+ ;; Stop parsing if we do not have a chunk here yet.
+ ;;(message "major-mode-chunk=%s" major-mode-chunk)
+ ;;(message "rng-valid-nxml-major-mode-chunk-function=%s" rng-valid-nxml-major-mode-chunk-function)
+ (setq continue (and major-mode-chunk
+ (funcall rng-valid-nxml-major-mode-chunk-function major-mode-chunk)))
+ ;;(unless continue (message "continue=nil, no major-mode-chunk"))
+ (when continue
+ ;;(message " continue=t")
+ (setq end-major-mode-chunk (funcall rng-end-major-mode-chunk-function major-mode-chunk)))))
+
+ (when continue
+ ;; Narrow since rng-forward will continue into next chunk
+ ;; even if limit is at chunk end.
+ (if t
+ (progn
+ ;;(message "before rng-forward, point=%s" (point))
+ (setq have-remaining-chars (rng-forward end-major-mode-chunk))
+ ;;(message "after rng-forward, point=%s" (point))
+ )
+ ;; Fix-me: Validation does not work when narrowing because
+ ;; some state variables values seems to be lost. Probably
+ ;; looking at `rng-validate-prepare' will tell what to do.
+ (save-restriction
+ (when (and end-major-mode-chunk
+ (< (point-min) end-major-mode-chunk))
+ (narrow-to-region (point-min) end-major-mode-chunk))
+ (setq have-remaining-chars (rng-forward end-major-mode-chunk)))
+ (unless (> end-major-mode-chunk (point))
+ ;;(setq have-remaining-chars t)
+ (goto-char end-major-mode-chunk))
+ )
+ ;;(message "end-major-mode-chunk=%s, rng-validate-up-to-date-end=%s" end-major-mode-chunk rng-validate-up-to-date-end)
+ (setq have-remaining-chars (< (point) point-max))
+ ;;(unless have-remaining-chars (message "*** here have-remaining-chars=%s, p=%s/%s" have-remaining-chars (point) point-max))
+ (let ((pos (point)))
+ (when end-major-mode-chunk
+ ;; Fix-me: Seems like we need a new initialization (or why
+ ;; do we otherwise hang without this?)
+ (and (> limit end-major-mode-chunk) (setq limit end-major-mode-chunk)))
+ (setq continue
+ (and have-remaining-chars
+ continue
+ (or (< pos limit)
+ (and continue-p-function
+ (funcall continue-p-function)
+ (setq limit (+ limit rng-validate-chunk-size))
+ t))))
+ ;;(unless continue (message "continue=nil, why?: %s<%s, %s" pos limit (when continue-p-function (funcall continue-p-function))))
+ (cond ((and rng-conditional-up-to-date-start
+ ;; > because we are getting the state from (1- pos)
+ (> pos rng-conditional-up-to-date-start)
+ (< pos rng-conditional-up-to-date-end)
+ (rng-state-matches-current (get-text-property (1- pos)
+ 'rng-state)))
+ (when (< remove-start (1- pos))
+ (rng-clear-cached-state remove-start (1- pos)))
+ ;; sync up with cached validation state
+ (setq continue nil)
+ ;; do this before settting rng-validate-up-to-date-end
+ ;; in case we get a quit
+ (rng-mark-xmltok-errors)
+ (rng-mark-xmltok-dependent-regions)
+ (setq rng-validate-up-to-date-end
+ (marker-position rng-conditional-up-to-date-end))
+ (rng-clear-conditional-region)
+ (setq have-remaining-chars
+ (< rng-validate-up-to-date-end point-max))
+ ;;(unless have-remaining-chars (message "have-remaining-chars=%s rng-validate-up-to-date-end=%s, point-max=%s" have-remaining-chars rng-validate-up-to-date-end point-max))
+ )
+ ((or (>= pos next-cache-point)
+ (not continue))
+ (setq next-cache-point (+ pos rng-state-cache-distance))
+ (rng-clear-cached-state remove-start pos)
+ (when have-remaining-chars
+ ;;(message "rng-cach-state (1- %s)" pos)
+ (rng-cache-state (1- pos)))
+ (setq remove-start pos)
+ (unless continue
+ ;; if we have just blank chars skip to the end
+ (when have-remaining-chars
+ (skip-chars-forward " \t\r\n")
+ (when (= (point) point-max)
+ (rng-clear-overlays pos (point))
+ (rng-clear-cached-state pos (point))
+ (setq have-remaining-chars nil)
+ ;;(message "have-remaining-chars => nil, cause (point) = point-max")
+ (setq pos (point))))
+ (when (not have-remaining-chars)
+ (rng-process-end-document))
+ (rng-mark-xmltok-errors)
+ (rng-mark-xmltok-dependent-regions)
+ (setq rng-validate-up-to-date-end pos)
+ (when rng-conditional-up-to-date-end
+ (cond ((<= rng-conditional-up-to-date-end pos)
+ (rng-clear-conditional-region))
+ ((< rng-conditional-up-to-date-start pos)
+ (set-marker rng-conditional-up-to-date-start
+ pos))))))))))
+ ;;(message "--- exit rng-do-some-validation-1, have-remaining-chars=%s" have-remaining-chars)
+ (setq have-remaining-chars (< (point) point-max))
+ (setq ad-return-value have-remaining-chars))))
+
+(defadvice rng-after-change-function (around
+ mumamo-ad-rng-after-change-function
+ activate
+ compile)
+ (when rng-validate-up-to-date-end
+ ad-do-it))
+
+(defadvice rng-validate-while-idle (around
+ mumamo-ad-rng-validate-while-idle
+ activate
+ compile)
+ (if (not (buffer-live-p buffer))
+ (rng-kill-timers)
+ ad-do-it))
+
+(defadvice rng-validate-quick-while-idle (around
+ mumamo-ad-rng-validate-quick-while-idle
+ activate
+ compile)
+ (if (not (buffer-live-p buffer))
+ (rng-kill-timers)
+ ad-do-it))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; xmltok.el
+
+;; (ad-disable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
+;; (ad-ensable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
+(defadvice xmltok-add-error (around
+ mumamo-ad-xmltok-add-error
+ activate
+ compile
+ )
+ "Prevent rng validation errors in non-xml chunks.
+This advice only prevents adding nxml/rng-valid errors in non-xml
+chunks. Doing more seems like a very big job - unless Emacs gets
+a narrow-to-multiple-regions function!"
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ ;;(error "xmltok-add-error: %S" (with-output-to-string (backtrace)))
+ (when (let* ((start (or start xmltok-start))
+ (end (or end (point)))
+ (chunk (mumamo-find-chunks (if start start end) "xmltok-add-error"))
+ )
+ (or (not chunk)
+ (and (not (overlay-get chunk 'mumamo-region))
+ (mumamo-valid-nxml-chunk chunk))))
+ (setq xmltok-errors
+ (cons (xmltok-make-error message
+ (or start xmltok-start)
+ (or end (point)))
+ xmltok-errors)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Maybe activate advices
+
+;; Fix-me: This assumes there are no other advices on these functions.
+(if t
+ (progn
+ ;; (ad-activate 'syntax-ppss)
+ ;; (ad-activate 'syntax-ppss-flush-cache)
+ ;; (ad-activate 'syntax-ppss-stats)
+ ;; (ad-activate 'rng-do-some-validation-1)
+ ;; (ad-activate 'rng-mark-error)
+ ;; (ad-activate 'xmltok-add-error)
+ (ad-enable-advice 'syntax-ppss 'around 'mumamo-ad-syntax-ppss)
+ (ad-enable-advice 'syntax-ppss-flush-cache 'around 'mumamo-ad-syntax-ppss-flush-cache)
+ (ad-enable-advice 'syntax-ppss-stats 'around 'mumamo-ad-syntax-ppss-stats)
+ (ad-enable-advice 'rng-do-some-validation-1 'around 'mumamo-ad-rng-do-some-validation-1)
+ (ad-enable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
+ (ad-enable-advice 'rng-after-change-function 'around 'mumamo-ad-rng-after-change-function)
+ (ad-enable-advice 'rng-validate-while-idle 'around 'mumamo-ad-rng-validate-while-idle)
+ (ad-enable-advice 'rng-validate-quick-while-idle 'around 'mumamo-ad-rng-validate-quick-while-idle)
+ (ad-enable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
+ )
+ ;; (ad-deactivate 'syntax-ppss)
+ ;; (ad-deactivate 'syntax-ppss-flush-cache)
+ ;; (ad-deactivate 'syntax-ppss-stats)
+ ;; (ad-deactivate 'rng-do-some-validation-1)
+ ;; (ad-deactivate 'rng-mark-error)
+ ;; (ad-deactivate 'xmltok-add-error)
+ (ad-disable-advice 'syntax-ppss 'around 'mumamo-ad-syntax-ppss)
+ (ad-disable-advice 'syntax-ppss-flush-cache 'around 'mumamo-ad-syntax-ppss-flush-cache)
+ (ad-disable-advice 'syntax-ppss-stats 'around 'mumamo-ad-syntax-ppss-stats)
+ (ad-disable-advice 'rng-do-some-validation-1 'around 'mumamo-ad-rng-do-some-validation-1)
+ (ad-disable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
+ (ad-disable-advice 'rng-after-change-function 'around 'mumamo-ad-rng-after-change-function)
+ (ad-disable-advice 'rng-validate-while-idle 'around 'mumamo-ad-rng-validate-while-idle)
+ (ad-disable-advice 'rng-validate-quick-while-idle 'around 'mumamo-ad-rng-validate-quick-while-idle)
+ (ad-disable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
+ )
+
+(font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("\\<define-mumamo-multi-major-mode\\>" . font-lock-keyword-face)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Simple defadvice to move into Emacs later
+
+(defun mumamo-ad-desktop-buffer-info (buffer)
+ (set-buffer buffer)
+ (list
+ ;; base name of the buffer; replaces the buffer name if managed by uniquify
+ (and (fboundp 'uniquify-buffer-base-name) (uniquify-buffer-base-name))
+ ;; basic information
+ (desktop-file-name (buffer-file-name) desktop-dirname)
+ (buffer-name)
+ (if mumamo-multi-major-mode mumamo-multi-major-mode major-mode)
+ ;; minor modes
+ (let (ret)
+ (mapc
+ #'(lambda (minor-mode)
+ (and (boundp minor-mode)
+ (symbol-value minor-mode)
+ (let* ((special (assq minor-mode desktop-minor-mode-table))
+ (value (cond (special (cadr special))
+ ((functionp minor-mode) minor-mode))))
+ (when value (add-to-list 'ret value)))))
+ (mapcar #'car minor-mode-alist))
+ ret)
+ ;; point and mark, and read-only status
+ (point)
+ (list (mark t) mark-active)
+ buffer-read-only
+ ;; auxiliary information
+ (when (functionp desktop-save-buffer)
+ (funcall desktop-save-buffer desktop-dirname))
+ ;; local variables
+ (let ((locals desktop-locals-to-save)
+ (loclist (buffer-local-variables))
+ (ll))
+ (while locals
+ (let ((here (assq (car locals) loclist)))
+ (if here
+ (setq ll (cons here ll))
+ (when (member (car locals) loclist)
+ (setq ll (cons (car locals) ll)))))
+ (setq locals (cdr locals)))
+ ll)))
+
+(defadvice desktop-buffer-info (around
+ mumamo-ad-desktop-buffer-info
+ activate
+ compile)
+ (setq ad-return-value (mumamo-ad-desktop-buffer-info (ad-get-arg 0))))
+
+(defun mumamo-ad-set-auto-mode-0 (mode &optional keep-mode-if-same)
+ "Apply MODE and return it.
+If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
+any aliases and compared to current major mode. If they are the
+same, do nothing and return nil."
+ (unless (and keep-mode-if-same
+ (eq (indirect-function mode)
+ (if mumamo-multi-major-mode
+ (indirect-function mumamo-multi-major-mode)
+ (indirect-function major-mode))))
+ (when mode
+ (funcall mode)
+ mode)))
+
+(defadvice set-auto-mode-0 (around
+ mumamo-ad-set-auto-mode-0
+ activate
+ compile)
+ (setq ad-return-value (mumamo-ad-set-auto-mode-0 (ad-get-arg 0)
+ (ad-get-arg 1)
+ )))
+
+
+
+(defvar mumamo-sgml-get-context-last-close nil
+ "Last close tag start.
+Only used for outermost level.")
+
+(defun mumamo-sgml-get-context (&optional until)
+ "Determine the context of the current position.
+By default, parse until we find a start-tag as the first thing on a line.
+If UNTIL is `empty', return even if the context is empty (i.e.
+we just skipped over some element and got to a beginning of line).
+
+The context is a list of tag-info structures. The last one is the tag
+immediately enclosing the current position.
+
+Point is assumed to be outside of any tag. If we discover that it's
+not the case, the first tag returned is the one inside which we are."
+ (let ((here (point))
+ (stack nil)
+ (ignore nil)
+ (context nil)
+ tag-info
+ last-close)
+ ;; CONTEXT keeps track of the tag-stack
+ ;; STACK keeps track of the end tags we've seen (and thus the start-tags
+ ;; we'll have to ignore) when skipping over matching open..close pairs.
+ ;; IGNORE is a list of tags that can be ignored because they have been
+ ;; closed implicitly.
+ ;; LAST-CLOSE is last close tag that can be useful for indentation
+ ;; when on outermost level.
+ (skip-chars-backward " \t\n") ; Make sure we're not at indentation.
+ (while
+ (and (not (eq until 'now))
+ (or stack
+ (not (if until (eq until 'empty) context))
+ (not (sgml-at-indentation-p))
+ (and context
+ (/= (point) (sgml-tag-start (car context)))
+ (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
+ (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
+
+ ;; This tag may enclose things we thought were tags. If so,
+ ;; discard them.
+ (while (and context
+ (> (sgml-tag-end tag-info)
+ (sgml-tag-end (car context))))
+ (setq context (cdr context)))
+
+ (cond
+ ((> (sgml-tag-end tag-info) here)
+ ;; Oops!! Looks like we were not outside of any tag, after all.
+ (push tag-info context)
+ (setq until 'now))
+
+ ;; start-tag
+ ((eq (sgml-tag-type tag-info) 'open)
+ (when (and (null stack)
+ last-close)
+ (setq last-close 'no-use))
+ (cond
+ ((null stack)
+ (if (assoc-string (sgml-tag-name tag-info) ignore t)
+ ;; There was an implicit end-tag.
+ nil
+ (push tag-info context)
+ ;; We're changing context so the tags implicitly closed inside
+ ;; the previous context aren't implicitly closed here any more.
+ ;; [ Well, actually it depends, but we don't have the info about
+ ;; when it doesn't and when it does. --Stef ]
+ (setq ignore nil)))
+ ((eq t (compare-strings (sgml-tag-name tag-info) nil nil
+ (car stack) nil nil t))
+ (setq stack (cdr stack)))
+ (t
+ ;; The open and close tags don't match.
+ (if (not sgml-xml-mode)
+ (unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
+ (message "Unclosed tag <%s>" (sgml-tag-name tag-info))
+ (let ((tmp stack))
+ ;; We could just assume that the tag is simply not closed
+ ;; but it's a bad assumption when tags *are* closed but
+ ;; not properly nested.
+ (while (and (cdr tmp)
+ (not (eq t (compare-strings
+ (sgml-tag-name tag-info) nil nil
+ (cadr tmp) nil nil t))))
+ (setq tmp (cdr tmp)))
+ (if (cdr tmp) (setcdr tmp (cddr tmp)))))
+ (message "Unmatched tags <%s> and </%s>"
+ (sgml-tag-name tag-info) (pop stack)))))
+
+ (if (and (null stack) (sgml-unclosed-tag-p (sgml-tag-name tag-info)))
+ ;; This is a top-level open of an implicitly closed tag, so any
+ ;; occurrence of such an open tag at the same level can be ignored
+ ;; because it's been implicitly closed.
+ (push (sgml-tag-name tag-info) ignore)))
+
+ ;; end-tag
+ ((eq (sgml-tag-type tag-info) 'close)
+ (if (sgml-empty-tag-p (sgml-tag-name tag-info))
+ (message "Spurious </%s>: empty tag" (sgml-tag-name tag-info))
+ ;; Keep track of last close if context will return nil
+ (when (and (not last-close)
+ (null stack)
+ (> here (point-at-eol))
+ (let ((here (point)))
+ (goto-char (sgml-tag-start tag-info))
+ (skip-chars-backward " \t")
+ (prog1
+ (bolp)
+ (goto-char here))))
+ (setq last-close tag-info))
+
+ (push (sgml-tag-name tag-info) stack)))
+ ))
+
+ ;; return context
+ (setq mumamo-sgml-get-context-last-close
+ (when (and last-close
+ (not (eq last-close 'no-use)))
+ (sgml-tag-start last-close)))
+ context))
+
+(defadvice sgml-get-context (around
+ mumamo-ad-sgml-get-context
+ activate
+ compile)
+ (setq ad-return-value (mumamo-sgml-get-context (ad-get-arg 0))))
+
+(defun mumamo-sgml-calculate-indent (&optional lcon)
+ "Calculate the column to which this line should be indented.
+LCON is the lexical context, if any."
+ (unless lcon (setq lcon (sgml-lexical-context)))
+
+ ;; Indent comment-start markers inside <!-- just like comment-end markers.
+ (if (and (eq (car lcon) 'tag)
+ (looking-at "--")
+ (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
+ (setq lcon (cons 'comment (+ (cdr lcon) 2))))
+
+ (case (car lcon)
+
+ (string
+ ;; Go back to previous non-empty line.
+ (while (and (> (point) (cdr lcon))
+ (zerop (forward-line -1))
+ (looking-at "[ \t]*$")))
+ (if (> (point) (cdr lcon))
+ ;; Previous line is inside the string.
+ (current-indentation)
+ (goto-char (cdr lcon))
+ (1+ (current-column))))
+
+ (comment
+ (let ((mark (looking-at "--")))
+ ;; Go back to previous non-empty line.
+ (while (and (> (point) (cdr lcon))
+ (zerop (forward-line -1))
+ (or (looking-at "[ \t]*$")
+ (if mark (not (looking-at "[ \t]*--"))))))
+ (if (> (point) (cdr lcon))
+ ;; Previous line is inside the comment.
+ (skip-chars-forward " \t")
+ (goto-char (cdr lcon))
+ ;; Skip `<!' to get to the `--' with which we want to align.
+ (search-forward "--")
+ (goto-char (match-beginning 0)))
+ (when (and (not mark) (looking-at "--"))
+ (forward-char 2) (skip-chars-forward " \t"))
+ (current-column)))
+
+ ;; We don't know how to indent it. Let's be honest about it.
+ (cdata nil)
+ ;; We don't know how to indent it. Let's be honest about it.
+ (pi nil)
+
+ (tag
+ (goto-char (1+ (cdr lcon)))
+ (skip-chars-forward "^ \t\n") ;Skip tag name.
+ (skip-chars-forward " \t")
+ (if (not (eolp))
+ (current-column)
+ ;; This is the first attribute: indent.
+ (goto-char (1+ (cdr lcon)))
+ (+ (current-column) sgml-basic-offset)))
+
+ (text
+ (while (looking-at "</")
+ (forward-sexp 1)
+ (skip-chars-forward " \t"))
+ (let* ((here (point))
+ (unclosed (and ;; (not sgml-xml-mode)
+ (looking-at sgml-tag-name-re)
+ (assoc-string (match-string 1)
+ sgml-unclosed-tags 'ignore-case)
+ (match-string 1)))
+ (context
+ ;; If possible, align on the previous non-empty text line.
+ ;; Otherwise, do a more serious parsing to find the
+ ;; tag(s) relative to which we should be indenting.
+ (if (and (not unclosed) (skip-chars-backward " \t")
+ (< (skip-chars-backward " \t\n") 0)
+ (back-to-indentation)
+ (> (point) (cdr lcon)))
+ nil
+ (goto-char here)
+ (nreverse (sgml-get-context (if unclosed nil 'empty)))))
+ (there (point)))
+ ;; Ignore previous unclosed start-tag in context.
+ (while (and context unclosed
+ (eq t (compare-strings
+ (sgml-tag-name (car context)) nil nil
+ unclosed nil nil t)))
+ (setq context (cdr context)))
+ ;; Indent to reflect nesting.
+ (cond
+ ;; If we were not in a text context after all, let's try again.
+ ((and context (> (sgml-tag-end (car context)) here))
+ (goto-char here)
+ (sgml-calculate-indent
+ (cons (if (memq (sgml-tag-type (car context)) '(comment cdata))
+ (sgml-tag-type (car context)) 'tag)
+ (sgml-tag-start (car context)))))
+ ;; Align on the first element after the nearest open-tag, if any.
+ ((and context
+ (goto-char (sgml-tag-end (car context)))
+ (skip-chars-forward " \t\n")
+ (< (point) here) (sgml-at-indentation-p))
+ (current-column))
+ (t
+ (goto-char (or (and (null context)
+ mumamo-sgml-get-context-last-close)
+ there))
+ (+ (current-column)
+ (* sgml-basic-offset (length context)))))))
+
+ (otherwise
+ (error "Unrecognized context %s" (car lcon)))
+
+ ))
+
+(defadvice sgml-calculate-indent (around
+ mumamo-ad-sgml-calculate-indent
+ activate
+ compile)
+ (setq ad-return-value (mumamo-sgml-calculate-indent (ad-get-arg 0))))
+
+(defadvice python-eldoc-function (around
+ mumamo-ad-python-eldoc-function
+ activate
+ compile)
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (let ((here (point)))
+ (unwind-protect
+ (save-restriction
+ (mumamo-narrow-to-chunk-inner)
+ ad-do-it)
+ (goto-char here)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; The END
+;;(when buffer-file-name (message "Finished evaluating %s" buffer-file-name))
+;;(when load-file-name (message "Finished loading %s" load-file-name))
+
+(provide 'mumamo)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; mumamo.el ends bere
--- /dev/null
+;;; n-back.el --- n-back game
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-05-23 Sat
+(defconst n-back:version "0.5");; Version:
+;; Last-Updated: 2009-08-04 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `winsize'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; n-back game for brain training. See `n-back-game' for more
+;; information.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;(eval-when-compile (require 'viper))
+
+;; (setq n-back-trials 2)
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'nxhtml-base nil t))
+(eval-when-compile (require 'nxhtml-web-vcs nil t))
+(require 'winsize nil t) ;; Ehum...
+
+(defvar n-back-game-window nil)
+(defvar n-back-game-buffer nil)
+
+(defvar n-back-ctrl-window nil)
+(defvar n-back-ctrl-buffer nil)
+
+(defvar n-back-info-window nil)
+(defvar n-back-info-buffer nil)
+
+(defvar n-back-trials-left nil)
+(defvar n-back-timer nil)
+(defvar n-back-clear-timer nil)
+
+(defvar n-back-result nil)
+(defvar n-back-this-result nil)
+
+(defvar n-back-ring nil)
+
+(defvar n-back-num-active nil)
+
+
+;;;###autoload
+(defgroup n-back nil
+ "Customizations for `n-back-game' game."
+ :group 'games)
+
+(defgroup n-back-feel nil
+ "Customizations for `n-back-game' game keys, faces etc."
+ :group 'n-back)
+
+(defface n-back-ok
+ '((t (:foreground "black" :background "green")))
+ "Face for OK answer."
+ :group 'n-back-feel)
+
+(defface n-back-bad
+ '((t (:foreground "black" :background "OrangeRed1")))
+ "Face for bad answer."
+ :group 'n-back-feel)
+
+(defface n-back-hint
+ '((t (:foreground "black" :background "gold")))
+ "Face for bad answer."
+ :group 'n-back-feel)
+
+(defface n-back-do-now
+ '((((background dark)) (:foreground "yellow"))
+ (t (:foreground "blue")))
+ "Face for start and stop hints."
+ :group 'n-back-feel)
+
+(defface n-back-game-word
+ '((t (:foreground "black")))
+ "Face for word displayed in game."
+ :group 'n-back-feel)
+
+(defface n-back-header
+ '((((background dark)) (:background "OrangeRed4"))
+ (t (:background "gold")))
+ "Face for headers."
+ :group 'n-back-feel)
+
+(defface n-back-keybinding
+ '((((background dark)) (:background "purple4"))
+ (t (:background "OliveDrab1")))
+ "Face for key bindings."
+ :group 'n-back-feel)
+
+(defface n-back-last-result
+ '((((background dark)) (:background "OliveDrab4"))
+ (t (:background "yellow")))
+ "Face for last game result header."
+ :group 'n-back-feel)
+
+(defface n-back-welcome
+ '((((background dark)) (:foreground "OliveDrab3"))
+ (t (:foreground "OliveDrab4")))
+ "Face for welcome string"
+ :group 'n-back-feel)
+
+(defface n-back-welcome-header
+ '((t (:height 2.0)))
+ "Face for welcome header."
+ :group 'n-back-feel)
+
+(defcustom n-back-level 1
+ "The n-Back level."
+ :type '(radio (const 1)
+ (const 2)
+ (const 3)
+ (const 4))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (featurep 'n-back)
+ (n-back-update-control-buffer)
+ (n-back-update-info)))
+ :group 'n-back)
+
+(defcustom n-back-active-match-types '(position color sound)
+ "Active match types."
+ :type '(set (const position)
+ (const color)
+ (const sound)
+ (const word))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (setq n-back-num-active (length val))
+ (when (featurep 'n-back)
+ (n-back-init-control-status)
+ (n-back-update-control-buffer)
+ (n-back-update-info)))
+ :group 'n-back)
+
+(defcustom n-back-allowed-match-types '(position color sound word)
+ "Match types allowed in auto challenging."
+ :type '(set (const position)
+ (const color)
+ (const sound)
+ (const word))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (featurep 'n-back)
+ (n-back-set-random-match-types (length n-back-active-match-types) nil)
+ (n-back-init-control-status)
+ (n-back-update-control-buffer)
+ (n-back-update-info)))
+ :group 'n-back)
+
+(defcustom n-back-auto-challenge t
+ "Automatic challenge decrease/increase."
+ :type 'boolean
+ :group 'n-back)
+
+(defun n-back-toggle-auto-challenge ()
+ "Toggle `n-back-auto-challenge'."
+ (interactive)
+ (let ((val (not n-back-auto-challenge)))
+ (customize-set-variable 'n-back-auto-challenge val)
+ (customize-set-value 'n-back-auto-challenge val)))
+
+(defcustom n-back-colors
+ '("gold" "orange red" "lawn green" "peru" "pink" "gray" "light blue")
+ "Random colors to display."
+ :type '(repeat color)
+ :group 'n-back)
+
+(defcustom n-back-words "you cat going me forest crying brown"
+ "Random words to display."
+ :type 'string
+ :group 'n-back)
+
+(defcustom n-back-sound-volume 0.2
+ "Sound volume 0-1."
+ :type 'float
+ :group 'n-back-feel)
+
+(defcustom n-back-sounds '("c:/program files/brain workshop/res" "piano-")
+ "Random sounds location."
+ :type '(list (directory :tag "Directory")
+ (regexp :tag "File name regexp"))
+ :group 'n-back)
+
+(defcustom n-back-keys
+ '(
+ [?p]
+ [?c]
+ [?s]
+ [?w]
+ )
+ "Key bindings for answering."
+ :type '(list
+ (key-sequence :tag "position key")
+ (key-sequence :tag "color key")
+ (key-sequence :tag "sound key")
+ (key-sequence :tag "word key")
+ )
+ ;; :set (lambda (sym val)
+ ;; (set-default sym val)
+ ;; (n-back-make-keymap))
+ :group 'n-back-feel)
+
+(defvar n-back-control-mode-map nil)
+
+(defun n-back-key-binding (what)
+ "Return key binding used for WHAT match answers."
+ (nth
+ (case what
+ (position 0)
+ (color 1)
+ (sound 2)
+ (word 3))
+ n-back-keys))
+
+(defun n-back-make-keymap ()
+ "Make keymap for the game."
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?1] 'n-back-change-level)
+ (define-key map [?2] 'n-back-change-level)
+ (define-key map [?3] 'n-back-change-level)
+ (define-key map [?4] 'n-back-change-level)
+ (define-key map [?5] 'n-back-change-level)
+ (define-key map [?6] 'n-back-change-level)
+ (define-key map [??] 'n-back-help)
+ (define-key map [?\ ] 'n-back-play)
+ (define-key map [(control ?g)] 'n-back-stop)
+ (define-key map [?-] 'n-back-decrease-speed)
+ (define-key map [?+] 'n-back-increase-speed)
+
+ (define-key map [(control ?r)] 'n-back-reset-game-to-saved)
+ (define-key map [(control ?s)] 'n-back-save-game-settings)
+
+ (define-key map [?t ?p] 'n-back-toggle-position)
+ (define-key map [?t ?c] 'n-back-toggle-color)
+ (define-key map [?t ?s] 'n-back-toggle-sound)
+ (define-key map [?t ?w] 'n-back-toggle-word)
+
+ (define-key map [?T ?a] 'n-back-toggle-auto-challenge)
+ (define-key map [up] 'n-back-challenge-up)
+ (define-key map [down] 'n-back-challenge-down)
+
+ (define-key map [?T ?p] 'n-back-toggle-allowed-position)
+ (define-key map [?T ?c] 'n-back-toggle-allowed-color)
+ (define-key map [?T ?s] 'n-back-toggle-allowed-sound)
+ (define-key map [?T ?w] 'n-back-toggle-allowed-word)
+
+ (define-key map (n-back-key-binding 'position) 'n-back-position-answer)
+ (define-key map (n-back-key-binding 'color) 'n-back-color-answer)
+ (define-key map (n-back-key-binding 'sound) 'n-back-sound-answer)
+ (define-key map (n-back-key-binding 'word) 'n-back-word-answer)
+ ;;(define-key map [t] 'ignore)
+ (setq n-back-control-mode-map map)))
+
+(defvar n-back-display-hint nil)
+(defcustom n-back-hint t
+ "Display hints - learning mode."
+ :type 'boolean
+ :group 'n-back)
+
+
+
+(defvar n-back-sound-files nil)
+;;(n-back-get-sound-files)
+(defun n-back-get-sound-files ()
+ "Get sound file names."
+ (let ((dir (nth 0 n-back-sounds))
+ (regexp (nth 1 n-back-sounds)))
+ (when (file-directory-p dir)
+ (setq n-back-sound-files (directory-files dir nil regexp)))))
+
+(defun n-back-toggle-position ()
+ "Toggle use of position in `n-back-active-match-types'."
+ (interactive)
+ (n-back-toggle 'position))
+
+(defun n-back-toggle-color ()
+ "Toggle use of color in `n-back-active-match-types'."
+ (interactive)
+ (n-back-toggle 'color))
+
+(defun n-back-toggle-sound ()
+ "Toggle use of sound in `n-back-active-match-types'."
+ (interactive)
+ (n-back-toggle 'sound))
+
+(defun n-back-toggle-word ()
+ "Toggle use of word in `n-back-active-match-types'."
+ (interactive)
+ (n-back-toggle 'word))
+
+(defun n-back-toggle (match-type)
+ "Toggle use of MATCH-TYPE in `n-back-active-match-types'."
+ (n-back-toggle-1 match-type 'n-back-active-match-types))
+
+(defun n-back-toggle-allowed-position ()
+ "Toggle use of position in `n-back-allowed-match-types'."
+ (interactive)
+ (n-back-toggle-allowed 'position))
+
+(defun n-back-toggle-allowed-color ()
+ "Toggle use of color in `n-back-allowed-match-types'."
+ (interactive)
+ (n-back-toggle-allowed 'color))
+
+(defun n-back-toggle-allowed-sound ()
+ "Toggle use of sound in `n-back-allowed-match-types'."
+ (interactive)
+ (n-back-toggle-allowed 'sound))
+
+(defun n-back-toggle-allowed-word ()
+ "Toggle use of word in `n-back-allowed-match-types'."
+ (interactive)
+ (n-back-toggle-allowed 'word))
+
+(defun n-back-toggle-allowed (match-type)
+ "Toggle use of MATCH-TYPE in `n-back-allowed-match-types'."
+ (n-back-toggle-1 match-type 'n-back-allowed-match-types))
+
+(defun n-back-sort-types (types)
+ "Sort TYPES to order used in defcustoms here."
+ (sort types
+ (lambda (a b)
+ (let ((all '(position color sound word)))
+ (< (length (memq a all))
+ (length (memq b all)))))))
+
+(defun n-back-toggle-1 (match-type active-list-sym)
+ "Toggle use of MATCH-TYPE in list ACTIVE-LIST-SYM."
+ (let (active-types)
+ (if (memq match-type (symbol-value active-list-sym))
+ (setq active-types (delq match-type (symbol-value active-list-sym)))
+ (setq active-types (cons match-type (symbol-value active-list-sym))))
+ (setq active-types (n-back-sort-types active-types))
+ (customize-set-variable active-list-sym active-types)
+ (customize-set-value active-list-sym active-types)))
+
+(defcustom n-back-sec-per-trial 3.0
+ "Seconds per trial."
+ :type 'float
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (featurep 'n-back)
+ (n-back-update-info)))
+ :group 'n-back)
+
+(defun n-back-decrease-speed ()
+ "Decrease speed of trials."
+ (interactive)
+ (setq n-back-sec-per-trial (+ n-back-sec-per-trial 0.25))
+ (when (> n-back-sec-per-trial 5.0)
+ (setq n-back-sec-per-trial 5.0))
+ (n-back-update-info))
+
+(defun n-back-increase-speed ()
+ "Increase speed of trials."
+ (interactive)
+ (let ((sec (- n-back-sec-per-trial 0.25)))
+ (when (< sec 1.0)
+ (setq sec 1.0))
+ (customize-set-variable 'n-back-sec-per-trial sec)
+ (customize-set-value 'n-back-sec-per-trial sec)))
+
+(defun n-back-help ()
+ "Show help for `n-back-game' game."
+ (interactive)
+ (save-selected-window
+ (describe-function 'n-back-game)))
+
+(defun n-back-change-level (level)
+ "Change n-Back level to LEVEL."
+ (interactive (progn
+ (if (and (numberp last-input-event)
+ (>= last-input-event ?1)
+ (<= last-input-event ?9))
+ (list (- last-input-event ?0))
+ (list (string-to-number (read-string "n Back: "))))))
+ (customize-set-variable 'n-back-level level)
+ (customize-set-value 'n-back-level level))
+
+(defvar n-back-frame nil)
+
+;;;###autoload
+(defun n-back-game ()
+ "Emacs n-Back game.
+This game is supposed to increase your working memory and fluid
+intelligence.
+
+In this game something is shown for half a second on the screen
+and maybe a sound is played. You should then answer if parts of
+it is the same as you have seen or heard before. This is
+repeated for about 20 trials.
+
+You answer with the keys shown in the bottom window.
+
+In the easiest version of the game you should answer if you have
+just seen or heard what is shown now. By default the game gets
+harder as you play it with success. Then first the number of
+items presented in a trial grows. After that it gets harder by
+that you have to somehow remember not the last item, but the item
+before that \(or even earlier). That is what \"n-Back\" stands
+for.
+
+Note that remember does not really mean remember clearly. The
+game is for training your brain getting used to keep those things
+in the working memory, maybe as a cross-modal unit. You are
+supposed to just nearly be able to do what you do in the game.
+And you are supposed to have fun, that is what your brain like.
+
+You should probably not overdue this. Half an hour a day playing
+might be an optimal time according to some people.
+
+The game is shamelessly modeled after Brain Workshop, see URL
+`http://brainworkshop.sourceforge.net/' just for the fun of
+getting it into Emacs. The game resembles but it not the same as
+that used in the report by Jaeggi mentioned at the above URL.
+
+Not all features in Brain Workshop are implemented here, but some
+new are maybe ... - and you have it available here in Emacs."
+ ;; -----
+ ;; Below is a short excerpt from the report by Jaeggi et al which
+ ;; gave the idea to the game:
+
+ ;; Training task. For the training task, we used the same material
+ ;; as described by Jaeggi et al. (33), which was a dual n-Back task
+ ;; where squares at eight different locations were presented
+ ;; sequentially on a computer screen at a rate of 3 s (stimulus
+ ;; length, 500 ms; interstimulus interval, 2,500 ms).
+ ;; Simultaneously with the presentation of the squares, one of eight
+ ;; consonants was presented sequentially through headphones. A
+ ;; response was required whenever one of the presented stimuli
+ ;; matched the one presented n positions back in the sequence. The
+ ;; value of n was the same for both streams of stimuli. There were
+ ;; six auditory and six visual targets per block (four appearing in
+ ;; only one modality, and two appearing in both modalities
+ ;; simultaneously), and their positions were determined randomly.
+ ;; Participants made responses manually by pressing on the letter
+ ;; ‘‘A’’ of a standard keyboard with their left index finger for
+ ;; visual targets, and on the letter ‘‘L’’ with their right index
+ ;; finger for auditory targets. No responses were required for
+ ;; non-targets.
+ (interactive)
+ (n-back-make-keymap)
+ (when window-system
+ (unless (frame-live-p n-back-frame)
+ (setq n-back-frame (make-frame
+ (list '(name . "n-back game")
+ '(tool-bar-lines . 0)
+ '(menu-bar-lines . 0)
+ (case (frame-parameter nil 'background-mode)
+ (light '(background-color . "cornsilk"))
+ (dark '(background-color . "MidnightBlue"))
+ (otherwise nil))
+ '(height . 45)
+ '(width . 150)))))
+ (select-frame n-back-frame)
+ (raise-frame n-back-frame))
+ (n-back-cancel-timers)
+ (n-back-get-sound-files)
+ (unless n-back-sound-files
+ (when (memq 'sound n-back-allowed-match-types)
+ (n-back-toggle-allowed-sound))
+ (when (memq 'sound n-back-active-match-types)
+ (n-back-toggle-sound)))
+ (n-back-init-control-status)
+ (n-back-setup-windows)
+ )
+
+(defconst n-back-match-types
+ '((position ": position match" nil)
+ (color ": color match" nil)
+ (sound ": sound match" nil)
+ (word ": word match" nil)
+ ))
+
+(defvar n-back-control-status nil
+ "For showing status in control window.")
+(setq n-back-control-status nil)
+
+;;(n-back-set-match-status 'position 'bad)
+(defun n-back-set-match-status (match-type status)
+ "Set MATCH-TYPE status to STATUS for control window."
+ (unless (memq status '(ok bad miss nil)) (error "n-back: Bad status=%s" status))
+ (let ((entry (assoc match-type n-back-control-status)))
+ (setcar (cddr entry) status)
+ ))
+
+;;(n-back-clear-match-status)
+(defun n-back-clear-match-status ()
+ "Clear match status for control window."
+ ;;(dolist (entry n-back-control-status)
+ (dolist (entry n-back-match-types)
+ (setcar (cddr entry) nil)
+ ))
+
+;; (n-back-init-control-status)
+(defun n-back-init-control-status ()
+ "Init match status for control window."
+ (setq n-back-control-status nil)
+ (dolist (what n-back-active-match-types)
+ (setq n-back-control-status
+ (cons (assoc what n-back-match-types)
+ n-back-control-status))))
+
+(defsubst n-back-is-playing ()
+ "Return non-nil when game is active."
+ (timerp n-back-timer))
+
+;;(n-back-update-control-buffer)
+(defun n-back-update-control-buffer ()
+ "Update content of control buffer."
+ (save-match-data ;; runs in timer
+ (when (buffer-live-p n-back-ctrl-buffer)
+ (with-current-buffer n-back-ctrl-buffer
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (insert (propertize (format "%s %s-back"
+ (let ((n (length n-back-active-match-types)))
+ (cond
+ ((= 1 n) "Single")
+ ((= 2 n) "Dual")
+ ((= 3 n) "Triple")
+ ))
+ n-back-level
+ ) 'face 'n-back-header)
+ (propertize
+ (if (n-back-is-playing) " Press C-g to stop" " Press SPACE to play")
+ 'face 'n-back-do-now)
+ (if (n-back-is-playing) (format " Left %s" n-back-trials-left) "")
+ "\n")
+ ;;(unless n-back-control-status (n-back-init-control-status))
+ (dolist (entry n-back-control-status)
+ (let* ((what (nth 0 entry))
+ (msg (nth 1 entry))
+ (sts (nth 2 entry))
+ (key (key-description (n-back-key-binding what))))
+ ;;(setq msg (concat (key-description (n-back-key-binding what)) msg))
+ (cond
+ ((eq sts 'bad)
+ (setq msg (propertize (concat key msg) 'face 'n-back-bad)))
+ ((eq sts 'ok)
+ (setq msg (propertize (concat key msg) 'face 'n-back-ok)))
+ ((eq sts 'miss)
+ (setq msg (concat
+ (if n-back-display-hint
+ (propertize key 'face 'n-back-header)
+ key)
+ msg)))
+ ((not sts)
+ (setq msg (concat key msg)))
+ (t
+ (error "n-back:Unknown sts=%s" sts)
+ ))
+ (insert msg " "))
+ )
+ (when n-back-display-hint
+ (setq n-back-display-hint nil)
+ (run-with-timer 0.1 nil 'n-back-update-control-buffer))
+ (setq buffer-read-only t)
+ (if (window-live-p n-back-ctrl-window)
+ (with-selected-window n-back-ctrl-window
+ (goto-char 1))
+ (goto-char 1))))))
+
+(defcustom n-back-trials 20
+ "Number of trials per session."
+ :type 'integer
+ :group 'n-back)
+
+;;(n-back-compute-result-values n-back-result)
+(defvar n-back-result-values nil)
+(defun n-back-compute-single-result-value (entry)
+ "Compute result stored in ENTRY."
+ (let* ((what (nth 0 entry))
+ (good (nth 1 entry))
+ (bad (nth 2 entry))
+ (miss (nth 3 entry))
+ (err (+ bad miss))
+ ;;(tot (+ good bad miss 0.0))
+ ;;(gnum 6)
+ ;;(weighted-err (* err (/ gnum tot)))
+ )
+ (cons what (if (= 0 good)
+ 0
+ (/ (- n-back-trials err 0.0)
+ n-back-trials)))))
+
+(defun n-back-compute-result-values (result)
+ "Compute result values from game result RESULT."
+ (let ((results nil))
+ (dolist (entry result)
+ (let ((res (n-back-compute-single-result-value entry)))
+ (setq results (cons res results))))
+ (setq n-back-result-values (reverse results))))
+
+;; Thresholds
+(defun n-back-view-threshold-discussion-page ()
+ "View some discussion of threshold."
+ (interactive)
+ (browse-url "http://groups.google.com/group/brain-training/browse_thread/thread/f4bfa452943c2a2d/ba31adfd0b97771c?lnk=gst&q=threshold#ba31adfd0b97771c"))
+
+;;(n-back-set-next-challenge)
+(defvar n-back-worst nil)
+
+(defvar n-back-challenge-change nil)
+
+(defun n-back-set-next-challenge ()
+ "Set next game difficulty level from last game result."
+ (let ((r 2.8)) ;; stay as default
+ (setq n-back-worst nil)
+ (dolist (res n-back-result-values)
+ (when (< (cdr res) r)
+ (setq r (cdr res))
+ (setq n-back-worst res)))
+ (setq n-back-challenge-change (if (< r 0.74)
+ 'down
+ (if (> r 0.91)
+ 'up
+ 'stay)))
+ (n-back-change-challenge n-back-challenge-change)))
+
+(defun n-back-challenge-up ()
+ "Make the game harder."
+ (interactive)
+ (n-back-change-challenge 'up))
+
+(defun n-back-challenge-down ()
+ "Make the game easier."
+ (interactive)
+ (n-back-change-challenge 'down))
+
+(defun n-back-change-challenge (challenge-change)
+ "Change game difficulty level by CHALLENGE-CHANGE."
+ (let ((new-level n-back-level)
+ (new-num-active n-back-num-active)
+ (num-allowed (length n-back-allowed-match-types)))
+ (case challenge-change
+ (down
+ (if (= 1 n-back-num-active)
+ (unless (= 1 n-back-level)
+ (setq new-num-active (min 3 num-allowed))
+ (setq new-level (1- n-back-level)))
+ (setq new-num-active (1- n-back-num-active))))
+ (up
+ (if (or (<= 3 n-back-num-active)
+ (<= num-allowed n-back-num-active))
+ (progn
+ (setq new-level (1+ n-back-level))
+ (setq new-num-active 1))
+ (setq new-num-active (min 3 (1+ n-back-num-active))))))
+ ;;(when (= new-level 0) (setq new-level 1))
+ ;;(when (= new-num-active 0) (setq new-num-active 1))
+ (when (and (= new-level n-back-level)
+ (= new-num-active n-back-num-active))
+ (setq n-back-challenge-change 'stay))
+ (unless (= new-level n-back-level)
+ (customize-set-variable 'n-back-level new-level)
+ (customize-set-value 'n-back-level new-level))
+ (n-back-set-random-match-types new-num-active (car n-back-worst))))
+
+(defun n-back-set-random-match-types (num worst)
+ "Select NUM random match types.
+If type WORST is non-nil try to include that."
+ (let ((alen (length n-back-allowed-match-types))
+ (old-types n-back-active-match-types)
+ types)
+ (unless (<= num alen)
+ (error "n-back: Too many match types required = %s" num))
+ (when (and worst
+ (< 1 num)
+ (memq worst n-back-allowed-match-types))
+ (add-to-list 'types worst))
+ (while (< (length types) num)
+ (add-to-list 'types (nth (random alen) n-back-allowed-match-types)))
+ (setq types (n-back-sort-types types))
+ (unless (equal old-types types)
+ (customize-set-variable 'n-back-active-match-types types)
+ (customize-set-value 'n-back-active-match-types types))))
+
+;; (defcustom n-back-keybinding-color "OliveDrab1"
+;; "Background color for key binding hints."
+;; :type 'color
+;; :group 'n-back)
+
+(defun n-back-update-info ()
+ "Update info buffer."
+ (when (buffer-live-p n-back-info-buffer)
+ (when (window-live-p n-back-info-window)
+ (set-window-buffer n-back-info-window n-back-info-buffer))
+ (with-current-buffer n-back-info-buffer
+ (setq buffer-read-only nil)
+ (erase-buffer)
+
+ (insert (propertize "n-back" 'face 'n-back-header)
+ " "
+ (propertize "Help: ?" 'face 'n-back-keybinding))
+
+ ;; Auto challenging
+ (insert "\n\nAuto challenging: "
+ (if n-back-auto-challenge "on " "off ")
+ (propertize "toggle: Ta" 'face 'n-back-keybinding))
+
+ (insert "\n Manually change challenging: "
+ (propertize "up-arrow/down-arrow" 'face 'n-back-keybinding))
+
+ (insert "\n Allowed match types: ")
+ (dolist (type n-back-allowed-match-types)
+ (insert (format "%s " type)))
+ (insert (propertize "toggle: T" 'face 'n-back-keybinding))
+
+ ;; Current game
+ (insert "\n\nCurrent game:")
+
+ (insert (format "\n n Back: %s " n-back-level)
+ (propertize "change: number 1-9" 'face 'n-back-keybinding))
+ (insert "\n Match types: ")
+ (dolist (type n-back-active-match-types)
+ (insert (format "%s " type)))
+ (insert (propertize "toggle: t" 'face 'n-back-keybinding))
+
+ (insert (format "\n %.2f seconds per trial " n-back-sec-per-trial)
+ (propertize "change: +/-" 'face 'n-back-keybinding))
+
+ ;; Save and restore
+ (insert "\n\n")
+ (insert "Game settings: "
+ (propertize "reset: C-r" 'face 'n-back-keybinding)
+ " "
+ (propertize "save: C-s" 'face 'n-back-keybinding))
+
+ (insert "\n\n")
+ (unless (or (n-back-is-playing)
+ (not n-back-result))
+ (insert (propertize (format "Last result, %s" n-back-challenge-change)
+ 'face 'n-back-last-result)
+ "\n Good-Bad-Miss:")
+ (dolist (entry n-back-result)
+ (let* ((what (nth 0 entry))
+ (good (nth 1 entry))
+ (bad (nth 2 entry))
+ (miss (nth 3 entry))
+ (tot (+ good bad miss 0.0))
+ (res (n-back-compute-single-result-value entry)))
+ (insert (format " %s: %s-%s-%s (%d%%)"
+ (key-description (n-back-key-binding what))
+ good
+ bad
+ miss
+ (floor (* 100 (cdr res))))))))
+
+ (setq buffer-read-only t))))
+
+(defun n-back-show-welcome (msg)
+ "Show welcome startup info and message MSG."
+ (when (and n-back-game-buffer
+ (buffer-live-p n-back-game-buffer))
+ (with-current-buffer n-back-game-buffer
+ (let ((src (or (when (boundp 'nxhtml-install-dir)
+ (expand-file-name "nxhtml/doc/img/fun-brain-2.png" nxhtml-install-dir))
+ "c:/program files/brain workshop/res/brain_graphic.png"))
+ img
+ buffer-read-only)
+ (erase-buffer)
+ ;;(insert (propertize "\nEmacs n-back game (after Brain Workshop)\n\n" 'face '(:height 2.0)))
+ (insert (propertize "\nEmacs n-back game (after Brain Workshop)\n\n" 'face 'n-back-welcome-header))
+ (unless (file-exists-p src)
+ (n-back-maybe-download-files (file-name-directory src) (list (file-name-nondirectory src))))
+ (if (file-exists-p src)
+ (condition-case err
+ (setq img (create-image src nil nil
+ :relief 0
+ ;;:margin inlimg-margins
+ ))
+ (error (setq img (error-message-string err))))
+ (setq img (concat "Image not found: " src)))
+ (if (stringp img)
+ (insert img)
+ (insert-image img))
+ (insert (propertize "\n\nPlay for fun and maybe a somewhat happier brain"
+ 'face 'n-back-welcome))
+ (when msg (insert "\n\n" msg))
+ ))))
+
+(defun n-back-setup-windows ()
+ "Setup game frame and windows."
+ (delete-other-windows)
+ ;; Info
+ (split-window-horizontally)
+ (setq n-back-info-window (next-window (frame-first-window)))
+ (setq n-back-info-buffer (get-buffer-create "* n-back info *"))
+ (when (< 75 (window-width n-back-info-window))
+ (with-selected-window n-back-info-window
+ (enlarge-window (- 75 (window-width n-back-info-window)) t)))
+ (with-current-buffer n-back-info-buffer
+ (n-back-control-mode)
+ (setq wrap-prefix " "))
+ (n-back-update-info)
+ ;; Control
+ (split-window-vertically)
+ (setq n-back-ctrl-window (next-window (frame-first-window)))
+ (setq n-back-ctrl-buffer (get-buffer-create "* n-back control *"))
+ (set-window-buffer n-back-ctrl-window n-back-ctrl-buffer)
+ (with-current-buffer n-back-ctrl-buffer (n-back-control-mode))
+ (n-back-update-control-buffer)
+ (fit-window-to-buffer n-back-ctrl-window)
+ (set-window-dedicated-p n-back-ctrl-window t)
+ ;; Game
+ (setq n-back-game-window (frame-first-window))
+ (setq n-back-game-buffer (get-buffer-create "*n-back game*"))
+ (set-window-buffer n-back-game-window n-back-game-buffer)
+ (set-window-dedicated-p n-back-game-window t)
+ (with-current-buffer n-back-game-buffer (n-back-control-mode))
+ (n-back-show-welcome nil)
+ ;; Position in control window
+ (select-window n-back-ctrl-window)
+ )
+
+;;(n-back-display "str" 1 0 3 3 6)
+(defun n-back-display (str x y cols rows max-strlen color)
+ "Display a trial.
+Display item with text STR at column X in row Y using COLS
+columns and ROWS rows. Strings to display have max length
+MAX-STRLEN. Display item with background color COLOR."
+ (unless (< x cols) (error "n-back: Not x=%s < cols=%s" x cols))
+ (unless (< y rows) (error "Not y=%s < rows=%s" y rows))
+ (unless str (setq str ""))
+ (with-current-buffer n-back-game-buffer
+ (let* (buffer-read-only
+ (tot-str "")
+ ;; Pad spaces left, two right, four between
+ (game-w (window-width n-back-game-window))
+ (pad-x 0)
+ (scale (if (not window-system)
+ 1.0
+ (/ (* 1.0 game-w)
+ (+ (* 2 pad-x)
+ (* (1- cols) 4)
+ (* cols max-strlen)))))
+ (str-diff (- max-strlen (length str)))
+ (str-l-len (/ str-diff 2))
+ (str-r-len (- max-strlen (length str) str-l-len))
+ (face-spec (if window-system
+ (list :inherit 'n-back-game-word :background color :height scale)
+ (list :inherit 'n-back-game-word :background color)))
+ (str-disp (propertize
+ (concat (make-string str-l-len 32) str (make-string str-r-len 32))
+ 'face face-spec))
+ (col-str (concat
+ (make-string pad-x ?p)
+ (make-string
+ (+ (* x (+ 4 max-strlen)))
+ 32
+ ;;?x
+ )))
+ ;; Pad lines above and below, two between
+ (pad-y 0)
+ (game-h (window-body-height n-back-game-window))
+ (game-h-scaled (/ game-h scale))
+ (lines-between (/ (- game-h-scaled rows (* 2 pad-y))
+ (1- rows)))
+ (row-scaled (+ pad-y (* y (1+ lines-between)) (1- y)))
+ (row-num (if (= y 0)
+ pad-y
+ (round row-scaled)))
+ (row-str (make-string row-num ?\n)))
+ (setq show-trailing-whitespace nil)
+ ;;(setq cursor-type nil)
+ (erase-buffer)
+ (setq tot-str row-str)
+ (setq tot-str (concat tot-str col-str))
+ (insert (propertize tot-str 'face (list :height scale)))
+ (insert str-disp)
+ )))
+
+;; (setq timer-list nil)
+;;(n-back-display-in-timer)
+;; (setq n-back-trials-left 3)
+
+(defun n-back-clear-game-window ()
+ "Erase game buffer."
+ (save-match-data ;; runs in timer
+ (with-current-buffer n-back-game-buffer
+ (let (buffer-read-only)
+ (erase-buffer)))))
+
+(defun n-back-play ()
+ "Start playing."
+ (interactive)
+ (message " ") ;; For easier reading *Messages*
+ (n-back-update-info)
+ (if (not n-back-active-match-types)
+ (message (propertize "No active match types"
+ 'face 'secondary-selection))
+ ;;(setq n-back-result nil)
+ (n-back-init-control-status)
+ (n-back-init-this-result)
+ (n-back-cancel-timers)
+ (winsize-set-mode-line-colors t)
+ (setq n-back-ring (make-ring (1+ n-back-level)))
+ (n-back-clear-game-window)
+ (setq n-back-trials-left (+ n-back-trials n-back-level))
+ (random t)
+ (n-back-start-main-timer)
+ (n-back-update-control-buffer)))
+
+(defun n-back-start-main-timer ()
+ "Start main game timer."
+ (setq n-back-timer
+ (run-with-timer
+ n-back-sec-per-trial
+ nil ;;n-back-sec-per-trial
+ 'n-back-display-in-timer)))
+
+(defun n-back-maybe-download-files (dir file-name-list)
+ (nxhtml-get-missing-files (file-relative-name dir nxhtml-install-dir) file-name-list))
+
+(defun n-back-finish-game ()
+ "Finish the game."
+ (n-back-cancel-timers)
+ (fit-window-to-buffer n-back-ctrl-window)
+ (setq n-back-result n-back-this-result)
+ (n-back-compute-result-values n-back-result)
+ (when n-back-auto-challenge (n-back-set-next-challenge))
+ (n-back-update-info)
+ (n-back-init-control-status)
+ (n-back-clear-match-status)
+ (n-back-update-control-buffer)
+ (n-back-show-welcome "Game over")
+ (with-current-buffer n-back-game-buffer
+ ;;(setq n-back-challenge-change 'up)
+ (let (buffer-read-only)
+ (insert
+ "\n\n"
+ (case n-back-challenge-change
+ (up "Congratulations! I see you need more challenge, raising difficulty!")
+ (down "Making it a bit easier for now to make your playing more fun.")
+ (otherwise "This game challenges seems the right way for you now.")))
+ (let* ((dir (when (boundp 'nxhtml-install-dir)
+ (expand-file-name "nxhtml/doc/img/" nxhtml-install-dir)))
+ (up-imgs '("rembrandt-self-portrait.jpg"
+ "bacchante2.jpg"
+ "giraffe.jpg"
+ "Las_Medulas.jpg"
+ ))
+ (t-imgs '("continue-play.jpg"
+ "Toco_toucan.jpg"
+ "raindrops2.jpg"
+ "divine2.jpg"
+ ;;"butterflies.png"
+ "volga.jpg"
+ "healthy_feet2.jpg"
+ ))
+ ;; (setq n-back-trials 1)
+ (pic (when dir (case n-back-challenge-change
+ (up (nth (random (length up-imgs)) up-imgs))
+ (otherwise (nth (random (length t-imgs)) t-imgs)))))
+ (src (when dir (expand-file-name pic dir)))
+ img)
+ (when (and src (not (file-exists-p src)))
+ ;; Time to download?
+ (n-back-maybe-download-files (file-name-directory src) (append up-imgs t-imgs nil)))
+ (when (and src (file-exists-p src))
+ (condition-case err
+ (setq img (create-image src nil nil
+ :relief 0
+ ))
+ (error (setq img (error-message-string err)))))
+ (if (stringp img)
+ img
+ (insert "\n\n")
+ (insert-image img)))))
+ (message "Game over"))
+
+(defun n-back-display-random ()
+ "Display a random item."
+ (when (current-message) (message ""))
+ ;;(message "here start display")
+ (let* ((use-position (memq 'position n-back-active-match-types))
+ (use-color (memq 'color n-back-active-match-types))
+ (use-sound (memq 'sound n-back-active-match-types))
+ (use-word (memq 'word n-back-active-match-types))
+ (old-rec (when (n-back-match-possible)
+ (ring-ref n-back-ring (1- n-back-level))))
+ (cols 3)
+ (rows 3)
+ (x (if use-position (random 3) 1))
+ (y (if use-position (random 3) 1))
+ (old-x (if use-position (nth 1 old-rec)))
+ (old-y (if use-position (nth 2 old-rec)))
+ (color (nth (if use-color (random (length n-back-colors)) 0) n-back-colors))
+ (old-color (if use-color (nth 3 old-rec)))
+ (sound (when use-sound (expand-file-name (nth (random (length n-back-sound-files))
+ n-back-sound-files)
+ (nth 0 n-back-sounds))))
+ (old-sound (if use-sound (nth 4 old-rec)))
+ (words (when use-word (split-string n-back-words)))
+ (word (when use-word (nth (random (length words)) words)))
+ (old-word (when use-word (nth 5 old-rec)))
+ (str (if word word "")) ;(format "%s" n-back-trials-left))
+ (max-strlen (if words
+ (+ 2 (apply 'max (mapcar (lambda (w) (length w)) words)))
+ 5))
+ (compensate 24)
+ )
+ ;; To get more targets make it more plausible that it is the same here.
+ ;; (/ (- 6 (/ 20.0 8)) 20)
+ (when old-rec
+ (when (and use-position
+ (not (and (= x old-x)
+ (= y old-y)))
+ (< (random 100) compensate))
+ (setq x (nth 1 old-rec))
+ (setq y (nth 2 old-rec)))
+ (when (and use-color
+ (not (equal color old-color))
+ (< (random 100) compensate))
+ (setq color (nth 3 old-rec)))
+ (when (and use-sound
+ (not (equal sound old-sound))
+ (< (random 100) compensate))
+ (setq sound (nth 4 old-rec)))
+ (when (and use-word
+ (not (equal word old-word))
+ (< (random 100) compensate))
+ (setq word (nth 5 old-rec))))
+ (setq str word) ;; fix-me
+ (ring-insert n-back-ring (list str x y color sound word))
+ ;;(message "here before display")
+ (n-back-display str x y cols rows max-strlen color)
+ ;;(when sound (play-sound (list 'sound :file sound)))
+ ;;(message "here before clear-m")
+ (n-back-clear-match-status)
+ ;;(message "here before position")
+ (when (and use-position (n-back-matches 'position)) (n-back-set-match-status 'position 'miss))
+ ;;(message "here before color")
+ (when (and use-color (n-back-matches 'color)) (n-back-set-match-status 'color 'miss))
+ ;;(message "here before sound")
+ (when (and use-sound (n-back-matches 'sound)) (n-back-set-match-status 'sound 'miss))
+ ;;(message "here before word")
+ (when (and use-word (n-back-matches 'word)) (n-back-set-match-status 'word 'miss))
+ (setq n-back-display-hint n-back-hint)
+ ;;(message "here before control")
+ (n-back-update-control-buffer)
+ ;;(message "here before clear timer")
+ (setq n-back-clear-timer (run-with-timer 0.5 nil 'n-back-clear-game-window))
+ ;;(message "here before sound timer")
+ (when sound (run-with-timer 0.01 nil 'n-back-play-sound-in-timer sound))
+ ;;(message "here exit display")
+ ))
+
+(defun n-back-display-in-timer ()
+ "Display a trial in a timer."
+ (condition-case err
+ (save-match-data ;; runs in timer
+ (n-back-add-result)
+ (if (>= 0 (setq n-back-trials-left (1- n-back-trials-left)))
+ (n-back-finish-game)
+ (n-back-display-random)
+ (n-back-start-main-timer)
+ ;;(message "after start-main-timer")
+ ))
+ (error (message "n-back-display: %s" (error-message-string err))
+ (n-back-cancel-timers))))
+
+(defun n-back-play-sound-in-timer (sound-file)
+ "Play sound SOUND-FILE in a timer."
+ (condition-case err
+ (save-match-data ;; runs in timer
+ (play-sound (list 'sound :file sound-file :volume n-back-sound-volume)))
+ (error (message "n-back-sound: %s" (error-message-string err))
+ (n-back-cancel-timers))))
+
+
+;;; Answers
+
+;;(defvar n-back-answers nil)
+
+(defun n-back-init-this-result ()
+ "Init `n-back-this-result'."
+ (setq n-back-this-result nil)
+ (dolist (sts-entry n-back-control-status)
+ (let* ((what (nth 0 sts-entry))
+ (res-entry (list what 0 0 0)))
+ (setq n-back-this-result (cons res-entry n-back-this-result)))))
+
+(defun n-back-match-possible ()
+ "Return t if enouch entries have been shown to match."
+ (= (ring-length n-back-ring) (1+ n-back-level)))
+
+(defun n-back-add-result ()
+ "Add result of last trial."
+ (when (n-back-match-possible)
+ (dolist (sts-entry n-back-control-status)
+ (let* ((what (nth 0 sts-entry))
+ (sts (nth 2 sts-entry))
+ (matches (n-back-matches what))
+ (num (cond
+ ((eq sts 'ok) 1)
+ ((eq sts 'bad) 2)
+ ;;((eq sts nil) (when matches 3))
+ ((eq sts 'miss) 3)
+ ((not sts) nil)
+ (t (error "n-back: Bad status=%s" sts))))
+ (res-entry (when num (assoc what n-back-this-result)))
+ (lst (when num (nthcdr num res-entry))))
+ (when num
+ (if res-entry
+ (setcar lst (1+ (car lst)))
+ (setq res-entry (list what 0 0 0))
+ ;;(setq lst (nthcdr num res-entry))
+ (setq n-back-this-result (cons res-entry n-back-this-result))))))))
+
+(defun n-back-matches-position ()
+ "Return non-nil iff last trial position match."
+ (when (n-back-match-possible)
+ (let* ((comp-item (ring-ref n-back-ring n-back-level))
+ (curr-item (ring-ref n-back-ring 0))
+ (comp-x (nth 1 comp-item))
+ (curr-x (nth 1 curr-item))
+ (comp-y (nth 2 comp-item))
+ (curr-y (nth 2 curr-item)))
+ (and (= comp-y curr-y)
+ (= comp-x curr-x)))))
+
+(defun n-back-matches-color ()
+ "Return non-nil iff last trial color match."
+ (when (n-back-match-possible)
+ (let* ((comp-item (ring-ref n-back-ring n-back-level))
+ (curr-item (ring-ref n-back-ring 0))
+ (comp-color (nth 3 comp-item))
+ (curr-color (nth 3 curr-item)))
+ (equal comp-color curr-color))))
+
+(defun n-back-matches-sound ()
+ "Return non-nil iff last trial sound match."
+ (when (n-back-match-possible)
+ (let* ((comp-item (ring-ref n-back-ring n-back-level))
+ (curr-item (ring-ref n-back-ring 0))
+ (comp-sound (nth 4 comp-item))
+ (curr-sound (nth 4 curr-item)))
+ (equal comp-sound curr-sound))))
+
+(defun n-back-matches-word ()
+ "Return non-nil iff last trial word match."
+ (when (n-back-match-possible)
+ (let* ((comp-item (ring-ref n-back-ring n-back-level))
+ (curr-item (ring-ref n-back-ring 0))
+ (comp-word (nth 5 comp-item))
+ (curr-word (nth 5 curr-item)))
+ (equal comp-word curr-word))))
+
+(defun n-back-matches (what)
+ "Return non-nil iff last trial part WHAT match."
+ (cond
+ ((eq what 'position) (n-back-matches-position))
+ ((eq what 'color) (n-back-matches-color))
+ ((eq what 'sound) (n-back-matches-sound))
+ ((eq what 'word) (n-back-matches-word))
+ (t (error "n-back: Unknown match type: %s" what))))
+
+(defun n-back-answer (what)
+ "Tell that you think WHAT matched."
+ (when (n-back-is-playing)
+ (if (memq what n-back-active-match-types)
+ (if (n-back-match-possible)
+ (let ((sts (if (n-back-matches what) 'ok 'bad)))
+ (n-back-set-match-status what sts)
+ (n-back-update-control-buffer))
+ (message "%s n-back items must be displayed before anything can match"
+ n-back-level))
+ (message "%s match is not active" what)
+ (ding t))))
+
+(defun n-back-position-answer ()
+ "Tell that you think position matched."
+ (interactive)
+ (n-back-answer 'position))
+
+(defun n-back-color-answer ()
+ "Tell that you think color matched."
+ (interactive)
+ (n-back-answer 'color))
+
+(defun n-back-sound-answer ()
+ "Tell that you think sound matched."
+ (interactive)
+ (n-back-answer 'sound))
+
+(defun n-back-word-answer ()
+ "Tell that you think word matched."
+ (interactive)
+ (n-back-answer 'word))
+
+(defun n-back-stop ()
+ "Stop playing."
+ (interactive)
+ (n-back-cancel-timers)
+ (n-back-update-control-buffer)
+ (message "Stopped n-back game")
+ (n-back-show-welcome "Stopped"))
+
+(defvar viper-emacs-state-mode-list) ;; silence compiler
+(defvar viper-emacs-state-hook) ;; silence compiler
+
+(define-derived-mode n-back-control-mode nil "N-back"
+ "Mode for controlling n-back game."
+ (setq cursor-type nil)
+ (setq buffer-read-only t)
+ (set (make-local-variable 'viper-emacs-state-mode-list) '(n-back-control-mode))
+ (set (make-local-variable 'viper-emacs-state-hook) nil) ;; in vis cursor
+ (abbrev-mode -1)
+ (setq show-trailing-whitespace nil)
+ (when (fboundp 'visual-line-mode) (visual-line-mode 1))
+ (n-back-make-keymap))
+
+(defun n-back-cancel-timers ()
+ "Cancel game timers."
+ (when (timerp n-back-timer)
+ (cancel-timer n-back-timer))
+ (setq n-back-timer nil)
+ (when (timerp n-back-clear-timer)
+ (cancel-timer n-back-clear-timer))
+ (setq n-back-clear-timer nil)
+ (winsize-set-mode-line-colors nil))
+
+(defvar n-back-game-settings-symbols
+ '(
+ ;;n-back-keys
+ n-back-level
+ n-back-active-match-types
+ n-back-allowed-match-types
+ n-back-auto-challenge
+ ;;n-back-colors
+ ;;n-back-words
+ ;;n-back-sound-volume
+ ;;n-back-sounds
+ n-back-sec-per-trial
+ ;;n-back-keybinding-color
+ ;;n-back-trials
+ ))
+
+(defun n-back-save-game-settings ()
+ "Save game settings."
+ (interactive)
+ (dolist (var n-back-game-settings-symbols)
+ )
+ (custom-save-all))
+
+(defun n-back-reset-game-to-saved ()
+ "Reset game playing options to saved values."
+ (interactive)
+ (dolist (pass '(1 2))
+ (dolist (var n-back-game-settings-symbols)
+ (if (= pass 1)
+ ;; pass 1 is for my lousy programming:
+ (condition-case err
+ (custom-reevaluate-setting var)
+ (error nil))
+ (custom-reevaluate-setting var)))))
+
+(provide 'n-back)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; n-back.el ends here
--- /dev/null
+;;; new-key-seq-widget.el --- New key-sequence widget for Emacs
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Tue Dec 25 23:00:43 2007
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; New version of Kim's Emacs key-sequence widget. For inclusion in
+;; Emacs I hope.
+;;
+;; Fix-me: check what was included.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; I do not know how much I have changed, but I keep it together here
+;; for simplicity.
+;;
+;; Note: I have named made `widget-key-sequence-map' a constant for
+;; the moment.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'wid-edit)
+(require 'edmacro)
+
+;;; I'm not sure about what this is good for? KFS.
+;;
+;;; This should probably be for customize-set-value etc, but it is not
+;;; used. Or for the widget editing, but it is not used there
+;;; either. /Lennart
+(defvar widget-key-sequence-prompt-value-history nil
+ "History of input to `widget-key-sequence-prompt-value'.")
+
+(defvar widget-key-sequence-default-value [ignore]
+ "Default value for an empty key sequence.")
+
+(defconst widget-key-sequence-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map widget-field-keymap)
+ (define-key map [(control ?q)] 'widget-key-sequence-read-event)
+ (define-key map [(control ?t)] 'widget-key-sequence-toggle-input-format)
+ map))
+
+(defvar widget-key-sequence-input-formats '(key-description vector))
+
+(defcustom widget-key-sequence-default-input-format 'key-description
+ "Format used to edit key sequences.
+This is the format shown and edited in a key-sequence widget."
+ :type '(choice (const :tag "Key description" 'key-description)
+ (const :tag "Vector" 'vector))
+ :group 'widgets)
+
+(define-widget 'key-sequence 'restricted-sexp
+ "A key sequence."
+ :prompt-value 'widget-field-prompt-value
+ :prompt-internal 'widget-symbol-prompt-internal
+; :prompt-match 'fboundp ;; What was this good for? KFS
+ :prompt-history 'widget-key-sequence-prompt-value-history
+ :action 'widget-field-action
+ :match-alternatives '(stringp vectorp)
+ :format "%{%t%}: %v"
+ :validate 'widget-key-sequence-validate
+ :value-to-internal 'widget-key-sequence-value-to-internal
+ :value-to-external 'widget-key-sequence-value-to-external
+ :value widget-key-sequence-default-value
+ :keymap widget-key-sequence-map
+ :help-echo "C-q: insert KEY, EVENT, or CODE; C-t: toggle format"
+ :tag "Key sequence")
+
+
+;;; Leave these here for testing:
+;; (edmacro-parse-keys "C-x h" t) => [24 104]
+;; (key-description-to-vector "C-x h" ) => [(control 120) 104]
+;; (key-description (key-description-to-vector "C-x h")) => "C-x h"
+;; (key-description (edmacro-parse-keys "C-x h")) => "C-x h"
+;; (key-description [M-mouse-1]) => <M-mouse-1>
+;; (edmacro-parse-keys "<M-mouse-1>") => [M-mouse-1]
+
+;; (event-modifiers 'mouse-1) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1)
+;; (event-modifiers 'M-mouse-1) =>
+;; (event-modifiers '(mouse-1)) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1)
+;; (event-modifiers '(down-mouse-1)) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1)
+;; (event-modifiers '(S-down-mouse-1)) => (shift down)
+;; (event-modifiers 'S-down-mouse-1) => (shift down)
+;; (event-modifiers 'down-mouse-1) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1)
+;; (event-modifiers '(down-mouse-1)) => (click mouse-1 mouse-1 mouse-1 mouse-1 mouse-1)
+;; (let ((m (make-sparse-keymap))) (define-key m [(down mouse-1)] 'hej))
+(defun key-description-to-vector (kd)
+ "Convert human readable key description KD to vector format.
+KD should be in the format returned by `key-description'."
+ (let ((v
+ (vconcat
+ (mapcar (lambda (k)
+ ;; Fix-me: temporarily clean the event here:
+ (when (symbolp k)
+ (let ((esem (get k 'event-symbol-element-mask))) (when esem (lwarn t :warning "kd=%s, k=%s, esem=%s" kd k esem)))
+ (put k 'event-symbol-element-mask nil))
+ (let ((m (event-modifiers k))
+ (b (event-basic-type k)))
+ (setq m (delq 'click m))
+ (if m
+ (nconc m (list b))
+ b)))
+ ;; fix-me: does not always work for menu and tool
+ ;; bar event because they may contains spaces.
+ (edmacro-parse-keys kd t))))
+ (m (make-sparse-keymap))
+ )
+ ;; Test before returning it:
+ (define-key m v 'test)
+ v))
+
+(defun widget-key-sequence-current-input-format ()
+ (let ((fmt (or (widget-get (widget-at (point)) :key-sequence-format)
+ widget-key-sequence-default-input-format)))
+ fmt))
+
+(defun widget-key-sequence-toggle-input-format ()
+ "Toggle key sequence input format."
+ (interactive)
+ (let* ((widget (widget-at (point)))
+ (value (widget-apply widget :value-get))
+ (first (string-to-char value))
+ (old-fmt
+ (let ((fmt (or (widget-get widget :key-sequence-format)
+ widget-key-sequence-default-input-format)))
+ fmt))
+ (new-fmt
+ (let ((m (cdr (memq old-fmt widget-key-sequence-input-formats))))
+ (if m (car m) (car widget-key-sequence-input-formats))))
+ (new-value
+ (cond
+ ((eq new-fmt 'key-description)
+ (setq value (replace-regexp-in-string "\\` *\\(.*?\\) *\\'" "\\1" value))
+ (if (string= value "")
+ ""
+ (key-description (read value))))
+ ((eq new-fmt 'vector)
+ (format "%S" (key-description-to-vector value)))
+ (t
+ (error "Bad key seq format spec: %s" new-fmt))))
+ (state (widget-get (widget-get widget :parent) :custom-state))
+ )
+ (widget-put widget :key-sequence-format new-fmt)
+ (setq new-value (propertize new-value 'face 'highlight))
+ (widget-apply widget :value-set new-value)
+ (widget-setup)
+ (widget-put (widget-get widget :parent) :custom-state state)
+ (cond
+ ((eq new-fmt 'key-description)
+ (message "Switched to human readable format"))
+ ((eq new-fmt 'vector)
+ (message "Switched to vector format"))
+ (t
+ (error "Uh? format=%s" new-fmt)))))
+
+
+(defun widget-key-sequence-read-event (ev)
+ "Read event or char code and put description in widget.
+The events may come from keyboard, mouse, menu or tool bar.
+
+If the event is a mouse event then multiple entries will be
+entered. It is not possible to know which one is wanted. Please
+remove those not wanted!
+
+If 0-7 is pressed then code for an event is prompted for."
+ (interactive (list
+ (let ((inhibit-quit t) quit-flag)
+ (unless (eq 'key-description
+ (widget-key-sequence-current-input-format))
+ (error "Wrong input format, please do C-t first"))
+ (read-event "Insert KEY, EVENT, or CODE: "))))
+ (lwarn t :warning "=====> ev=%s" ev)
+ (let ((tr (and (keymapp function-key-map)
+ (lookup-key function-key-map (vector ev)))))
+ (insert (if (= (char-before) ?\s) "" " "))
+ ;; Fix-me: change to check for ? instead of 0-7 to allow char
+ ;; literal input format
+ (when (and (integerp ev)
+ (or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix))))
+ (and (<= ?a (downcase ev))
+ (< (downcase ev) (+ ?a -10 (min 36 read-quoted-char-radix))))))
+ (setq unread-command-events (cons ev unread-command-events)
+ ev (read-quoted-char (format "Enter code (radix %d)" read-quoted-char-radix))
+ tr nil)
+ (if (and (integerp ev) (not (characterp ev)))
+ (insert (char-to-string ev)))) ;; throw invalid char error
+ (setq ev (key-description (list ev)))
+ (when (arrayp tr)
+ (setq tr (key-description (list (aref tr 0))))
+ (when (y-or-n-p (format "Key %s is translated to %s -- use %s? " ev tr tr))
+ (setq ev tr)
+ ;;(setq ev2 nil)
+ ))
+ (insert ev " ")
+ (when (or (string-match "mouse-" ev)
+ (string-match "menu-bar" ev)
+ (string-match "tool-bar" ev))
+ (let ((ev2 (read-event nil nil (* 0.001 double-click-time))))
+ (while ev2
+ (lwarn t :warning "(stringp ev2)=%s, (sequencp ev2)=%s, (symbolp ev2)=%s, ev2=%S" (stringp ev2) (sequencep ev2) (symbolp ev2) ev2)
+ (if nil ;(memq 32 (append (symbol-name ev2) nil)) ;; Fix-me: contains space
+ (insert ?\" (symbol-name ev2) ?\")
+ (insert (key-description (list ev2))))
+ (insert " ")
+ (setq ev2 (read-event nil nil (* 0.001 double-click-time))))))))
+
+(defun widget-key-sequence-validate (widget)
+ "Validate the internal value of the widget.
+Actually there is nothing to validate here. The internal value
+is always valid, but it is however maybe not what the user
+expects. Because of this the internal format is rewritten when
+the user gives the value in a way that is not the normal
+representation of it. A warning is also shown then."
+ (condition-case err
+ (let* ((int-val (widget-apply widget :value-get))
+ (def-desc (key-description (edmacro-parse-keys int-val)))
+ (fmt (or (widget-get widget :key-sequence-format)
+ widget-key-sequence-default-input-format)))
+ ;; Normalize and compare with default description
+ (setq int-val
+ (replace-regexp-in-string " *" " " int-val t))
+ (setq int-val
+ (replace-regexp-in-string "\\` *\\(.*?\\) *\\'" "\\1" int-val t))
+ (unless (or
+ (eq fmt 'vector)
+ (string= int-val def-desc))
+ ;; Replace with the default description if it is different
+ ;; so the user sees what the value actually means:
+ (widget-apply widget :value-set def-desc)
+ (lwarn t :warning
+ (concat "Key description %s means the same as %s\n"
+ "\tTip: You can type C-q to insert a key or event")
+ int-val def-desc)
+ )
+ ;; Return nil if there a no problem validating
+ nil)
+ (error (widget-put widget :error (error-message-string err))
+ (lwarn t :warning "invalid %S: %s" widget (error-message-string err))
+ ;; Return widget if there was an error
+ widget)))
+
+(defun widget-key-sequence-value-to-internal (widget value)
+ (if (widget-apply widget :match value)
+ (if (equal value widget-key-sequence-default-value)
+ ""
+ (let ((fmt (or (widget-get widget :key-sequence-format)
+ widget-key-sequence-default-input-format)))
+ (if (eq fmt 'vector)
+ (format "%S" value)
+ (key-description value))))
+ value))
+
+(defun widget-key-sequence-value-to-external (widget value)
+ (if (stringp value)
+ (if (string-match "\\`[[:space:]]*\\'" value)
+ widget-key-sequence-default-value
+ ;; Give a better error message and a trace back on debug:
+ (condition-case err
+ (let* ((fmt (or (widget-get widget :key-sequence-format)
+ widget-key-sequence-default-input-format))
+ (first (string-to-char value)))
+ (cond
+ ((eq fmt 'vector)
+ (read value)
+ )
+ (t
+ (key-description-to-vector value))))
+ (error (error "Bad value: %s" (error-message-string err)))))
+ value))
+
+;; (customize-option 'new-key-seq-widget-test)
+(defcustom new-key-seq-widget-test []
+ "Testing only!"
+ :type 'key-sequence
+ :group 'widgets)
+
+ (provide 'new-key-seq-widget)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; new-key-seq-widget.el ends here
--- /dev/null
+;;; nxml-mode-os-additions.el --- additional functions for nxml-mode
+
+;; Copyright (C) 2004 by Oliver Steele
+
+;; Author: Oliver Steele <steele@osteele.com>
+;; Version: 1.0 (2004-08-08)
+;; Homepage: http://osteele.com/sources/nxml-mode-os-additions.el
+;; Keywords: XML
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be
+;; useful, but WITHOUT ANY WARRANTY; without even the implied
+;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public
+;; License along with this program; if not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+;; MA 02111-1307 USA
+
+;;; Description:
+
+;; nxml-mode-os-additions defines additional functions for using
+;; James Clark's nxml-mode:
+;; - reload the current buffer's schema
+;; - edit the current buffer's schema
+
+;;; Installation:
+;;
+;; To use nxml-mode-os-additions.el, put it in your load-path and add
+;; the following to your .emacs:
+;;
+;; (load-library "nxml-mode-os-additions")
+
+;; Configuration:
+;;
+;; To make it easier to use, assign the commands to some keys.
+;; Once nxml-mode has been loaded, you can define keys on nxml-mode-map.
+;; The function rng-mode-os-additions-set-key-bindings illustrates
+;; this.
+;;
+;; Alternatively, you can place the following in your .emacs:
+;; (add-hook 'nxml-mode-hook 'rng-mode-os-additions-set-key-bindings)
+
+;;; ChangeLog:
+;;
+;; 2004-08-08 (version 1.0):
+;; * Initial public release
+
+;; Added require rng-valid (Lennart Borgman)
+
+;;; Code:
+
+(require 'nxml-mode)
+(eval-and-compile (require 'rng-valid))
+
+(defun rng-mode-os-additions-set-key-bindings ()
+ (define-key nxml-mode-map "\C-c\C-s\C-r" 'rng-reload-schema-file)
+ ; move the rng-set-schema-file-and-validate to another key binding
+ ;(define-key nxml-mode-map "\C-c\C-s\C-s" 'rng-set-schema-file-and-validate)
+ (define-key nxml-mode-map "\C-c\C-sf" 'rng-find-schema-file)
+ )
+
+(defun rng-reload-schema-file ()
+ "Reloads the current schema file."
+ (interactive)
+ (let ((schema-filename rng-current-schema-file-name))
+ (when schema-filename
+ (setq rng-current-schema (rng-load-schema schema-filename))
+ (run-hooks 'rng-schema-change-hook)
+ (message "Reloaded schema %s" schema-filename))
+ (unless schema-filename
+ (rng-set-schema-and-validate))))
+
+;; Helper function for rng-find-schema-file*
+(defun rng-apply-find-schema-file (fn)
+ (let ((schema-filename rng-current-schema-file-name))
+ (unless schema-filename
+ (error "This file is not associated with a schema file."))
+ (funcall fn schema-filename)))
+
+(defun rng-find-schema-file ()
+ "Edit the current schema file."
+ (interactive)
+ (rng-apply-find-schema-file 'find-file))
+
+(defun rng-find-schema-file-other-frame ()
+ "Edit the current schema in another frame."
+ (interactive)
+ (rng-apply-find-schema-file 'find-file-other-frame))
+
+(defun rng-find-schema-file-other-window ()
+ "Edit the current schema in another window."
+ (interactive)
+ (rng-apply-find-schema-file 'find-file-other-window))
--- /dev/null
+;;; ocr-user.el --- Input looong OCR number more safely
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-06-18T23:00:25+0200 Wed
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; I just get mad at entering OCR numbers more than twenty digits long
+;; so I wrote this litte minor mode that colors up the digits three by
+;; tree.
+;;
+;; To use it do
+;;
+;; M-x ocr-user-mode
+;;
+;; Crazy? Yeah, I get crazy by entering these digits. You would not
+;; like to meet me when I have done that!
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defconst ocr-keywords
+ `((
+ ,(concat
+ ;;"\\<\\(?:"
+ "\\(?1:[0-9]\\{3\\}\\)"
+ "\\(?2:[0-9]\\{3\\}\\)?"
+ ;;"\\)+"
+ )
+ (0 (progn
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face '(:background "LightBlue1"))
+ (when (match-beginning 2)
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'face '(:background "PaleGreen1"))))))))
+
+;; 23456
+;; 1234567890
+;; 346789238
+;;;###autoload
+(define-minor-mode ocr-user-mode
+ "Color up digits three by three."
+ :group 'convenience
+ (if ocr-user-mode
+ (font-lock-add-keywords nil ocr-keywords)
+ (font-lock-remove-keywords nil ocr-keywords))
+ (font-lock-fontify-buffer))
+
+
+(provide 'ocr-user)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ocr-user.el ends here
--- /dev/null
+;;; org-panel.el --- Simple routines for us with bad memory
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Thu Nov 15 15:35:03 2007
+;; Version: 0.21
+;; Lxast-Updated: Wed Nov 21 03:06:03 2007 (3600 +0100)
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Fxeatures that might be required by this library:
+;;
+;; `easymenu', `font-lock', `noutline', `org', `outline', `syntax',
+;; `time-date'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This defines a kind of control panel for `org-mode'. This control
+;; panel should make it fast to move around and edit structure etc.
+;;
+;; To bring up the control panel type
+;;
+;; M-x orgpan-panel
+;;
+;; Type ? there for help.
+;;
+;; I suggest you add the following to your .emacs for quick access of
+;; the panel:
+;;
+;; (eval-after-load 'org-mode
+;; (define-key org-mode-map [(control ?c) ?p] 'orgpan-panel))
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'org)
+(require 'outline)
+
+;; Fix-me: this is for testing. A minor mode version interferes badly
+;; with emulation minor modes.
+(defconst orgpan-minor-mode-version nil)
+
+(defface orgpan-field
+ '((t (:inherit widget-field)))
+ "Face for fields."
+ :group 'orgpan)
+(defvar orgpan-field-face 'orgpan-field)
+
+(defface orgpan-active-field
+ '((t (:inherit highlight)))
+ "Face for fields."
+ :group 'orgpan)
+(defvar orgpan-active-field-face 'orgpan-active-field)
+
+(defface orgpan-spaceline
+ '((t (:height 0.2)))
+ "Face for spacing lines."
+ :group 'orgpan)
+
+(defcustom orgpan-panel-at-top nil
+ "Put org panel at top if non-nil."
+ :type 'boolean
+ :group 'orgpan)
+
+(defcustom orgpan-panel-buttons nil
+ "Panel style, if non-nil use buttons.
+If there are buttons in the panel they are used to change the way
+the arrow keys work. The panel looks something like this, with
+the first button chosen:
+
+ [Navigate] [Restructure] [TODO/Priority]
+ ----------
+ up/down, left: Go to, right: Visibility
+
+The line below the buttons try to give a short hint about what
+the arrow keys does. \(Personally I prefer the version without
+buttons since I then do not have to remember which button is
+active.)"
+ :type 'boolean
+ :group 'orgpan)
+
+;; Fix-me: add org-mode-map
+;; (memq 'org-self-insert-command orgpan-org-mode-commands)
+;; (memq 'org-self-insert-command orgpan-org-commands)
+(defvar orgpan-org-mode-commands nil)
+(setq orgpan-org-mode-commands nil)
+
+(defconst orgpan-org-commands
+ '(
+ orgpan-copy-subtree
+ orgpan-cut-subtree
+ orgpan-paste-subtree
+ undo
+ save-buffer
+ ;;
+ ;orgpan-occur
+ orgpan-find-org-file
+ ;;
+ org-cycle
+ org-global-cycle
+ outline-up-heading
+ outline-next-visible-heading
+ outline-previous-visible-heading
+ outline-forward-same-level
+ outline-backward-same-level
+ org-todo
+ org-show-todo-tree
+ org-priority-up
+ org-priority-down
+ org-move-subtree-up
+ org-move-subtree-down
+ org-do-promote
+ org-do-demote
+ org-promote-subtree
+ org-demote-subtree))
+
+
+(defvar orgpan-panel-window nil
+ "The window showing `orgpan-panel-buffer'.")
+
+(defvar orgpan-panel-buffer nil
+ "The panel buffer.
+There can be only one such buffer at any time.")
+
+(defvar orgpan-org-window nil)
+;;(make-variable-buffer-local 'orgpan-org-window)
+
+;; Fix-me: used?
+(defvar orgpan-org-buffer nil)
+;;(make-variable-buffer-local 'orgpan-org-buffer)
+
+(defvar orgpan-last-org-buffer nil)
+;;(make-variable-buffer-local 'orgpan-last-org-buffer)
+
+(defvar orgpan-point nil)
+;;(make-variable-buffer-local 'orgpan-point)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Hook functions etc
+
+(defun orgpan-delete-panel ()
+ "Remove the panel."
+ (interactive)
+ (let ((was-in-panel (and (window-live-p orgpan-panel-window)
+ (eq (selected-window) orgpan-panel-window))))
+ (when (buffer-live-p orgpan-panel-buffer)
+ (delete-windows-on orgpan-panel-buffer)
+ (kill-buffer orgpan-panel-buffer))
+ (when was-in-panel
+ (select-window orgpan-org-window)))
+ (setq orgpan-panel-buffer nil)
+ (setq orgpan-panel-window nil)
+ (orgpan-panel-minor-mode 0)
+ (remove-hook 'post-command-hook 'orgpan-minor-post-command)
+ (remove-hook 'post-command-hook 'orgpan-mode-post-command)
+ ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
+ )
+
+(defvar orgpan-from-panel 0)
+(defun orgpan-mode-pre-command ()
+ ;;(setq orgpan-from-panel nil)
+ (condition-case err
+ (if (not (and (windowp orgpan-org-window)
+ (window-live-p orgpan-org-window)))
+ (progn
+ (setq this-command 'ignore)
+ (orgpan-delete-panel)
+ (message "The window belonging to the panel had disappeared, removed panel."))
+ (let ((buf (window-buffer orgpan-org-window)))
+ (when (with-current-buffer buf
+ (derived-mode-p 'org-mode))
+ (setq orgpan-last-org-buffer buf))
+ ;; Fix me: add a list of those commands that are not
+ ;; meaningful from the panel (for example org-time-stamp)
+ (when (or (memq this-command orgpan-org-commands)
+ (memq this-command orgpan-org-mode-commands)
+ ;; For some reason not all org commands are found above:
+ (unless (eq this-command 'org-self-insert-command)
+ (let ((this-name (format "%s" this-command)))
+ (when (< 4 (length this-name))
+ (string= "org-" (substring this-name 0 4))))))
+ (if (not (with-current-buffer buf
+ (derived-mode-p 'org-mode)))
+ (progn
+ (if (buffer-live-p orgpan-org-buffer)
+ (set-window-buffer orgpan-org-window orgpan-org-buffer)
+ (message "Please use `l' or `b' to choose an org-mode buffer"))
+ (setq this-command 'ignore))
+ (setq orgpan-org-buffer (window-buffer orgpan-org-window))
+ (setq orgpan-from-panel 1)
+ (select-window orgpan-org-window)
+ ))))
+ (error (lwarn 't :warning "orgpan-pre: %S" err))))
+
+(defun orgpan-mode-post-command ()
+ (condition-case err
+ (progn
+ ;;(message "post %s" (current-time-string))(sit-for 1)
+ (unless (and (windowp orgpan-panel-window)
+ (window-live-p orgpan-panel-window)
+ (bufferp orgpan-panel-buffer)
+ (buffer-live-p orgpan-panel-buffer))
+ (orgpan-delete-panel))
+ (unless (active-minibuffer-window)
+ (when (and (= 1 orgpan-from-panel)
+ (windowp orgpan-panel-window)
+ (window-live-p orgpan-panel-window))
+ (select-window orgpan-panel-window)
+ (when (derived-mode-p 'orgpan-mode)
+ (setq deactivate-mark t)
+ (when orgpan-panel-buttons
+ (unless (and orgpan-point
+ (= (point) orgpan-point))
+ ;; Go backward so it is possible to click on a "button":
+ (orgpan-backward-field)))))
+ (when (< 0 orgpan-from-panel)
+ (setq orgpan-from-panel (1- orgpan-from-panel)))
+ (unless (eq (selected-window) orgpan-panel-window)
+ (orgpan-delete-panel))))
+ (error (lwarn 't :warning "orgpan-post: %S" err))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Commands
+
+(defun orgpan-last-buffer ()
+ "Open last org-mode buffer in panels org window."
+ (interactive)
+ (let ((buf (window-buffer orgpan-org-window))
+ (last-buf orgpan-last-org-buffer))
+;; (when (with-current-buffer buf
+;; (derived-mode-p 'org-mode))
+;; (setq orgpan-last-org-buffer buf))
+ (when (eq last-buf buf)
+ (setq last-buf nil))
+ (if (not last-buf)
+ (orgpan-switch-buffer)
+ (set-window-buffer orgpan-org-window last-buf))))
+
+(defun orgpan-switch-buffer ()
+ "Switch to next org-mode buffer in panels org window."
+ (interactive)
+ (let ((buf (window-buffer orgpan-org-window))
+ (org-buffers nil))
+ (with-current-buffer buf
+ (when (derived-mode-p 'org-mode)
+ (bury-buffer buf)
+ ;;(setq orgpan-last-org-buffer buf)
+ ))
+ (setq org-buffers (delq nil (mapcar (lambda (buf)
+ (when (with-current-buffer buf
+ (derived-mode-p 'org-mode))
+ buf))
+ (buffer-list))))
+ (setq org-buffers (delq buf org-buffers))
+ (if (not org-buffers)
+ (message "No other org-mode buffers")
+ (set-window-buffer orgpan-org-window (car org-buffers))
+ (setq orgpan-org-buffer (car org-buffers)))))
+
+(defcustom orgpan-cautious-cut-copy-paste nil
+ "Ask the user about panel cut, paste and copy before doing them.
+This refers to the functions `orgpan-paste-subtree',
+`orgpan-cut-subtree' and `orgpan-copy-subtree'."
+ :type 'boolean
+ :group 'orgpan)
+
+(defun orgpan-paste-subtree ()
+ (interactive)
+ (if orgpan-cautious-cut-copy-paste
+ (if (y-or-n-p "Paste subtree here? ")
+ (org-paste-subtree)
+ (message "Nothing was pasted"))
+ (org-paste-subtree)))
+
+(defun orgpan-cut-subtree ()
+ (interactive)
+ (let ((heading (progn
+ (org-back-to-heading)
+ (buffer-substring (point) (line-end-position))
+ )))
+ (if orgpan-cautious-cut-copy-paste
+ (if (y-or-n-p (format "Do you want to cut the subtree\n%s\n? " heading))
+ (org-cut-subtree)
+ (message "Nothing was cut"))
+ (org-cut-subtree))))
+
+(defun orgpan-copy-subtree ()
+ (interactive)
+ (let ((heading (progn
+ (org-back-to-heading)
+ (buffer-substring (point) (line-end-position))
+ )))
+ (if orgpan-cautious-cut-copy-paste
+ (if (y-or-n-p (format "Do you want to copy the subtree\n%s\n? " heading))
+ (org-copy-subtree)
+ (message "Nothing was copied"))
+ (org-copy-subtree))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Buttons
+
+(defvar orgpan-ovl-help nil)
+
+(defun orgpan-check-panel-mode ()
+ (unless (derived-mode-p 'orgpan-mode)
+ (error "Not orgpan-mode in buffer: %s" major-mode)))
+
+(defun orgpan-display-bindings-help ()
+ ;;(orgpan-check-panel-mode)
+ (setq orgpan-point (point-marker))
+ (let* ((ovls (overlays-at orgpan-point))
+ (ovl (car ovls))
+ (help (when ovl (overlay-get ovl 'orgpan-explain))))
+ (dolist (o (overlays-in (point-min) (point-max)))
+ (unless ovl (setq ovl o))
+ (overlay-put o 'face orgpan-field-face))
+ (overlay-put ovl 'face orgpan-active-field-face)
+ (unless orgpan-ovl-help
+ (setq orgpan-ovl-help (make-overlay orgpan-point orgpan-point)))
+ (overlay-put orgpan-ovl-help 'before-string help)))
+
+(defun orgpan-forward-field ()
+ (interactive)
+ (orgpan-check-panel-mode)
+ (let ((pos (next-overlay-change (point))))
+ (unless (overlays-at pos)
+ (setq pos (next-overlay-change pos)))
+ (when (= pos (point-max))
+ (setq pos (point-min))
+ (unless (overlays-at pos)
+ (setq pos (next-overlay-change pos))))
+ (goto-char pos))
+ (orgpan-display-bindings-help))
+
+(defun orgpan-backward-field ()
+ (interactive)
+ (orgpan-check-panel-mode)
+ (when (= (point) (point-min))
+ (goto-char (point-max)))
+ (let ((pos (previous-overlay-change (point))))
+ (unless (overlays-at pos)
+ (setq pos (previous-overlay-change pos)))
+ (goto-char pos))
+ (orgpan-display-bindings-help))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Mode
+(defun orgpan-agenda ()
+ "Start agenda"
+ (interactive)
+ (orgpan-delete-panel)
+ (call-interactively 'org-agenda))
+
+(defun orgpan-outline-up-heading (arg &optional invisible-ok)
+ (interactive "p")
+ (outline-back-to-heading invisible-ok)
+ (let ((start-level (funcall outline-level)))
+ (if (<= start-level 1)
+ (message "Already at top level of the outline")
+ (outline-up-heading arg invisible-ok))))
+
+(defvar orgpan-mode-map
+ ;; Fix-me: clean up here!
+ ;; Fix-me: viper support
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?q] 'orgpan-delete-panel)
+ (define-key map [??] 'orgpan-help)
+ (define-key map [?a] 'orgpan-agenda)
+ ;; Copying etc
+ (define-key map [?c] 'orgpan-copy-subtree)
+ (define-key map [?x] 'orgpan-cut-subtree)
+ (define-key map [?v] 'orgpan-paste-subtree)
+ (define-key map [?z] 'undo)
+ (define-key map [(control ?c)] 'orgpan-copy-subtree)
+ (define-key map [(control ?x)] 'orgpan-cut-subtree)
+ (define-key map [(control ?v)] 'orgpan-paste-subtree)
+ (define-key map [(control ?z)] 'undo)
+ ;; Buffers:
+ (define-key map [?b] 'orgpan-switch-buffer)
+ (define-key map [?l] 'orgpan-last-buffer)
+ (define-key map [?o] 'orgpan-find-org-file)
+ (define-key map [?w] 'save-buffer)
+ ;; Some keys for moving between headings. Emacs keys for next/prev
+ ;; line seems ok:
+ (define-key map [(control ?p)] 'outline-previous-visible-heading)
+ (define-key map [(control ?n)] 'outline-next-visible-heading)
+ (define-key map [(shift control ?p)] 'outline-backward-same-level)
+ (define-key map [(shift control ?n)] 'outline-forward-same-level)
+ ;; A mnemunic for up:
+ (define-key map [(control ?u)] 'orgpan-outline-up-heading)
+ ;; Search sparse tree:
+ (define-key map [?s] 'org-sparse-tree)
+ ;;(define-key map [?s] 'orgpan-occur)
+ ;;(define-key map [?s] 'org-occur)
+ ;; Same as in org-mode:
+ ;;(define-key map [(control ?c)(control ?v)] 'org-show-todo-tree)
+ ;; Fix-me: This leads to strange problems:
+ ;;(define-key map [t] 'ignore)
+ map))
+
+(defun orgpan-find-org-file ()
+ "Prompt for an .org file and open it."
+ (interactive)
+ (let ((file-name
+ (read-file-name
+ "Find .org file: " nil nil t nil
+ (lambda (fn)
+ (unless (backup-file-name-p fn)
+ (let ((ext (file-name-extension fn)))
+ (when ext
+ (string= "org" ext))))))))
+ (find-file file-name)))
+
+(defun orgpan-occur ()
+ "Replacement for `org-occur'.
+Technical reasons."
+ (interactive)
+ (let ((rgx (read-from-minibuffer "(panel) Regexp: ")))
+ (setq orgpan-from-panel 1)
+ (select-window orgpan-org-window)
+ (org-occur rgx)))
+
+(defun orgpan-sparse-tree (&optional arg)
+ "Create a sparse tree, prompt for the details.
+This command can create sparse trees. You first need to select the type
+of match used to create the tree:
+
+t Show entries with a specific TODO keyword.
+T Show entries selected by a tags match.
+p Enter a property name and its value (both with completion on existing
+ names/values) and show entries with that property.
+r Show entries matching a regular expression"
+ (interactive "P")
+ (let (ans kwd value)
+ (message "Sparse tree: [r]egexp [t]odo-kwd [T]ag [p]roperty")
+ (setq ans (read-char-exclusive))
+ (cond
+ ((equal ans ?t)
+ (org-show-todo-tree '(4)))
+ ((equal ans ?T)
+ (call-interactively 'org-tags-sparse-tree))
+ ((member ans '(?p ?P))
+ (setq kwd (completing-read "Property: "
+ (mapcar 'list (org-buffer-property-keys))))
+ (setq value (completing-read "Value: "
+ (mapcar 'list (org-property-values kwd))))
+ (unless (string-match "\\`{.*}\\'" value)
+ (setq value (concat "\"" value "\"")))
+ (org-tags-sparse-tree arg (concat kwd "=" value)))
+ ((member ans '(?r ?R))
+ (call-interactively 'org-occur))
+ (t (error "No such sparse tree command \"%c\"" ans)))))
+
+;; (defun orgpan-avoid-viper-in-buffer ()
+;; ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
+;; (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
+;; (set (make-local-variable 'viper-new-major-mode-buffer-list) nil)
+;; (local-set-key [?\ ] 'ignore))
+
+(define-derived-mode orgpan-mode nil "Org-Panel"
+ "Mode for org-simple.el control panel."
+ (set (make-local-variable 'buffer-read-only) t)
+ (unless orgpan-minor-mode-version
+ (add-hook 'pre-command-hook 'orgpan-mode-pre-command nil t)
+ (add-hook 'post-command-hook 'orgpan-mode-post-command t))
+ (set (make-local-variable 'cursor-type) nil)
+ (when (boundp 'yas/dont-activate) (setq yas/dont-activate t))
+ ;; Avoid emulation modes here (cua, viper):
+ (set (make-local-variable 'emulation-mode-map-alists) nil))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Panel layout
+
+(defun orgpan-insert-field (text keymap explain)
+ (insert text)
+ (let* ((end (point))
+ (len (length text))
+ (beg (- end len))
+ (ovl (make-overlay beg end)))
+ (overlay-put ovl 'face orgpan-field-face)
+ (overlay-put ovl 'keymap keymap)
+ (overlay-put ovl 'orgpan-explain explain)))
+
+(defconst orgpan-with-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map org-mode-map)
+ ;; Users are used to tabbing between fields:
+ (define-key map [(tab)] 'orgpan-forward-field)
+ (define-key map [(shift tab)] 'orgpan-backward-field)
+ (define-key map [backtab] 'orgpan-backward-field)
+ ;; Now we must use something else for visibility (first does not
+ ;; work if Viper):
+ (define-key map [(meta tab)] 'org-cycle)
+ (define-key map [(control meta tab)] 'org-global-cycle)
+ map))
+
+(defconst orgpan-without-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map org-mode-map)
+ ;; Visibility (those are in org-mode-map):
+ ;;(define-key map [tab] 'org-cycle)
+ ;;(define-key map [(shift tab)] 'org-global-cycle)
+ ;; Navigate:
+ (define-key map [left] 'orgpan-outline-up-heading)
+ (define-key map [right] 'org-cycle)
+ (define-key map [up] 'outline-previous-visible-heading)
+ (define-key map [down] 'outline-next-visible-heading)
+ (define-key map [(shift down)] 'outline-forward-same-level)
+ (define-key map [(shift up)] 'outline-backward-same-level)
+ ;; Restructure:
+ (define-key map [(control up)] 'org-move-subtree-up)
+ (define-key map [(control down)] 'org-move-subtree-down)
+ (define-key map [(control left)] 'org-do-promote)
+ (define-key map [(control right)] 'org-do-demote)
+ (define-key map [(control shift left)] 'org-promote-subtree)
+ (define-key map [(control shift right)] 'org-demote-subtree)
+ ;; Todo etc
+ (define-key map [?+] 'org-priority-up)
+ (define-key map [?-] 'org-priority-down)
+ (define-key map [?t] 'org-todo)
+ map))
+
+(defun orgpan-make-panel-without-buttons (buf)
+ (with-current-buffer buf
+ (insert (propertize "*Org Panel*" 'face 'orgpan-active-field))
+ (let ((ovl (make-overlay (point-min) (point-max))))
+ (overlay-put ovl 'priority 10)
+ (overlay-put ovl 'face 'orgpan-active-field))
+ (insert " ? for help, q quit\n")
+ (insert (propertize "arrows" 'face 'font-lock-keyword-face)
+ ": Go to, "
+ (propertize "C-arrows" 'face 'font-lock-keyword-face)
+ ": Edit tree\n"
+ (propertize "C-cxvz" 'face 'font-lock-keyword-face)
+ ": copy cut paste undo, "
+ (propertize "tT+-" 'face 'font-lock-keyword-face)
+ ": todo priority, "
+ (propertize "s" 'face 'font-lock-keyword-face)
+ ": search, "
+ (propertize "o" 'face 'font-lock-keyword-face)
+ ": open file\n"
+ (propertize "w" 'face 'font-lock-keyword-face)
+ ": write, "
+ (propertize "a" 'face 'font-lock-keyword-face)
+ ": agenda"
+ "\n"
+ )
+ (set-keymap-parent orgpan-mode-map orgpan-without-keymap)
+ (let ((ovl (make-overlay (point-min) (point-max))))
+ (overlay-put ovl 'face 'secondary-selection))
+ ))
+
+(defun orgpan-make-panel-with-buttons (buf)
+ (with-current-buffer buf
+ (let* ((base-map (make-sparse-keymap))
+ (space-line (propertize "\n\n" 'face 'orgpan-spaceline))
+ (arrow-face 'font-lock-keyword-face)
+ (L (propertize "left" 'face arrow-face))
+ (R (propertize "right" 'face arrow-face))
+ (U (propertize "up" 'face arrow-face))
+ (D (propertize "down" 'face arrow-face)))
+ ;;(message D)(sit-for 2)
+ (define-key base-map [left] 'ignore)
+ (define-key base-map [right] 'ignore)
+ (define-key base-map [up] 'ignore)
+ (define-key base-map [down] 'ignore)
+ (define-key base-map [?q] 'delete-window)
+ (define-key base-map [??] 'orgpan-help)
+ ;; Navigating
+ (let ((map (copy-keymap base-map)))
+ (define-key map [left] 'outline-up-heading)
+ (define-key map [right] 'org-cycle)
+ (define-key map [up] 'outline-previous-visible-heading)
+ (define-key map [down] 'outline-next-visible-heading)
+ (define-key map [(shift down)] 'outline-forward-same-level)
+ (define-key map [(shift up)] 'outline-backward-same-level)
+ (orgpan-insert-field "Navigate" map (concat U "/" D ", " L ": Go to, " R ": Visibility")))
+ (insert " ")
+ (let ((map (copy-keymap base-map)))
+ (define-key map [up] 'org-move-subtree-up)
+ (define-key map [down] 'org-move-subtree-down)
+ (define-key map [left] 'org-do-promote)
+ (define-key map [right] 'org-do-demote)
+ (define-key map [(shift left)] 'org-promote-subtree)
+ (define-key map [(shift right)] 'org-demote-subtree)
+ (orgpan-insert-field
+ "Restructure" map
+ (concat U "/" D ": "
+ (propertize "Move" 'face 'font-lock-warning-face)
+ ", " L "/" R ": "
+ (propertize "Level (w S: Subtree Level)" 'face 'font-lock-warning-face))))
+ (insert " ")
+ (let ((map (copy-keymap base-map)))
+ (define-key map [up] 'org-priority-up)
+ (define-key map [down] 'org-priority-down)
+ (define-key map [right] 'org-todo)
+ (orgpan-insert-field "TODO/priority" map
+ (concat R ": TODO, " U "/" D ": Priority")))
+ )
+ (insert " ? for help, q quit\n")
+ (orgpan-display-bindings-help)
+ (set-keymap-parent orgpan-mode-map orgpan-with-keymap)
+ ))
+
+(defun orgpan-make-panel-buffer ()
+ "Make the panel buffer."
+ (let* ((buf-name "*Org Panel*"))
+ (when orgpan-panel-buffer (kill-buffer orgpan-panel-buffer))
+ ;;(with-current-buffer orgpan-panel-buffer (orgpan-mode))
+ (setq orgpan-panel-buffer (get-buffer-create buf-name))
+ (if orgpan-panel-buttons
+ (orgpan-make-panel-with-buttons orgpan-panel-buffer)
+ (orgpan-make-panel-without-buttons orgpan-panel-buffer))
+ (with-current-buffer orgpan-panel-buffer
+ (orgpan-mode)
+ (goto-char (point-min)))
+ orgpan-panel-buffer))
+
+(defun orgpan-help ()
+ (interactive)
+ (set-keymap-parent orgpan-with-keymap nil)
+ (set-keymap-parent orgpan-without-keymap nil)
+ (describe-function 'orgpan-panel)
+ (set-keymap-parent orgpan-with-keymap org-mode-map)
+ (set-keymap-parent orgpan-without-keymap org-mode-map)
+ (message "Use 'l' to get back to last viewed org file"))
+
+(defcustom orgpan-panel-height 5
+ "Panel height"
+ :type '(choice (integer :tag "One line" 2)
+ (integer :tag "All lines" 5))
+ :group 'orgpan)
+
+(defun orgpan-panel ()
+ "Create a control panel for current `org-mode' buffer.
+The control panel may be used to quickly move around and change
+the headings. The idea is that when you want to to a lot of this
+kind of editing you should be able to do that with few
+keystrokes (and without having to remember the complicated
+keystrokes). A typical situation when this perhaps can be useful
+is when you are looking at your notes file \(usually ~/.notes,
+see `remember-data-file') where you have saved quick notes with
+`remember'.
+
+The keys below are defined in the panel. Note that the commands
+are carried out in the `org-mode' buffer that belongs to the
+panel.
+
+\\{orgpan-mode-map}
+
+In addition to the keys above most of the keys in `org-mode' can
+also be used from the panel.
+
+Note: There are two forms of the control panel, one with buttons
+and one without. The default is without, see
+`orgpan-panel-buttons'. If buttons are used choosing a different
+button changes the binding of the arrow keys."
+ (interactive)
+ (unless (derived-mode-p 'org-mode)
+ (error "Buffer is not in org-mode"))
+ (orgpan-delete-panel)
+ (unless orgpan-org-mode-commands
+ (map-keymap (lambda (ev def)
+ (when (and def
+ (symbolp def)
+ (fboundp def))
+ (setq orgpan-org-mode-commands
+ (cons def orgpan-org-mode-commands))))
+ org-mode-map))
+ (remq 'org-self-insert-command orgpan-org-mode-commands)
+ ;;(org-back-to-heading)
+ ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
+ (split-window)
+ (if orgpan-panel-at-top
+ (setq orgpan-org-window (next-window))
+ (setq orgpan-org-window (selected-window))
+ (select-window (next-window)))
+ (set-window-buffer (selected-window) (orgpan-make-panel-buffer))
+ (setq orgpan-panel-window (selected-window))
+ (set-window-dedicated-p orgpan-panel-window t)
+ (adjust-window-trailing-edge orgpan-org-window
+ (- (window-height) orgpan-panel-height) nil)
+ ;; The minor mode version starts here:
+ (when orgpan-minor-mode-version
+ (select-window orgpan-org-window)
+ (orgpan-panel-minor-mode 1)
+ (add-hook 'post-command-hook 'orgpan-minor-post-command t)))
+
+(define-minor-mode orgpan-panel-minor-mode
+ "Minor mode used in `org-mode' buffer when showing panel."
+ :keymap orgpan-mode-map
+ :lighter " PANEL"
+ :group 'orgpan
+ )
+
+(defun orgpan-minor-post-command ()
+ ;; Check org window and buffer
+ (if (and (windowp orgpan-org-window)
+ (window-live-p orgpan-org-window)
+ (eq orgpan-org-window (selected-window))
+ (derived-mode-p 'org-mode)
+ ;; Check panel window and buffer
+ (windowp orgpan-panel-window)
+ (window-live-p orgpan-panel-window)
+ (bufferp orgpan-panel-buffer)
+ (buffer-live-p orgpan-panel-buffer)
+ (eq (window-buffer orgpan-panel-window) orgpan-panel-buffer)
+ ;; Check minor mode
+ orgpan-panel-minor-mode)
+ (setq cursor-type nil)
+ (orgpan-delete-panel)))
+
+
+(provide 'org-panel)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; org-panel.el ends here
--- /dev/null
+;;; ourcomments-util.el --- Utility routines
+;;
+;; Author: Lennart Borgman <lennart dot borgman at gmail dot com>
+;; Created: Wed Feb 21 2007
+(defconst ourcomments-util:version "0.25") ;;Version:
+;; Last-Updated: 2009-08-04 Tue
+;; Keywords:
+;; Compatibility: Emacs 22
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; The functionality given by these small routines should in my
+;; opinion be part of Emacs (but they are not that currently).
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'apropos))
+(eval-when-compile (require 'bookmark))
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'grep))
+(eval-when-compile (require 'ido))
+(eval-when-compile (require 'org))
+(eval-when-compile (require 'recentf))
+(eval-when-compile (require 'uniquify))
+
+(require 'cus-edit)
+
+;; (ourcomments-indirect-fun 'html-mumamo)
+;; (ourcomments-indirect-fun 'html-mumamo-mode)
+;;;###autoload
+(defun ourcomments-indirect-fun (fun)
+ "Get the alias symbol for function FUN if any."
+ ;; This code is from `describe-function-1'.
+ (when (and (symbolp fun)
+ (functionp fun))
+ (let ((def (symbol-function fun)))
+ (when (symbolp def)
+ (while (and (fboundp def)
+ (symbolp (symbol-function def)))
+ (setq def (symbol-function def)))
+ def))))
+
+(defun ourcomments-goto-line (line)
+ "A version of `goto-line' for use in elisp code."
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Popups etc.
+
+(defun point-to-coord (point)
+ "Return coordinates of POINT in selected window.
+The coordinates are in the form \(\(XOFFSET YOFFSET) WINDOW).
+This form is suitable for `popup-menu'."
+ ;; Fix-me: showtip.el adds (window-inside-pixel-edges
+ ;; (selected-window)). Why?
+ (let* ((pn (posn-at-point point))
+ (x-y (posn-x-y pn))
+ (x (car x-y))
+ (y (cdr x-y))
+ (pos (list (list x (+ y 20)) (selected-window))))
+ pos))
+
+;;;###autoload
+(defun popup-menu-at-point (menu &optional prefix)
+ "Popup the given menu at point.
+This is similar to `popup-menu' and MENU and PREFIX has the same
+meaning as there. The position for the popup is however where
+the window point is."
+ (let ((where (point-to-coord (point))))
+ (popup-menu menu where prefix)))
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Toggles in menus
+
+;;;###autoload
+(defmacro define-toggle (symbol value doc &rest args)
+ "Declare SYMBOL as a customizable variable with a toggle function.
+The purpose of this macro is to define a defcustom and a toggle
+function suitable for use in a menu.
+
+The arguments have the same meaning as for `defcustom' with these
+restrictions:
+
+- The :type keyword cannot be used. Type is always 'boolean.
+- VALUE must be t or nil.
+
+DOC and ARGS are just passed to `defcustom'.
+
+A `defcustom' named SYMBOL with doc-string DOC and a function
+named SYMBOL-toggle is defined. The function toggles the value
+of SYMBOL. It takes no parameters.
+
+To create a menu item something similar to this can be used:
+
+ \(define-key map [SYMBOL]
+ \(list 'menu-item \"Toggle nice SYMBOL\"
+ 'SYMBOL-toggle
+ :button '(:toggle . SYMBOL)))"
+ (declare
+ (doc-string 3)
+ (debug t))
+ (let* ((SYMBOL-toggle (intern (concat (symbol-name symbol) "-toggle")))
+ (SYMBOL-name (symbol-name symbol))
+ (var-doc doc)
+ (fun-doc (concat "Toggles the \(boolean) value of `"
+ SYMBOL-name
+ "'.\n"
+ "For how to set it permanently see this variable.\n"
+ )))
+ (let ((var (append `(defcustom ,symbol ,value ,var-doc)
+ args
+ nil))
+ (fun `(defun ,SYMBOL-toggle ()
+ ,fun-doc
+ (interactive)
+ (customize-set-variable (quote ,symbol) (not ,symbol)))))
+ ;;(message "\nvar=%S\nfun=%S\n" var fun)
+ ;; Fix-me: I am having problems with this one, see
+ ;; http://lists.gnu.org/archive/html/help-gnu-emacs/2009-12/msg00608.html
+ `(progn ,var ,fun)
+ )))
+
+;;(macroexpand '(define-toggle my-toggle t "doc" :tag "Short help" :group 'popcmp))
+;;(macroexpand-all (define-toggle my-toggle t "doc" :tag "Short help" :group 'popcmp))
+
+;;;###autoload
+(defmacro define-toggle-old (symbol value doc &rest args)
+ (declare (doc-string 3))
+ (list
+ 'progn
+ (let ((var-decl (list 'custom-declare-variable
+ (list 'quote symbol)
+ (list 'quote value)
+ doc)))
+ (while args
+ (let ((arg (car args)))
+ (setq args (cdr args))
+ (unless (symbolp arg)
+ (error "Junk in args %S" args))
+ (let ((keyword arg)
+ (value (car args)))
+ (unless args
+ (error "Keyword %s is missing an argument" keyword))
+ (setq args (cdr args))
+ (cond
+ ((not (memq keyword '(:type)))
+ (setq var-decl (append var-decl (list keyword value))))
+ (t
+ (lwarn '(define-toggle) :error "Keyword %s can't be used here"
+ keyword))))))
+ (when (assoc :type var-decl) (error ":type is set. Should not happen!"))
+ (setq var-decl (append var-decl (list :type '(quote boolean))))
+ var-decl)
+ (let* ((SYMBOL-toggle (intern (concat (symbol-name symbol) "-toggle")))
+ (SYMBOL-name (symbol-name symbol))
+ (fun-doc (concat "Toggles the \(boolean) value of `"
+ SYMBOL-name
+ "'.\n"
+ "For how to set it permanently see this variable.\n"
+ ;;"\nDescription of `" SYMBOL-name "':\n" doc
+ )))
+ `(defun ,SYMBOL-toggle ()
+ ,fun-doc
+ (interactive)
+ (customize-set-variable (quote ,symbol) (not ,symbol)))
+ )))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Indentation of regions
+
+;; From an idea by weber <hugows@gmail.com>
+;; (defun indent-line-or-region ()
+;; "Indent line or region.
+;; Only do this if indentation seems bound to \\t.
+
+;; Call `indent-region' if region is active, otherwise
+;; `indent-according-to-mode'."
+;; (interactive)
+;; ;; Do a wild guess if we should indent or not ...
+;; (let* ((indent-region-mode)
+;; ;; The above hides the `indent-line-or-region' binding
+;; (t-bound (key-binding [?\t])))
+;; (if (not
+;; (save-match-data
+;; (string-match "indent" (symbol-name t-bound))))
+;; (call-interactively t-bound t)
+;; (if (and mark-active ;; there is a visible region selected
+;; transient-mark-mode)
+;; (indent-region (region-beginning) (region-end))
+;; (indent-according-to-mode))))) ;; indent line
+
+;; (define-minor-mode indent-region-mode
+;; "Use \\t to indent line or region.
+;; The key \\t is bound to `indent-line-or-region' if this mode is
+;; on."
+;; :global t
+;; :keymap '(([?\t] . indent-line-or-region)))
+;; (when indent-region-mode (indent-region-mode 1))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Minor modes
+
+;; (defmacro define-globalized-minor-mode-with-on-off (global-mode mode
+;; turn-on turn-off
+;; &rest keys)
+;; "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
+;; This is a special variant of `define-globalized-minor-mode' for
+;; mumamo. It let bounds the variable GLOBAL-MODE-checking before
+;; calling TURN-ON or TURN-OFF.
+
+;; TURN-ON is a function that will be called with no args in every buffer
+;; and that should try to turn MODE on if applicable for that buffer.
+;; TURN-OFF is a function that turns off MODE in a buffer.
+;; KEYS is a list of CL-style keyword arguments. As the minor mode
+;; defined by this function is always global, any :global keyword is
+;; ignored. Other keywords have the same meaning as in `define-minor-mode',
+;; which see. In particular, :group specifies the custom group.
+;; The most useful keywords are those that are passed on to the
+;; `defcustom'. It normally makes no sense to pass the :lighter
+;; or :keymap keywords to `define-globalized-minor-mode', since these
+;; are usually passed to the buffer-local version of the minor mode.
+
+;; If MODE's set-up depends on the major mode in effect when it was
+;; enabled, then disabling and reenabling MODE should make MODE work
+;; correctly with the current major mode. This is important to
+;; prevent problems with derived modes, that is, major modes that
+;; call another major mode in their body."
+
+;; (let* ((global-mode-name (symbol-name global-mode))
+;; (pretty-name (easy-mmode-pretty-mode-name mode))
+;; (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
+;; (group nil)
+;; (extra-keywords nil)
+;; (MODE-buffers (intern (concat global-mode-name "-buffers")))
+;; (MODE-enable-in-buffers
+;; (intern (concat global-mode-name "-enable-in-buffers")))
+;; (MODE-check-buffers
+;; (intern (concat global-mode-name "-check-buffers")))
+;; (MODE-cmhh (intern (concat global-mode-name "-cmhh")))
+;; (MODE-major-mode (intern (concat (symbol-name mode)
+;; "-major-mode")))
+;; (MODE-checking (intern (concat global-mode-name "-checking")))
+;; keyw)
+
+;; ;; Check keys.
+;; (while (keywordp (setq keyw (car keys)))
+;; (setq keys (cdr keys))
+;; (case keyw
+;; (:group (setq group (nconc group (list :group (pop keys)))))
+;; (:global (setq keys (cdr keys)))
+;; (t (push keyw extra-keywords) (push (pop keys) extra-keywords))))
+
+;; (unless group
+;; ;; We might as well provide a best-guess default group.
+;; (setq group
+;; `(:group ',(intern (replace-regexp-in-string
+;; "-mode\\'" "" (symbol-name mode))))))
+
+;; `(progn
+
+;; ;; Define functions for the global mode first so that it can be
+;; ;; turned on during load:
+
+;; ;; List of buffers left to process.
+;; (defvar ,MODE-buffers nil)
+
+;; ;; The function that calls TURN-ON in each buffer.
+;; (defun ,MODE-enable-in-buffers ()
+;; (let ((,MODE-checking nil))
+;; (dolist (buf ,MODE-buffers)
+;; (when (buffer-live-p buf)
+;; (with-current-buffer buf
+;; (if ,mode
+;; (unless (eq ,MODE-major-mode major-mode)
+;; (setq ,MODE-checking t)
+;; (,mode -1)
+;; (,turn-on)
+;; (setq ,MODE-checking nil)
+;; (setq ,MODE-major-mode major-mode))
+;; (setq ,MODE-checking t)
+;; (,turn-on)
+;; (setq ,MODE-checking nil)
+;; (setq ,MODE-major-mode major-mode)))))))
+;; (put ',MODE-enable-in-buffers 'definition-name ',global-mode)
+
+;; (defun ,MODE-check-buffers ()
+;; (,MODE-enable-in-buffers)
+;; (setq ,MODE-buffers nil)
+;; (remove-hook 'post-command-hook ',MODE-check-buffers))
+;; (put ',MODE-check-buffers 'definition-name ',global-mode)
+
+;; ;; The function that catches kill-all-local-variables.
+;; (defun ,MODE-cmhh ()
+;; (add-to-list ',MODE-buffers (current-buffer))
+;; (add-hook 'post-command-hook ',MODE-check-buffers))
+;; (put ',MODE-cmhh 'definition-name ',global-mode)
+
+
+;; (defvar ,MODE-major-mode nil)
+;; (make-variable-buffer-local ',MODE-major-mode)
+
+;; ;; The actual global minor-mode
+;; (define-minor-mode ,global-mode
+;; ,(format "Toggle %s in every possible buffer.
+;; With prefix ARG, turn %s on if and only if ARG is positive.
+;; %s is enabled in all buffers where `%s' would do it.
+;; See `%s' for more information on %s."
+;; pretty-name pretty-global-name pretty-name turn-on
+;; mode pretty-name)
+;; :global t ,@group ,@(nreverse extra-keywords)
+
+;; ;; Setup hook to handle future mode changes and new buffers.
+;; (if ,global-mode
+;; (progn
+;; (add-hook 'after-change-major-mode-hook
+;; ',MODE-enable-in-buffers)
+;; ;;(add-hook 'find-file-hook ',MODE-check-buffers)
+;; (add-hook 'find-file-hook ',MODE-cmhh)
+;; (add-hook 'change-major-mode-hook ',MODE-cmhh))
+;; (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
+;; ;;(remove-hook 'find-file-hook ',MODE-check-buffers)
+;; (remove-hook 'find-file-hook ',MODE-cmhh)
+;; (remove-hook 'change-major-mode-hook ',MODE-cmhh))
+
+;; ;; Go through existing buffers.
+;; (let ((,MODE-checking t))
+;; (dolist (buf (buffer-list))
+;; (with-current-buffer buf
+;; ;;(if ,global-mode (,turn-on) (when ,mode (,mode -1)))
+;; (if ,global-mode (,turn-on) (,turn-off))
+;; ))))
+
+;; )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Unfilling
+;;
+;; The idea is from
+;; http://interglacial.com/~sburke/pub/emacs/sburke_dot_emacs.config
+
+;;;###autoload
+(defun unfill-paragraph ()
+ "Unfill the current paragraph."
+ (interactive) (with-unfilling 'fill-paragraph))
+;;(defalias 'unwrap-paragraph 'unfill-paragraph)
+
+;;;###autoload
+(defun unfill-region ()
+ "Unfill the current region."
+ (interactive) (with-unfilling 'fill-region))
+;;(defalias 'unwrap-region 'unfill-region)
+
+;;;###autoload
+(defun unfill-individual-paragraphs ()
+ "Unfill individual paragraphs in the current region."
+ (interactive) (with-unfilling 'fill-individual-paragraphs))
+;;(defalias 'unwrap-individual-paragraphs 'unfill-individual-paragraphs)
+
+(defun with-unfilling (fn)
+ "Unfill using the fill function FN."
+ (let ((fill-column (1+ (point-max)))) (call-interactively fn)))
+
+(defvar fill-dwim-state nil)
+(defvar fill-dwim-mark nil)
+
+;;;###autoload
+(defun fill-dwim (arg)
+ "Fill or unfill paragraph or region.
+With prefix ARG fill only current line."
+ (interactive "P")
+ (or arg
+ (not fill-dwim-mark)
+ (equal (point-marker) fill-dwim-mark)
+ (setq fill-dwim-state nil))
+ (if mark-active
+ ;; This avoids deactivating the mark
+ (progn
+ (if fill-dwim-state
+ (call-interactively 'unfill-region)
+ (call-interactively 'fill-region))
+ (setq deactivate-mark nil))
+ (if arg
+ (fill-region (line-beginning-position) (line-end-position))
+ (if fill-dwim-state
+ (call-interactively 'unfill-paragraph)
+ (call-interactively 'fill-paragraph))))
+ (setq fill-dwim-mark (copy-marker (point)))
+ (unless arg
+ (setq fill-dwim-state (not fill-dwim-state))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Widgets
+
+;;;###autoload
+(defun ourcomments-mark-whole-buffer-or-field ()
+ "Mark whole buffer or editable field at point."
+ (interactive)
+ (let* ((field (widget-field-at (point)))
+ (from (when field (widget-field-start field)))
+ (to (when field (widget-field-end field)))
+ (size (when field (widget-get field :size))))
+ (if (not field)
+ (mark-whole-buffer)
+ (while (and size
+ (not (zerop size))
+ (> to from)
+ (eq (char-after (1- to)) ?\s))
+ (setq to (1- to)))
+ (push-mark (point))
+ (push-mark from nil t)
+ (goto-char to))))
+
+;; (rassq 'genshi-nxhtml-mumamo-mode mumamo-defined-turn-on-functions)
+;; (major-modep 'nxhtml-mode)
+;; (major-modep 'nxhtml-mumamo-mode)
+;; (major-modep 'jsp-nxhtml-mumamo-mode)
+;; (major-modep 'gsp-nxhtml-mumamo-mode)
+;; (major-modep 'asp-nxhtml-mumamo-mode)
+;; (major-modep 'django-nxhtml-mumamo-mode)
+;; (major-modep 'eruby-nxhtml-mumamo-mode)
+;; (major-modep 'eruby-nxhtml-mumamo-mode)
+;; (major-modep 'smarty-nxhtml-mumamo-mode)
+;; (major-modep 'embperl-nxhtml-mumamo-mode)
+;; (major-modep 'laszlo-nxml-mumamo-mode)
+;; (major-modep 'genshi-nxhtml-mumamo-mode)
+;; (major-modep 'javascript-mode)
+;; (major-modep 'espresso-mode)
+;; (major-modep 'css-mode)
+;; (major-modep 'js-mode)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Lines
+
+;; Changed from move-beginning-of-line to beginning-of-line to support
+;; physical-line-mode.
+;; Fix-me: use end-of-visual-line etc.
+;;;###autoload
+(defun ourcomments-move-beginning-of-line(arg)
+ "Move point to beginning of line or indentation.
+See `beginning-of-line' for ARG.
+
+If `line-move-visual' is non-nil then the visual line beginning
+is first tried.
+
+If in a widget field stay in that."
+ (interactive "p")
+ (let ((pos (point))
+ vis-pos
+ (field (widget-field-at (point))))
+ (when line-move-visual
+ (line-move-visual -1 t)
+ (beginning-of-line)
+ (setq vis-pos (point))
+ (goto-char pos))
+ (call-interactively 'beginning-of-line arg)
+ (when (and vis-pos
+ (= vis-pos (point)))
+ (while (and (> pos (point))
+ (not (eobp)))
+ (let (last-command)
+ (line-move-visual 1 t)))
+ (line-move-visual -1 t))
+ (when (= pos (point))
+ (if (= 0 (current-column))
+ (skip-chars-forward " \t")
+ (backward-char)
+ (beginning-of-line)))
+ (when (and field
+ (< (point) (widget-field-start field)))
+ (goto-char (widget-field-start field)))))
+(put 'ourcomments-move-beginning-of-line 'CUA 'move)
+
+;;;###autoload
+(defun ourcomments-move-end-of-line(arg)
+ "Move point to end of line or after last non blank char.
+See `end-of-line' for ARG.
+
+Similar to `ourcomments-move-beginning-of-line' but for end of
+line."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (let ((pos (point))
+ vis-pos
+ eol-pos)
+ (when line-move-visual
+ (let (last-command) (line-move-visual 1 t))
+ (end-of-line)
+ (setq vis-pos (point))
+ (goto-char pos))
+ (call-interactively 'end-of-line arg)
+ (when (and vis-pos
+ (= vis-pos (point)))
+ (setq eol-pos (point))
+ (beginning-of-line)
+ (let (last-command) (line-move-visual 1 t))
+ ;; move backwards if we moved to a new line
+ (unless (= (point) eol-pos)
+ (backward-char)))
+ (when (= pos (point))
+ (if (= (line-end-position) (point))
+ (skip-chars-backward " \t")
+ (forward-char)
+ (end-of-line)))))
+(put 'ourcomments-move-end-of-line 'CUA 'move)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Keymaps
+
+(defun ourcomments-find-keymap-variables (key--- binding--- keymap---)
+ "Return a list of matching keymap variables.
+They should have key KEY--- bound to BINDING--- and have value
+KEYMAP---.
+
+Ignore `special-event-map', `global-map', `overriding-local-map'
+and `overriding-terminal-local-map'."
+ (let ((vars--- nil)
+ (ancestors--- nil))
+ (let ((parent (keymap-parent keymap---)))
+ (while parent
+ (setq ancestors--- (cons parent ancestors---))
+ (setq parent (keymap-parent parent))))
+ (mapatoms (lambda (symbol)
+ (unless (memq symbol '(keymap---
+ ancestors---
+ vars---
+ special-event-map
+ global-map
+ overriding-local-map
+ overriding-terminal-local-map
+ ))
+ (let (val)
+ (if (boundp symbol)
+ (setq val (symbol-value symbol))
+ (when (keymapp symbol)
+ (setq val (symbol-function symbol))))
+ (when (and val
+ (keymapp val)
+ (eq binding--- (lookup-key val key--- t)))
+ (if (equal val keymap---)
+ (push symbol vars---)
+ (when ancestors---
+ (catch 'found
+ (dolist (ancestor ancestors---)
+ (when (equal val ancestor)
+ (push symbol vars---)
+ (throw 'found nil)))))))))))
+;;; (let ((childs nil))
+;;; (dolist (var vars---)
+;;; (dolist (ancestor ancestors---)
+;;; (when (equal (keymap-parent var)
+;;; (
+ vars---))
+
+;; This is modelled after `current-active-maps'.
+(defun key-bindings (key &optional olp position)
+ "Return list of bindings for key sequence KEY in current keymaps.
+The first binding is the active binding and the others are
+bindings shadowed by this in the order of their priority level
+\(see Info node `(elisp) Searching Keymaps').
+
+The entries in the list have the form
+
+ \(BINDING (MAPS) MORE-INFO)
+
+where BINDING is the command bound to and MAPS are matching maps
+\(according to `ourcomments-find-keymap-variables').
+
+MORE-INFO is a list with more information
+
+ \(PRIORITY-LEVEL \[ACTIVE-WHEN])
+
+where PRIORITY-LEVEL is a symbol matching the level where the
+keymap is found and ACTIVE-WHEN is a symbol which must be non-nil
+for the keymap to be active \(minor mode levels only)."
+ ;;(message "\nkey-bindings %s %s %s" key olp position)
+ (let* ((bindings nil)
+ (maps (current-active-maps))
+ map
+ map-sym
+ map-rec
+ binding
+ keymaps
+ minor-maps
+ where
+ map-where
+ where-map
+ (local-map (current-local-map))
+ (pt (or position (point)))
+ (point-keymap (get-char-property pt 'keymap))
+ (point-local-map (get-char-property pt 'local-map))
+ )
+ (setq keymaps
+ (cons (list global-map 'global-map)
+ keymaps))
+ (when overriding-terminal-local-map
+ (setq keymaps
+ (cons (list overriding-terminal-local-map 'overriding-terminal-local-map)
+ keymaps)))
+ (when overriding-local-map
+ (setq keymaps
+ (cons (list overriding-local-map 'overriding-local-map)
+ keymaps)))
+ (unless (cdr keymaps)
+ (when point-local-map
+ (setq keymaps
+ (cons (list point-local-map 'point-local-map)
+ keymaps)))
+ ;; Fix-me:
+ ;;/* If on a mode line string with a local keymap,
+
+ (when local-map
+ (setq keymaps
+ (cons (list local-map 'local-map)
+ keymaps)))
+
+ ;; Minor-modes
+ ;;(message "================ Minor-modes")
+ (dolist (list '(emulation-mode-map-alists
+ minor-mode-overriding-map-alist
+ minor-mode-map-alist))
+ ;;(message "------- %s" list)
+ (let ((alists (if (eq list 'emulation-mode-map-alists)
+ (symbol-value list)
+ (list (symbol-value list)))))
+ (dolist (alist alists)
+ ;;(message "\n(symbolp alist)=%s alist= %s (symbol-value alist)=%s" (symbolp alist) "dum" "dum2") ;alist "dummy");(when (symbolp alist) (symbol-value alist)))
+ (when (symbolp alist)
+ (setq alist (symbol-value alist)))
+ (dolist (assoc alist)
+ (let* (;(assoc (car alist-rec))
+ (var (when (consp assoc) (car assoc)))
+ (val (when (and (symbolp var)
+ (boundp var))
+ (symbol-value var))))
+ ;;(message "var= %s, val= %s" var val)
+ (when (and
+ val
+ (or (not (eq list 'minor-mode-map-alist))
+ (not (assq var minor-mode-overriding-map-alist))))
+ ;;(message "** Adding this")
+ (setq minor-maps
+ (cons (list (cdr assoc) list var)
+ minor-maps)))
+ )))))
+ (dolist (map minor-maps)
+ ;;(message "cdr map= %s" (cdr map))
+ (setq keymaps
+ (cons map
+ keymaps)))
+ (when point-keymap
+ (setq keymaps
+ (cons (list point-keymap 'point-keymap)
+ keymaps))))
+
+ ;; Fix-me: compare with current-active-maps
+ (let ((ca-maps (current-active-maps))
+ (wh-maps keymaps)
+ ca
+ wh)
+ (while (or ca-maps wh-maps)
+ (setq ca (car ca-maps))
+ (setq wh (car wh-maps))
+ (setq ca-maps (cdr ca-maps))
+ (setq wh-maps (cdr wh-maps))
+ ;;(message "\nca= %s" ca)
+ ;;(message "cdr wh= %s" (cdr wh))
+ (unless (equal ca (car wh))
+ (error "Did not match: %s" (cdr wh)))))
+
+ (while keymaps
+ (setq map-rec (car keymaps))
+ (setq map (car map-rec))
+ (when (setq binding (lookup-key map key t))
+ (setq map-sym (ourcomments-find-keymap-variables key binding map))
+ (setq map-sym (delq 'map map-sym))
+ (setq map-sym (delq 'local-map map-sym))
+ (setq map-sym (delq 'point-keymap map-sym))
+ (setq map-sym (delq 'point-local-map map-sym))
+ (setq bindings (cons (list binding map-sym (cdr map-rec)) bindings)))
+ (setq keymaps (cdr keymaps)))
+
+ (nreverse bindings)))
+
+(defun describe-keymap-placement (keymap-sym)
+ "Find minor mode keymap KEYMAP-SYM in the keymaps searched for key lookup.
+See Info node `Searching Keymaps'."
+ ;;(info "(elisp) Searching Keymaps")
+ (interactive (list (ourcomments-read-symbol "Describe minor mode keymap symbol"
+ (lambda (sym)
+ (and (boundp sym)
+ (keymapp (symbol-value sym)))))))
+ (unless (symbolp keymap-sym)
+ (error "Argument KEYMAP-SYM must be a symbol"))
+ (unless (keymapp (symbol-value keymap-sym))
+ (error "The value of argument KEYMAP-SYM must be a keymap"))
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'describe-keymap-placement keymap-sym) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert "Placement of keymap `")
+ (insert-text-button (symbol-name keymap-sym)
+ 'action
+ (lambda (btn)
+ (describe-variable keymap-sym)))
+ (insert "'\nin minor modes activation maps:\n")
+ (let (found)
+ (dolist (map-root '(emulation-mode-map-alists
+ minor-mode-overriding-map-alist
+ minor-mode-map-alist
+ ))
+ (dolist (emul-alist (symbol-value map-root))
+ ;;(message "emul-alist=%s" emul-alist)
+ (dolist (keymap-alist
+ (if (memq map-root '(emulation-mode-map-alists))
+ (symbol-value emul-alist)
+ (list emul-alist)))
+ (let* ((map (cdr keymap-alist))
+ (first (catch 'first
+ (map-keymap (lambda (key def)
+ (throw 'first (cons key def)))
+ map)))
+ (key (car first))
+ (def (cdr first))
+ (keymap-variables (when (and key def)
+ (ourcomments-find-keymap-variables
+ (vector key) def map)))
+ (active-var (car keymap-alist))
+ )
+ (assert (keymapp map))
+ ;;(message "keymap-alist=%s, %s" keymap-alist first)
+ ;;(message "active-var=%s, %s" active-var keymap-variables)
+ (when (memq keymap-sym keymap-variables)
+ (setq found t)
+ (insert (format "\n`%s' " map-root))
+ (insert (propertize "<= Minor mode keymap list holding this map"
+ 'face 'font-lock-doc-face))
+ (insert "\n")
+ (when (symbolp emul-alist)
+ (insert (format " `%s' " emul-alist))
+ (insert (propertize "<= Keymap alist variable" 'face 'font-lock-doc-face))
+ (insert "\n"))
+ ;;(insert (format " `%s'\n" keymap-alist))
+ (insert (format " `%s' " active-var))
+ (insert (propertize "<= Activation variable" 'face 'font-lock-doc-face))
+ (insert "\n")
+ )))))
+ (unless found
+ (insert (propertize "Not found." 'face 'font-lock-warning-face)))
+ ))))
+
+;; This is a replacement for describe-key-briefly.
+;;(global-set-key [f1 ?c] 'describe-key-and-map-briefly)
+;;;###autoload
+(defun describe-key-and-map-briefly (&optional key insert untranslated)
+ "Try to print names of keymap from which KEY fetch its definition.
+Look in current active keymaps and find keymap variables with the
+same value as the keymap where KEY is bound. Print a message
+with those keymap variable names. Return a list with the keymap
+variable symbols.
+
+When called interactively prompt for KEY.
+
+INSERT and UNTRANSLATED should normall be nil (and I am not sure
+what they will do ;-)."
+ ;; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ;; From describe-key-briefly. Keep this as it is for easier update.
+ (interactive
+ (let ((enable-disabled-menus-and-buttons t)
+ (cursor-in-echo-area t)
+ saved-yank-menu)
+ (unwind-protect
+ (let (key)
+ ;; If yank-menu is empty, populate it temporarily, so that
+ ;; "Select and Paste" menu can generate a complete event.
+ (when (null (cdr yank-menu))
+ (setq saved-yank-menu (copy-sequence yank-menu))
+ (menu-bar-update-yank-menu "(any string)" nil))
+ (setq key (read-key-sequence "Describe key (or click or menu item): "))
+ ;; If KEY is a down-event, read and discard the
+ ;; corresponding up-event. Note that there are also
+ ;; down-events on scroll bars and mode lines: the actual
+ ;; event then is in the second element of the vector.
+ (and (vectorp key)
+ (let ((last-idx (1- (length key))))
+ (and (eventp (aref key last-idx))
+ (memq 'down (event-modifiers (aref key last-idx)))))
+ (read-event))
+ (list
+ key
+ (if current-prefix-arg (prefix-numeric-value current-prefix-arg))
+ 1
+ ))
+ ;; Put yank-menu back as it was, if we changed it.
+ (when saved-yank-menu
+ (setq yank-menu (copy-sequence saved-yank-menu))
+ (fset 'yank-menu (cons 'keymap yank-menu))))))
+ (if (numberp untranslated)
+ (setq untranslated (this-single-command-raw-keys)))
+ (let* ((event (if (and (symbolp (aref key 0))
+ (> (length key) 1)
+ (consp (aref key 1)))
+ (aref key 1)
+ (aref key 0)))
+ (modifiers (event-modifiers event))
+ (standard-output (if insert (current-buffer) t))
+ (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
+ (memq 'drag modifiers)) " at that spot" ""))
+ (defn (key-binding key t))
+ key-desc)
+ ;; Handle the case where we faked an entry in "Select and Paste" menu.
+ (if (and (eq defn nil)
+ (stringp (aref key (1- (length key))))
+ (eq (key-binding (substring key 0 -1)) 'yank-menu))
+ (setq defn 'menu-bar-select-yank))
+ ;; Don't bother user with strings from (e.g.) the select-paste menu.
+ (if (stringp (aref key (1- (length key))))
+ (aset key (1- (length key)) "(any string)"))
+ (if (and (> (length untranslated) 0)
+ (stringp (aref untranslated (1- (length untranslated)))))
+ (aset untranslated (1- (length untranslated)) "(any string)"))
+ ;; Now describe the key, perhaps as changed.
+ (setq key-desc (help-key-description key untranslated))
+ ;;
+ ;; End of part from describe-key-briefly.
+ ;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+ ;;(message "bindings=%s" (key-bindings key)) (sit-for 2)
+ ;; Find the keymap:
+ (let* ((maps (current-active-maps))
+ ret
+ lk)
+ (if (or (null defn) (integerp defn) (equal defn 'undefined))
+ (setq ret 'not-defined)
+ (catch 'mapped
+ (while (< 1 (length maps))
+ (setq lk (lookup-key (car maps) key t))
+ (when (and lk (not (numberp lk)))
+ (setq ret (ourcomments-find-keymap-variables key lk (car maps)))
+ (when ret
+ (throw 'mapped (car maps))))
+ (setq maps (cdr maps))))
+ (unless ret
+ (setq lk (lookup-key global-map key t))
+ (when (and lk (not (numberp lk)))
+ (setq ret '(global-map)))))
+ (cond
+ ((eq ret 'not-defined)
+ (message "%s%s not defined in any keymap" key-desc mouse-msg))
+ ((listp ret)
+ (if (not ret)
+ (message "%s%s is bound to `%s', but don't know where"
+ key-desc mouse-msg defn)
+ (if (= 1 (length ret))
+ (message "%s%s is bound to `%s' in `%s'"
+ key-desc mouse-msg defn (car ret))
+ (message "%s%s is bound to `%s' in keymap variables `%s'"
+ key-desc mouse-msg defn ret))))
+ (t
+ (error "ret=%s" ret)))
+ ret)))
+
+;; (ourcomments-find-keymap-variables (current-local-map))
+;; (keymapp 'ctl-x-4-prefix)
+;; (equal 'ctl-x-4-prefix (current-local-map))
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Fringes.
+
+(defvar better-bottom-angles-defaults nil)
+(defun better-fringes-bottom-angles (on)
+ ;;(bottom bottom-left-angle bottom-right-angle top-right-angle top-left-angle)
+ (if (not on)
+ (when better-bottom-angles-defaults
+ (set-default 'fringe-indicator-alist better-bottom-angles-defaults))
+ (unless better-bottom-angles-defaults
+ (setq better-bottom-angles-defaults fringe-indicator-alist))
+ (let ((better
+ '(bottom
+ bottom-right-angle bottom-right-angle
+ bottom-left-angle bottom-left-angle
+ ))
+ ;;(indicators (copy-list fringe-indicator-alist)))
+ (indicators (copy-sequence fringe-indicator-alist)))
+ (setq indicators (assq-delete-all 'bottom indicators))
+ (set-default 'fringe-indicator-alist (cons better indicators)))))
+
+(defun better-fringes-faces (face face-important)
+ (dolist (bitmap '(bottom-left-angle
+ bottom-right-angle
+ top-left-angle
+ top-right-angle
+
+ right-curly-arrow
+ left-arrow right-arrow
+ left-curly-arrow right-curly-arrow
+ up-arrow
+ down-arrow
+ left-bracket right-bracket
+ empty-line))
+ (set-fringe-bitmap-face bitmap face))
+ (dolist (bitmap '(right-triangle
+ question-mark))
+ (set-fringe-bitmap-face bitmap face-important)))
+
+(defface better-fringes-bitmap
+ '((t (:foreground "dark khaki")))
+ "Face for bitmap fringes."
+ :group 'better-fringes
+ :group 'nxhtml)
+
+(defface better-fringes-important-bitmap
+ '((t (:foreground "red")))
+ "Face for bitmap fringes."
+ :group 'better-fringes
+ :group 'nxhtml)
+
+;;;###autoload
+(define-minor-mode better-fringes-mode
+ "Choose another fringe bitmap color and bottom angle."
+ :global t
+ :group 'better-fringes
+ (if better-fringes-mode
+ (progn
+ (better-fringes-faces 'better-fringes-bitmap
+ 'better-fringes-important-bitmap)
+ (better-fringes-bottom-angles t))
+ (better-fringes-faces nil nil)
+ (better-fringes-bottom-angles nil)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Copy+paste
+
+;; After an idea from andrea on help-gnu-emacs
+
+(defvar ourcomments-copy+paste-point nil)
+
+;;(global-set-key [(control ?c) ?y] 'ourcomments-copy+paste-set-point)
+;;;###autoload
+(defun ourcomments-copy+paste-set-point ()
+ "Set point for copy+paste here.
+Enable temporary minor mode `ourcomments-copy+paste-mode'.
+However if point for copy+paste already is set then cancel it and
+disable the minor mode.
+
+The purpose of this command is to make it easy to grab a piece of
+text and paste it at current position. After this command you
+should select a piece of text to copy and then call the command
+`ourcomments-copy+paste'."
+ (interactive)
+ (if ourcomments-copy+paste-point
+ (ourcomments-copy+paste-mode -1)
+ (setq ourcomments-copy+paste-point (list (copy-marker (point))
+ (selected-window)
+ (current-frame-configuration)
+ ))
+ (ourcomments-copy+paste-mode 1)
+ (let ((key (where-is-internal 'ourcomments-copy+paste))
+ (ckeys (key-description (this-command-keys))))
+ (setq key (if key (key-description (car key))
+ "M-x ourcomments-copy+paste"))
+ (when (> (length ckeys) 12)
+ (setq ckeys "this command"))
+ (message "Paste point set; select region and do %s to copy+paste (or cancel with %s)" key ckeys))))
+
+(defvar ourcomments-copy+paste-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Bind the copy+paste command to C-S-v which reminds of cua-paste
+ ;; binding and is hopefully not bound.
+ (define-key map [(control shift ?v)] 'ourcomments-copy+paste)
+ map))
+
+(define-minor-mode ourcomments-copy+paste-mode
+ "Temporary mode for copy+paste.
+This minor mode is enabled by `ourcomments-copy+paste-set-point'.
+
+When this mode is active there is a key binding for
+`ourcomments-copy+paste':
+\\<ourcomments-copy+paste-mode-map>
+\\[ourcomments-copy+paste]
+
+You should not turn on this minor mode yourself. It is turned on
+by `ourcomments-copy+paste-set-point'. For more information see
+that command."
+ :lighter " COPY+PASTE"
+ :global t
+ :group 'ourcomments-util
+ (if ourcomments-copy+paste-mode
+ (unless ourcomments-copy+paste-point
+ (message "Do not call this minor mode, use `ourcomments-copy+paste-set-point'.")
+ (setq ourcomments-copy+paste-mode nil))
+ (when ourcomments-copy+paste-point
+ (setq ourcomments-copy+paste-point nil)
+ (message "Canceled copy+paste mode"))))
+
+(defvar ourcomments-copy+paste-ovl nil)
+
+(defun ourcomments-copy+paste-cancel-highlight ()
+ (when (overlayp ourcomments-copy+paste-ovl)
+ (delete-overlay ourcomments-copy+paste-ovl))
+ (setq ourcomments-copy+paste-ovl nil))
+
+(defun ourcomments-copy+paste (restore-frames)
+ "Copy region to copy+paste point set by `ourcomments-copy+paste-set-point'.
+Also if prefix argument is given then restore frame configuration
+at the time that command was called. Otherwise look for the
+buffer for copy+paste point in current frame. If found select
+that window. If not then use `switch-to-buffer-other-window' to
+display it."
+ (interactive "P")
+ (cond
+ ((not ourcomments-copy+paste-point)
+ (let ((key (where-is-internal 'ourcomments-copy+paste-set-point)))
+ (setq key (if key (key-description (car key))
+ "M-x ourcomments-copy+paste-set-point"))
+ (message "Please select destination of copy+paste first with %s" key)))
+ ((not mark-active)
+ (message "Please select a region to copy+paste first"))
+ (t
+ ;;(copy-region-as-kill (region-beginning) (region-end))
+ (clipboard-kill-ring-save (region-beginning) (region-end))
+ (let* ((marker (nth 0 ourcomments-copy+paste-point))
+ (orig-win (nth 1 ourcomments-copy+paste-point))
+ (orig-fcfg (nth 2 ourcomments-copy+paste-point))
+ (buf (marker-buffer marker))
+ (win (or (when (window-live-p orig-win) orig-win)
+ (get-buffer-window buf))))
+ (message "win=%s, buf=%s" win buf)
+ (cond (restore-frames
+ (set-frame-configuration orig-fcfg))
+ ((and win (eq (window-buffer win) buf))
+ (select-window win))
+ (t
+ (switch-to-buffer-other-window buf)))
+ (goto-char marker))
+ (let ((here (point))
+ ovl)
+ (yank)
+ (setq ovl (make-overlay here (point)))
+ (overlay-put ovl 'face 'highlight)
+ (run-with-idle-timer 2 nil 'ourcomments-copy+paste-cancel-highlight)
+ (setq ourcomments-copy+paste-ovl ovl))
+ (setq ourcomments-copy+paste-point nil)
+ (ourcomments-copy+paste-mode -1))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Misc.
+
+;;(describe-timers)
+;;;###autoload
+(defun describe-timers ()
+ "Show timers with readable time format."
+ (interactive)
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'ourcommenst-show-timers) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert (format-time-string "Timers at %Y-%m-%d %H:%M:%S\n\n" (current-time)))
+ (if (not timer-list)
+ (insert " None\n")
+ (insert (propertize
+ " When Rpt What\n"
+ 'face 'font-lock-doc-face))
+ (dolist (tmr timer-list)
+ (let* ((hi-sec (timer--high-seconds tmr))
+ (lo-sec (timer--low-seconds tmr))
+ (mi-sec (timer--usecs tmr))
+ (fun (timer--function tmr))
+ (args (timer--args tmr))
+ (idle-d (timer--idle-delay tmr))
+ (rpt-d (timer--repeat-delay tmr))
+ (time (concat (format-time-string " %Y-%m-%d %H:%M:%S" (list hi-sec lo-sec 0))
+ (substring
+ (format "%.1f" (/ mi-sec 1000000.0))
+ 1))))
+ (assert (not idle-d) t)
+ (insert (format "%s %4s (`%-3s' %S)\n" time rpt-d fun args)))))
+ (insert "\nIdle timers:\n\n")
+ (if (not timer-idle-list)
+ (insert " None\n")
+ (insert (propertize
+ " After Rpt What\n"
+ 'face 'font-lock-doc-face))
+ (dolist (tmr timer-idle-list)
+ (let* ((hi-sec (timer--high-seconds tmr))
+ (lo-sec (timer--low-seconds tmr))
+ (mi-sec (timer--usecs tmr))
+ (fun (timer--function tmr))
+ (args (timer--args tmr))
+ (idle-d (timer--idle-delay tmr))
+ (rpt-d (timer--repeat-delay tmr))
+ (time (+ (* hi-sec 256 256) lo-sec (/ mi-sec 1000000.0)))
+ )
+ (assert (not (not idle-d)) t)
+ (insert (format " %.2f sec %3s (`%s' %S)\n" time rpt-d fun args))))))))
+
+(defcustom ourcomments-insert-date-and-time "%Y-%m-%d %R"
+ "Time format for command `ourcomments-insert-date-and-time'.
+See `format-time-string'."
+ :type 'string
+ :group 'ourcomments-util)
+
+;;;###autoload
+(defun ourcomments-insert-date-and-time ()
+ "Insert date and time.
+See option `ourcomments-insert-date-and-time' for how to
+customize it."
+ (interactive)
+ (insert (format-time-string ourcomments-insert-date-and-time)))
+
+;;;###autoload
+(defun find-emacs-other-file (display-file)
+ "Find corresponding file to source or installed elisp file.
+If you have checked out and compiled Emacs yourself you may have
+Emacs lisp files in two places, the checked out source tree and
+the installed Emacs tree. If buffer contains an Emacs elisp file
+in one of these places then find the corresponding elisp file in
+the other place. Return the file name of this file.
+
+Rename current buffer using your `uniquify-buffer-name-style' if
+it is set.
+
+When DISPLAY-FILE is non-nil display this file in other window
+and go to the same line number as in the current buffer."
+ (interactive (list t))
+ (unless (buffer-file-name)
+ (error "This buffer is not visiting a file"))
+ (unless source-directory
+ (error "Can't find the checked out Emacs sources"))
+ (let* ((installed-directory (file-name-as-directory
+ (expand-file-name ".." exec-directory)))
+ (relative-installed (file-relative-name
+ (buffer-file-name) installed-directory))
+ (relative-source (file-relative-name
+ (buffer-file-name) source-directory))
+ (name-nondir (file-name-nondirectory (buffer-file-name)))
+ source-file
+ installed-file
+ other-file
+ (line-num (save-restriction
+ (widen)
+ (line-number-at-pos))))
+ (cond
+ ((and relative-installed
+ (not (string= name-nondir relative-installed))
+ (not (file-name-absolute-p relative-installed))
+ (not (string= ".." (substring relative-installed 0 2))))
+ (setq source-file (expand-file-name relative-installed source-directory)))
+ ((and relative-source
+ (not (string= name-nondir relative-source))
+ (not (file-name-absolute-p relative-source))
+ (not (string= ".." (substring relative-source 0 2))))
+ (setq installed-file (expand-file-name relative-source installed-directory))))
+ (setq other-file (or source-file installed-file))
+ (unless other-file
+ (error "This file is not in Emacs source or installed lisp tree"))
+ (unless (file-exists-p other-file)
+ (error "Can't find the corresponding file %s" other-file))
+ (when display-file
+ (when uniquify-buffer-name-style
+ (rename-buffer (file-name-nondirectory buffer-file-name) t))
+ (find-file-other-window other-file)
+ (ourcomments-goto-line line-num))
+ other-file))
+
+;;;###autoload
+(defun ourcomments-ediff-files (def-dir file-a file-b)
+ "In directory DEF-DIR run `ediff-files' on files FILE-A and FILE-B.
+The purpose of this function is to make it eaiser to start
+`ediff-files' from a shell through Emacs Client.
+
+This is used in EmacsW32 in the file ediff.cmd where Emacs Client
+is called like this:
+
+ @%emacs_client% -e \"(setq default-directory \\\"%emacs_cd%\\\")\"
+ @%emacs_client% -n -e \"(ediff-files \\\"%f1%\\\" \\\"%f2%\\\")\"
+
+It can of course be done in a similar way with other shells."
+ (let ((default-directory def-dir))
+ (ediff-files file-a file-b)))
+
+
+(defun ourcomments-latest-changelog ()
+ "not ready"
+ (let ((changelogs
+ '("ChangeLog"
+ "admin/ChangeLog"
+ "doc/emacs/ChangeLog"
+ "doc/lispintro/ChangeLog"
+ "doc/lispref/ChangeLog"
+ "doc/man/ChangeLog"
+ "doc/misc/ChangeLog"
+ "etc/ChangeLog"
+ "leim/ChangeLog"
+ "lib-src/ChangeLog"
+ "lisp/ChangeLog"
+ "lisp/erc/ChangeLog"
+ "lisp/gnus/ChangeLog"
+ "lisp/mh-e/ChangeLog"
+ "lisp/org/ChangeLog"
+ "lisp/url/ChangeLog"
+ "lwlib/ChangeLog"
+ "msdos/ChangeLog"
+ "nextstep/ChangeLog"
+ "nt/ChangeLog"
+ "oldXMenu/ChangeLog"
+ "src/ChangeLog"
+ "test/ChangeLog"))
+ (emacs-root (expand-file-name ".." exec-directory)
+ ))))
+
+(defun ourcomments-read-symbol (prompt predicate)
+ "Basic function for reading a symbol for describe-* functions.
+Prompt with PROMPT and show only symbols satisfying function
+PREDICATE. PREDICATE takes one argument, the symbol."
+ (let* ((symbol (symbol-at-point))
+ (enable-recursive-minibuffers t)
+ val)
+ (when predicate
+ (unless (and symbol
+ (symbolp symbol)
+ (funcall predicate symbol))
+ (setq symbol nil)))
+ (setq val (completing-read (if symbol
+ (format
+ "%s (default %s): " prompt symbol)
+ (format "%s: " prompt))
+ obarray
+ predicate
+ t nil nil
+ (if symbol (symbol-name symbol))))
+ (if (equal val "") symbol (intern val))))
+
+(defun ourcomments-command-at-point ()
+ (let ((fun (function-called-at-point)))
+ (when (commandp fun)
+ fun)))
+
+;;;###autoload
+(defun describe-command (command)
+ "Like `describe-function', but prompts only for interactive commands."
+ (interactive
+ (let* ((fn (ourcomments-command-at-point))
+ (prompt (if fn
+ (format "Describe command (default %s): " fn)
+ "Describe command: "))
+ (enable-recursive-minibuffers t)
+ val)
+ (setq val (completing-read prompt
+ obarray 'commandp t nil nil
+ (and fn (symbol-name fn))))
+ (list (if (equal val "") fn (intern val)))))
+ (describe-function command))
+
+
+;;;###autoload
+(defun buffer-narrowed-p ()
+ "Return non-nil if the current buffer is narrowed."
+ (/= (buffer-size)
+ (- (point-max)
+ (point-min))))
+
+;;;###autoload
+(defun narrow-to-comment ()
+ (interactive)
+ (let* ((here (point-marker))
+ (size 1000)
+ (beg (progn (forward-comment (- size))
+ ;; It looks like the wrong syntax-table is used here:
+ ;;(message "skipped %s " (skip-chars-forward "[:space:]"))
+ ;; See Emacs bug 3823, http://debbugs.gnu.org/cgi/bugreport.cgi?bug=3823
+ (message "skipped %s " (skip-chars-forward " \t\r\n"))
+ (point)))
+ (end (progn (forward-comment size)
+ ;;(message "skipped %s " (skip-chars-backward "[:space:]"))
+ (message "skipped %s " (skip-chars-backward " \t\r\n"))
+ (point))))
+ (goto-char here)
+ (if (not (and (>= here beg)
+ (<= here end)))
+ (error "Not in a comment")
+ (narrow-to-region beg end))))
+
+(defvar describe-symbol-alist nil)
+
+(defun describe-symbol-add-known(property description)
+ (when (assq property describe-symbol-alist)
+ (error "Already known property"))
+ (setq describe-symbol-alist
+ (cons (list property description)
+ describe-symbol-alist)))
+
+;;(describe-symbol-add-known 'variable-documentation "Doc for variable")
+;;(describe-symbol-add-known 'cl-struct-slots "defstruct slots")
+
+(defun property-list-keys (plist)
+ "Return list of key names in property list PLIST."
+ (let ((keys))
+ (while plist
+ (setq keys (cons (car plist) keys))
+ (setq plist (cddr plist)))
+ keys))
+
+(defun ourcomments-symbol-type (symbol)
+ "Return a list of types where symbol SYMBOL is used.
+The can include 'variable, 'function and variaus 'cl-*."
+ (symbol-file symbol)
+ )
+
+(defun ourcomments-defstruct-p (symbol)
+ "Return non-nil if symbol SYMBOL is a CL defstruct."
+ (let ((plist (symbol-plist symbol)))
+ (and (plist-member plist 'cl-struct-slots)
+ (plist-member plist 'cl-struct-type)
+ (plist-member plist 'cl-struct-include)
+ (plist-member plist 'cl-struct-print))))
+
+(defun ourcomments-defstruct-slots (symbol)
+ (unless (ourcomments-defstruct-p symbol)
+ (error "Not a CL defstruct symbol: %s" symbol))
+ (let ((cl-struct-slots (get symbol 'cl-struct-slots)))
+ (delq 'cl-tag-slot
+ (loop for rec in cl-struct-slots
+ collect (nth 0 rec)))))
+
+;; (ourcomments-defstruct-slots 'ert-test)
+
+(defun ourcomments-defstruct-file (symbol)
+ (unless (ourcomments-defstruct-p symbol)
+ (error "Not a CL defstruct symbol: %s" symbol))
+ )
+
+(defun ourcomments-member-defstruct (symbol)
+ "Return defstruct name if member."
+ (when (and (functionp symbol)
+ (plist-member (symbol-plist symbol) 'cl-compiler-macro))
+ (let* (in-defstruct
+ (symbol-file (symbol-file symbol))
+ buf
+ was-here)
+ (unless symbol-file
+ (error "Can't check if defstruct member since don't know symbol file"))
+ (setq buf (find-buffer-visiting symbol-file))
+ (setq was-here (with-current-buffer buf (point)))
+ (unless buf
+ (setq buf (find-file-noselect symbol-file)))
+ (with-current-buffer buf
+ (save-restriction
+ (widen)
+ (let* ((buf-point (find-definition-noselect symbol nil)))
+ (goto-char (cdr buf-point))
+ (save-match-data
+ (when (looking-at "(defstruct (?\\(\\(?:\\sw\\|\\s_\\)+\\)")
+ (setq in-defstruct (match-string-no-properties 1))))))
+ (if was-here
+ (goto-char was-here)
+ (kill-buffer (current-buffer))))
+ in-defstruct)))
+;; (ourcomments-member-defstruct 'ert-test-name)
+;; (ourcomments-member-defstruct 'ert-test-error-condition)
+
+(defun ourcomments-custom-group-p (symbol)
+ (and (intern-soft symbol)
+ (or (and (get symbol 'custom-loads)
+ (not (get symbol 'custom-autoload)))
+ (get symbol 'custom-group))))
+
+;;;###autoload
+(defun describe-custom-group (symbol)
+ "Describe customization group SYMBOL."
+ (interactive
+ (list
+ (ourcomments-read-symbol "Customization group"
+ 'ourcomments-custom-group-p)))
+ ;; Fix-me:
+ (message "g=%s" symbol))
+;; nxhtml
+
+;; Added this to current-load-list in cl-macs.el
+;; (describe-defstruct 'ert-stats)
+;;;###autoload
+(defun describe-defstruct (symbol)
+ (interactive (list (ourcomments-read-symbol "Describe defstruct"
+ 'ourcomments-defstruct-p)))
+ (if (not (ourcomments-defstruct-p symbol))
+ (message "%s is not a CL defstruct." symbol)
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'describe-defstruct symbol) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert "This is a description of a CL thing.")
+ (insert "\n\n")
+ (insert (format "%s is a CL `defstruct'" symbol))
+ (let ((file (symbol-file symbol)))
+ (if file
+ ;; Fix-me: .elc => .el
+ (let ((name (file-name-nondirectory file)))
+ (insert "defined in file %s.\n" (file-name-nondirectory file)))
+ (insert ".\n")))
+ (insert "\n\nIt has the following slot functions:\n")
+ (let ((num-slot-funs 0)
+ (slots (ourcomments-defstruct-slots symbol)))
+ (dolist (slot slots)
+ (if (not (fboundp (intern-soft (format "%s-%s" symbol slot))))
+ (insert (format " Do not know function for slot %s\n" slot))
+ (setq num-slot-funs (1+ num-slot-funs))
+ (insert (format " `%s-%s'\n" symbol slot))))
+ (unless (= num-slot-funs (length slots))
+ (insert " No information about some slots, maybe :conc-name was used\n")))))))
+
+;;(defun describe-deftype (type)
+;;;###autoload
+(defun describe-symbol(symbol)
+ "Show information about SYMBOL.
+Show SYMBOL plist and whether is is a variable or/and a
+function."
+ (interactive (list (ourcomments-read-symbol "Describe symbol" nil)))
+;;; (let* ((s (symbol-at-point))
+;;; (val (completing-read (if (and (symbolp s)
+;;; (not (eq s nil)))
+;;; (format
+;;; "Describe symbol (default %s): " s)
+;;; "Describe symbol: ")
+;;; obarray
+;;; nil
+;;; t nil nil
+;;; (if (symbolp s) (symbol-name s)))))
+;;; (list (if (equal val "") s (intern val)))))
+ (require 'apropos)
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'describe-symbol symbol) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert (format "Description of symbol %s\n\n" symbol))
+ (when (plist-get (symbol-plist symbol) 'cl-compiler-macro)
+ (insert "(Looks like a CL thing.)\n"))
+ (if (boundp symbol)
+ (insert (format "- There is a variable `%s'.\n" symbol))
+ (insert "- This symbol is not a variable.\n"))
+ (if (fboundp symbol)
+ (progn
+ (insert (format "- There is a function `%s'" symbol))
+ (when (ourcomments-member-defstruct symbol)
+ (let ((ds-name (ourcomments-member-defstruct symbol)))
+ (insert "\n which is a member of defstruct ")
+ (insert-text-button (format "%s" ds-name)
+ 'symbol (intern-soft ds-name)
+ 'action (lambda (button)
+ (describe-symbol
+ (button-get button 'symbol))))))
+ (insert ".\n"))
+ (insert "- This symbol is not a function.\n"))
+ (if (facep symbol)
+ (insert (format "- There is a face `%s'.\n" symbol))
+ (insert "- This symbol is not a face.\n"))
+ (if (ourcomments-custom-group-p symbol)
+ (progn
+ (insert "- There is a customization group ")
+ (insert-text-button (format "%s" symbol)
+ 'symbol symbol
+ 'action (lambda (button)
+ (describe-custom-group
+ (button-get button 'symbol))))
+ (insert ".\n"))
+ (insert "- This symbol is not a customization group.\n"))
+ (if (ourcomments-defstruct-p symbol)
+ (progn
+ (insert (format "- There is a CL defstruct %s with setf-able slots:\n" symbol))
+ (let ((num-slot-funs 0)
+ (slots (ourcomments-defstruct-slots symbol)))
+ (dolist (slot slots)
+ (if (not (fboundp (intern-soft (format "%s-%s" symbol slot))))
+ (insert (format " Do not know function for slot %s\n" slot))
+ (setq num-slot-funs (1+ num-slot-funs))
+ (insert (format " `%s-%s'\n" symbol slot))))
+ (unless (= num-slot-funs (length slots))
+ (insert " No information about some slots, maybe :conc-name was used\n"))))
+ (insert "- This symbol is not a CL defstruct.\n"))
+ (insert "\n")
+ (let* ((pl (symbol-plist symbol))
+ (pl-not-known (property-list-keys pl))
+ any-known)
+ (if (not pl)
+ (insert (format "Symbol %s has no property list\n\n" symbol))
+ ;; Known properties
+ (dolist (rec describe-symbol-alist)
+ (let ((prop (nth 0 rec))
+ (desc (nth 1 rec)))
+ (when (plist-member pl prop)
+ (setq any-known (cons prop any-known))
+ (setq pl-not-known (delq prop pl-not-known))
+ (insert
+ "The following keys in the property list are known:\n\n")
+ (insert (format "* %s: %s\n" prop desc))
+ )))
+ (unless any-known
+ (insert "The are no known keys in the property list.\n"))
+ (let ((pl (ourcomments-format-plist pl "\n ")))
+ ;;(insert (format "plist=%s\n" (symbol-plist symbol)))
+ ;;(insert (format "pl-not-known=%s\n" pl-not-known))
+ (insert "\nFull property list:\n\n (")
+ (insert (propertize pl 'face 'default))
+ (insert ")\n\n")))))))
+
+(defun ourcomments-format-plist (pl sep &optional compare)
+ (when (symbolp pl)
+ (setq pl (symbol-plist pl)))
+ (let (p desc p-out)
+ (while pl
+ (setq p (format "%s" (car pl)))
+ (if (or (not compare) (string-match apropos-regexp p))
+ (if apropos-property-face
+ (put-text-property 0 (length (symbol-name (car pl)))
+ 'face apropos-property-face p))
+ (setq p nil))
+ (if p
+ (progn
+ (and compare apropos-match-face
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face apropos-match-face
+ p))
+ (setq desc (pp-to-string (nth 1 pl)))
+ (setq desc (split-string desc "\n"))
+ (if (= 1 (length desc))
+ (setq desc (concat " " (car desc)))
+ (let* ((indent " ")
+ (ind-nl (concat "\n" indent)))
+ (setq desc
+ (concat
+ ind-nl
+ (mapconcat 'identity desc ind-nl)))))
+ (setq p-out (concat p-out (if p-out sep) p desc))))
+ (setq pl (nthcdr 2 pl)))
+ p-out))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; ido
+
+(defvar ourcomments-ido-visit-method nil)
+
+;;;###autoload
+(defun ourcomments-ido-buffer-other-window ()
+ "Show buffer in other window."
+ (interactive)
+ (setq ourcomments-ido-visit-method 'other-window)
+ (call-interactively 'ido-exit-minibuffer))
+
+;;;###autoload
+(defun ourcomments-ido-buffer-other-frame ()
+ "Show buffer in other frame."
+ (interactive)
+ (setq ourcomments-ido-visit-method 'other-frame)
+ (call-interactively 'ido-exit-minibuffer))
+
+;;;###autoload
+(defun ourcomments-ido-buffer-raise-frame ()
+ "Raise frame showing buffer."
+ (interactive)
+ (setq ourcomments-ido-visit-method 'raise-frame)
+ (call-interactively 'ido-exit-minibuffer))
+
+(defun ourcomments-ido-switch-buffer-or-next-entry ()
+ (interactive)
+ (if (active-minibuffer-window)
+ (ido-next-match)
+ (ido-switch-buffer)))
+
+(defun ourcomments-ido-mode-advice()
+ (when (memq ido-mode '(both buffer))
+ (let ((the-ido-minor-map (cdr ido-minor-mode-map-entry)))
+ ;;(define-key the-ido-minor-map [(control tab)] 'ido-switch-buffer))
+ (define-key the-ido-minor-map [(control tab)] 'ourcomments-ido-switch-buffer-or-next-entry))
+ (dolist (the-map (list ido-buffer-completion-map ido-completion-map ido-common-completion-map))
+ (when the-map
+ (let ((map the-map))
+ (define-key map [(control tab)] 'ido-next-match)
+ (define-key map [(control shift tab)] 'ido-prev-match)
+ (define-key map [(control backtab)] 'ido-prev-match)
+ (define-key map [(shift return)] 'ourcomments-ido-buffer-other-window)
+ (define-key map [(control return)] 'ourcomments-ido-buffer-other-frame)
+ (define-key map [(meta return)] 'ourcomments-ido-buffer-raise-frame))))))
+
+;; (defun ourcomments-ido-setup-completion-map ()
+;; "Set up the keymap for `ido'."
+
+;; (ourcomments-ido-mode-advice)
+
+;; ;; generated every time so that it can inherit new functions.
+;; (let ((map (make-sparse-keymap))
+;; (viper-p (if (boundp 'viper-mode) viper-mode)))
+
+;; (when viper-p
+;; (define-key map [remap viper-intercept-ESC-key] 'ignore))
+
+;; (cond
+;; ((memq ido-cur-item '(file dir))
+;; (when ido-context-switch-command
+;; (define-key map "\C-x\C-b" ido-context-switch-command)
+;; (define-key map "\C-x\C-d" 'ignore))
+;; (when viper-p
+;; (define-key map [remap viper-backward-char] 'ido-delete-backward-updir)
+;; (define-key map [remap viper-del-backward-char-in-insert] 'ido-delete-backward-updir)
+;; (define-key map [remap viper-delete-backward-word] 'ido-delete-backward-word-updir))
+;; (set-keymap-parent map
+;; (if (eq ido-cur-item 'file)
+;; ido-file-completion-map
+;; ido-file-dir-completion-map)))
+
+;; ((eq ido-cur-item 'buffer)
+;; (when ido-context-switch-command
+;; (define-key map "\C-x\C-f" ido-context-switch-command))
+;; (set-keymap-parent map ido-buffer-completion-map))
+
+;; (t
+;; (set-keymap-parent map ido-common-completion-map)))
+
+;; ;; ctrl-tab etc
+;; (define-key map [(control tab)] 'ido-next-match)
+;; (define-key map [(control shift tab)] 'ido-prev-match)
+;; (define-key map [(control backtab)] 'ido-prev-match)
+;; (define-key map [(shift return)] 'ourcomments-ido-buffer-other-window)
+;; (define-key map [(control return)] 'ourcomments-ido-buffer-other-frame)
+;; (define-key map [(meta return)] 'ourcomments-ido-buffer-raise-frame)
+
+;; (setq ido-completion-map map)))
+
+;; (defadvice ido-setup-completion-map (around
+;; ourcomments-advice-ido-setup-completion-map
+;; disable)
+;; (setq ad-return-value (ourcomments-ido-setup-completion-map))
+;; )
+
+;;(add-hook 'ido-setup-hook 'ourcomments-ido-mode-advice)
+;;(remove-hook 'ido-setup-hook 'ourcomments-ido-mode-advice)
+(defvar ourcomments-ido-adviced nil)
+(unless ourcomments-ido-adviced
+(defadvice ido-mode (after
+ ourcomments-advice-ido-mode
+ ;;activate
+ ;;compile
+ disable)
+ "Add C-tab to ido buffer completion."
+ (ourcomments-ido-mode-advice)
+ ;;ad-return-value
+ )
+;; (ad-activate 'ido-mode)
+;; (ad-deactivate 'ido-mode)
+
+(defadvice ido-visit-buffer (before
+ ourcomments-advice-ido-visit-buffer
+ ;;activate
+ ;;compile
+ disable)
+ "Advice to show buffers in other window, frame etc."
+ (when ourcomments-ido-visit-method
+ (ad-set-arg 1 ourcomments-ido-visit-method)
+ (setq ourcomments-ido-visit-method nil)
+ ))
+(setq ourcomments-ido-adviced t)
+)
+
+;;(message "after advising ido")
+;;(ad-deactivate 'ido-visit-buffer)
+;;(ad-activate 'ido-visit-buffer)
+
+(defvar ourcomments-ido-old-state ido-mode)
+
+(defun ourcomments-ido-ctrl-tab-activate ()
+ ;;(message "ourcomments-ido-ctrl-tab-activate running")
+ ;;(ad-update 'ido-visit-buffer)
+ ;;(unless (ad-get-advice-info 'ido-visit-buffer)
+ ;; Fix-me: The advice must be enabled before activation. Send bug report.
+ (ad-enable-advice 'ido-visit-buffer 'before 'ourcomments-advice-ido-visit-buffer)
+ (unless (cdr (assoc 'active (ad-get-advice-info 'ido-visit-buffer)))
+ (ad-activate 'ido-visit-buffer))
+ ;; (ad-enable-advice 'ido-setup-completion-map 'around 'ourcomments-advice-ido-setup-completion-map)
+ ;; (unless (cdr (assoc 'active (ad-get-advice-info 'ido-setup-completion-map)))
+ ;; (ad-activate 'ido-setup-completion-map))
+ ;;(ad-update 'ido-mode)
+ (ad-enable-advice 'ido-mode 'after 'ourcomments-advice-ido-mode)
+ (unless (cdr (assoc 'active (ad-get-advice-info 'ido-mode)))
+ (ad-activate 'ido-mode))
+ (setq ourcomments-ido-old-state ido-mode)
+ (ido-mode (or ido-mode 'buffer)))
+
+;;;###autoload
+(define-minor-mode ourcomments-ido-ctrl-tab
+ "Enable buffer switching using C-Tab with function `ido-mode'.
+This changes buffer switching with function `ido-mode' the
+following way:
+
+- You can use C-Tab.
+
+- You can show the selected buffer in three ways independent of
+ how you entered function `ido-mode' buffer switching:
+
+ * S-return: other window
+ * C-return: other frame
+ * M-return: raise frame
+
+Those keys are selected to at least be a little bit reminiscent
+of those in for example common web browsers."
+ :global t
+ :group 'emacsw32
+ :group 'convenience
+ (if ourcomments-ido-ctrl-tab
+ (ourcomments-ido-ctrl-tab-activate)
+ (ad-disable-advice 'ido-visit-buffer 'before
+ 'ourcomments-advice-ido-visit-buffer)
+ (ad-disable-advice 'ido-mode 'after
+ 'ourcomments-advice-ido-mode)
+ ;; For some reason this little complicated construct is
+ ;; needed. If they are not there the defadvice
+ ;; disappears. Huh.
+ ;;(if ourcomments-ido-old-state
+ ;; (ido-mode ourcomments-ido-old-state)
+ ;; (when ido-mode (ido-mode -1)))
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; New Emacs instance
+
+(defun ourcomments-find-emacs ()
+ (locate-file invocation-name
+ (list invocation-directory)
+ exec-suffixes
+ ;; 1 ;; Fix-me: This parameter is depreceated, but used
+ ;; in executable-find, why?
+ ))
+
+(defvar ourcomments-restart-server-mode nil)
+
+(defun emacs-restart-in-kill ()
+ "Last step in restart Emacs and start `server-mode' if on before."
+ (let* ((restart-args (when ourcomments-restart-server-mode
+ ;; Delay 3+2 sec to be sure the old server has stopped.
+ (list "--eval=(run-with-idle-timer 5 nil 'server-mode 1)")))
+ ;; Fix-me: There is an Emacs bug here, default-directory shows
+ ;; up in load-path in the new Eamcs if restart-args is like
+ ;; this, but not otherwise. And it has w32 file syntax. The
+ ;; work around below is the best I can find at the moment.
+ (first-path (catch 'first
+ (dolist (p load-path)
+ (when (file-directory-p p)
+ (throw 'first p)))))
+ (default-directory (file-name-as-directory (expand-file-name first-path))))
+ ;; Fix-me: Adding -nw to restart in console does not work. Any way to fix it?
+ (unless window-system (setq restart-args (cons "-nw" restart-args)))
+ ;;(apply 'call-process (ourcomments-find-emacs) nil 0 nil restart-args)
+ (apply 'emacs restart-args)
+ ;; Wait to give focus to new Emacs instance:
+ (sleep-for 3)))
+
+;;;###autoload
+(defun emacs-restart ()
+ "Restart Emacs and start `server-mode' if on before."
+ (interactive)
+ (if (not window-system)
+ (message "Can't restart emacs if window-system is nil")
+ (let ((wait 4))
+ (while (> (setq wait (1- wait)) 0)
+ (message (propertize (format "Will restart Emacs in %d seconds..." wait)
+ 'face 'secondary-selection))
+ (sit-for 1)))
+ (setq ourcomments-restart-server-mode server-mode)
+ (add-hook 'kill-emacs-hook 'emacs-restart-in-kill t)
+ (save-buffers-kill-emacs)))
+
+(defvar ourcomments-started-emacs-use-output-buffer nil
+ "If non-nil then save output form `emacs'.
+Set this to `t' to debug problems with starting a new Emacs.
+
+If non-nil save output to buffer 'call-process emacs output'.
+Note that this will lock the Emacs calling `emacs' until the new
+Emacs has finished.")
+;;(setq ourcomments-started-emacs-use-output-buffer t)
+;;(defun my-test () (interactive) (emacs-Q "-bad-arg"))
+
+;;;###autoload
+(defun emacs (&rest args)
+ "Start a new Emacs with default parameters.
+Additional ARGS are passed to the new Emacs.
+
+See also `ourcomments-started-emacs-use-output-buffer'."
+ (interactive)
+ (recentf-save-list)
+ (let* ((out-buf (when ourcomments-started-emacs-use-output-buffer
+ (get-buffer-create "call-process emacs output")))
+ (buf-arg (or out-buf 0))
+ (args-text (mapconcat 'identity (cons "" args) " "))
+ ret
+ (fin-msg ""))
+ (when out-buf
+ (display-buffer out-buf)
+ (setq fin-msg ". Finished.")
+ (message "Started 'emacs%s' => %s. Locked until this is finished." args-text ret fin-msg)
+ (redisplay))
+ (setq ret (apply 'call-process (ourcomments-find-emacs) nil buf-arg nil args))
+ (message "Started 'emacs%s' => %s%s" args-text ret fin-msg)
+ ret))
+
+;;;###autoload
+(defun emacs-buffer-file()
+ "Start a new Emacs showing current buffer file.
+Go to the current line and column in that file.
+If there is no buffer file then instead start with `dired'.
+
+This calls the function `emacs' with argument --no-desktop and
+the file or a call to dired."
+ (interactive)
+ (recentf-save-list)
+ (let ((file (buffer-file-name))
+ (lin (line-number-at-pos))
+ (col (current-column)))
+ (if file
+ (apply 'emacs "--no-desktop" (format "+%d:%d" lin col) file nil)
+ (applay 'emacs "--no-desktop" "--eval" (format "(dired \"%s\")" default-directory nil)))))
+
+;;;###autoload
+(defun emacs--debug-init(&rest args)
+ "Start a new Emacs with --debug-init parameter.
+This calls the function `emacs' with added arguments ARGS."
+ (interactive)
+ (apply 'emacs "--debug-init" args))
+
+;;;###autoload
+(defun emacs--no-desktop (&rest args)
+ "Start a new Emacs with --no-desktop parameter.
+This calls the function `emacs' with added arguments ARGS."
+ (interactive)
+ (apply 'emacs "--no-desktop" args))
+
+;;;###autoload
+(defun emacs-Q (&rest args)
+ "Start a new Emacs with -Q parameter.
+Start new Emacs without any customization whatsoever.
+This calls the function `emacs' with added arguments ARGS."
+ (interactive)
+ (apply 'emacs "-Q" args))
+
+;;;###autoload
+(defun emacs-Q-nxhtml(&rest args)
+ "Start new Emacs with -Q and load nXhtml.
+This calls the function `emacs' with added arguments ARGS."
+ (interactive)
+ (let ((autostart (if (boundp 'nxhtml-install-dir)
+ (expand-file-name "autostart.el" nxhtml-install-dir)
+ (expand-file-name "../../EmacsW32/nxhtml/autostart.el"
+ exec-directory))))
+ (apply 'emacs-Q "--debug-init" "--load" autostart args)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Searching
+
+(defun grep-get-buffer-files ()
+ "Return list of files in a `grep-mode' buffer."
+ (or (and (compilation-buffer-p (current-buffer))
+ (derived-mode-p 'grep-mode))
+ (error "Not in a grep buffer"))
+ (let ((here (point))
+ files
+ loc)
+ (font-lock-fontify-buffer)
+ (goto-char (point-min))
+ (while (setq loc
+ (condition-case err
+ (compilation-next-error 1)
+ (error
+ ;; This should be the end, but give a message for
+ ;; easier debugging.
+ (message "%s" err)
+ nil)))
+ ;;(message "here =%s, loc=%s" (point) loc)
+ (let ((file (caar (nth 2 (car loc)))))
+ (setq file (expand-file-name file))
+ (add-to-list 'files file)))
+ (goto-char here)
+ ;;(message "files=%s" files)
+ files))
+
+(defvar grep-query-replace-defaults nil
+ "Default values of FROM-STRING and TO-STRING for `grep-query-replace'.
+This is a cons cell (FROM-STRING . TO-STRING), or nil if there is
+no default value.")
+
+;; Mostly copied from `dired-do-query-replace-regexp'. Fix-me: finish, test
+;;;###autoload
+(defun grep-query-replace(from to &optional delimited)
+ "Do `query-replace-regexp' of FROM with TO, on all files in *grep*.
+Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
+If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
+with the command \\[tags-loop-continue]."
+ (interactive
+ (let ((common
+ ;; Use the regexps that have been used in grep
+ (let ((query-replace-from-history-variable 'grep-regexp-history)
+ (query-replace-defaults (or grep-query-replace-defaults
+ query-replace-defaults)))
+ (query-replace-read-args
+ "Query replace regexp in files in *grep*" t t))))
+ (setq grep-query-replace-defaults (cons (nth 0 common)
+ (nth 1 common)))
+ (list (nth 0 common) (nth 1 common) (nth 2 common))))
+ (dolist (file (grep-get-buffer-files))
+ (let ((buffer (get-file-buffer file)))
+ (if (and buffer (with-current-buffer buffer
+ buffer-read-only))
+ (error "File `%s' is visited read-only" file))))
+ (tags-query-replace from to delimited
+ '(grep-get-buffer-files)))
+
+;;;###autoload
+(defun ldir-query-replace (from to files dir &optional delimited)
+ "Replace FROM with TO in FILES in directory DIR.
+This runs `query-replace-regexp' in files matching FILES in
+directory DIR.
+
+See `tags-query-replace' for DELIMETED and more information."
+ (interactive (dir-replace-read-parameters nil nil))
+ (message "%s" (list from to files dir delimited))
+ ;;(let ((files (directory-files root nil file-regexp))) (message "files=%s" files))
+ (tags-query-replace from to delimited
+ `(directory-files ,dir t ,files)))
+
+;;;###autoload
+(defun rdir-query-replace (from to file-regexp root &optional delimited)
+ "Replace FROM with TO in FILES in directory tree ROOT.
+This runs `query-replace-regexp' in files matching FILES in
+directory tree ROOT.
+
+See `tags-query-replace' for DELIMETED and more information."
+ (interactive (dir-replace-read-parameters nil t))
+ (message "%s" (list from to file-regexp root delimited))
+ ;;(let ((files (directory-files root nil file-regexp))) (message "files=%s" files))
+ (tags-query-replace from to delimited
+ `(rdir-get-files ,root ,file-regexp)))
+
+;; (rdir-get-files ".." "^a.*\.el$")
+(defun rdir-get-files (root file-regexp)
+ (let ((files (directory-files root t file-regexp))
+ (subdirs (directory-files root t)))
+ (dolist (subdir subdirs)
+ (when (and (file-directory-p subdir)
+ (not (or (string= "/." (substring subdir -2))
+ (string= "/.." (substring subdir -3)))))
+ (setq files (append files (rdir-get-files subdir file-regexp) nil))))
+ files))
+
+(defun dir-replace-read-parameters (has-dir recursive)
+ (let* ((common
+ (let (;;(query-replace-from-history-variable 'grep-regexp-history)
+ ;;(query-replace-defaults (or grep-query-replace-defaults
+ ;; query-replace-defaults))
+ )
+ (query-replace-read-args
+ "Query replace regexp in files" t t)))
+ (from (nth 0 common))
+ (to (nth 1 common))
+ (delimited (nth 2 common))
+ (files (replace-read-files from to))
+ (root (unless has-dir (read-directory-name (if recursive "Root directory: "
+ "In single directory: ")))))
+ (list from to files root delimited)))
+
+;; Mostly copied from `grep-read-files'. Could possible be merged with
+;; that.
+(defvar replace-read-files-history nil)
+;;;###autoload
+(defun replace-read-files (regexp &optional replace)
+ "Read files arg for replace."
+ (let* ((bn (or (buffer-file-name) (buffer-name)))
+ (fn (and bn
+ (stringp bn)
+ (file-name-nondirectory bn)))
+ (default
+ (let ((pre-default
+ (or (and fn
+ (let ((aliases grep-files-aliases)
+ alias)
+ (while aliases
+ (setq alias (car aliases)
+ aliases (cdr aliases))
+ (if (string-match (wildcard-to-regexp
+ (cdr alias)) fn)
+ (setq aliases nil)
+ (setq alias nil)))
+ (cdr alias)))
+ (and fn
+ (let ((ext (file-name-extension fn)))
+ (and ext (concat "^.*\." ext))))
+ (car replace-read-files-history)
+ (car (car grep-files-aliases)))))
+ (if (string-match-p "^\\*\\.[a-zA-Z0-9]*$" pre-default)
+ (concat "\\." (substring pre-default 2) "$")
+ pre-default)))
+ (files (read-string
+ (if replace
+ (concat "Replace \"" regexp
+ "\" with \"" replace "\" in files"
+ (if default (concat " (default " default
+ ", regexp or *.EXT)"))
+ ": ")
+ (concat "Search for \"" regexp
+ "\" in files"
+ (if default (concat " (default " default ")"))
+ ": "))
+ nil 'replace-read-files-history default)))
+ (let ((pattern (and files
+ (or (cdr (assoc files grep-files-aliases))
+ files))))
+ (if (and pattern
+ (string-match-p "^\\*\\.[a-zA-Z0-9]*$" pattern))
+ (concat "\\." (substring pattern 2) "$")
+ pattern))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Info
+
+;;;###autoload
+(defun info-open-file (info-file)
+ "Open an info file in `Info-mode'."
+ (interactive
+ (let ((name (read-file-name "Info file: "
+ nil ;; dir
+ nil ;; default-filename
+ t ;; mustmatch
+ nil ;; initial
+ ;; predicate:
+ (lambda (file)
+ (or (file-directory-p file)
+ (string-match ".*\\.info\\'" file))))))
+ (list name)))
+ (info info-file))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Exec path etc
+
+(defun ourcomments-which (prog)
+ "Look for first program PROG in `exec-path' using `exec-suffixes'.
+Return full path if found."
+ (interactive "sProgram: ")
+ (let ((path (executable-find prog)))
+ (when (with-no-warnings (called-interactively-p))
+ (message "%s found in %s" prog path))
+ path))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Custom faces and keys
+
+;;;###autoload
+(defun use-custom-style ()
+ "Setup like in `Custom-mode', but without things specific to Custom."
+ (make-local-variable 'widget-documentation-face)
+ (setq widget-documentation-face 'custom-documentation)
+ (make-local-variable 'widget-button-face)
+ (setq widget-button-face custom-button)
+ (setq show-trailing-whitespace nil)
+
+ ;; We need this because of the "More" button on docstrings.
+ ;; Otherwise clicking on "More" can push point offscreen, which
+ ;; causes the window to recenter on point, which pushes the
+ ;; newly-revealed docstring offscreen; which is annoying. -- cyd.
+ (set (make-local-variable 'widget-button-click-moves-point) t)
+
+ (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed)
+ (set (make-local-variable 'widget-mouse-face) custom-button-mouse)
+
+ ;; When possible, use relief for buttons, not bracketing. This test
+ ;; may not be optimal.
+ (when custom-raised-buttons
+ (set (make-local-variable 'widget-push-button-prefix) "")
+ (set (make-local-variable 'widget-push-button-suffix) "")
+ (set (make-local-variable 'widget-link-prefix) "")
+ (set (make-local-variable 'widget-link-suffix) ""))
+
+ ;; From widget-keymap
+ (local-set-key "\t" 'widget-forward)
+ (local-set-key "\e\t" 'widget-backward)
+ (local-set-key [(shift tab)] 'advertised-widget-backward)
+ (local-set-key [backtab] 'widget-backward)
+ (local-set-key [down-mouse-2] 'widget-button-click)
+ (local-set-key [down-mouse-1] 'widget-button-click)
+ (local-set-key [(control ?m)] 'widget-button-press)
+ ;; From custom-mode-map
+ (local-set-key " " 'scroll-up)
+ (local-set-key "\177" 'scroll-down)
+ (local-set-key "n" 'widget-forward)
+ (local-set-key "p" 'widget-backward))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Bookmarks
+
+(defun bookmark-next-marked ()
+ (interactive)
+ (let ((bb (get-buffer "*Bookmark List*"))
+ pos)
+ (when bb
+ (with-current-buffer bb
+ (setq pos (re-search-forward "^>" nil t))
+ (unless pos
+ (goto-char (point-min))
+ (setq pos (re-search-forward "^>" nil t)))))
+ (if pos
+ (with-current-buffer bb
+ ;; Defined in bookmark.el, should be loaded now.
+ (bookmark-bmenu-this-window))
+ (call-interactively 'bookmark-bmenu-list)
+ (message "Please select bookmark for bookmark next command, then press n"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Org Mode
+
+(defun ourcomments-org-complete-and-replace-file-link ()
+ "If on a org file link complete file name and replace it."
+ (interactive)
+ (require 'org)
+ (let* ((here (point-marker))
+ (on-link (eq 'org-link (get-text-property (point) 'face)))
+ (link-beg (when on-link
+ (previous-single-property-change (1+ here) 'face)))
+ (link-end (when on-link
+ (next-single-property-change here 'face)))
+ (link (when on-link (buffer-substring-no-properties link-beg link-end)))
+ type+link
+ link-link
+ link-link-beg
+ link-link-end
+ new-link
+ dir
+ ovl)
+ (when (and on-link
+ (string-match (rx string-start "[["
+ (group (0+ (not (any "]"))))) link))
+ (setq type+link (match-string 1 link))
+ (when (string-match "^file:\\(.*\\)" type+link)
+ (setq link-link (match-string 1 type+link))
+ (setq link-link-beg (+ 2 link-beg (match-beginning 1)))
+ (setq link-link-end (+ 2 link-beg (match-end 1)))
+ (unwind-protect
+ (progn
+ (setq ovl (make-overlay link-link-beg link-link-end))
+ (overlay-put ovl 'face 'highlight)
+ (when link-link
+ (setq link-link (org-link-unescape link-link))
+ (setq dir (when (and link-link (> (length link-link) 0))
+ (file-name-directory link-link)))
+ (setq new-link (read-file-name "Org file:" dir nil nil (file-name-nondirectory link-link)))
+ (delete-overlay ovl)
+ (setq new-link (expand-file-name new-link))
+ (setq new-link (file-relative-name new-link))
+ (delete-region link-link-beg link-link-end)
+ (goto-char link-link-beg)
+ (insert (org-link-escape new-link))
+ t))
+ (delete-overlay ovl)
+ (goto-char here))))))
+
+;; (defun ourcomments-org-paste-html-link (html-link)
+;; "If there is an html link on clipboard paste it as an org link.
+;; If you have this on the clipboard
+;; <a href=\"http://my.site.org/\">My Site</a>
+;; It will paste this
+;; [[http://my.site.org/][My Site]]
+;; If the URL is to a local file it will create an org link to the
+;; file.
+;; Tip: You can use the Firefox plugin Copy as HTML Link, see URL
+;; `https://addons.mozilla.org/en-US/firefox/addon/2617'.
+;; "
+;; (interactive (list (current-kill 0)))
+;; (let ((conv-link (ourcomments-org-convert-html-link html-link)))
+;; (if (not conv-link)
+;; (message (propertize "No html link on clipboard" 'face 'font-lock-warning-face))
+;; (insert conv-link))))
+
+;; (defun ourcomments-org-convert-html-link (html-link)
+;; (let (converted url str)
+;; (save-match-data
+;; (while (string-match ourcomments-org-paste-html-link-regexp html-link)
+;; (setq converted t)
+;; (setq url (match-string 1 html-link))
+;; (setq str (match-string 2 html-link))
+;; ;;(setq str (concat str (format "%s" (setq temp-n (1+ temp-n)))))
+;; (setq html-link (replace-match (concat "[[" url "][" str "]]") nil nil html-link 0))))
+;; (when converted
+;; html-link)))
+
+(defconst ourcomments-org-paste-html-link-regexp
+ "\\`\\(?:<a [^>]*?href=\"\\(.*?\\)\"[^>]*?>\\([^<]*\\)</a>\\)\\'")
+
+;;(string-match-p ourcomments-org-paste-html-link-regexp "<a href=\"link\">text</a>")
+
+;;(defvar temp-n 0)
+(defun ourcomments-org-convert-html-links-in-buffer (beg end)
+ "Convert html link between BEG and END to org mode links.
+If there is an html link in the buffer
+
+ <a href=\"http://my.site.org/\">My Site</a>
+
+that starts at BEG and ends at END then convert it to this
+
+ [[http://my.site.org/][My Site]]
+
+If the URL is to a local file and the buffer is visiting a file
+make the link relative.
+
+However, if the html link is inside an #+BEGIN - #+END block or a
+variant of such blocks then leave the link as it is."
+ (when (derived-mode-p 'org-mode)
+ (save-match-data
+ (let ((here (copy-marker (point)))
+ url str converted
+ lit-beg lit-end)
+ (goto-char beg)
+ (save-restriction
+ (widen)
+ (setq lit-beg (search-backward "#+BEGIN" nil t))
+ (when lit-beg
+ (goto-char lit-beg)
+ (setq lit-end (or (search-forward "#+END" nil t)
+ (point-max)))))
+ (when (or (not lit-beg)
+ (> beg lit-end))
+ (goto-char beg)
+ (when (save-restriction
+ (narrow-to-region beg end)
+ (looking-at ourcomments-org-paste-html-link-regexp))
+ (setq converted t)
+ (setq url (match-string-no-properties 1))
+ (setq str (match-string-no-properties 2))
+ ;; Check if the URL is to a local file and absolute. And we
+ ;; have a buffer.
+ (when (and (buffer-file-name)
+ (> (length url) 5)
+ (string= (substring url 0 6) "file:/"))
+ (let ((abs-file-url
+ (if (not (memq system-type '(windows-nt ms-dos)))
+ (substring url 8)
+ (if (string= (substring url 0 8) "file:///")
+ (substring url 8)
+ ;; file://c:/some/where.txt
+ (substring url 7)))))
+ (setq url (concat "file:"
+ (file-relative-name abs-file-url
+ (file-name-directory
+ (buffer-file-name)))))))
+ (replace-match (concat "[[" url "][" str "]]") nil nil nil 0)))
+ (goto-char here)
+ nil))))
+
+(defvar ourcomments-paste-with-convert-hook nil
+ "Normal hook run after certain paste commands.
+These paste commands are in the list
+`ourcomments-paste-with-convert-commands'.
+
+Each function in this hook is called with two parameters, the
+start and end of the pasted text, until a function returns
+non-nil.")
+(add-hook 'ourcomments-paste-with-convert-hook 'ourcomments-org-convert-html-links-in-buffer)
+
+(defvar ourcomments-paste-beg) ;; dyn var
+(defvar ourcomments-paste-end) ;; dyn var
+(defun ourcomments-grab-paste-bounds (beg end len)
+ (setq ourcomments-paste-beg (min beg ourcomments-paste-beg))
+ (setq ourcomments-paste-end (max end ourcomments-paste-end)))
+
+(defmacro ourcomments-advice-paste-command (paste-command)
+ (let ((adv-name (make-symbol (concat "ourcomments-org-ad-"
+ (symbol-name paste-command)))))
+ `(defadvice ,paste-command (around
+ ,adv-name)
+ (let ((ourcomments-paste-beg (point-max)) ;; dyn var
+ (ourcomments-paste-end (point-min))) ;; dyn var
+ (add-hook 'after-change-functions `ourcomments-grab-paste-bounds nil t)
+ ad-do-it ;;;;;;;;;;;;;;;;;;;;;;;;;;
+ (remove-hook 'after-change-functions `ourcomments-grab-paste-bounds t)
+ (run-hook-with-args-until-success 'ourcomments-paste-with-convert-hook
+ ourcomments-paste-beg
+ ourcomments-paste-end)))))
+
+(defcustom ourcomments-paste-with-convert-commands '(yank cua-paste viper-put-back viper-Put-back)
+ "Commands for which past converting is done.
+See `ourcomments-paste-with-convert-mode' for more information."
+ :type '(repeat function)
+ :group 'ourcomments-util)
+
+;;;###autoload
+(define-minor-mode ourcomments-paste-with-convert-mode
+ "Pasted text may be automatically converted in this mode.
+The functions in `ourcomments-paste-with-convert-hook' are run
+after commands in `ourcomments-paste-with-convert-commands' if any
+of the functions returns non-nil that text is inserted instead of
+the original text.
+
+For exampel when this mode is on and you paste an html link in an
+`org-mode' buffer it will be directly converted to an org style
+link. \(This is the default behaviour.)
+
+Tip: The Firefox plugin Copy as HTML Link is handy, see URL
+ `https://addons.mozilla.org/en-US/firefox/addon/2617'.
+
+Note: This minor mode will defadvice the paste commands."
+ :global t
+ :group 'cua
+ :group 'viper
+ :group 'ourcomments-util
+ (if ourcomments-paste-with-convert-mode
+ (progn
+ (dolist (command ourcomments-paste-with-convert-commands)
+ (eval `(ourcomments-advice-paste-command ,command))
+ (ad-activate command)))
+ (dolist (command ourcomments-paste-with-convert-commands)
+ (ad-unadvise command))))
+
+;; (ourcomments-advice-paste-command cua-paste)
+;; (ad-activate 'cua-paste)
+;; (ad-deactivate 'cua-paste)
+;; (ad-update 'cua-paste)
+;; (ad-unadvise 'cua-paste)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Menu commands to M-x history
+
+;; (where-is-internal 'mumamo-mark-chunk nil nil)
+;; (where-is-internal 'mark-whole-buffer nil nil)
+;; (where-is-internal 'save-buffer nil nil)
+;; (where-is-internal 'revert-buffer nil nil)
+;; (setq extended-command-history nil)
+(defun ourcomments-M-x-menu-pre ()
+ "Add menu command to M-x history."
+ (let ((is-menu-command (equal '(menu-bar)
+ (when (< 0 (length (this-command-keys-vector)))
+ (elt (this-command-keys-vector) 0))))
+ (pre-len (length extended-command-history)))
+ (when (and is-menu-command
+ (not (memq this-command '(ourcomments-M-x-menu-mode))))
+ (pushnew (symbol-name this-command) extended-command-history)
+ (when (< pre-len (length extended-command-history))
+ ;; This message is given pre-command and is therefore likely
+ ;; to be overwritten, but that is ok in this case. If the user
+ ;; has seen one of these messages s?he knows.
+ (message (propertize "(Added %s to M-x history so you can run it from there)"
+ 'face 'file-name-shadow)
+ this-command)))))
+
+;;;###autoload
+(define-minor-mode ourcomments-M-x-menu-mode
+ "Add commands started from Emacs menus to M-x history.
+The purpose of this is to make it easier to redo them and easier
+to learn how to do them from the command line \(which is often
+faster if you know how to do it).
+
+Only commands that are not already in M-x history are added."
+ :global t
+ (if ourcomments-M-x-menu-mode
+ (add-hook 'pre-command-hook 'ourcomments-M-x-menu-pre)
+ (remove-hook 'pre-command-hook 'ourcomments-M-x-menu-pre)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Warnings etc
+
+(defvar ourcomments-warnings nil)
+
+(defun ourcomments-display-warnings ()
+ (condition-case err
+ (let ((msg (mapconcat 'identity (reverse ourcomments-warnings) "\n")))
+ (setq ourcomments-warnings nil)
+ (message "%s" (propertize msg 'face 'secondary-selection)))
+ (error (message "ourcomments-display-warnings: %s" err))))
+
+(defun ourcomments-warning-post ()
+ (condition-case err
+ (run-with-idle-timer 0.5 nil 'ourcomments-display-warnings)
+ (error (message "ourcomments-warning-post: %s" err))))
+
+;;;###autoload
+(defun ourcomments-warning (format-string &rest args)
+ (setq ourcomments-warnings (cons (apply 'format format-string args)
+ ourcomments-warnings))
+ (add-hook 'post-command-hook 'ourcomments-warning-post))
+
+
+
+(provide 'ourcomments-util)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ourcomments-util.el ends here
--- /dev/null
+;;; ourcomments-widgets.el --- widgets for custom etc
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-10-13 Tue
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'mumamo nil t))
+
+;;;###autoload (autoload 'command "ourcomments-widgets")
+(define-widget 'command 'restricted-sexp
+ "A command function."
+ :complete-function (lambda ()
+ (interactive)
+ (lisp-complete-symbol 'commandp))
+ :prompt-value 'widget-field-prompt-value
+ :prompt-internal 'widget-symbol-prompt-internal
+ :prompt-match 'commandp
+ :prompt-history 'widget-command-prompt-value-history
+ :action 'widget-field-action
+ :match-alternatives '(commandp)
+ :validate (lambda (widget)
+ (unless (commandp (widget-value widget))
+ (widget-put widget :error (format "Invalid command: %S"
+ (widget-value widget)))
+ widget))
+ :value 'ignore
+ :tag "Command")
+
+
+;;;###autoload
+(defun major-or-multi-majorp (value)
+ "Return t if VALUE is a major or multi major mode function."
+ (or (and (fboundp 'mumamo-multi-major-modep)
+ (fboundp (mumamo-multi-major-modep value)))
+ (major-modep value)))
+
+;; Fix-me: This might in the future be defined in Emacs.
+;;;###autoload
+(defun major-modep (value)
+ "Return t if VALUE is a major mode function."
+ (let ((sym-name (symbol-name value)))
+ ;; Do some reasonable test to find out if it is a major mode.
+ ;; Load autoloaded mode functions.
+ ;;
+ ;; Fix-me: Maybe test for minor modes? How was that done?
+ (when (and (fboundp value)
+ (commandp value)
+ (not (memq value '(flyspell-mode
+ isearch-mode
+ savehist-mode
+ )))
+ (< 5 (length sym-name))
+ (string= "-mode" (substring sym-name (- (length sym-name) 5)))
+ (if (and (listp (symbol-function value))
+ (eq 'autoload (car (symbol-function value))))
+ (progn
+ (message "loading ")
+ (load (cadr (symbol-function value)) t t))
+ t)
+ (or (memq value
+ ;; Fix-me: Complement this table of known major modes:
+ '(fundamental-mode
+ xml-mode
+ nxml-mode
+ nxhtml-mode
+ css-mode
+ javascript-mode
+ espresso-mode
+ php-mode
+ ))
+ (and (intern-soft (concat sym-name "-hook"))
+ ;; This fits `define-derived-mode'
+ (get (intern-soft (concat sym-name "-hook")) 'variable-documentation))
+ (progn (message "Not a major mode: %s" value)
+ ;;(sit-for 4)
+ nil)
+ ))
+ t)))
+
+;;;###autoload (autoload 'major-mode-function "ourcomments-widgets")
+(define-widget 'major-mode-function 'function
+ "A major mode lisp function."
+ :complete-function (lambda ()
+ (interactive)
+ (lisp-complete-symbol 'major-or-multi-majorp))
+ :prompt-match 'major-or-multi-majorp
+ :prompt-history 'widget-function-prompt-value-history
+ :match-alternatives '(major-or-multi-majorp)
+ :validate (lambda (widget)
+ (unless (major-or-multi-majorp (widget-value widget))
+ (widget-put widget :error (format "Invalid function: %S"
+ (widget-value widget)))
+ widget))
+ :value 'fundamental-mode
+ :tag "Major mode function")
+
+
+
+(provide 'ourcomments-widgets)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ourcomments-widgets.el ends here
--- /dev/null
+;;; pause.el --- Take a break!
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-01-19 Sat
+(defconst pause:version "0.70");; Version:
+;; Last-Updated: 2010-01-18 Mon
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; If you are using Emacs then don't you need a little reminder to
+;; take a pause? This library makes Emacs remind you of that. And
+;; gives you a link to a yoga exercise to try in the pause.
+;;
+;; There are essentially two different ways to use this library.
+;; Either you run a separate Emacs process that just reminds you of
+;; pauses. To use it that way see `pause-start-in-new-emacs'.
+;;
+;; Or run it in the current Emacs. To do that add to your .emacs
+;;
+;; (require 'pause)
+;;
+;; and do
+;;
+;; M-x customize-group RET pause RET
+;;
+;; and set `pause-mode' to t.
+;;
+;;
+;; Note: I am unsure if it works on all systems to use a separate
+;; Emacs process. It does work on w32 though. Please tell me
+;; about other systems.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;;###autoload
+(defgroup pause nil
+ "Customize your health personal Emacs health saver!"
+ :group 'convenience)
+
+(defcustom pause-after-minutes 15
+ "Pause after this number of minutes."
+ :type 'number
+ :group 'pause)
+
+(defcustom pause-1-minute-delay 60
+ "Number of seconds to wait in 1 minutes delay."
+ :type 'number
+ :group 'pause)
+
+(defcustom pause-idle-delay 5
+ "Seconds to wait for user to be idle before pause."
+ :type 'number
+ :group 'pause)
+
+(defcustom pause-even-if-not-in-emacs t
+ "Jump up pause even if not in Emacs."
+ :type 'boolean
+ :group 'pause)
+
+(defcustom pause-restart-anyway-after 2
+ "If user does not use Emacs restart timer after this minutes.
+This is used when a user has clicked a link."
+ :type 'number
+ :group 'pause)
+
+(defcustom pause-tell-again-after 2
+ "If user does not exit pause tell again after this minutes."
+ :type 'number
+ :group 'pause)
+
+(defcustom pause-extra-fun 'pause-start-get-yoga-poses
+ "Function to call for extra fun when pausing.
+Default is to show a link to a yoga exercise (recommended!).
+
+Set this variable to nil if you do not want any extra fun.
+
+If this variable's value is a function it will be called when the
+pause frame has just been shown."
+ :type '(choice (function :tag "Extra function")
+ (const :tag "No extra function" nil))
+ :group 'pause)
+
+(defvar pause-exited-from-button nil)
+
+(defcustom pause-background-color "orange"
+ "Background color during pause."
+ :type 'color
+ :group 'pause)
+
+(defcustom pause-mode-line-color "sienna"
+ "Mode line color during pause."
+ :type 'color
+ :group 'pause)
+
+(defcustom pause-1-minute-mode-line-color "yellow"
+ "Mode line color during 1 minute phase of pause."
+ :type 'color
+ :group 'pause)
+
+(defface pause-text-face
+ '((t (:foreground "sienna" :height 1.5 :bold t)))
+ "Face main text in pause buffer."
+ :group 'pause)
+
+(defface pause-info-text-face
+ '((t (:foreground "yellow")))
+ "Face info text in pause buffer."
+ :group 'pause)
+
+(defface pause-message-face
+ '((t (:inherit secondary-selection)))
+ "Face for pause messages."
+ :group 'pause)
+
+(defface pause-1-minute-message-face
+ '((t (:inherit mode-line-inactive)))
+ "Face for pause messages."
+ :group 'pause)
+
+(defcustom pause-break-text
+ (concat "\n\tHi there,"
+ "\n\tYou are worth a PAUSE!"
+ "\n\nTry some mindfulness:"
+ "\n\t- Look around and observe."
+ "\n\t- Listen."
+ "\n\t- Feel your body.")
+ "Text to show during pause."
+ :type 'integer
+ :group 'pause)
+
+(defvar pause-el-file (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+
+(defvar pause-default-img-dir
+ (let ((this-dir (file-name-directory pause-el-file)))
+ (expand-file-name "../etc/img/pause/" this-dir)))
+
+(defcustom pause-img-dir pause-default-img-dir
+ "Image directory for pause.
+A random image is choosen from this directory for pauses."
+ :type 'directory
+ :group 'pause)
+
+
+
+(defvar pause-timer nil)
+
+;;(defvar pause-break-exit-calls nil)
+
+(defun pause-start-timer ()
+ (pause-start-timer-1 (* 60 pause-after-minutes)))
+
+(defun pause-start-timer-1 (sec)
+ (pause-cancel-timer)
+ (setq pause-timer (run-with-timer sec nil 'pause-pre-break)))
+
+(defun pause-one-minute ()
+ "Give you another minute ..."
+ (pause-start-timer-1 pause-1-minute-delay)
+ (message (propertize " OK, I will come back in a minute! -- greatings from pause"
+ 'face 'pause-message-face)))
+
+(defun pause-save-me ()
+ (pause-start-timer)
+ (message (propertize " OK, I will save you again in %d minutes! -- greatings from pause "
+ 'face 'pause-message-face)
+ pause-after-minutes))
+
+(defun pause-pre-break ()
+ (condition-case err
+ (save-match-data ;; runs in timer
+ (pause-cancel-timer)
+ (setq pause-timer (run-with-idle-timer pause-idle-delay nil 'pause-break-in-timer)))
+ (error
+ (lwarn 'pause-pre-break
+ :error "%s" (error-message-string err)))))
+
+(defvar pause-break-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control meta shift ?p)] 'pause-break-exit)
+ (define-key map [tab] 'forward-button)
+ (define-key map [(meta tab)] 'backward-button)
+ (define-key map [(shift tab)] 'backward-button)
+ (define-key map [backtab] 'backward-button)
+ map))
+
+(defvar pause-buffer nil)
+(defvar pause-frame nil)
+
+(define-derived-mode pause-break-mode nil "Pause"
+ "Mode used during pause in pause buffer.
+
+It defines the following key bindings:
+
+\\{pause-break-mode-map}"
+ (set (make-local-variable 'buffer-read-only) t)
+ (setq show-trailing-whitespace nil)
+ ;;(set (make-local-variable 'cursor-type) nil)
+ ;; Fix-me: workaround for emacs bug
+ ;;(run-with-idle-timer 0 nil 'pause-hide-cursor)
+ )
+
+;; Fix-me: make one state var
+(defvar pause-break-exit-active nil)
+(defvar pause-break-1-minute-state nil)
+
+
+(defun pause-break ()
+ (pause-cancel-timer)
+ (let ((wcfg (current-frame-configuration))
+ (old-mode-line-bg (face-attribute 'mode-line :background))
+ old-frame-bg-color
+ old-frame-left-fringe
+ old-frame-right-fringe
+ old-frame-tool-bar-lines
+ old-frame-menu-bar-lines
+ old-frame-vertical-scroll-bars)
+ (dolist (f (frame-list))
+ (add-to-list 'old-frame-bg-color (cons f (frame-parameter f 'background-color)))
+ (add-to-list 'old-frame-left-fringe (cons f (frame-parameter f 'left-fringe)))
+ (add-to-list 'old-frame-right-fringe (cons f (frame-parameter f 'right-fringe)))
+ (add-to-list 'old-frame-tool-bar-lines (cons f (frame-parameter f 'tool-bar-lines)))
+ (add-to-list 'old-frame-menu-bar-lines (cons f (frame-parameter f 'menu-bar-lines)))
+ (add-to-list 'old-frame-vertical-scroll-bars (cons f (frame-parameter f 'vertical-scroll-bars))))
+
+ ;; Fix-me: Something goes wrong with the window configuration, try a short pause
+ (remove-hook 'window-configuration-change-hook 'pause-break-exit)
+ (run-with-idle-timer 0.2 nil 'pause-break-show)
+ (setq pause-break-exit-active nil)
+ (setq pause-break-1-minute-state nil) ;; set in `pause-break-show'
+ (setq pause-exited-from-button nil)
+ (unwind-protect
+ (let ((n 0)
+ (debug-on-error nil))
+ (while (and (> 3 (setq n (1+ n)))
+ (not pause-break-exit-active)
+ (not pause-break-1-minute-state))
+ (condition-case err
+ (recursive-edit)
+ (error (message "%s" (error-message-string err))))
+ (unless (or pause-break-exit-active
+ pause-break-1-minute-state)
+ (when (> 2 n) (message "Too early to pause (%s < 2)" n))
+ (add-hook 'window-configuration-change-hook 'pause-break-exit))))
+
+ (remove-hook 'window-configuration-change-hook 'pause-break-exit)
+ (pause-tell-again-cancel-timer)
+ ;;(set-frame-parameter nil 'background-color "white")
+ (dolist (f (frame-list))
+ (set-frame-parameter f 'background-color (cdr (assq f old-frame-bg-color)))
+ (set-frame-parameter f 'left-fringe (cdr (assq f old-frame-left-fringe)))
+ (set-frame-parameter f 'right-fringe (cdr (assq f old-frame-right-fringe)))
+ (set-frame-parameter f 'tool-bar-lines (cdr (assq f old-frame-tool-bar-lines)))
+ (set-frame-parameter f 'menu-bar-lines (cdr (assq f old-frame-menu-bar-lines)))
+ (set-frame-parameter f 'vertical-scroll-bars (cdr (assq f old-frame-vertical-scroll-bars))))
+ ;; Fix-me: The frame grows unless we do redisplay here:
+ (redisplay t)
+ (set-frame-configuration wcfg t)
+ (when pause-frame(lower-frame pause-frame))
+ (set-face-attribute 'mode-line nil :background old-mode-line-bg)
+ (run-with-idle-timer 2.0 nil 'run-hooks 'pause-break-exit-hook)
+ (kill-buffer pause-buffer)
+ (cond (pause-exited-from-button
+ ;; Do not start timer until we start working again.
+ (run-with-idle-timer 1 nil 'add-hook 'post-command-hook 'pause-save-me-post-command)
+ ;; But if we do not do that within some minutes then start timer anyway.
+ (run-with-idle-timer (* 60 pause-restart-anyway-after) nil 'pause-save-me))
+ (pause-break-1-minute-state
+ (run-with-idle-timer 0 nil 'pause-one-minute))
+ (t
+ (run-with-idle-timer 0 nil 'pause-save-me))))))
+
+(defun pause-save-me-post-command ()
+ (pause-start-timer))
+
+(defvar pause-break-exit-hook nil
+ "Hook run after break exit.
+Frame configuration has been restored when this is run.
+Please note that it is run in a timer.")
+
+(defun pause-break-show ()
+ ;; In timer
+ (save-match-data
+ (condition-case err
+ (pause-break-show-1)
+ (error
+ ;;(remove-hook 'window-configuration-change-hook 'pause-break-exit)
+ (pause-break-exit)
+ (message "pause-break-show error: %s" (error-message-string err))))))
+
+(defvar pause-break-last-wcfg-change (float-time))
+
+(defun pause-break-show-1 ()
+ ;; Do these first if something goes wrong.
+ (setq pause-break-last-wcfg-change (float-time))
+ ;;(run-with-idle-timer (* 1.5 (length (frame-list))) nil 'add-hook 'window-configuration-change-hook 'pause-break-exit)
+
+ ;; fix-me: temporary:
+ ;;(add-hook 'window-configuration-change-hook 'pause-break-exit)
+ (unless pause-extra-fun (run-with-idle-timer 1 nil 'pause-break-message))
+ (run-with-idle-timer 10 nil 'pause-break-exit-activate)
+ (setq pause-break-1-minute-state t)
+ (set-face-attribute 'mode-line nil :background pause-1-minute-mode-line-color)
+ (with-current-buffer (setq pause-buffer
+ (get-buffer-create "* P A U S E *"))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (pause-break-mode)
+ (setq left-margin-width 25)
+ (pause-insert-img)
+ (insert (propertize pause-break-text 'face 'pause-text-face))
+ (goto-char (point-min))
+ (when (search-forward "mindfulness" nil t)
+ (make-text-button (- (point) 11) (point)
+ 'face '(:inherit pause-text-face :underline t)
+ 'action (lambda (btn)
+ (browse-url "http://www.jimhopper.com/mindfulness/"))))
+ (goto-char (point-max))
+ (insert (propertize "\n\nClick on a link below to exit pause\n" 'face 'pause-info-text-face))
+ ;;(add-text-properties (point-min) (point-max) (list 'keymap (make-sparse-keymap)))
+ (insert-text-button "Exit pause"
+ 'action `(lambda (button)
+ (condition-case err
+ (pause-break-exit-from-button)
+ (error (message "%s" (error-message-string err))))))
+ (insert "\n")
+ (dolist (m '(hl-needed-mode))
+ (when (and (boundp m) (symbol-value m))
+ (funcall m -1)))))
+ (dolist (f (frame-list))
+ (pause-max-frame f))
+ (pause-tell-again)
+ (when pause-extra-fun (funcall pause-extra-fun))
+ ;;(setq pause-break-exit-calls 0)
+ (setq pause-break-last-wcfg-change (float-time))
+ (pause-tell-again-start-timer))
+
+(defun pause-max-frame (f)
+ (let* ((avail-width (- (display-pixel-width)
+ (* 2 (frame-parameter f 'border-width))
+ (* 2 (frame-parameter f 'internal-border-width))))
+ (avail-height (- (display-pixel-height)
+ (* 2 (frame-parameter f 'border-width))
+ (* 2 (frame-parameter f 'internal-border-width))))
+ (cols (/ avail-width (frame-char-width)))
+ (rows (- (/ avail-height (frame-char-height)) 2)))
+ ;;(set-frame-parameter (selected-frame) 'fullscreen 'fullboth)
+ ;;(set-frame-parameter (selected-frame) 'fullscreen 'maximized)
+ (setq pause-break-last-wcfg-change (float-time))
+ (with-selected-frame f
+ (delete-other-windows (frame-first-window f))
+ (with-selected-window (frame-first-window)
+ (switch-to-buffer pause-buffer)
+ (goto-char (point-max))))
+ (modify-frame-parameters f
+ `((background-color . ,pause-background-color)
+ (left-fringe . 0)
+ (right-fringe . 0)
+ (tool-bar-lines . 0)
+ (menu-bar-lines . 0)
+ (vertical-scroll-bars . nil)
+ (left . 0)
+ (top . 0)
+ (width . ,cols)
+ (height . ,rows)
+ ))))
+
+(defvar pause-tell-again-timer nil)
+
+(defun pause-tell-again-start-timer ()
+ (pause-tell-again-cancel-timer)
+ (setq pause-tell-again-timer
+ (run-with-idle-timer (* 60 pause-tell-again-after) t 'pause-tell-again)))
+
+(defun pause-tell-again-cancel-timer ()
+ (when (timerp pause-tell-again-timer)
+ (cancel-timer pause-tell-again-timer))
+ (setq pause-tell-again-timer nil))
+
+(defun pause-tell-again ()
+ (when (and window-system pause-even-if-not-in-emacs)
+ (pause-max-frame pause-frame)
+ (raise-frame pause-frame)))
+
+
+(defun pause-break-message ()
+ (when (/= 0 (recursion-depth))
+ (message "%s" (propertize "Please take a pause! (Or exit now to take it in 1 minute.)"
+ 'face 'pause-1-minute-message-face))))
+
+(defun pause-break-exit-activate ()
+ (when (/= 0 (recursion-depth))
+ (setq pause-break-exit-active t)
+ (setq pause-break-1-minute-state nil)
+ (set-face-attribute 'mode-line nil :background pause-mode-line-color)
+ (message nil)
+ (with-current-buffer pause-buffer
+ (let ((inhibit-read-only t))
+ ;; Fix-me: This interfere with text buttons.
+ ;;(add-text-properties (point-min) (point-max) (list 'keymap nil))
+ ))))
+
+(defun pause-break-exit ()
+ (interactive)
+ (let ((elapsed (- (float-time) pause-break-last-wcfg-change)))
+ ;;(message "elapsed=%s pause-break-last-wcfg-change=%s" elapsed pause-break-last-wcfg-change)
+ (setq pause-break-last-wcfg-change (float-time))
+ (when (> elapsed 1.0)
+ (setq pause-break-exit-active t)
+ (remove-hook 'window-configuration-change-hook 'pause-break-exit)
+ ;;(pause-tell-again-cancel-timer)
+ (when (/= 0 (recursion-depth))
+ (exit-recursive-edit)))))
+
+(defun pause-break-exit-from-button ()
+ (setq pause-break-1-minute-state nil)
+ (setq pause-exited-from-button t)
+ (pause-break-exit))
+
+(defun pause-insert-img ()
+ (let* ((inhibit-read-only t)
+ img
+ src
+ (slice '(0 0 200 300))
+ (imgs (directory-files pause-img-dir nil nil t))
+ skip
+ )
+ (setq imgs (delete nil
+ (mapcar (lambda (d)
+ (unless (file-directory-p d) d))
+ imgs)))
+ (if (not imgs)
+ (setq img "No images found")
+ (setq skip (random (length imgs)))
+ (while (> skip 0)
+ (setq skip (1- skip))
+ (setq imgs (cdr imgs)))
+ (setq src (expand-file-name (car imgs) pause-img-dir))
+ (if (file-exists-p src)
+ (condition-case err
+ (setq img (create-image src nil nil
+ :relief 1
+ ;;:margin inlimg-margins
+ ))
+ (error (setq img (error-message-string err))))
+ (setq img (concat "Image not found: " src))))
+ (if (stringp img)
+ (insert img)
+ (insert-image img nil 'left-margin slice)
+ )
+ ))
+
+(defun pause-hide-cursor ()
+ ;; runs in timer, save-match-data
+ (with-current-buffer pause-buffer
+ (set (make-local-variable 'cursor-type) nil)))
+
+(defun pause-cancel-timer ()
+ (remove-hook 'post-command-hook 'pause-save-me-post-command)
+ (when (timerp pause-timer) (cancel-timer pause-timer))
+ (setq pause-timer nil))
+
+(defun pause-break-in-timer ()
+ (save-match-data ;; runs in timer
+ (pause-cancel-timer)
+ (if (or (active-minibuffer-window)
+ (and (boundp 'edebug-active)
+ edebug-active))
+ (let ((pause-idle-delay 5))
+ (pause-pre-break))
+ (let ((there-was-an-error nil))
+ (condition-case err
+ (pause-break)
+ (error
+ (setq there-was-an-error t)))
+ (when there-was-an-error
+ (condition-case err
+ (progn
+ (select-frame last-event-frame)
+ (let ((pause-idle-delay nil))
+ (pause-pre-break)))
+ (error
+ (lwarn 'pause-break-in-timer2 :error "%s" (error-message-string err))
+ )))))))
+
+(defcustom pause-only-when-server-mode t
+ "Allow `pause-mode' inly in the Emacs that has server-mode enabled.
+This is to prevent multiple Emacs with `pause-mode'."
+ :type 'boolean
+ :group 'pause)
+
+;;;###autoload
+(define-minor-mode pause-mode
+ "This minor mode tries to make you take a break.
+It will jump up and temporary stop your work - even if you are
+not in Emacs. If you are in Emacs it will however try to be
+gentle and wait until you have been idle with the keyboard for a
+short while. \(If you are not in Emacs it can't be gentle. How
+could it?)
+
+Then it will show you a special screen with a link to a yoga
+exercise you can do when you pause.
+
+After the pause you continue your work where you were
+interrupted."
+ :global t
+ :group 'pause
+ :set-after '(server-mode)
+ (if pause-mode
+ (if (and pause-only-when-server-mode
+ (not server-mode)
+ (not (with-no-warnings (called-interactively-p))))
+ (progn
+ (setq pause-mode nil)
+ (message "Pause mode canceled because not server-mode"))
+ (pause-start-timer))
+ (pause-cancel-timer)))
+
+;; (emacs-Q "-l" buffer-file-name "--eval" "(pause-temp-err)")
+;; (emacs-Q "-l" buffer-file-name "--eval" "(run-with-timer 1 nil 'pause-temp-err)")
+;; (pause-temp-err)
+(defun pause-temp-err ()
+ (switch-to-buffer (get-buffer-create "pause-temp-err buffer"))
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (add-text-properties (point-min) (point-max) (list 'keymap nil))
+ (insert-text-button "click to test"
+ 'action (lambda (btn)
+ (message "Click worked")))
+ ;;(add-text-properties (point-min) (point-max) (list 'keymap nil))
+ ))
+
+;; (customize-group-other-window 'pause)
+;; (apply 'custom-set-variables (pause-get-group-saved-customizations 'pause custom-file))
+;; (pause-get-group-saved-customizations 'w32shell custom-file)
+(defun pause-get-group-saved-customizations (group cus-file)
+ "Return customizations saved for GROUP in CUS-FILE."
+ (let* ((cus-buf (find-buffer-visiting cus-file))
+ (cus-old cus-buf)
+ (cus-point (when cus-old (with-current-buffer cus-old (point))))
+ (cusg-all (get group 'custom-group))
+ (cusg-vars (delq nil (mapcar (lambda (elt)
+ (when (eq (nth 1 elt) 'custom-variable)
+ (car elt)))
+ cusg-all)))
+ cus-vars-form
+ cus-face-form
+ cus-saved-vars
+ cus-saved-face)
+ (unless cus-buf (setq cus-buf (find-file-noselect cus-file)))
+ (with-current-buffer cus-buf
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (progn
+ (while (progn (skip-chars-forward " \t\n\^l")
+ (looking-at ";"))
+ (forward-line 1))
+ (not (eobp)))
+ (let ((form (read (current-buffer))))
+ (cond
+ ((eq (car form) 'custom-set-variables)
+ (setq cus-vars-form form))
+ ((eq (car form) 'custom-set-faces)
+ (setq cus-face-form form))
+ )))))
+ (dolist (vl (cdr cus-vars-form))
+ (when (memq (car (cadr vl)) cusg-vars)
+ (setq cus-saved-vars (cons (cadr vl) cus-saved-vars))))
+ cus-saved-vars))
+
+;; (emacs-Q "-l" buffer-file-name "--eval" "(pause-start 0.1 nil)")
+(defun pause-start (after-minutes cus-file)
+ "Start `pause-mode' with interval AFTER-MINUTES.
+This bypasses `pause-only-when-server-mode'.
+
+You can use this funciton to start a separate Emacs process that
+handles pause, for example like this if you want a pause every 15
+minutes:
+
+ emacs -Q -l pause --eval \"(pause-start 15 nil)\"
+
+Note: Another easier alternative might be to use
+ `pause-start-in-new-emacs'."
+ (interactive "nPause after how many minutes: ")
+ (pause-start-1 after-minutes cus-file))
+
+(defun pause-start-1 (after-minutes cus-file)
+ (setq debug-on-error t)
+ (pause-cancel-timer)
+ (when (and cus-file (file-exists-p cus-file))
+ (let ((args (pause-get-group-saved-customizations 'pause cus-file)))
+ ;;(message "cus-file=%S" cus-file)
+ ;;(message "args=%S" args)
+ (apply 'custom-set-variables args)))
+ (setq pause-after-minutes after-minutes)
+ (let ((pause-only-when-server-mode nil))
+ (pause-mode 1))
+ (switch-to-buffer (get-buffer-create "Pause information"))
+ (insert (propertize "Emacs pause\n"
+ 'face '(:inherit variable-pitch :height 1.5)))
+ (insert (format "Pausing every %d minute.\n" after-minutes))
+ (insert "Or, ")
+ (insert-text-button "pause now"
+ 'action `(lambda (button)
+ (condition-case err
+ (pause-break)
+ (error (message "%s" (error-message-string err))))))
+ (insert "!\n")
+ ;;(setq buffer-read-only t)
+ (pause-break-mode)
+ (delete-other-windows)
+ (setq mode-line-format nil)
+ (setq pause-frame (selected-frame))
+ (message nil)
+ (set-frame-parameter nil 'background-color pause-background-color))
+
+;; (pause-start-in-new-emacs 0.3)
+;; (pause-start-in-new-emacs 15)
+;;;###autoload
+(defun pause-start-in-new-emacs (after-minutes)
+ "Start pause with interval AFTER-MINUTES in a new Emacs instance.
+The new Emacs instance will be started with -Q. However if
+`custom-file' is non-nil it will be loaded so you can still
+customize pause.
+
+One way of using this function may be to put in your .emacs
+something like
+
+ ;; for just one Emacs running pause
+ (when server-mode (pause-start-in-new-emacs 15))
+
+See `pause-start' for more info.
+
+"
+ (interactive (list pause-after-minutes))
+ (let* ((this-emacs (locate-file invocation-name
+ (list invocation-directory)
+ exec-suffixes))
+ (cus-file (if custom-file custom-file "~/.emacs"))
+ (args `("-l" ,pause-el-file
+ "--geometry=40x3"
+ "-D"
+ "--eval" ,(format "(pause-start %s %S)" after-minutes cus-file))))
+ (setq args (cons "-Q" args))
+ (apply 'call-process this-emacs nil 0 nil args)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Link to yoga poses
+
+;; (defun w3-download-callback (fname)
+;; (let ((coding-system-for-write 'binary))
+;; (goto-char (point-min))
+;; (search-forward "\n\n" nil t)
+;; (write-region (point) (point-max) fname))
+;; (url-mark-buffer-as-dead (current-buffer))
+;; (message "Download of %s complete." (url-view-url t))
+;; (sit-for 3))
+
+;;(run-with-idle-timer 0 nil 'pause-get-yoga-poses)
+(defvar pause-yoga-poses-host-url "http://www.abc-of-yoga.com/")
+
+;;(pause-start-get-yoga-poses)
+(defun pause-start-get-yoga-poses ()
+ (require 'url-vars)
+ (let ((url-show-status nil)) ;; do not show download messages
+ (url-retrieve (concat pause-yoga-poses-host-url "yogapractice/mountain.asp")
+ 'pause-callback-get-yoga-poses)))
+
+(defun pause-callback-get-yoga-poses (status)
+ (let ((pose (pause-random-yoga-pose (pause-get-yoga-poses-1 (current-buffer)))))
+ (message nil)
+ (when (and pose (buffer-live-p pause-buffer))
+ (pause-insert-yoga-link pose))))
+
+(defun pause-insert-yoga-link (pose)
+ (with-current-buffer pause-buffer
+ (let ((here (point))
+ (inhibit-read-only t)
+ (pose-url (concat pause-yoga-poses-host-url (car pose))))
+ (goto-char (point-max))
+ (insert "Link to yoga posture for you: ")
+ (insert-text-button (cdr pose)
+ 'action `(lambda (button)
+ (condition-case err
+ (progn
+ (browse-url ,pose-url)
+ (run-with-idle-timer 1 nil 'pause-break-exit-from-button))
+ (error (message "%s" (error-message-string err))))))
+ (insert "\n")
+ (pause-break-message))))
+
+(defun pause-get-yoga-poses ()
+ (let* ((url-show-status nil) ;; do not show download messages
+ (buf (url-retrieve-synchronously "http://www.abc-of-yoga.com/yogapractice/mountain.asp")))
+ (pause-get-yoga-poses-1 buf)))
+
+;; (setq x (url-retrieve-synchronously "http://www.abc-of-yoga.com/yogapractice/mountain.asp"))
+;; (setq x (url-retrieve-synchronously "http://www.emacswiki.org/emacs/EmacsFromBazaar"))
+
+;; (defun temp-y ()
+;; (message "before y")
+;; ;;(setq y (url-retrieve-synchronously "http://www.emacswiki.org/emacs/EmacsFromBazaar"))
+;; (setq x (url-retrieve-synchronously "http://www.abc-of-yoga.com/yogapractice/mountain.asp"))
+;; (message "after x")
+;; )
+;; (run-with-idle-timer 0 nil 'temp-y)
+
+(defun pause-get-yoga-poses-1 (buf)
+ (require 'url)
+ (setq url-debug t)
+ ;; url-insert-file-contents
+ (let* ((first-marker "<p>These are all the Yoga Poses covered in this section:</p>")
+ (table-patt "<table\\(?:.\\|\n\\)*?</table>")
+ table-beg
+ table-end
+ (pose-patt "<A HREF=\"\\([^\"]*?\\)\" class=\"LinkBold\">\\([^<]*?\\)</A>")
+ poses
+ (trouble-msg
+ (catch 'trouble
+ ;;(switch-to-buffer-other-window buf)
+ (with-current-buffer buf
+ (goto-char 1)
+ (rename-buffer "YOGA" t)
+ (unless (search-forward first-marker nil t)
+ (throw 'trouble "Can't find marker for the poses on the page"))
+ (backward-char 10)
+ (unless (re-search-forward table-patt nil t)
+ (throw 'trouble "Can't find table with poses on the page"))
+ (setq table-beg (match-beginning 0))
+ (setq table-end (match-end 0))
+ (goto-char table-beg)
+ (while (re-search-forward pose-patt table-end t)
+ (setq poses (cons (cons (match-string 1) (match-string 2))
+ poses)))
+ (unless poses
+ (throw 'trouble "Can't find poses in table on the page"))
+ (kill-buffer)
+ nil))))
+ (if trouble-msg
+ (progn
+ (message "%s" trouble-msg)
+ nil)
+ (message "Number of yoga poses found=%s" (length poses))
+ poses)))
+
+(defun pause-random-yoga-pose (poses)
+ (when poses
+ (random t)
+ (let* ((n-poses (length poses))
+ (pose-num (random (1- n-poses)))
+ (the-pose (nth pose-num poses)))
+ the-pose)))
+
+;;(pause-random-yoga-pose (pause-get-yoga-poses))
+
+(provide 'pause)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; pause.el ends here
--- /dev/null
+;;; pointback.el --- Restore window points when returning to buffers
+
+;; Copyright (C) 2009 Markus Triska
+
+;; Author: Markus Triska <markus.triska@gmx.at>
+;; Keywords: convenience
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; When you have two windows X and Y showing different sections of the
+;; same buffer B, then switch to a different buffer in X, and then
+;; show B in X again, the new point in X will be the same as in Y.
+;; With pointback-mode, window points are preserved instead, and point
+;; will be where it originally was in X for B when you return to B.
+
+;; Use M-x pointback-mode RET to enable pointback-mode for a buffer.
+;; Use M-x global-pointback-mode RET to enable it for all buffers.
+
+;;; Code:
+
+(require 'assoc)
+
+(defconst pointback-version "0.2")
+
+(defvar pointback-windows nil
+ "Association list of windows to buffers and window points.")
+
+(defun pointback-store-point ()
+ "Save window point and start for the current buffer of the
+selected window."
+ (sit-for 0) ; redisplay to update window-start
+ (let* ((buffers (cdr (assq (selected-window) pointback-windows)))
+ (b (assq (current-buffer) buffers))
+ (p (cons (point) (window-start))))
+ (if b
+ (setcdr b p)
+ (let ((current (cons (current-buffer) p)))
+ (aput 'pointback-windows (selected-window) (cons current buffers))))))
+
+(defun pointback-restore ()
+ "Restore previously stored window point for the selected window."
+ (let* ((buffers (cdr (assq (selected-window) pointback-windows)))
+ (b (assq (current-buffer) buffers))
+ (p (cdr b)))
+ (when b
+ (goto-char (car p))
+ (set-window-start (selected-window) (cdr p) t)))
+ ;; delete dead windows from pointback-windows
+ (dolist (w pointback-windows)
+ (unless (window-live-p (car w))
+ (adelete 'pointback-windows (car w))))
+ ;; delete window points of dead buffers
+ (dolist (w pointback-windows)
+ (let (buffers)
+ (dolist (b (cdr w))
+ (when (buffer-live-p (car b))
+ (push b buffers)))
+ (aput 'pointback-windows (car w) buffers))))
+
+;;;###autoload
+(define-minor-mode pointback-mode
+ "Restore previous window point when switching back to a buffer."
+ :lighter ""
+ (if pointback-mode
+ (progn
+ (add-hook 'post-command-hook 'pointback-store-point nil t)
+ (add-hook 'window-configuration-change-hook
+ 'pointback-restore nil t))
+ (remove-hook 'post-command-hook 'pointback-store-point t)
+ (remove-hook 'window-configuration-change-hook 'pointback-restore t)
+ (setq pointback-windows nil)))
+
+;;;###autoload
+(define-globalized-minor-mode global-pointback-mode pointback-mode pointback-on)
+
+(defun pointback-on ()
+ (pointback-mode 1))
+
+(provide 'pointback)
+;;; pointback.el ends here
--- /dev/null
+;;; popcmp.el --- Completion enhancements, popup etc
+;;
+;; Author: Lennart Borgman
+;; Created: Tue Jan 09 12:00:29 2007
+;; Version: 1.00
+;; Last-Updated: 2008-03-08T03:30:15+0100 Sat
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `ourcomments-util'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'ourcomments-util nil t))
+
+;;;###autoload
+(defgroup popcmp nil
+ "Customization group for popup completion."
+ :tag "Completion Style \(popup etc)"
+ :group 'nxhtml
+ :group 'convenience)
+
+;; (define-toggle popcmp-popup-completion t
+;; "Use a popup menu for some completions if non-nil.
+
+;; ***** Obsolete: Use `popcmp-completion-style' instead.
+
+;; When completion is used for alternatives tighed to text at the
+;; point in buffer it may make sense to use a popup menu for
+;; completion. This variable let you decide whether normal style
+;; completion or popup style completion should be used then.
+
+;; This style of completion is not implemented for all completions.
+;; It is implemented for specific cases but the choice of completion
+;; style is managed generally by this variable for all these cases.
+
+;; See also the options `popcmp-short-help-beside-alts' and
+;; `popcmp-group-alternatives' which are also availabe when popup
+;; completion is available."
+;; :tag "Popup style completion"
+;; :group 'popcmp)
+
+(defun popcmp-cant-use-style (style)
+ (save-match-data ;; runs in timer
+ (describe-variable 'popcmp-completion-style)
+ (message (propertize "popcmp-completion-style: style `%s' is not available"
+ 'face 'secondary-selection)
+ style)))
+
+
+
+(defun popcmp-set-completion-style (val)
+ "Internal use, set `popcmp-completion-style' to VAL."
+ (assert (memq val '(popcmp-popup emacs-default company-mode anything)) t)
+ (case val
+ ('company-mode (unless (fboundp 'company-mode)
+ (require 'company-mode nil t))
+ (unless (fboundp 'company-mode)
+ (run-with-idle-timer 1 nil 'popcmp-cant-use-style val)
+ (setq val 'popcmp-popup)))
+ ('anything (unless (fboundp 'anything)
+ (require 'anything nil t))
+ (unless (fboundp 'anything)
+ (run-with-idle-timer 1 nil 'popcmp-cant-use-style val)
+ (setq val 'popcmp-popup))))
+ (set-default 'popcmp-completion-style val)
+ (unless (eq val 'company-mode)
+ (when (and (boundp 'global-company-mode)
+ global-company-mode)
+ (global-company-mode -1))
+ (remove-hook 'after-change-major-mode-hook 'company-set-major-mode-backend)
+ (remove-hook 'mumamo-after-change-major-mode-hook 'mumamo-turn-on-company-mode))
+ (when (eq val 'company-mode)
+ (unless (and (boundp 'global-company-mode)
+ global-company-mode)
+ (global-company-mode 1))
+ (add-hook 'after-change-major-mode-hook 'company-set-major-mode-backend)
+ (add-hook 'mumamo-after-change-major-mode-hook 'mumamo-turn-on-company-mode)))
+
+;; fix-me: move to mumamo.el
+(defun mumamo-turn-on-company-mode ()
+ (when (and (boundp 'company-mode)
+ company-mode)
+ (company-mode 1)
+ (company-set-major-mode-backend)))
+
+;;;###autoload
+(defcustom popcmp-completion-style (cond
+ ;;((and (fboundp 'global-company-mode) 'company-mode) 'company-mode)
+ (t 'popcmp-popup))
+ "Completion style.
+The currently available completion styles are:
+
+- popcmp-popup: Use OS popup menus (default).
+- emacs-default: Emacs default completion.
+- Company Mode completion.
+- anything: The Anything elisp lib completion style.
+
+The style of completion set here is not implemented for all
+completions. The scope varies however with which completion
+style you have choosen.
+
+For information about Company Mode and how to use it see URL
+`http://www.emacswiki.org/emacs/CompanyMode'.
+
+For information about Anything and how to use it see URL
+`http://www.emacswiki.org/emacs/Anything'.
+
+See also the options `popcmp-short-help-beside-alts' and
+`popcmp-group-alternatives' which are also availabe when popup
+completion is available."
+ :type '(choice (const company-mode)
+ (const popcmp-popup)
+ (const emacs-default)
+ (const anything))
+ :set (lambda (sym val)
+ (popcmp-set-completion-style val))
+ :group 'popcmp)
+
+;;(define-toggle popcmp-short-help-beside-alts t
+(define-minor-mode popcmp-short-help-beside-alts
+ "Show a short help text beside each alternative.
+If this is non-nil a short help text is shown beside each
+alternative for which such a help text is available.
+
+This works in the same circumstances as
+`popcmp-completion-style'."
+ :tag "Short help beside alternatives"
+ :global t
+ :init-value t
+ :group 'popcmp)
+
+(defun popcmp-short-help-beside-alts-toggle ()
+ "Toggle `popcmp-short-help-beside-alts'."
+ (popcmp-short-help-beside-alts (if popcmp-short-help-beside-alts -1 1)))
+
+;;(define-toggle popcmp-group-alternatives t
+(define-minor-mode popcmp-group-alternatives
+ "Do completion in two steps.
+For some completions the alternatives may have been grouped in
+sets. If this option is non-nil then you will first choose a set
+and then an alternative within this set.
+
+This works in the same circumstances as
+`popcmp-completion-style'."
+ :tag "Group alternatives"
+ :global t
+ :init-value t
+ :group 'popcmp)
+
+(defun popcmp-group-alternatives-toggle ()
+ "Toggle `popcmp-group-alternatives-toggle'."
+ (interactive)
+ (popcmp-group-alternatives (if popcmp-group-alternatives -1 1)))
+
+(defun popcmp-getsets (alts available-sets)
+ (let ((sets nil))
+ (dolist (tg alts)
+ (let (found)
+ (dolist (s available-sets)
+ (when (member tg (cdr s))
+ (setq found t)
+ (let ((sets-entry (assq (car s) sets)))
+ (unless sets-entry
+ (setq sets (cons (list (car s)) sets))
+ (setq sets-entry (assq (car s) sets)))
+ (setcdr sets-entry (cons tg (cdr sets-entry))))))
+ (unless found
+ (let ((sets-entry (assq 'unsorted sets)))
+ (unless sets-entry
+ (setq sets (cons (list 'unsorted) sets))
+ (setq sets-entry (assq 'unsorted sets)))
+ (setcdr sets-entry (cons tg (cdr sets-entry)))))))
+ (setq sets (sort sets (lambda (a b)
+ (string< (format "%s" b)
+ (format "%s" a)))))
+ ;;(dolist (s sets) (setcdr s (reverse (cdr s))))
+ sets))
+
+(defun popcmp-getset-alts (set-name sets)
+ ;; Allow both strings and symbols as keys:
+ (let ((set (or (assoc (downcase set-name) sets)
+ (assoc (read (downcase set-name)) sets))))
+ (cdr set)))
+
+(defvar popcmp-completing-with-help nil)
+
+(defun popcmp-add-help (alt alt-help-hash)
+ (if alt-help-hash
+ (let ((h (if (hash-table-p alt-help-hash)
+ (gethash alt alt-help-hash)
+ (let ((hh (assoc alt alt-help-hash)))
+ (cadr hh)))
+ ))
+ (if h
+ (concat alt " -- " h)
+ alt))
+ alt))
+
+(defun popcmp-remove-help (alt-with-help)
+ (when alt-with-help
+ (replace-regexp-in-string " -- .*" "" alt-with-help)))
+
+(defun popcmp-anything (prompt collection
+ predicate require-match
+ initial-input hist def inherit-input-method
+ alt-help alt-sets)
+ (let* ((table collection)
+ (alt-sets2 (apply 'append (mapcar 'cdr alt-sets)))
+ (cands (cond ((not (listp table)) alt-sets2)
+ (t table)))
+ ret-val
+ (source `((name . "Completion candidates")
+ (candidates . ,cands)
+ (action . (("Select current alternative (press TAB to see it again)" . (lambda (candidate)
+ (setq ret-val candidate))))))))
+ (anything (list source) initial-input prompt)
+ ret-val))
+
+(defun popcmp-completing-read-1 (prompt collection
+ predicate require-match
+ initial-input hist2 def inherit-input-method alt-help alt-sets)
+ ;; Fix-me: must rename hist to hist2 in par list. Emacs bug?
+ (cond
+ ((eq popcmp-completion-style 'emacs-default)
+ (completing-read prompt collection predicate require-match initial-input hist2 def inherit-input-method))
+ ((eq popcmp-completion-style 'anything)
+ (popcmp-anything prompt collection predicate require-match initial-input hist2 def inherit-input-method
+ alt-help alt-sets))
+ ((eq popcmp-completion-style 'company-mode)
+ ;; No way to read this from company-mode, use emacs-default
+ (completing-read prompt collection predicate require-match initial-input hist2 def inherit-input-method))
+ (t (error "Do not know popcmp-completion-style %S" popcmp-completion-style))))
+
+(defun popcmp-completing-read-other (prompt
+ table
+ &optional predicate require-match
+ initial-input pop-hist def inherit-input-method
+ alt-help
+ alt-sets)
+ (let ((alts
+ (if (and popcmp-group-alternatives alt-sets)
+ (all-completions initial-input table predicate)
+ (if popcmp-short-help-beside-alts
+ (all-completions "" table predicate)
+ table))))
+ (when (and popcmp-group-alternatives alt-sets)
+ (let* ((sets (popcmp-getsets alts alt-sets))
+ (set-names (mapcar (lambda (elt)
+ (capitalize (format "%s" (car elt))))
+ sets))
+ set)
+ (setq set
+ (popcmp-completing-read-1 (concat
+ (substring prompt 0 (- (length prompt) 2))
+ ", select group: ")
+ set-names
+ nil t
+ nil nil nil inherit-input-method nil nil))
+ (if (or (not set) (= 0 (length set)))
+ (setq alts nil)
+ (setq set (downcase set))
+ (setq alts (popcmp-getset-alts set sets)))))
+ (if (not alts)
+ ""
+ (if (= 1 (length alts))
+ (car alts)
+ (when popcmp-short-help-beside-alts
+ (setq alts (mapcar (lambda (a)
+ (popcmp-add-help a alt-help))
+ alts)))
+ (popcmp-remove-help
+ ;;(completing-read prompt
+ (popcmp-completing-read-1 prompt
+ alts ;table
+ predicate require-match
+ initial-input pop-hist def inherit-input-method
+ ;;alt-help alt-sets
+ nil nil
+ ))))))
+
+(defun popcmp-completing-read-pop (prompt
+ table
+ &optional predicate require-match
+ initial-input hist def inherit-input-method
+ alt-help
+ alt-sets)
+ (unless initial-input
+ (setq initial-input ""))
+ (let ((matching-alts (all-completions initial-input table predicate))
+ completion)
+ (if (not matching-alts)
+ (progn
+ (message "No alternative found")
+ nil)
+ (let ((pop-map (make-sparse-keymap prompt))
+ (sets (when (and popcmp-group-alternatives alt-sets)
+ (popcmp-getsets matching-alts alt-sets)))
+ (add-alt (lambda (k tg)
+ (define-key k
+ (read (format "[popcmp-%s]" (replace-regexp-in-string " " "-" tg)))
+ (list 'menu-item
+ (popcmp-add-help tg alt-help)
+ `(lambda ()
+ (interactive)
+ (setq completion ,tg)))))))
+ (if sets
+ (dolist (s sets)
+ (let ((k (make-sparse-keymap)))
+ (dolist (tg (cdr s))
+ (funcall add-alt k tg))
+ (define-key pop-map
+ (read (format "[popcmps-%s]" (car s)))
+ (list 'menu-item
+ (capitalize (format "%s" (car s)))
+ k))))
+ (dolist (tg matching-alts)
+ (funcall add-alt pop-map tg)))
+ (popup-menu-at-point pop-map)
+ completion))))
+
+(defvar popcmp-in-buffer-allowed nil)
+
+;;;###autoload
+(defun popcmp-completing-read (prompt
+ table
+ &optional predicate require-match
+ initial-input pop-hist def inherit-input-method
+ alt-help
+ alt-sets)
+ "Read a string in the minubuffer with completion, or popup a menu.
+This function can be used instead `completing-read'. The main
+purpose is to provide a popup style menu for completion when
+completion is tighed to text at point in a buffer. If a popup
+menu is used it will be shown at window point. Whether a popup
+menu or minibuffer completion is used is governed by
+`popcmp-completion-style'.
+
+The variables PROMPT, TABLE, PREDICATE, REQUIRE-MATCH,
+INITIAL-INPUT, POP-HIST, DEF and INHERIT-INPUT-METHOD all have the
+same meaning is for `completing-read'.
+
+ALT-HELP should be nil or a hash variable or an association list
+with the completion alternative as key and a short help text as
+value. You do not need to supply help text for all alternatives.
+The use of ALT-HELP is set by `popcmp-short-help-beside-alts'.
+
+ALT-SETS should be nil or an association list that has as keys
+groups and as second element an alternative that should go into
+this group.
+"
+ (if (and popcmp-in-buffer-allowed
+ (eq popcmp-completion-style 'company-mode)
+ (boundp 'company-mode)
+ company-mode)
+ (progn
+ (add-hook 'company-completion-finished-hook 'nxhtml-complete-tag-do-also-for-state-completion t)
+ ;;(remove-hook 'company-completion-finished-hook 'nxhtml-complete-tag-do-also-for-state-completion)
+ (call-interactively 'company-nxml)
+ initial-input)
+
+ (popcmp-mark-completing initial-input)
+ (let ((err-sym 'quit)
+ (err-val nil)
+ ret)
+ (unwind-protect
+ (if (eq popcmp-completion-style 'popcmp-popup)
+ (progn
+ (setq err-sym nil)
+ (popcmp-completing-read-pop
+ prompt
+ table
+ predicate require-match
+ initial-input pop-hist def inherit-input-method
+ alt-help
+ alt-sets))
+ ;;(condition-case err
+ (prog1
+ (setq ret (popcmp-completing-read-other
+ prompt
+ table
+ predicate require-match
+ initial-input pop-hist def inherit-input-method
+ alt-help
+ alt-sets))
+ ;; Unless quit or error in Anything we come here:
+ ;;(message "ret=(%S)" ret)
+ (when (and ret (not (string= ret "")))
+ (setq err-sym nil)))
+ ;; (error
+ ;; ;;(message "err=%S" err)
+ ;; (setq err-sym (car err))
+ ;; (setq err-val (cdr err))))
+ )
+ (popcmp-unmark-completing)
+ (when err-sym (signal err-sym err-val))))))
+
+(defvar popcmp-mark-completing-ovl nil)
+
+(defun popcmp-mark-completing (initial-input)
+ (let ((start (- (point) (length initial-input)))
+ (end (point)))
+ (if (overlayp popcmp-mark-completing-ovl)
+ (move-overlay popcmp-mark-completing-ovl start end)
+ (setq popcmp-mark-completing-ovl (make-overlay start end))
+ (overlay-put popcmp-mark-completing-ovl 'face 'match)))
+ (sit-for 0))
+
+(defun popcmp-unmark-completing ()
+ (when popcmp-mark-completing-ovl
+ (delete-overlay popcmp-mark-completing-ovl)))
+
+
+;; (defun popcmp-temp ()
+;; (interactive)
+;; (let* ((coord (point-to-coord (point)))
+;; (x (nth 0 (car coord)))
+;; (y (nth 1 (car coord)))
+;; (emacsw32-max-frames nil)
+;; (f (make-frame
+;; (list '(minibuffer . only)
+;; '(title . "Input")
+;; '(name . "Input frame")
+;; (cons 'left x)
+;; (cons 'top y)
+;; '(height . 1)
+;; '(width . 40)
+;; '(border-width . 1)
+;; '(internal-border-width . 2)
+;; '(tool-bar-lines . nil)
+;; '(menu-bar-lines . nil)
+;; ))))
+;; f))
+
+
+(provide 'popcmp)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; popcmp.el ends here
--- /dev/null
+This subdirectory contains files used by nXhtml that I have\r
+written. The files are placed here because they may be of use also\r
+outside of nXhtml.\r
--- /dev/null
+;;; rebind.el --- Rebind keys
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-01-20T12:04:37+0100 Sun
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; See `rebind-keys-mode' for information.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'new-key-seq-widget nil t))
+(eval-when-compile (require 'ourcomments-widgets nil t))
+
+
+(defun rebind-toggle-first-modifier (orig-key-seq mod)
+ (let* ((first (elt orig-key-seq 0))
+ (new-key-seq (copy-sequence orig-key-seq)))
+ (setq first (if (memq mod first)
+ (delq mod first)
+ (cons mod first)))
+ (aset new-key-seq 0 first)
+ new-key-seq))
+;; (rebind-toggle-first-modifier (key-description-to-vector "C-c a") 'shift)
+;; (rebind-toggle-first-modifier (key-description-to-vector "C-S-c a") 'shift)
+
+(defvar widget-commandp-prompt-value-history nil)
+
+;;;###autoload
+(defgroup rebind nil
+ "Customizaton group for `rebind-keys-mode'."
+ :group 'convenience
+ :group 'emulations
+ :group 'editing-basics
+ :group 'emacsw32)
+
+;; (customize-option-other-window 'rebind-keys)
+;; (Fetched key bindings from http://www.davidco.com/tips_tools/tip45.html)
+(defcustom rebind-keys
+ '(
+ ("MS Windows - often used key bindings" t
+ (
+ (
+ [(control ?a)]
+ "C-a on w32 normally means 'select all'. In Emacs it is `beginning-of-line'."
+ t
+ shift
+ ourcomments-mark-whole-buffer-or-field)
+ (
+ [(control ?o)]
+ "C-o on w32 normally means 'open file'. In Emacs it is `open-line'."
+ nil
+ shift
+ find-file)
+ (
+ [(control ?f)]
+ "C-f is commonly search on w32. In Emacs it is `forward-char'."
+ nil
+ shift
+ isearch-forward)
+ (
+ [(control ?s)]
+ "C-s is normally 'save file' on w32. In Emacs it is `isearch-forward'."
+ nil
+ nil
+ save-buffer)
+ (
+ [(control ?w)]
+ "C-w is often something like kill-buffer on w32. In Emacs it is `kill-region'."
+ t
+ shift
+ kill-buffer)
+ (
+ [(control ?p)]
+ "C-p is nearly always print on w32. In Emacs it is `previous-line'."
+ t
+ shift
+ hfyview-buffer)
+ (
+ [(home)]
+ "HOME normally stays in a field. By default it does not do that in Emacs."
+ t
+ nil
+ ourcomments-move-beginning-of-line)
+ (
+ [(control ?+)]
+ "C-+ often increases font size (in web browsers for example)."
+ t
+ shift
+ text-scale-adjust)
+ (
+ [(control ?-)]
+ "C-- often decreases font size (in web browsers for example)."
+ t
+ shift
+ text-scale-adjust)
+ (
+ [(control ?0)]
+ "C-0 often resets font size (in web browsers for example)."
+ t
+ shift
+ text-scale-adjust)
+ )))
+ "Normal Emacs keys that are remapped to follow some other standard.
+The purpose of this variable is to make it easy to switch between
+Emacs key bindings and other standards.
+
+The new bindings are made in the global minor mode
+`rebind-keys-mode' and will only have effect when this mode is
+on.
+
+*Note:* You can only move functions bound in the global key map
+ this way.
+*Note:* To get CUA keys you should turn on option `cua-mode'.
+*Note:* To get vi key bindings call function `viper-mode'.
+*Note:* `text-scale-adjust' already have default key bindings."
+ :type '(repeat
+ (list
+ (string :tag "For what")
+ (boolean :tag "Group on/off")
+ (repeat
+ (list
+ (key-sequence :tag "Emacs key binding")
+ (string :tag "Why rebind")
+ (boolean :tag "Rebinding on/off")
+ (choice :tag "Move original by"
+ (const :tag "Don't put it on any new binding" nil)
+ (choice :tag "Add key binding modifier"
+ (const meta)
+ (const control)
+ (const shift))
+ (key-sequence :tag "New binding for original function"))
+ (command :tag "New command on above key"))
+ )))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (featurep 'rebind)
+ (rebind-update-keymap)))
+ :group 'rebind)
+
+(defvar rebind-keys-mode-map nil)
+
+(defvar rebind--emul-keymap-alist nil)
+
+;;(rebind-update-keymap)
+(defun rebind-update-keymap ()
+ (let ((m (make-sparse-keymap)))
+ (dolist (group rebind-keys)
+ (when (nth 1 group)
+ (dolist (v (nth 2 group))
+ (let* ((orig-key (nth 0 v))
+ (comment (nth 1 v))
+ (enabled (nth 2 v))
+ (new-choice (nth 3 v))
+ (new-fun (nth 4 v))
+ (orig-fun (lookup-key global-map orig-key))
+ new-key)
+ (when enabled
+ (when new-choice
+ (if (memq new-choice '(meta control shift))
+ (setq new-key (rebind-toggle-first-modifier orig-key new-choice))
+ (setq new-key new-choice))
+ (define-key m new-key orig-fun))
+ (define-key m orig-key new-fun))))
+ (setq rebind-keys-mode-map m))))
+ (setq rebind--emul-keymap-alist (list (cons 'rebind-keys-mode rebind-keys-mode-map))))
+
+;;;###autoload
+(define-minor-mode rebind-keys-mode
+ "Rebind keys as defined in `rebind-keys'.
+The key bindings will override almost all other key bindings
+since it is put on emulation level, like for example ``cua-mode'
+and `viper-mode'.
+
+This is for using for example C-a to mark the whole buffer \(or a
+field). There are some predifined keybindings for this."
+ :keymap rebind-keys-mode-map
+ :global t
+ :group 'rebind
+ (if rebind-keys-mode
+ (progn
+ (rebind-update-keymap)
+ ;;(rebind-keys-post-command)
+ (add-hook 'post-command-hook 'rebind-keys-post-command t))
+ (remove-hook 'post-command-hook 'rebind-keys-post-command)
+ (setq emulation-mode-map-alists (delq 'rebind--emul-keymap-alist emulation-mode-map-alists))))
+
+(defun rebind-keys-post-command ()
+ "Make sure we are first in the list when turned on.
+This is reasonable since we are using this mode to really get the
+key bindings we want!"
+ (unless (eq 'rebind--emul-keymap-alist (car emulation-mode-map-alists))
+ (setq emulation-mode-map-alists (delq 'rebind--emul-keymap-alist emulation-mode-map-alists))
+ (when rebind-keys-mode
+ (add-to-list 'emulation-mode-map-alists 'rebind--emul-keymap-alist))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Interactive functions for the keymap
+
+
+
+(provide 'rebind)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; rebind.el ends here
--- /dev/null
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; A major mode for editing RELAX NG Compact syntax.
+;; Version: 1.0b3
+;; Date: 2002-12-05
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Copyright (c) 2002, Pantor Engineering AB
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or
+;; without modification, are permitted provided that the following
+;; conditions are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;;
+;; * Redistributions in binary form must reproduce the above
+;; copyright notice, this list of conditions and the following
+;; disclaimer in the documentation and/or other materials provided
+;; with the distribution.
+;;
+;; * Neither the name of Pantor Engineering AB nor the names of its
+;; contributors may be used to endorse or promote products derived
+;; from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
+;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
+;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+;; POSSIBILITY OF SUCH DAMAGE.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Created by David.Rosenborg@pantor.com
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Example setup for your ~/.emacs file:
+;;
+;; (autoload 'rnc-mode "rnc-mode")
+;; (setq auto-mode-alist
+;; (cons '("\\.rnc\\'" . rnc-mode) auto-mode-alist))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Changes since 1.0b:
+;; Added a couple of defvars for faces to handle differences
+;; between GNU Emacs and XEmacs.
+;;
+;; 2008-12-28: Changed forward-char-command => forward-char
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'font-lock)
+
+(defvar rnc-indent-level 3 "The RNC indentation level.")
+
+(defvar rnc-keywords
+ (mapcar (lambda (kw) (concat "\\b" kw "\\b"))
+ '("attribute" "div" "element"
+ "empty" "external" "grammar" "include" "inherit" "list"
+ "mixed" "notAllowed" "parent" "start" "string"
+ "text" "token"))
+ "RNC keywords")
+
+(defvar rnc-atoms
+ (mapcar (lambda (kw) (concat "\\b" kw "\\b"))
+ '("empty" "notAllowed" "string" "text" "token"))
+ "RNC atomic pattern keywords")
+
+(defun rnc-make-regexp-choice (operands)
+ "(op1 op2 ...) -> \"\\(op1\\|op2\\|...\\)\""
+ (let ((result "\\("))
+ (mapc (lambda (op) (setq result (concat result op "\\|"))) operands)
+ (concat (substring result 0 -2) "\\)")))
+
+;; Font lock treats face names differently in GNU Emacs and XEmacs
+;; The following defvars is a workaround
+
+(defvar italic 'italic)
+(defvar default 'default)
+(defvar font-lock-preprocessor-face 'font-lock-preprocessor-face)
+
+(defvar rnc-font-lock-keywords
+ (list
+ '("\\b\\(attribute\\|element\\)\\b\\([^{]+\\){" 2
+ font-lock-variable-name-face)
+ '("[a-zA-Z][-a-zA-Z0-9._]*:[a-zA-Z][-a-zA-Z0-9._]*" . italic)
+ '("\\b\\(default\\(\\s +namespace\\)?\\|namespace\\|datatypes\\)\\(\\s +[a-zA-Z][-a-zA-Z0-9._]*\\)?\\s *=" 1 font-lock-preprocessor-face)
+ '("\\([a-zA-Z][-a-zA-Z0-9._]*\\)\\(\\s \\|\n\\)*[|&]?=" 1
+ font-lock-function-name-face)
+ '("[a-zA-Z][a-zA-Z0-9._]*\\(-[a-zA-Z][a-zA-Z0-9._]*\\)+" . default)
+ (cons (rnc-make-regexp-choice rnc-atoms) 'italic)
+ (cons (rnc-make-regexp-choice rnc-keywords) font-lock-keyword-face)
+ )
+ "RNC Highlighting")
+
+
+(defun rnc-find-column (first start)
+ "Find which column to indent to."
+
+ ;; FIXME: backward-sexp doesn't work with unbalanced braces in comments
+
+ (let* (column
+ pos
+ ;; Find start of enclosing block or assignment
+ (token
+ (if (member first '("]" "}" ")"))
+ (progn
+ (goto-char (+ start 1))
+ (backward-sexp)
+ (beginning-of-line)
+ (re-search-forward "\\S ")
+ (setq pos (point))
+ (setq column (- (current-column) 1))
+ 'lpar)
+ (catch 'done
+ (while (setq pos (re-search-backward "[{}()=]\\|\\[\\|\\]"
+ (point-min) t))
+ (let ((c (match-string 0)))
+ (beginning-of-line)
+ (re-search-forward "\\S ")
+ (setq column (- (current-column) 1))
+ (beginning-of-line)
+ (cond
+ ;; Don't match inside comments
+ ;; FIXME: Should exclude matches inside string literals too
+ ((re-search-forward "#" pos t) (beginning-of-line))
+ ;; Skip block
+ ((member c '("]" "}" ")"))
+ (goto-char (+ pos 1))
+ (backward-sexp))
+
+ ((string= c "=") (throw 'done 'eq))
+ (t (throw 'done 'lpar)))))))))
+
+ (cond
+ ((not pos) 0)
+ ((member first '("]" "}" ")")) column)
+ ((member first '("{" "(")) (+ column rnc-indent-level))
+
+ ;; Give lines starting with an operator a small negative indent.
+ ;; This allows for the following indentation style:
+ ;; foo =
+ ;; bar
+ ;; | baz
+ ;; | oof
+ ((member first '("," "&" "|")) (+ column (- rnc-indent-level 2)))
+
+ ;; Check if first preceding non-whitespace character was an operator
+ ;; If not, this is most likely a new assignment.
+ ;; FIXME: This doesn't play well with name classes starting on a new
+ ;; line
+ ((eq token 'eq)
+ (goto-char start)
+ (if (and (re-search-backward "[^ \t\n]" (point-min) t)
+ (member (match-string 0) '("&" "|" "," "=" "~")))
+ (+ column rnc-indent-level)
+ column))
+
+ (t (+ column rnc-indent-level)))))
+
+(defun rnc-indent-line ()
+ "Indents the current line."
+ (interactive)
+ (let ((orig-point (point)))
+ (beginning-of-line)
+ (let* ((beg-of-line (point))
+ (pos (re-search-forward "\\(\\S \\|\n\\)" (point-max) t))
+ (first (match-string 0))
+ (start (match-beginning 0))
+ (col (- (current-column) 1)))
+
+ (goto-char beg-of-line)
+
+ (let ((indent-column (rnc-find-column first start)))
+ (goto-char beg-of-line)
+
+ (cond
+ ;; Only modify buffer if the line must be reindented
+ ((not (= col indent-column))
+ (if (not (or (null pos)
+ (= beg-of-line start)))
+ (kill-region beg-of-line start))
+
+ (goto-char beg-of-line)
+
+ (while (< 0 indent-column)
+ (insert " ")
+ (setq indent-column (- indent-column 1))))
+
+ ((< orig-point start) (goto-char start))
+ (t (goto-char orig-point)))))))
+
+
+(defun rnc-electric-brace (arg)
+ (interactive "*P")
+ (self-insert-command (prefix-numeric-value arg))
+ (rnc-indent-line)
+ (let ((p (point)))
+ (when (save-excursion
+ (beginning-of-line)
+ (let ((pos (re-search-forward "\\S " (point-max) t)))
+ (and pos (= (- pos 1) p))))
+ (forward-char))))
+
+(defvar rnc-mode-map () "Keymap used in RNC mode.")
+(when (not rnc-mode-map)
+ (setq rnc-mode-map (make-sparse-keymap))
+ (define-key rnc-mode-map "\C-c\C-c" 'comment-region)
+ (define-key rnc-mode-map "}" 'rnc-electric-brace)
+ (define-key rnc-mode-map "{" 'rnc-electric-brace)
+ (define-key rnc-mode-map "]" 'rnc-electric-brace)
+ (define-key rnc-mode-map "[" 'rnc-electric-brace))
+
+;;;###autoload
+(defun rnc-mode ()
+ "Major mode for editing RELAX NG Compact Syntax schemas.
+\\{rnc-mode-map}"
+ (interactive)
+
+ (kill-all-local-variables)
+
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'rnc-indent-line)
+
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(rnc-font-lock-keywords nil t nil nil))
+
+ (use-local-map rnc-mode-map)
+
+ (make-local-variable 'comment-start)
+ (make-local-variable 'comment-end)
+ (make-local-variable 'comment-start-skip)
+
+ (setq comment-start "#"
+ comment-end ""
+ comment-start-skip "\\([ \n\t]+\\)##?[ \n\t]+")
+
+ (let ((rnc-syntax-table (copy-syntax-table)))
+ (modify-syntax-entry ?# "< " rnc-syntax-table)
+ (modify-syntax-entry ?\n "> " rnc-syntax-table)
+ (modify-syntax-entry ?\^m "> " rnc-syntax-table)
+ (modify-syntax-entry ?\\ "w " rnc-syntax-table)
+ (modify-syntax-entry ?' "\" " rnc-syntax-table)
+ (modify-syntax-entry ?. "w " rnc-syntax-table)
+ (modify-syntax-entry ?- "w " rnc-syntax-table)
+ (modify-syntax-entry ?_ "w " rnc-syntax-table)
+ (set-syntax-table rnc-syntax-table))
+
+ (setq mode-name "RNC"
+ major-mode 'rnc-mode)
+ (run-hooks 'rnc-mode-hook))
+
+(provide 'rnc-mode)
--- /dev/null
+;;; rxi.el --- Interactive regexp reading using rx format
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-04-07T18:18:39+0200 Mon
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Read regexp as `rx' forms from minibuffer.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defvar rxi-read-hist nil)
+
+(defun rxi-find-definition (rx-sym)
+ (let* ((rec (assoc rx-sym rx-constituents))
+ )
+ (while (symbolp (cdr rec))
+ (setq rec (assoc (cdr rec) rx-constituents)))
+ (cdr rec)))
+
+(defun rxi-list-type-p (rx-sym)
+ (listp (rxi-find-definition rx-sym)))
+
+(defun rxi-complete ()
+ "Complete `rx' constituents."
+ (interactive)
+ ;; Don't care about state for now, there will be an error instead
+ (let* ((partial (when (looking-back (rx (1+ (any "a-z01:|=>*?+\\-"))) nil t)
+ (match-string-no-properties 0)))
+ (candidates (let ((want-list
+ (= ?\( (char-before (match-beginning 0)))))
+ (delq nil
+ (mapcar (lambda (rec)
+ (let* ((sym (car rec))
+ (lst (rxi-list-type-p sym)))
+ (when (or (and want-list lst)
+ (and (not want-list)
+ (not lst)))
+ (symbol-name sym))))
+ rx-constituents))))
+ (match-set (when partial
+ (all-completions
+ partial
+ candidates))))
+ (cond
+ ((not match-set)
+ (message "No completions"))
+ ((= 1 (length match-set))
+ (insert (substring (car match-set) (length partial))))
+ (t
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list match-set partial))))))
+
+(defvar rxi-read-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-completion-map)
+ (define-key map [tab] 'rxi-complete)
+ (define-key map [(meta tab)] 'rxi-complete)
+ (define-key map [?\ ] 'self-insert-command)
+ map))
+
+(defvar rxi-trailing-overlay nil)
+
+(defun rxi-minibuf-setup ()
+ (when rxi-trailing-overlay (delete-overlay rxi-trailing-overlay))
+ (setq rxi-trailing-overlay
+ (make-overlay (point-max) (point-max)
+ (current-buffer)
+ t t))
+ (overlay-put rxi-trailing-overlay 'after-string
+ (propertize ")"
+ 'face
+ (if (and
+ (fboundp 'noticeable-minibuffer-prompts-mode)
+ noticeable-minibuffer-prompts-mode)
+ 'minibuffer-noticeable-prompt
+ 'minibuffer-prompt)))
+ (remove-hook 'minibuffer-setup-hook 'rxi-minibuf-setup))
+
+(defun rxi-minibuf-exit ()
+ (when rxi-trailing-overlay
+ (delete-overlay rxi-trailing-overlay)
+ (setq rxi-trailing-overlay nil))
+ (remove-hook 'minibuffer-exit-hook 'rxi-minibuf-exit))
+
+(defun rxi-read (prompt)
+ "Read a `rx' regexp form from minibuffer.
+Return cons of rx and regexp, both as strings."
+ (interactive (list "Test (rx "))
+ (let (rx-str rx-full-str res-regexp)
+ (while (not res-regexp)
+ (condition-case err
+ (progn
+ (add-hook 'minibuffer-setup-hook 'rxi-minibuf-setup)
+ (add-hook 'minibuffer-exit-hook 'rxi-minibuf-exit)
+ (setq rx-str (read-from-minibuffer prompt
+ rx-str ;; initial-contents
+ rxi-read-keymap
+ nil ;; read
+ 'rxi-read-hist
+ nil ;; inherit-input-method - no idea...
+ ))
+ (setq rx-full-str (concat "(rx " rx-str ")"))
+ (setq res-regexp (eval (read rx-full-str))))
+ (error (message "%s" (error-message-string err))
+ (sit-for 2))))
+ (when (with-no-warnings (called-interactively-p)) (message "%s => \"%s\"" rx-full-str res-regexp))
+ (cons rx-full-str res-regexp)))
+
+
+(provide 'rxi)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; rxi.el ends here
--- /dev/null
+;;; search-form.el --- Search form
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-05-05T01:50:20+0200 Sun
+;; Version: 0.11
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `cus-edit', `cus-face', `cus-load', `cus-start', `wid-edit'.
+;;
+;;;;;;;;;;seasfireplstring ;;
+;;
+;;; Commentary:
+;;
+;; After an idea by Eric Ludlam on Emacs Devel:
+;;
+;; http://lists.gnu.org/archive/html/emacs-devel/2008-05/msg00152.html
+;;
+;; NOT QUITE READY! Tagged files have not been tested.
+;;
+;; Fix-me: work on other windows buffer by default, not buffer from
+;; where search form was created.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'ourcomments-util))
+(require 'cus-edit)
+(require 'grep)
+
+(defvar search-form-sfield nil)
+(make-variable-buffer-local 'search-form-sfield)
+(defvar search-form-rfield nil)
+(make-variable-buffer-local 'search-form-rfield)
+
+(defvar search-form-win-config nil)
+(make-variable-buffer-local 'search-form-win-config)
+(put 'search-form-win-config 'permanent-local t)
+
+(defvar search-form-current-buffer nil)
+
+(defun search-form-multi-occur-get-buffers ()
+ (let* ((bufs (list (read-buffer "First buffer to search: "
+ (current-buffer) t)))
+ (buf nil)
+ (ido-ignore-item-temp-list bufs))
+ (while (not (string-equal
+ (setq buf (read-buffer
+ (if (eq read-buffer-function 'ido-read-buffer)
+ "Next buffer to search (C-j to end): "
+ "Next buffer to search (RET to end): ")
+ nil t))
+ ""))
+ (add-to-list 'bufs buf)
+ (setq ido-ignore-item-temp-list bufs))
+ (nreverse (mapcar #'get-buffer bufs))))
+
+(defvar search-form-buffer) ;; dyn var, silence compiler
+(defvar search-form-search-string) ;; dyn var, silence compiler
+(defvar search-form-replace-string) ;; dyn var, silence compiler
+
+(defun search-form-notify-1 (use-search-field
+ use-replace-field
+ w
+ hide-form
+ display-orig-buf)
+ (let ((search-form-search-string (when use-search-field (widget-value search-form-sfield)))
+ (search-form-replace-string (when use-replace-field (widget-value search-form-rfield)))
+ (search-form-buffer (current-buffer))
+ (this-search (widget-get w :do-search))
+ (do-it t))
+ (if (and use-search-field
+ (= 0 (length search-form-search-string)))
+ (progn
+ (setq do-it nil)
+ (message "Please specify a search string"))
+ (when (and use-replace-field
+ (= 0 (length search-form-replace-string)))
+ (setq do-it nil)
+ (message "Please specify a replace string")))
+ (when do-it
+ (if hide-form
+ (progn
+ (set-window-configuration search-form-win-config)
+ (funcall this-search search-form-search-string)
+ ;;(kill-buffer search-form-buffer)
+ )
+ (when display-orig-buf
+ (let ((win (display-buffer search-form-current-buffer t)))
+ (select-window win t)))
+ ;;(funcall this-search search-form-search-string))
+ (funcall this-search w)
+ ))))
+
+(defun search-form-notify-no-field (w &rest ignore)
+ (search-form-notify-1 nil nil w nil t))
+
+(defun search-form-notify-sfield (w &rest ignore)
+ (search-form-notify-1 t nil w nil t))
+
+(defun search-form-notify-sfield-nobuf (w &rest ignore)
+ (search-form-notify-1 t nil w nil nil))
+
+(defun search-form-notify-both-fields (w &rest ignore)
+ (search-form-notify-1 t t w nil t))
+
+(defun search-form-insert-button (title function descr do-search-fun)
+ (widget-insert " ")
+ (let ((button-title (format " %-15s " title)))
+ (widget-create 'push-button
+ :do-search do-search-fun
+ :notify 'search-form-notify-no-field
+ :current-buffer search-form-current-buffer
+ button-title))
+ (widget-insert " " descr)
+ (widget-insert "\n"))
+
+(defun search-form-insert-search (title search-fun descr do-search-fun no-buf)
+ (widget-insert " ")
+ (let ((button-title (format " %-15s " title)))
+ (if no-buf
+ (widget-create 'push-button
+ :do-search do-search-fun
+ :notify 'search-form-notify-sfield-nobuf
+ :current-buffer search-form-current-buffer
+ button-title)
+ (widget-create 'push-button
+ :do-search do-search-fun
+ :notify 'search-form-notify-sfield
+ :current-buffer search-form-current-buffer
+ button-title)
+ ))
+ (widget-insert " " descr " ")
+ (search-form-insert-help search-fun)
+ (widget-insert "\n"))
+
+(defun search-form-insert-fb (descr
+ use-sfield
+ forward-fun
+ do-forward-fun
+ backward-fun
+ do-backward-fun)
+ (widget-insert (format " %s: " descr))
+ (widget-create 'push-button
+ :do-search do-forward-fun
+ :use-sfield use-sfield
+ :notify '(lambda (widget &rest event)
+ (if (widget-get widget :use-sfield)
+ (search-form-notify-sfield widget)
+ (search-form-notify-no-field widget)))
+ :current-buffer search-form-current-buffer
+ " Forward ")
+ (widget-insert " ")
+ (search-form-insert-help forward-fun)
+ (widget-insert " ")
+ (widget-create 'push-button
+ :do-search do-backward-fun
+ :use-sfield use-sfield
+ :notify '(lambda (widget &rest event)
+ (if (widget-get widget :use-sfield)
+ (search-form-notify-sfield widget)
+ (search-form-notify-no-field widget)))
+ :current-buffer search-form-current-buffer
+ " Backward ")
+ (widget-insert " ")
+ (search-form-insert-help backward-fun)
+ (widget-insert "\n"))
+
+(defun search-form-insert-replace (title replace-fun descr do-replace-fun)
+ (widget-insert " ")
+ (let ((button-title (format " %-15s " title)))
+ (widget-create 'push-button
+ :do-search do-replace-fun
+ :notify 'search-form-notify-both-fields
+ :current-buffer search-form-current-buffer
+ button-title))
+ (widget-insert " " descr " ")
+ (search-form-insert-help replace-fun)
+ (widget-insert "\n"))
+
+(defun search-form-insert-help (fun)
+ (widget-insert "(")
+ (widget-create 'function-link
+ :value fun
+ :tag "help"
+ :button-face 'link)
+ (widget-insert ")"))
+
+(defun sf-widget-field-value-set (widget value)
+ "Set current text in editing field."
+ (let ((from (widget-field-start widget))
+ (to (widget-field-end widget))
+ (buffer (widget-field-buffer widget))
+ (size (widget-get widget :size))
+ (secret (widget-get widget :secret))
+ (old (current-buffer)))
+ (if (and from to)
+ (progn
+ (set-buffer buffer)
+ (while (and size
+ (not (zerop size))
+ (> to from)
+ (eq (char-after (1- to)) ?\s))
+ (setq to (1- to)))
+ (goto-char to)
+ (delete-region from to)
+ (insert value)
+ (let ((result (buffer-substring-no-properties from to)))
+ (when secret
+ (let ((index 0))
+ (while (< (+ from index) to)
+ (aset result index
+ (get-char-property (+ from index) 'secret))
+ (setq index (1+ index)))))
+ (set-buffer old)
+ result))
+ (widget-get widget :value))))
+
+(defvar search-form-form nil)
+
+(defun search-form-isearch-end ()
+ (condition-case err
+ (progn
+ (message "sfie: search-form-form=%s" (widget-value (cdr search-form-form)))
+ (remove-hook 'isearch-mode-end-hook 'search-form-isearch-end)
+ ;; enter isearch-string in field
+ (with-current-buffer (car search-form-form)
+ ;; Fix-me: trashes the widget, it disappears... - there seem
+ ;; to be know default set function.
+ ;;(widget-value-set (cdr search-form-form) isearch-string)
+ ))
+ (error (message "search-form-isearch-end: %S" err))))
+
+(defun search-form-isearch-forward (w)
+ (interactive)
+ (add-hook 'isearch-mode-end-hook 'search-form-isearch-end)
+ (with-current-buffer search-form-buffer
+ (setq search-form-form (cons search-form-buffer search-form-sfield))
+ (message "sfif: cb=%s field=%S" (current-buffer) (widget-value (cdr search-form-form)))
+ )
+ (call-interactively 'isearch-forward))
+
+(defun search-form-isearch-backward (w)
+ (interactive)
+ (add-hook 'isearch-mode-end-hook 'search-form-isearch-end)
+ (setq search-form-form search-form-sfield)
+ (call-interactively 'isearch-backward))
+
+;;;###autoload
+(defun search-form ()
+ "Display a form for search and replace."
+ (interactive)
+ (let* ((buf-name "*Search Form*")
+ (cur-buf (current-buffer))
+ (buffer (get-buffer-create buf-name))
+ (win-config (current-window-configuration)))
+ (setq search-form-current-buffer (current-buffer))
+ (with-current-buffer buffer
+ (set (make-local-variable 'search-form-win-config) win-config))
+ (switch-to-buffer-other-window buffer)
+
+ (kill-all-local-variables) ;; why???
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ ;;(Custom-mode)
+ (remove-overlays)
+
+ (make-local-variable 'widget-button-face)
+ (setq widget-button-face custom-button)
+ (setq show-trailing-whitespace nil)
+ (when custom-raised-buttons
+ (set (make-local-variable 'widget-push-button-prefix) "")
+ (set (make-local-variable 'widget-push-button-suffix) "")
+ (set (make-local-variable 'widget-link-prefix) "")
+ (set (make-local-variable 'widget-link-suffix) ""))
+
+ (widget-insert (propertize "Search/Replace, buffer: " 'face 'font-lock-comment-face))
+ (widget-insert (format "%s" (buffer-name search-form-current-buffer)))
+ (let ((file (buffer-file-name search-form-current-buffer)))
+ (when file
+ (insert " (" file ")")))
+ (widget-insert "\n\n")
+ (search-form-insert-fb
+ "Incremental String Search" nil
+ 'isearch-forward
+ 'search-form-isearch-forward
+ 'isearch-backward
+ 'search-form-isearch-backward)
+
+ (search-form-insert-fb
+ "Incremental Regexp Search" nil
+ 'isearch-forward-regexp
+ (lambda (w) (call-interactively 'isearch-forward-regexp))
+ 'isearch-backward-regexp
+ (lambda (w) (call-interactively 'isearch-backward-regexp)))
+
+ ;; Fix-me: in multiple buffers, from buffer-list
+
+ (widget-insert (make-string (window-width) ?-) "\n")
+
+ (widget-insert "Search: ")
+ (setq search-form-sfield
+ (widget-create 'editable-field
+ :size 58))
+ (widget-insert "\n\n")
+ (widget-insert (propertize "* Buffers:" 'face 'font-lock-comment-face) "\n")
+ (search-form-insert-fb "String Search" t
+ 'search-forward
+ (lambda (w) (search-forward search-form-search-string))
+ 'search-backward
+ (lambda (w) (search-backward search-form-search-string)))
+
+ (search-form-insert-fb "Regexp Search" t
+ 're-search-forward
+ (lambda (w) (re-search-forward search-form-search-string))
+ 're-search-backward
+ (lambda (w) (re-search-backward search-form-search-string)))
+
+ ;; occur
+ (search-form-insert-search "Occur" 'occur
+ "Lines in buffer"
+ (lambda (w)
+ (with-current-buffer (widget-get w :current-buffer)
+ (occur search-form-search-string)))
+ t)
+
+ ;; multi-occur
+ ;; Fix-me: This should be done from buffer-list. Have juri finished that?
+ (search-form-insert-search "Multi-Occur" 'multi-occur
+ "Lines in specified buffers"
+ (lambda (w)
+ (let ((bufs (search-form-multi-occur-get-buffers)))
+ (multi-occur bufs search-form-search-string)))
+ t)
+ ;;
+ (widget-insert "\n")
+ (widget-insert (propertize "* Files:" 'face 'font-lock-comment-face)
+ "\n")
+
+ (search-form-insert-search "Search in Dir" 'lgrep
+ "Grep in directory"
+ 'search-form-lgrep
+ t)
+ (search-form-insert-search "Search in Tree" 'rgrep
+ "Grep in directory tree"
+ 'search-form-rgrep
+ t)
+
+ (widget-insert "\n")
+
+ (search-form-insert-search "Tagged Files" 'tags-search
+ "Search files in tags table"
+ (lambda (w)
+ (with-current-buffer (widget-get w :current-buffer)
+ (tags-search search-form-search-string)))
+ t)
+
+ (widget-insert (make-string (window-width) ?-) "\n")
+
+ (widget-insert "Replace: ")
+ (setq search-form-rfield
+ (widget-create 'editable-field
+ :size 58))
+ (widget-insert "\n\n")
+
+ (widget-insert (propertize "* Buffers:" 'face 'font-lock-comment-face) "\n")
+ (search-form-insert-replace "Replace String"
+ 'query-replace
+ "In buffer from point"
+ (lambda (w)
+ (query-replace search-form-search-string search-form-replace-string)))
+
+ (search-form-insert-replace "Replace Regexp"
+ 'query-replace-regexp
+ "In buffer from point"
+ (lambda (w)
+ (query-replace-regexp search-form-search-string search-form-replace-string)))
+
+ (widget-insert "\n" (propertize "* Files:" 'face 'font-lock-comment-face) "\n")
+
+ ;; fix-me: rdir-query-replace (from to file-regexp root &optional delimited)
+ (search-form-insert-replace "Replace in Dir"
+ 'ldir-query-replace
+ "Replace in files in directory"
+ 'search-form-ldir-replace)
+ (search-form-insert-replace "Replace in Tree"
+ 'rdir-query-replace
+ "Replace in files in directory tree"
+ 'search-form-rdir-replace)
+
+ (widget-insert "\n")
+
+ (search-form-insert-replace "Tagged Files"
+ 'tags-query-replace
+ "Replace in files in tags tables"
+ (lambda (w)
+ (tags-query-replace search-form-search-string search-form-replace-string)))
+
+ (buffer-disable-undo)
+ (widget-setup)
+ (buffer-enable-undo)
+ (use-local-map widget-keymap)
+ (fit-window-to-buffer)
+ (widget-forward 1)
+ ))
+
+(defun search-form-lgrep (w)
+ (search-form-r-or-lgrep w t))
+
+(defun search-form-rgrep (w)
+ (search-form-r-or-lgrep w nil))
+
+(defun search-form-r-or-lgrep (w l)
+ (with-current-buffer (widget-get w :current-buffer)
+ (let* ((regexp search-form-search-string)
+ (files (grep-read-files regexp))
+ (dir (read-directory-name (if l "In directory: "
+ "Base directory: ")
+ nil default-directory t)))
+ (if l
+ (lgrep regexp files dir)
+ (rgrep regexp files dir)
+ ))))
+
+(defun search-form-ldir-replace (w)
+ (search-form-l-or-r-dir-replace w t))
+
+(defun search-form-rdir-replace (w)
+ (search-form-l-or-r-dir-replace w nil))
+
+(defun search-form-l-or-r-dir-replace (w l)
+ (let ((files (replace-read-files search-form-search-string search-form-replace-string))
+ (dir (read-directory-name (if l
+ "In directory: "
+ "In directory tree: ")
+ nil
+ (file-name-directory
+ (buffer-file-name search-form-current-buffer))
+ t)))
+ (if l
+ (ldir-query-replace search-form-search-string search-form-replace-string files dir)
+ (rdir-query-replace search-form-search-string search-form-replace-string files dir))))
+
+(provide 'search-form)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; search-form.el ends here
--- /dev/null
+;;; sex-mode.el --- Shell EXecute mode / Send to EXternal program
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-06-01T18:41:50+0200 Sun
+(defconst sex-mode:version "0.71")
+;; Last-Updated: 2009-01-06 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Open urls belonging to other programs with those programs. To
+;; enable this turn on the global minor mode `sex-mode'.
+;;
+;; If you for example open a .pdf file with C-x C-f it can be opened
+;; by the .pdf application you have set your computer to use. (Or, if
+;; that such settings are not possible on your OS, with the
+;; application you have choosen here.)
+;;
+;; There is also a defmacro `sex-with-temporary-apps' that you can use
+;; for example with `find-file' to open files in external
+;; applications.
+;;
+;; The functions used to open files in external applications are
+;; borrowed from `org-mode'. There is some small differences:
+;;
+;; - There is an extra variable here `sex-file-apps' that is checked
+;; before the corresponding lists in `org-mode'.
+;;
+;; - In `org-mode' any file that is not found in the lists (and is not
+;; remote or a directory) is sent to an external application. This
+;; would create trouble when used here in a file handler so the
+;; logic is the reverse here: Any file that is not found in the
+;; lists is opened inside Emacs. (Actually I think that might be a
+;; good default in `org-mode' too, but I am not sure.)
+;;
+;; - Because of the above I have to guess which function is the one
+;; that sends a file to an external application.
+;;
+;; (Currently the integration with org.el is not the best code wise.
+;; We hope to improve that soon.)
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;(org-open-file "c:/EmacsW32/nxhtml/nxhtml/doc/nxhtml-changes.html")
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'org))
+(eval-when-compile (require 'mailcap))
+
+(defcustom sex-file-apps
+ '(
+ ("html" . emacs)
+ ("pdf" . default)
+ ("wnk" . default)
+ )
+ "Application for opening a file.
+See `sex-get-file-open-cmd'."
+ :group 'sex
+ :type '(repeat
+ (cons (choice :value ""
+ (string :tag "Extension")
+ (const :tag "Default for unrecognized files" t)
+ (const :tag "Remote file" remote)
+ (const :tag "Links to a directory" directory))
+ (choice :value ""
+ (const :tag "Visit with Emacs" emacs)
+ (const :tag "Use system default" default)
+ (string :tag "Command")
+ (sexp :tag "Lisp form")))))
+
+;;(sex-get-apps)
+
+(defvar sex-with-temporary-file-apps nil)
+
+(defun sex-get-apps ()
+ (or sex-with-temporary-file-apps
+ (append sex-file-apps org-file-apps (org-default-apps))))
+
+;; (sex-get-file-open-cmd "temp.el")
+;; (sex-get-file-open-cmd "http://some.where/temp.el")
+;; (sex-get-file-open-cmd "temp.c")
+;; (sex-get-file-open-cmd "temp.pdf")
+;; (sex-get-file-open-cmd "temp.doc")
+;; (sex-get-file-open-cmd "/ftp:temp.doc")
+;; (sex-get-file-open-cmd "http://some.host/temp.doc")
+;; (sex-get-file-open-cmd "http://some.host/temp.html")
+
+(defun sex-get-file-open-cmd (path)
+ "Get action for opening file.
+Construct a key from PATH:
+- If PATH specifies a location on a remote system then set key to
+ 'remote.
+- If PATH is a directory set key to 'directory.
+- Otherwise use the file extension of PATH as key.
+
+Search with this key against the combined association list of
+`sex-file-apps', `org-file-apps' and `org-default-apps'. The
+first matching entry is used.
+
+If cdr of this entry is 'default then search again with key equal
+to t for the default action for the operating system you are on
+\(or your own default action if you have defined one in the
+variables above).
+
+Return the cdr of the found entry.
+
+If no entry was found return `emacs' for opening inside Emacs."
+ (let* ((apps (sex-get-apps))
+ (key (if (org-file-remote-p path)
+ 'remote
+ (if (file-directory-p path)
+ 'directory
+ (let ((ext (file-name-extension path)))
+ (if (and t ext)
+ ;; t should be a check for case insensitive
+ ;; file names ... - how do you do that?
+ (downcase ext)
+ ext)))))
+ (cmd (or (cdr (assoc key apps))
+ 'emacs)))
+ (when (eq cmd 'default)
+ (setq cmd (or (cdr (assoc t apps))
+ 'emacs)))
+ (when (eq cmd 'mailcap)
+ (require 'mailcap)
+ (mailcap-parse-mailcaps)
+ (let* ((mime-type (mailcap-extension-to-mime (or key "")))
+ (command (mailcap-mime-info mime-type)))
+ (if (stringp command)
+ (setq cmd command)
+ (setq cmd 'emacs))))
+ ;;(message "cmd=%s" cmd)
+ cmd))
+
+;;;###autoload
+(defgroup sex nil
+ "Customization group for `sex-mode'."
+ :group 'external)
+
+;;(setq sex-handle-urls t)
+(defcustom sex-handle-urls nil
+ "When non-nil `sex-mode' also handles urls.
+Turn on `url-handler-mode' when turning on `sex-mode' if this is
+non-nil. Open urls in a web browser."
+ :type 'boolean
+ :group 'sex)
+
+;; (setq sex-keep-dummy-buffer nil)
+;; (setq sex-keep-dummy-buffer 'visible)
+;; (setq sex-keep-dummy-buffer 'burried)
+(defcustom sex-keep-dummy-buffer 'visible
+ "Keep dummy buffer after opening file.
+When opening a file with the shell a dummy buffer is created in
+Emacs in `sex-file-mode' and an external program is called to
+handle the file. How this dummy buffer is handled is governed by
+this variable."
+ :type '(choice (const :tag "Visible" visible)
+ (const :tag "Burried" burried)
+ (const :tag "Do not keep it" nil))
+ :group 'sex)
+
+(defcustom sex-reopen-on-buffer-entry nil
+ "If non-nil send file to shell again on buffer entry."
+ :type 'boolean
+ :group 'sex)
+
+(defun sex-post-command ()
+ "Run post command in `sex-file-mode' buffers.
+If `sex-reopen-on-buffer-entry' is non-nil then send the buffer
+file to system again."
+ (when sex-reopen-on-buffer-entry
+ (if (and (boundp 'url-handler-regexp)
+ (string-match url-handler-regexp buffer-file-name))
+ (sex-browse-url buffer-file-name)
+ (sex-handle-by-external buffer-file-name))
+ (bury-buffer)))
+
+(defun sex-browse-url (url)
+ "Ask a web browser to open URL."
+ (condition-case err
+ (list (browse-url url) "Opened URL in web browser")
+ (error (list nil (error-message-string err)))))
+
+(defun sex-url-insert-file-contents (url &optional visit beg end replace)
+ (sex-generic-insert-file-contents
+ 'sex-browse-url
+ (concat "This dummy buffer is used just for opening a URL.\n"
+ "To open the URL again click here:\n\n ")
+ (concat "Tried to open URL in web browser, "
+ "but it failed with message\n\n ")
+ url visit beg end replace))
+
+(defun sex-file-insert-file-contents (url &optional visit beg end replace)
+ ;;(message "sex-file-insert-file-contents %s %s %s %s %s" url visit beg end replace)
+ (sex-generic-insert-file-contents
+ 'sex-handle-by-external
+ (concat "This dummy buffer is used just for opening a file.\n"
+ "The file itself was sent to system for opening.\n\n"
+ "To open the file again click here:\n\n ")
+ (concat "Tried to send file"
+ " to system but it failed with message\n\n ")
+ url visit beg end replace))
+
+(defun sex-write-file-function ()
+ (set-buffer-modified-p nil)
+ (error "Can't write this to file, it is just a dummy buffer"))
+
+(defun sex-generic-insert-file-contents (insert-fun
+ success-header
+ fail-header
+ url &optional visit beg end replace)
+ (let ((window-config (current-window-configuration)))
+ (unless (= 0 (buffer-size))
+ (error "Buffer must be empty"))
+ (set (make-local-variable 'write-file-functions)
+ '(sex-write-file-function))
+ (let* ((name url)
+ ;;(result (sex-browse-url name))
+ (result (funcall insert-fun name))
+ (success (nth 0 result))
+ (msg (nth 1 result)))
+ (setq buffer-file-name name)
+ (if success
+ (progn
+ (insert success-header)
+ (sex-setup-restore-window-config window-config)
+ (message "%s" msg))
+ (insert (propertize "Error: " 'face 'font-lock-warning-face)
+ fail-header msg
+ "\n\nTo try again click here:\n\n "))
+ (save-excursion
+ (insert-text-button
+ buffer-file-name
+ 'insert-fun insert-fun
+ 'action (lambda (button)
+ ;;(sex-browse-url buffer-file-name)
+ (funcall (button-get button 'insert-fun) buffer-file-name)
+ ))))))
+
+(defun sex-file-handler (operation &rest args)
+ "Handler for `insert-file-contents'."
+ ;;(message "\noperation=%s, args=%s" operation args)
+ (let ((done nil)
+ (ftype 'emacs))
+ ;; Always open files inside Emacs if the file opening request came
+ ;; through Emacs client. Here is a primitive test if we are called
+ ;; from outside, client-record is bound in `server-visit-files'
+ ;; ...
+ (when (not (boundp 'client-record))
+ (let* ((filename (car args))
+ (insert-handling (sex-get-file-open-cmd filename)))
+ ;;(message "insert-handling=%s" insert-handling)
+ (when insert-handling
+ (setq ftype insert-handling))
+ ;;(message "ftype=%s, filename=%s" ftype filename)
+ ))
+ (unless (eq ftype 'emacs)
+ ;;(message "using sex-file-insert-file-contents for %s" args)
+ (apply 'sex-file-insert-file-contents args)
+ (setq done t))
+ ;; Handle any operation we don't know about.
+ (unless done
+ ;;(message "fallback for operation=%s, args=%s" operation args)
+ (let ((inhibit-file-name-handlers
+ (cons 'sex-file-handler
+ (and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation operation))
+ (apply operation args)))))
+;; Note: Because of a bug in Emacs we must restrict the use of this
+;; file handler to only 'insert-file-contents. (We should of course
+;; anyway do that.)
+(put 'sex-file-handler 'operations '(insert-file-contents))
+
+(defun sex-setup-restore-window-config (window-config)
+ (when (not (eq sex-keep-dummy-buffer 'visible))
+ (run-with-idle-timer 0 nil
+ 'sex-restore-window-config
+ (selected-frame)
+ window-config
+ (unless sex-keep-dummy-buffer
+ (current-buffer)))))
+
+(defun sex-restore-window-config (frame win-config buffer)
+ (save-match-data ;; runs in timer
+ (with-selected-frame frame
+ (set-window-configuration win-config))
+ (when buffer (kill-buffer buffer))))
+
+(defun sex-handle-by-external (&optional file)
+ "Give file FILE to external program.
+Return a list:
+
+ (SUCCESS MESSAGE)
+
+where SUCCESS is non-nil if operation succeeded and MESSAGE is an
+informational message."
+ (unless file (setq file buffer-file-name))
+ (let ((cmd (sex-get-file-open-cmd file)))
+ (assert (not (eq cmd 'emacs)))
+ (cond
+ ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
+ ;; Remove quotes around the file name - we'll use shell-quote-argument.
+ (while (string-match "['\"]%s['\"]" cmd)
+ (setq cmd (replace-match "%s" t t cmd)))
+ (while (string-match "%s" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument
+ (convert-standard-filename file)))
+ t t cmd)))
+ (save-window-excursion
+ (start-process-shell-command cmd nil cmd)
+ ;;(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
+ )
+ (list t (format "Opened %s in external application" file)))
+ ((consp cmd)
+ (let ((file (convert-standard-filename file)))
+ (eval cmd))
+ (list t (format "Opened %s in external application" file)))
+ (t (list nil (format "Don't know how to handle %s" file))))
+ ))
+
+
+(define-derived-mode sex-file-mode nil
+ "External"
+ "Mode for files opened in external programs."
+ (add-hook 'post-command-hook 'sex-post-command nil t)
+ (set-keymap-parent (current-local-map) button-buffer-map)
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t))
+
+
+(defvar sex-old-url-insert-file-contents nil)
+(defvar sex-old-url-handler-mode nil)
+
+;;;###autoload
+(define-minor-mode sex-mode
+ "Open certain files in external programs.
+See `sex-get-file-open-cmd' for how to determine which files to
+open by external applications. Note that this selection is
+nearly the same as in `org-mode'. The main difference is that
+the fallback always is to open a file in Emacs. \(This is
+necessary to avoid to disturb many of Emacs operations.)
+
+This affects all functions that opens files, like `find-file',
+`find-file-noselect' etc.
+
+However it does not affect files opened through Emacs client.
+
+Urls can also be handled, see `sex-handle-urls'.
+
+When opening a file with the shell a \(temporary) dummy buffer is
+created in Emacs with major mode `sex-file-mode' and an external
+program is called to handle the file. How this dummy buffer is
+handled is governed by `sex-keep-dummy-buffer'."
+
+ ;; On MS Windows `w32-shell-execute' is called to open files in an
+ ;; external application. Be aware that this may run scripts if the
+ ;; script file extension is not blocked in `sex-open-alist'.
+ nil
+ :group 'sex
+ :global t
+ ;; fix-me: better list handling
+ (if sex-mode
+ (progn
+ (require 'org)
+ (dolist (rec (sex-get-apps))
+ (let* ((ext (car rec))
+ (app (cdr rec))
+ (patt (when (and (stringp ext)
+ (not (eq app 'emacs)))
+ (concat "\\." ext "\\'"))))
+ (unless patt
+ (when (eq ext t)
+ (setq patt (concat ".*\\'"))))
+ (when patt
+ (unless (eq ext t)
+ (add-to-list 'auto-mode-alist (cons patt 'sex-file-mode)))
+ (add-to-list 'file-name-handler-alist
+ (cons patt 'sex-file-handler) t))))
+ (setq sex-old-url-insert-file-contents
+ (get 'insert-file-contents 'url-file-handlers))
+ (setq sex-old-url-handler-mode url-handler-mode)
+ (when sex-handle-urls
+ ;;(message "req url, before")
+ (require 'url-handlers)
+ ;;(message "req url, after")
+ (put 'insert-file-contents 'url-file-handlers
+ 'sex-url-insert-file-contents)
+ (unless url-handler-mode
+ (url-handler-mode 1)
+ ;;(message "after url-handler-mode 1")
+ )))
+ ;; Remove from the lists:
+ ;;(let ((handler-list (copy-list file-name-handler-alist)))
+ (let ((handler-list (copy-sequence file-name-handler-alist)))
+ (dolist (handler handler-list)
+ (when (eq 'sex-file-handler (cdr handler))
+ (setq file-name-handler-alist
+ (delete handler file-name-handler-alist)))))
+ ;;(let ((mode-alist (copy-list auto-mode-alist)))
+ (let ((mode-alist (copy-sequence auto-mode-alist)))
+ (dolist (auto-mode mode-alist)
+ (when (eq 'sex-file-mode (cdr auto-mode))
+ (setq auto-mode-alist
+ (delete auto-mode auto-mode-alist)))))
+ (put 'insert-file-contents 'url-file-handlers
+ sex-old-url-insert-file-contents)
+ (unless sex-old-url-handler-mode (url-handler-mode 0))))
+
+(defmacro sex-with-temporary-apps (open-alist &rest body)
+ "Run BODY with `sex-mode' on.
+If OPEN-ALIST is not t it replaces the list normally used by
+`sex-get-file-open-cmd'."
+ (declare (indent 1) (debug t))
+ `(let ((old-sex-mode sex-mode)
+ (sex-with-temporary-file-apps
+ (if (eq ,open-alist t)
+ nil
+ ,open-alist)))
+ (when sex-mode (sex-mode -1))
+ (sex-mode 1)
+ ,@body
+ (setq sex-with-temporary-file-apps nil)
+ (unless old-sex-mode (sex-mode -1))))
+
+;; (with-sex t (find-file "c:/emacs-lisp/gimp-mode-v1.40/gimpmode.pdf"))
+;; (with-sex nil (find-file "c:/emacs-lisp/gimp-mode-v1.40/gimpmode.pdf"))
+
+(provide 'sex-mode)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; sex-mode.el ends here
--- /dev/null
+;;; sml-modeline.el --- Show position in a scrollbar like way in mode-line
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2010-03-16 Tue
+;; Version: 0.5
+;; Last-Updated: 2010-03-18 Thu
+;; URL: http://bazaar.launchpad.net/~nxhtml/nxhtml/main/annotate/head%3A/util/sml-modeline.el
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Show scrollbar like position indicator in mode line.
+;; See the global minor mode `sml-modeline-mode' for more information.
+;;
+;; Idea and part of this code is adapted from David Engster's and Drew
+;; Adam's code in these mail messages:
+;;
+;; http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00523.html
+;; http://permalink.gmane.org/gmane.emacs.devel/122038
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;;###autoload
+(defgroup sml-modeline nil
+ "Customization group for `sml-modeline-mode'."
+ :group 'frames)
+
+(defun sml-modeline-refresh ()
+ "Refresh after option changes if loaded."
+ (when (featurep 'sml-modeline)
+ (when (and (boundp 'sml-modeline-mode)
+ sml-modeline-mode)
+ (sml-modeline-mode -1)
+ (sml-modeline-mode 1))))
+
+(defcustom sml-modeline-len 12
+ "Mode line indicator total length."
+ :type 'integer
+ :set (lambda (sym val)
+ (set-default sym val)
+ (sml-modeline-refresh))
+ :group 'sml-modeline)
+
+(defcustom sml-modeline-borders nil
+ "Indicator borders.
+This is a pair of indicators, like [] or nil."
+ :type '(choice (const :tag "None" nil)
+ (cons (string :tag "Left border")
+ (string :tag "Right border")))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (sml-modeline-refresh))
+ :group 'sml-modeline)
+
+(defcustom sml-modeline-numbers 'percentage
+ "Position number style.
+This can be 'percentage or 'line-number."
+ :type '(choice (const :tag "Line numbers" line-numbers)
+ (const :tag "Percentage" percentage))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (sml-modeline-refresh))
+ :group 'sml-modeline)
+
+(defface sml-modeline-end-face
+ '((t (:inherit match)))
+ "Face for invisible buffer parts."
+ :group 'sml-modeline)
+;; 'face `(:background ,(face-foreground 'mode-line-inactive)
+;; :foreground ,(face-background 'mode-line))
+
+(defface sml-modeline-vis-face
+ '((t (:inherit region)))
+ "Face for invisible buffer parts."
+ :group 'sml-modeline)
+;; 'face `(:background ,(face-foreground 'mode-line)
+;; :foreground ,(face-background 'mode-line))
+
+;;(sml-modeline-create)
+(defun sml-modeline-create ()
+ (let* ((wstart (window-start))
+ (wend (window-end))
+ number-max number-beg number-end
+ (sml-begin (or (car sml-modeline-borders) ""))
+ (sml-end (or (cdr sml-modeline-borders) ""))
+ (inner-len (- sml-modeline-len (length sml-begin) (length sml-end)))
+ bpad-len epad-len
+ pos-%
+ start end
+ string)
+ (if (not (or (< wend (save-restriction (widen) (point-max)))
+ (> wstart 1)))
+ ""
+ (cond
+ ((eq sml-modeline-numbers 'percentage)
+ (setq number-max (save-restriction (widen) (point-max)))
+ (setq number-beg (/ (float wstart) (float number-max)))
+ (setq number-end (/ (float wend) (float number-max)))
+ (setq start (floor (* number-beg inner-len)))
+ (setq end (floor (* number-end inner-len)))
+ (setq string
+ (concat (format "%02d" (round (* number-beg 100)))
+ "-"
+ (format "%02d" (round (* number-end 100))) "%%")))
+ ((eq sml-modeline-numbers 'line-numbers)
+ (save-restriction
+ (widen)
+ (setq number-max (line-number-at-pos (point-max)))
+ (setq number-beg (line-number-at-pos wstart))
+ (setq number-end (line-number-at-pos wend)))
+ (setq start (floor (* (/ number-beg (float number-max)) inner-len)))
+ (setq end (floor (* (/ number-end (float number-max)) inner-len)))
+ (setq string
+ (concat "L"
+ (format "%02d" number-beg)
+ "-"
+ (format "%02d" number-end))))
+ (t (error "Unknown sml-modeline-numbers=%S" sml-modeline-numbers)))
+ (setq inner-len (max inner-len (length string)))
+ (setq bpad-len (floor (/ (- inner-len (length string)) 2.0)))
+ (setq epad-len (- inner-len (length string) bpad-len))
+ (setq pos-% (+ bpad-len (length string) -1))
+ (setq string (concat sml-begin
+ (make-string bpad-len 32)
+ string
+ (make-string epad-len 32)
+ sml-end))
+ ;;(assert (= (length string) sml-modeline-len) t)
+ (when (= start sml-modeline-len) (setq start (1- start)))
+ (setq start (+ start (length sml-begin)))
+ (when (= start end) (setq end (1+ end)))
+ (when (= end pos-%) (setq end (1+ end))) ;; If on % add 1
+ (put-text-property start end 'face 'sml-modeline-vis-face string)
+ (when (and (= 0 (length sml-begin))
+ (= 0 (length sml-end)))
+ (put-text-property 0 start 'face 'sml-modeline-end-face string)
+ (put-text-property end sml-modeline-len 'face 'sml-modeline-end-face string))
+ string)))
+
+(defvar sml-modeline-old-car-mode-line-position nil)
+
+;;;###autoload
+(define-minor-mode sml-modeline-mode
+ "Show buffer size and position like scrollbar in mode line.
+You can customize this minor mode, see option `sml-modeline-mode'.
+
+Note: If you turn this mode on then you probably want to turn off
+option `scroll-bar-mode'."
+ :global t
+ :group 'sml-modeline
+ (if sml-modeline-mode
+ (progn
+ (unless sml-modeline-old-car-mode-line-position
+ (setq sml-modeline-old-car-mode-line-position (car mode-line-position)))
+ (setcar mode-line-position '(:eval (list (sml-modeline-create)))))
+ (setcar mode-line-position sml-modeline-old-car-mode-line-position)))
+
+
+(provide 'sml-modeline)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; sml-modeline.el ends here
--- /dev/null
+;;; tabkey2.el --- Use second tab key pressed for what you want
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-03-15
+(defconst tabkey2:version "1.40")
+;; Last-Updated: 2009-07-15 Wed
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/tabkey2.el
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+ ;; `appmenu', `cl'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; The tab key is in Emacs often used for indentation. However if you
+;; press the tab key a second time and Emacs tries to do indentation
+;; again, then usually nothing exciting will happen. Then why not use
+;; second tab key in a row for something else?
+;;
+;; Commonly used completion functions in Emacs is often bound to
+;; something corresponding to Alt-Tab. Unfortunately this is unusable
+;; if you have a window manager that have an apetite for it (like that
+;; on MS Windows for example, and several on GNU/Linux).
+;;
+;; Then using the second tab key press for completion might be a good
+;; choice and perhaps also easy to remember.
+;;
+;; This little library tries to make it easy to do use the second tab
+;; press for completion. Or you can see this library as a swizz army
+;; knife for the tab key ;-)
+;;
+;; See `tabkey2-mode' for more information.
+;;
+;;
+;; This is a generalized of an idea Sebastien Rocca Serra once
+;; presented on Emacs Wiki and called "Smart Tab". (It seems like
+;; many others have also been using Tab for completion in one way or
+;; another for years.)
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; Version 1.04:
+;; - Add overlay to display state after first tab.
+;;
+;; Version 1.05:
+;; - Fix remove overlay problem.
+;;
+;; Version 1.06:
+;; - Add completion function choice.
+;; - Add support for popcmp popup completion.
+;;
+;; Version 1.07:
+;; - Add informational message after first tab.
+;;
+;; Version 1.08:
+;; - Give better informational message after first tab.
+;;
+;; Version 1.09:
+;; - Put flyspell first.
+;;
+;; Version 1.09:
+;; - Give the overlay higher priority.
+;;
+;; Version 1.10:
+;; - Correct tabkey2-completion-functions.
+;; - Add double-tab for modes where tab can not be typed again.
+;; - Use better condition for when completion can be done, so that it
+;; can be done later while still on the same line.
+;; - Add a better message handling for the "Tab completion state".
+;; - Add C-g break out of the "Tab completion state".
+;; - Add faces for highlight.
+;; - Make it work in custom mode buffers.
+;; - Fix documentation for `tabkey2-first'
+;;
+;; Version 1.11:
+;; - Don't call chosen completion function directly. Instead make it
+;; default for current buffer.
+;;
+;; Version 1.12:
+;; - Simplify code.
+;; - Add help to C-f1 during "Tab completion state".
+;; - Fix documentation basics.
+;; - Add customization of state message and line marking.
+;; - Fix handling of double-Tab modes.
+;; - Make user interaction better.
+;; - Handle read-only in custom buffers better.
+;; - Add more flexible check for if completion function is active.
+;; - Support predictive mode.
+;; - Reorder and simplify.
+;;
+;; Version 1.13:
+;; - Add org-mode to the double-tab gang.
+;; - Make it possible to use double-tab in normal buffers.
+;; - Add cycling through completion functions to S-tab.
+;;
+;; Version 1.14:
+;; - Fix bug in handling of read-only.
+;; - Show completion binding in help message.
+;; - Add binding to make current choice buffer local when cycling.
+;;
+;; Version 1.15:
+;; - Fix problem at buffer end.
+;; - Add S-tab to enter completion state without indentation.
+;; - Add backtab bindings too for this.
+;; - Remove double-tab, S-tab is better.
+;; - Add list of modes that uses more tabs.
+;; - Add list of modes that uses tab only for completion.
+;; - Move first overlay when indentation changes.
+;; - Make mark at line beginning 1 char long.
+;;
+;; Version 1.16:
+;; - Don't call tab function when alternate key is pressed.
+;;
+;; Version 1.17:
+;; - Let alternate key cycle completion functions instead of complete.
+;; - Bind backtab.
+;; - Fix bug when only one completion funciton was available.
+;; - Fix bug when alt key and major without fix indent.
+;;
+;; Version 1.18:
+;; - Add popup style messages.
+;; - Add delay to first message.
+;; - Use different face for indicator on line and message.
+;; - Use different face for echo area and popup messages.
+;; - Add anything to completion functions.
+;; - Put help funciton on f1.
+;; - Always bind alternate key to cycle.
+;; - Change defcustoms to simplify (excuse me).
+;; - Work around end of buffer problems.
+;; - Work around start of buffer problems.
+;; - Assure popup messages are visible.
+;; - Reorder code in more logical order.
+;;
+;; Version 1.19:
+;; - Make overlay keymap end advance.
+;; - Remove overlay keymap parent.
+;;
+;; Version 1.20:
+;; - Fix bug on emtpy line.
+;; - Fix some text problems.
+;; - Make f1 c/k work in tab completion state.
+;;
+;; Version 1.20:
+;; - Fixed bug in overlay removal.
+;;
+;; Version 1.21:
+;; - Fixed bug in minibuffer setup.
+;;
+;; Version 1.22:
+;; - Honour widget-forward, button-forward.
+;;
+;; Version 1.23:
+;; - Remove binding of shift tab.
+;; - Check if use-region-p is defined.
+;;
+;; Version 1.24:
+;; - Add option for completion state mode line marker.
+;; - Fix bug in tabkey2-show-completion-functions.
+;; - Move off completion point cancels completion state.
+;; - Fix bugs in help.
+;; - Try to fix some problems with invisible text, at least in
+;; org-mode.
+;; - Restore window config, completions often leaves without.
+;;
+;; Version 1.25:
+;; - Fix bug in tabkey2-completion-state-p.
+;;
+;; Version 1.26:
+;; - Make tabkey2-mode a buffer local mode.
+;; - Add tabkey2-global-mode.
+;; - Fix some bugs.
+;;
+;; Version 1.27:
+;; - Fix some bugs in customization.
+;;
+;; Version 1.28:
+;; - Use invisible-p.
+;;
+;; Version 1.29:
+;; - Remove tabkey2-global-mode because of problem with minibuffers.
+;;
+;; Version 1.30:
+;; - Add Semantic's smart completion to completion functions.
+;; (Thanks Eric.)
+;;
+;; Version 1.31:
+;; - Add yasnippet and pabbrev completion functions. (Thanks Eric.)
+;; - Reorder completion functions.
+;;
+;; Version 1.32:
+;; - Add support for pcomplete.
+;; - Inform about other key bindings in completion functions list.
+;; - Remove no longer used "preferred" from completion functions list.
+;;
+;; Version 1.33:
+;; -- Automatically select next function on completion failure.
+;; -- Add completion functions reset functions.
+;;
+;; Version 1.34:
+;; - Set this-command on call-interactively.
+;; - Avoid setting last-command.
+;;
+;; Version 1.35:
+;; - Do not complete in or nearby mumamo chunk borders.
+;; - Finish completion mode unless last command was a tabkey2 command.
+;; - Finish when there are no more active completion functions.
+;;
+;; Version 1.36:
+;; - Actually check if completion function is a defined command.
+;; - Integrate better with YASnippet.
+;; - Give YASnippet higher priority since that seems what is wanted.
+;;
+;; Version 1.37:
+;; - Fix bug revealed by 1.36 changes.
+;;
+;; Version 1.38:
+;; - Fix typo in completion function list.
+;; - Fix corresponding part of check if function is active.
+;;
+;; Version 1.39:
+;; - Try first [tab] and then [?\t] when looking for command.
+;;
+;; Version 1.40:
+;; - Added Company Mode completion.
+;;
+;; Fix-me: maybe add \\_>> option to behave like smart-tab. But this
+;; will only works for modes that does not do completion of empty
+;; words (like in smart-tab).
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Known bugs
+;;
+;; - Maybe problems with comint shell.
+;; - Does not check visibility very carefully.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'appmenu nil t))
+(eval-when-compile (require 'mumamo nil t))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Custom
+
+;;;###autoload
+(defgroup tabkey2 nil
+ "Customization of second tab key press."
+ :group 'nxhtml
+ :group 'convenience)
+
+(defface tabkey2-highlight-line
+ '((t :inherit highlight))
+ "Face for marker on line when default function is active."
+ :group 'tabkey2)
+
+(defface tabkey2-highlight-line2
+ '((t :inherit isearch-fail))
+ "Face for marker on line when non-default function is active."
+ :group 'tabkey2)
+
+(defface tabkey2-highlight-message
+ '((t :inherit tabkey2-highlight-line))
+ "Face for messages in echo area."
+ :group 'tabkey2)
+
+(defface tabkey2-highlight-popup
+ '((default :box t :inherit tabkey2-highlight-message)
+ (((class color) (background light)) :foreground "black")
+ (((class color) (background dark)) :foreground "yellow"))
+ "Face for popup messages."
+ :group 'tabkey2)
+
+(defcustom tabkey2-show-mark-on-active-line t
+ "Show mark on active line if non-nil.
+This mark is shown during 'Tab completion state'."
+ :type 'boolean
+ :group 'tabkey2)
+
+(defvar tabkey2-completion-lighter nil)
+(defcustom tabkey2-completion-lighter-on nil
+ "Mode line lighter for function `tabkey2-completion-state-mode'."
+ :type 'boolean
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (setq tabkey2-completion-lighter (if value " Tab2" nil))
+ (setq minor-mode-alist
+ (assq-delete-all 'tabkey2-completion-state-mode
+ minor-mode-alist)))
+ :group 'tabkey2)
+
+(defcustom tabkey2-show-message-on-enter 2.0
+ "If non-nil show message when entering 'Tab completion state'.
+If value is a number then delay message that number of seconds."
+ :type '(choice (const :tag "Don't show" nil)
+ (const :tag "Show at once" t)
+ (float :tag "Show, but delayed (seconds)"))
+ :group 'tabkey2)
+
+
+;; (setq tabkey2-message-style 'popup)
+;; (setq tabkey2-message-style 'echo-area)
+(defcustom tabkey2-message-style 'popup
+ "How to show messages."
+ :type '(choice (const :tag "Popup" popup)
+ (const :tag "Echo area" echo-area))
+ :group 'tabkey2)
+
+(defcustom tabkey2-in-minibuffer nil
+ "If non-nil use command `tabkey2-mode' also in minibuffer."
+ :type 'boolean
+ :group 'tabkey2)
+
+(defcustom tabkey2-in-appmenu t
+ "Show a completion menu in command `appmenu-mode' if t."
+ :type 'boolean
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (fboundp 'appmenu-add)
+ (if val
+ (appmenu-add 'tabkey2 nil t "Completion" 'tabkey2-appmenu)
+ (appmenu-remove 'tabkey2))))
+ :group 'tabkey2)
+
+(defun yas/expandable-at-point ()
+ "Return non-nil if a snippet can be expanded here."
+ (when (and (fboundp 'yas/template-condition-predicate)
+ (boundp 'yas/buffer-local-condition))
+ (yas/template-condition-predicate
+ yas/buffer-local-condition)))
+
+(defvar tabkey2-company-backends
+ "List of frontends and their backends."
+ '((company-mode (NONE company-abbrev . "Abbrev")
+ (NONE company-css . "CSS")
+ (dabbrev-expan company-dabbrev . "dabbrev for plain text")
+ (NONE company-dabbrev-code . "dabbrev for code")
+ (NONE company-eclim . "eclim (an Eclipse interace)")
+ (lisp-symbol-complete company-elisp . "Emacs Lisp")
+ (complete-tag company-etags . "etags")
+ (NONE company-files . "Files")
+ (NONE company-gtags . "GNU Global")
+ (ispell-complete-word company-ispell . "ispell")
+ (flyspell-correct-word-before-point company-ispell . "ispell")
+ (NONE company-keywords . "Programming language keywords")
+ (nxml-complete company-nxml . "nxml")
+ (NONE company-oddmuse . "Oddmuse")
+ (NONE company-pysmell . "PySmell")
+ (NONE company-ropemacs . "ropemacs")
+ (senator-complete-symbol company-semantic . "CEDET Semantic")
+ (NONE company-tempo . "Tempo templates")
+ (NONE company-xcode . "Xcode"))))
+
+(defun tabkey2-find-front-end (fun)
+ (let ((
+ ))))
+
+(defcustom tabkey2-completion-functions
+ '(
+ ;; Front ends (should take care of the rest, ie temporary things,
+ ;; snippets etc...)
+ ("Company Mode completion" company-complete company-mode)
+ ;; Temporary things
+ ("Spell check word" flyspell-correct-word-before-point)
+ ;; Snippets
+ ("Yasnippet" yas/expand (yas/expandable-at-point))
+ ;; Main mode related, often used
+ ("Semantic Smart Completion" senator-complete-symbol senator-minor-mode)
+ ("Programmable completion" pcomplete)
+ ("nXML completion" nxml-complete)
+ ("Complete Emacs symbol" lisp-complete-symbol)
+ ("Widget complete" widget-complete)
+ ("Comint Dynamic Complete" comint-dynamic-complete)
+ ("PHP completion" php-complete-function)
+ ("Tags completion" complete-tag)
+ ;; General word completion
+ ("Predictive word" complete-word-at-point predictive-mode)
+ ("Predictive abbreviations" pabbrev-expand-maybe)
+ ("Dynamic word expansion" dabbrev-expand nil (setq dabbrev--last-abbrev-location nil))
+ ("Ispell complete word" ispell-complete-word)
+ ;; The catch all
+ ("Anything" anything (commandp 'anything))
+ )
+ "List of completion functions.
+The first 'active' entry in this list is normally used during the
+'Tab completion state' by `tabkey2-complete'. An entry in the
+list should have either of this forms
+
+ \(TITLE COMPLETION-FUNCTION ACTIVE-FORM RESET-FORM)
+
+TITLE to show in menus etc.
+
+COMPLETION-FUNCTION is the completion function symbol.
+
+The entry is considered active if the symbol COMPLETION-FUNCTION
+is bound to a command and
+
+ - This function has a key binding at point.
+
+or
+
+ - The elisp expression ACTIVE-FORM evaluates to non-nil. If it
+ is a single symbol then its variable value is used, otherwise
+ the elisp form is evaled.
+
+RESET-FORM is used to reset the completion function before
+calling it.
+
+When choosing with `tabkey2-cycle-completion-functions'
+only the currently active entry in this list are shown."
+ :type '(repeat (list string (choice (command :tag "Currently known command")
+ (symbol :tag "Command not known yet"))
+ (choice (const :tag "Active only if it has a key binding at point" nil)
+ (sexp :tag "Elisp, if evals to non-nil then active"))
+ (sexp :tag "Elisp, reset completion function")))
+ :group 'tabkey2)
+
+;; Use emulation mode map for first Tab key
+(defconst tabkey2-mode-emul-map (make-sparse-keymap)
+ "This keymap just binds tab and alternate key all the time.
+By default this binds Tab to `tabkey2-first'. The actual keys
+bound are in `tabkey2-first-key' and `tabkey2-alternate-key'.")
+
+(defvar tabkey2--emul-keymap-alist nil)
+
+;; (setq tabkey2-keymap-overlay nil)
+(defconst tabkey2-completion-state-emul-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c) tab] 'tabkey2-make-current-default)
+
+ ;;(define-key map tabkey2-alternate-key 'tabkey2-cycle-completion-functions)
+ (define-key map [backtab] 'tabkey2-cycle-completion-functions)
+
+ (define-key map [(control f1)] 'tabkey2-completion-function-help)
+ (define-key map [(meta f1)] 'tabkey2-show-completion-functions)
+ (define-key map [f1] 'tabkey2-completion-state-help)
+
+ (define-key map [(control ?g)] 'tabkey2-completion-state-off)
+ (define-key map [tab] 'tabkey2-complete)
+ map)
+ "This keymap is for `tabkey2-keymap-overlay'.")
+
+(defun tabkey2-bind-keys (first-key alternate-key)
+ (let ((mode-map tabkey2-mode-emul-map)
+ (comp-map tabkey2-completion-state-emul-map))
+ ;; First key
+ (when (and (boundp 'tabkey2-first-key)
+ tabkey2-first-key)
+ (define-key mode-map tabkey2-first-key nil))
+ (when first-key
+ (define-key mode-map first-key 'tabkey2-first))
+ ;; Alternate key
+ (when (and (boundp 'tabkey2-alternate-key)
+ tabkey2-alternate-key)
+ (define-key mode-map tabkey2-alternate-key nil)
+ (define-key comp-map tabkey2-alternate-key nil))
+ (when alternate-key
+ (define-key mode-map alternate-key 'tabkey2-cycle-completion-functions)
+ (define-key comp-map alternate-key 'tabkey2-cycle-completion-functions))
+ (when (and (boundp 'tabkey2-completion-state-mode)
+ tabkey2-completion-state-mode)
+ (tabkey2-completion-state-mode -1)
+ (tabkey2-completion-state-mode 1))))
+
+(defcustom tabkey2-first-key [tab]
+ "First key, first time indents, more invocations completes.
+This key is always bound to `tabkey2-first'."
+ :set (lambda (sym val)
+ (set-default sym val)
+ (tabkey2-bind-keys
+ val
+ (when (boundp 'tabkey2-alternate-key)
+ tabkey2-alternate-key)))
+ :type 'key-sequence
+ :group 'tabkey2)
+
+(defcustom tabkey2-alternate-key [f8]
+ "Alternate key, bound to cycle and show completion functions.
+This key is always bound to `tabkey2-cycle-completion-functions'."
+ :set (lambda (sym val)
+ (set-default sym val)
+ (tabkey2-bind-keys (when (boundp 'tabkey2-first-key) tabkey2-first-key) val))
+ :type 'key-sequence
+ :group 'tabkey2)
+
+(tabkey2-bind-keys tabkey2-first-key tabkey2-alternate-key)
+
+;;;###autoload
+(define-minor-mode tabkey2-mode
+ "More fun with Tab key number two (completion etc).
+This global minor mode by default binds Tab in a way that let you
+do completion with Tab in all buffers \(where it is possible).
+
+The Tab key is easy to type on your keyboard. Then why not use
+it for completion, something that is very useful? Shells usually
+use Tab for completion so many are used to it. This was the idea
+of Smart Tabs and this is a generalization of that idea.
+
+However in Emacs the Tab key is usually used for indentation.
+The idea here is that if Tab has been pressed once for
+indentation, then as long as point stays further Tab keys might
+as well do completion.
+
+So you kind of do Tab-Tab for first completion \(and then just
+Tab for further completions as long as point is not moved).
+
+And there is even kind of Tab-Tab-Tab completion: If completion
+fails the next completion function will be the one you try with
+next Tab. \(You get some notification of this, of course.)
+
+See `tabkey2-first' for more information about usage.
+
+Note: If you do not want the Tab-Tab behaviour above, but still
+want an easy way to reach the available completion functions,
+then you can instead of turning on tabkey2-mode enter this in
+your .emacs:
+
+ \(global-set-key [f8] 'tabkey2-cycle-completion-functions)
+
+After hitting f8 you will then be in the same state as after the
+first in tabkey2-mode."
+ :keymap nil
+ :global t
+ :group 'tabkey2
+ (if tabkey2-mode
+ (progn
+ (add-hook 'minibuffer-setup-hook 'tabkey2-minibuffer-setup)
+ (add-hook 'post-command-hook 'tabkey2-post-command)
+ ;; Update emul here if keymap have changed
+ (setq tabkey2--emul-keymap-alist
+ (list (cons 'tabkey2-mode
+ tabkey2-mode-emul-map)))
+ (add-to-list 'emulation-mode-map-alists 'tabkey2--emul-keymap-alist))
+ (tabkey2-completion-state-mode -1)
+ (remove-hook 'post-command-hook 'tabkey2-post-command)
+ (remove-hook 'minibuffer-setup-hook 'tabkey2-minibuffer-setup)
+ (setq emulation-mode-map-alists (delq 'tabkey2--emul-keymap-alist
+ emulation-mode-map-alists))))
+
+(defcustom tabkey2-modes-that-use-more-tabs
+ '(python-mode
+ haskell-mode
+ makefile-mode
+ org-mode
+ Custom-mode
+ custom-mode ;; For Emacs 22
+ ;; other
+ cmd-mode
+ )
+ "In those modes use must use S-Tab to start completion state.
+In those modes pressing Tab several types may make sense so you
+can not go into 'Tab completion state' just because one Tab has
+been pressed. Instead you use S-Tab to go into that state.
+After that Tab does completion.
+
+You can do use S-Tab in other modes too if you want too."
+ :type '(repeat (choice (command :tag "Currently known command")
+ (symbol :tag "Command not known yet")))
+ :group 'tabkey2)
+
+(defcustom tabkey2-modes-that-just-complete
+ '(shell-mode
+ fundamental-mode
+ text-mode)
+ "Tab is only used for completion in these modes.
+Therefore `tabkey2-first' just calls the function on Tab."
+ :type '(repeat (choice (command :tag "Currently known command")
+ (symbol :tag "Command not known yet")))
+ :group 'tabkey2)
+
+;;(setq tabkey2-use-popup-menus nil)
+;; (defcustom tabkey2-use-popup-menus (when (featurep 'popcmp) t)
+;; "Use pop menus if available."
+;; :type 'boolean
+;; :group 'tabkey2)
+
+;; (defvar tabkey2-preferred nil
+;; "Preferred function for second tab key press.")
+;; (make-variable-buffer-local 'tabkey2-preferred)
+;; (put 'tabkey2-preferred 'permanent-local t)
+
+(defvar tabkey2-fallback nil
+ "Fallback function for second tab key press.")
+(make-variable-buffer-local 'tabkey2-fallback)
+(put 'tabkey2-fallback 'permanent-local t)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; State
+
+(defvar tabkey2-overlay nil
+ "Show when tab key 2 action is to be done.")
+(defvar tabkey2-keymap-overlay nil
+ "Hold the keymap for tab key 2.")
+
+(defvar tabkey2-current-tab-info nil
+ "Saved information message for Tab completion state.")
+(defvar tabkey2-current-tab-function nil
+ "Tab completion state current completion function.")
+(make-variable-buffer-local 'tabkey2-current-tab-function)
+
+(defun tabkey2-completion-state-p ()
+ "Return t if Tab completion state should continue.
+Otherwise return nil."
+ (when (and (eq (current-buffer) (overlay-buffer tabkey2-keymap-overlay))
+ (eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window)))
+ (let* ((start (overlay-start tabkey2-keymap-overlay))
+ (end (overlay-end tabkey2-keymap-overlay))
+ (chars (append (buffer-substring-no-properties start end) nil)))
+ (and (not (memq ?\n chars))
+ (not (eq ?\ (car (last chars))))
+ (not (eq ?\ last-input-event))
+ (<= start (point))
+ (<= (point) end)
+ tabkey2-current-tab-function
+ (or (memq this-original-command '(tabkey2-first tabkey2-complete))
+ (let* ((last-name (symbol-name this-original-command))
+ (name-prefix "tabkey2-")
+ (prefix-len (length name-prefix)))
+ (and (> (length last-name) prefix-len)
+ (string= name-prefix (substring last-name 0 prefix-len)))))
+ ))))
+
+(defun tabkey2-read-only-p ()
+ "Return non-nil if buffer seems to be read-only at point."
+ (or buffer-read-only
+ (get-char-property (min (+ 0 (point)) (point-max)) 'read-only)
+ (let ((remap (command-remapping 'self-insert-command (point))))
+ (memq remap '(Custom-no-edit)))))
+
+;;;; Minor mode active after first tab
+
+(defun tabkey2-get-highlight-face ()
+ (if (eq tabkey2-current-tab-function
+ (tabkey2-first-active-from-completion-functions))
+ 'tabkey2-highlight-line
+ 'tabkey2-highlight-line2))
+
+(defun tabkey2-move-overlays ()
+ "Move overlays that mark the state and carries the state keymap."
+ (let* ((beg (let ((inhibit-field-text-motion t))
+ (line-beginning-position)))
+ (ind (current-indentation))
+ (end (+ beg 1)) ;(if (> ind 0) ind 1)))
+ (inhibit-read-only t))
+ (unless tabkey2-overlay
+ (setq tabkey2-overlay (make-overlay beg end)))
+ ;; Fix-me: gets some strange errors, try avoid moving:
+ (unless (and (eq (current-buffer) (overlay-buffer tabkey2-overlay))
+ (= beg (overlay-start tabkey2-overlay))
+ (= end (overlay-end tabkey2-overlay)))
+ (move-overlay tabkey2-overlay beg end (current-buffer)))
+ ;; Give it a high priority, it is very temporary
+ (overlay-put tabkey2-overlay 'priority 1000)
+ (if tabkey2-show-mark-on-active-line
+ (progn
+ (overlay-put tabkey2-overlay 'face
+ ;;'tabkey2-highlight-line
+ (tabkey2-get-highlight-face)
+ )
+ (overlay-put tabkey2-overlay 'help-echo
+ "This highlight shows that Tab completion state is on"))
+ (overlay-put tabkey2-overlay 'face nil)
+ (overlay-put tabkey2-overlay 'help-echo nil)))
+ ;; The keymap overlay
+ (let ((beg (line-beginning-position))
+ (end (line-end-position)))
+ ;;(when (= end (point-max)) (setq end (1+ end)))
+ (setq beg (point))
+ (setq end (point))
+
+ (unless tabkey2-keymap-overlay
+ ;; Make the rear of the overlay advance so that the keymap works
+ ;; at the end of a line and the end of the buffer.
+ (setq tabkey2-keymap-overlay (make-overlay 0 0 nil nil t)))
+ (overlay-put tabkey2-keymap-overlay 'priority 1000)
+ ;;(overlay-put tabkey2-keymap-overlay 'face 'secondary-selection)
+ (overlay-put tabkey2-keymap-overlay 'keymap
+ tabkey2-completion-state-emul-map)
+ (overlay-put tabkey2-keymap-overlay 'window (selected-window))
+ (move-overlay tabkey2-keymap-overlay beg end (current-buffer))))
+
+(defun tabkey2-is-active (fun chk)
+ "Return t FUN is active.
+Return t if CHK is a symbol with non-nil value or a form that
+evals to non-nil.
+
+Otherwise return t if FUN has a key binding at point."
+ (when (and (fboundp fun)
+ (commandp fun))
+ (or (if (symbolp chk)
+ (when (boundp chk) (symbol-value chk))
+ (eval chk))
+ (let* ((emulation-mode-map-alists
+ ;; Remove keymaps from tabkey2 in this copy:
+ (delq 'tabkey2--emul-keymap-alist
+ (copy-sequence emulation-mode-map-alists)))
+ (keys (tabkey2-symbol-keys fun))
+ kb-bound)
+ (dolist (key keys)
+ (unless (memq (car (append key nil))
+ '(menu-bar))
+ (setq kb-bound t)))
+ kb-bound))))
+
+(defun tabkey2-is-active-p (fun)
+ "Return FUN is active.
+Look it up in `tabkey2-completion-functions' to find out what to
+check and return the value from `tabkey2-is-active'."
+ (let ((chk (catch 'chk
+ (dolist (rec tabkey2-completion-functions)
+ (when (eq fun (nth 1 rec))
+ (throw 'chk (nth 2 rec)))))))
+ (tabkey2-is-active fun chk)))
+
+(defvar tabkey2-chosen-completion-function nil)
+(make-variable-buffer-local 'tabkey2-chosen-completion-function)
+(put 'tabkey2-chosen-completion-function 'permanent-local t)
+
+(defun tabkey2-first-active-from-completion-functions ()
+ "Return first active completion function.
+Look in `tabkey2-completion-functions' for the first function
+that has an active key binding."
+ (catch 'active-fun
+ (dolist (rec tabkey2-completion-functions)
+ (let ((fun (nth 1 rec))
+ (chk (nth 2 rec)))
+ (when (tabkey2-is-active fun chk)
+ (throw 'active-fun fun))))))
+
+(defun tabkey2-get-default-completion-fun ()
+ "Return the default completion function.
+See `tabkey2-first' for the list considered."
+ (or (when (and tabkey2-chosen-completion-function
+ (tabkey2-is-active-p
+ tabkey2-chosen-completion-function))
+ tabkey2-chosen-completion-function)
+ ;;tabkey2-preferred
+ (tabkey2-first-active-from-completion-functions)
+ tabkey2-fallback))
+
+(defvar tabkey2-overlay-message nil)
+
+(defvar tabkey2-completion-state-mode nil)
+;;(make-variable-buffer-local 'tabkey2-completion-state-mode)
+(defun tabkey2-completion-state-mode (arg)
+ "Tab completion state minor mode.
+This pseudo-minor mode holds the 'Tab completion state'. When this
+minor mode is on completion key bindings are available.
+
+With ARG a positive number turn on, otherwise turn off this minor
+mode.
+
+See `tabkey2-first' for more information."
+ ;;(assq-delete-all 'tabkey2-completion-state-mode minor-mode-alist)
+ (unless (assoc 'tabkey2-completion-state-mode minor-mode-alist)
+ ;;(setq minor-mode-alist (cons '(tabkey2-completion-state-mode " Tab2")
+ (setq minor-mode-alist (cons (list 'tabkey2-completion-state-mode
+ tabkey2-completion-lighter)
+ minor-mode-alist)))
+ (let ((emul-map (cdr (car tabkey2--emul-keymap-alist)))
+ (old-wincfg tabkey2-completion-state-mode))
+ (setq tabkey2-completion-state-mode (when (and (numberp arg)
+ (> arg 0))
+ ;;t
+ (current-window-configuration)
+ ))
+ (if tabkey2-completion-state-mode
+ (progn
+ ;; Set default completion function
+ (tabkey2-make-message-and-set-fun
+ (tabkey2-get-default-completion-fun))
+ ;; Message
+ ;;(setq tabkey2-message-is-shown nil)
+ (when tabkey2-show-message-on-enter
+ (tabkey2-show-current-message
+ (when (numberp tabkey2-show-message-on-enter)
+ tabkey2-show-message-on-enter)))
+ ;; Move overlays
+ (tabkey2-move-overlays)
+ ;; Work around eob keymap problem ...
+ ;;(set-keymap-parent emul-map (overlay-get tabkey2-keymap-overlay
+ ;; 'keymap))
+ ;; Set up for pre/post-command-hook
+ (add-hook 'pre-command-hook 'tabkey2-completion-state-pre-command)
+ (add-hook 'post-command-hook 'tabkey2-completion-state-post-command))
+ ;;(set-keymap-parent emul-map nil)
+ (setq tabkey2-current-tab-function nil)
+ (when (and old-wincfg
+ tabkey2-keymap-overlay
+ (eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window))
+ (not (active-minibuffer-window)))
+ (set-window-configuration old-wincfg))
+ (let ((inhibit-read-only t))
+ (when tabkey2-keymap-overlay
+ (delete-overlay tabkey2-keymap-overlay))
+ (when tabkey2-overlay
+ (delete-overlay tabkey2-overlay)))
+ (remove-hook 'pre-command-hook 'tabkey2-completion-state-pre-command)
+ (remove-hook 'post-command-hook 'tabkey2-completion-state-post-command)
+ (tabkey2-overlay-message nil)
+ ;;(message "")
+ )))
+
+(defun tabkey2-completion-state-off ()
+ "Quit Tab completion state."
+ (interactive)
+ (tabkey2-completion-state-mode -1)
+ (let ((C-g-binding (or (key-binding [(control ?g)])
+ (key-binding "\C-g")))
+ did-more)
+ (when (and (boundp 'company-mode)
+ company-mode)
+ ;;(message "tabkey2:company-abort")
+ (company-abort)
+ (setq did-more t))
+ (when (and C-g-binding
+ (not (eq C-g-binding this-command)))
+ ;;(message "tabkey2:c-g=%s" C-g-binding)
+ (call-interactively C-g-binding)
+ (setq did-more t))
+ (message "Quit")))
+
+(defvar tabkey2-message-is-shown nil)
+(defun tabkey2-message-is-shown ()
+ (case tabkey2-message-style
+ ('popup
+ (when tabkey2-overlay-message
+ (overlay-buffer tabkey2-overlay-message)))
+ ('echo-area
+ (get (current-message) 'tabkey2))))
+
+(defun tabkey2-completion-state-pre-command ()
+ "Run this in `pre-command-hook'.
+Check if message is shown.
+Remove overlay message.
+Cancel delayed message."
+ ;;(message "=====> tabkey2-completion-state-pre-command")
+ (condition-case err
+ (progn
+ (setq tabkey2-message-is-shown (tabkey2-message-is-shown))
+ ;;(message "tabkey2-overlay-message=%s, is-shown=%s" tabkey2-overlay-message tabkey2-message-is-shown)
+ (tabkey2-overlay-message nil)
+ (tabkey2-cancel-delayed-message)
+ ;;(message "here buffer=%s, this-command=%s" (current-buffer) this-command)
+ )
+ (error (message "tabkey2 pre: %s" (error-message-string err)))))
+
+(defun tabkey2-completion-state-post-command ()
+ "Turn off Tab completion state if not feasable any more.
+This is run in `post-command-hook' after each command."
+ (condition-case err
+ ;;(save-match-data
+ ;; Delayed messages
+ (if (not (tabkey2-completion-state-p))
+ (tabkey2-completion-state-mode -1)
+ ;;(message "tabkey2-current-tab-function=%s" tabkey2-current-tab-function)
+ (tabkey2-move-overlays))
+ ;;)
+ (error (message "tabkey2 post: %s" (error-message-string err)))))
+
+(defun tabkey2-minibuffer-setup ()
+ "Activate/deactivate function `tabkey2-mode' in minibuffer."
+ (set (make-local-variable 'tabkey2-mode)
+ (and tabkey2-mode
+ tabkey2-in-minibuffer))
+ (unless tabkey2-mode
+ (set (make-local-variable 'emulation-mode-map-alists)
+ (delq 'tabkey2--emul-keymap-alist
+ (copy-sequence emulation-mode-map-alists)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Message functions
+
+;; Fix-me: Included in Emacs 23.
+(unless (fboundp 'invisible-p)
+ (defun invisible-p (pos)
+ "Return non-nil if the character after POS is currently invisible."
+ (let ((prop
+ (get-char-property pos 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (if (listp prop)
+ (catch 'invis
+ (dolist (p prop)
+ (when (or (memq p buffer-invisibility-spec)
+ (assq p buffer-invisibility-spec))
+ (throw 'invis t))))
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))))
+
+;; (defun test-scroll ()
+;; (interactive)
+;; (setq debug-on-error t)
+;; (let* ((buffer-name "test-scroll")
+;; (buffer (get-buffer buffer-name)))
+;; (when buffer (kill-buffer buffer))
+;; (setq buffer (get-buffer-create buffer-name))
+;; (switch-to-buffer buffer)
+;; (message "here 1") (sit-for 1)
+;; (condition-case err
+;; (scroll-up 1)
+;; (error (message "scroll-up error: %s" err)
+;; (sit-for 1)))
+;; (message "here 2") (sit-for 1)
+;; (scroll-up 1)
+;; (message "here 3") (sit-for 1)
+;; ))
+
+(defun tabkey2-overlay-message (txt)
+ "Display TXT below or above current line using an overlay."
+ ;;(setq tabkey2-message-is-shown txt)
+ (if (not txt)
+ (when tabkey2-overlay-message
+ (delete-overlay tabkey2-overlay-message)
+ (setq tabkey2-overlay-message nil))
+ (let ((ovl tabkey2-overlay-message)
+ (column (current-column))
+ (txt-len (length txt))
+ (here (point))
+ beg end
+ (before "")
+ (after "")
+ ovl-str too-much
+ (is-eob (eobp))
+ (direction 1))
+ (unless ovl (setq ovl (make-overlay 0 0)))
+ (when tabkey2-overlay-message
+ (delete-overlay tabkey2-overlay-message))
+ (setq tabkey2-overlay-message ovl)
+
+ (when is-eob
+ (setq direction -1))
+ (when (and (/= (point-min) (window-start))
+ (not (pos-visible-in-window-p (min (point-max) (1+ (line-end-position))))))
+ ;; Go back inside window to avoid aggressive scrolling:
+ (forward-line -1)
+ (scroll-up 1)
+ (forward-line 1))
+ (forward-line direction)
+ ;; Fix-me: Emacs bug workaround
+ (if (when (< 1 (point))
+ (invisible-p (1- (line-end-position))))
+ (progn
+ (goto-char here)
+ (tabkey2-echo-area-message txt))
+ ;; Fix-me: Does this really do anything now:
+ (when (invisible-p (point))
+ (while (invisible-p (point))
+ (forward-line direction)))
+ (setq beg (line-beginning-position))
+ (setq end (line-end-position))
+
+ (if (or (invisible-p beg) (invisible-p end))
+ ;; Give up, do not fight invisibility:
+ (progn
+ (tabkey2-overlay-message nil)
+ (tabkey2-echo-area-message txt))
+
+ ;; string before
+ (move-to-column column)
+ (setq before (buffer-substring beg (point)))
+ (when (< (current-column) column)
+ (setq before
+ (concat before
+ (make-string (- column (current-column)) ? ))))
+ (setq too-much (- (+ 1 txt-len (length before))
+ (window-width)))
+ (when (> too-much 0)
+ (setq before (substring before 0 (- too-much))))
+
+ (unless (> too-much 0)
+ (move-to-column (+ txt-len (length before)))
+ (setq after (buffer-substring (point) end)))
+
+ (setq ovl-str (concat before
+ (propertize txt 'face 'tabkey2-highlight-popup)
+ after
+ ))
+
+ (overlay-put ovl 'after-string ovl-str)
+ (overlay-put ovl 'display "")
+ (overlay-put ovl 'window (selected-window))
+ (move-overlay ovl beg end (current-buffer)))
+
+ (goto-char here)
+ ))))
+
+;; Fix-me: This was not usable IMO. Too much flickering.
+;; (defun tabkey2-tooltip (txt)
+;; (let* ((params tooltip-frame-parameters)
+;; (coord (car (point-to-coord (point))))
+;; (left (car coord))
+;; (top (cadr coord))
+;; tooltip-frame-parameters
+;; )
+;; ;; Fix-me: how do you get char height??
+;; (setq top (+ top 50))
+;; (setq params (tooltip-set-param params 'left left))
+;; (setq params (tooltip-set-param params 'top top))
+;; (setq params (tooltip-set-param params 'top top))
+;; (setq tooltip-frame-parameters params)
+;; (tooltip-hide)
+;; (tooltip-show txt nil)))
+
+(defun tabkey2-echo-area-message (txt)
+ "Show TXT in the echo area with a special face.
+Shown with the face `tabkey2-highlight-message'."
+ (message "%s" (propertize txt
+ 'face 'tabkey2-highlight-message
+ 'tabkey2 t)))
+
+(defun tabkey2-deliver-message (txt)
+ "Show message TXT to user."
+ (case tabkey2-message-style
+ (popup (tabkey2-overlay-message txt))
+ (t (tabkey2-echo-area-message txt))))
+
+(defun tabkey2-timer-deliver-message (txt where)
+ "Show message TXT to user.
+Protect from errors cause this is run during a timer."
+ (save-match-data ;; runs in timer
+ (when (and tabkey2-completion-state-mode
+ (equal (point-marker) where))
+ (condition-case err
+ (tabkey2-deliver-message txt)
+ (error (message "tabkey2-timer-deliver-message: %s"
+ (error-message-string err)))))))
+
+(defvar tabkey2-delayed-timer nil)
+
+(defun tabkey2-cancel-delayed-message ()
+ "Cancel delayed message."
+ (when tabkey2-delayed-timer
+ (cancel-timer tabkey2-delayed-timer)
+ (setq tabkey2-delayed-timer)))
+
+(defun tabkey2-maybe-delayed-message (txt delay)
+ "Show message TXT, delay it if DELAY is non-nil."
+ (if delay
+ (setq tabkey2-delayed-timer
+ (run-with-idle-timer
+ delay nil
+ 'tabkey2-timer-deliver-message txt (point-marker)))
+ (tabkey2-deliver-message txt)))
+
+(defun tabkey2-message (delay format-string &rest args)
+ "Show, if DELAY delayed, otherwise immediately message.
+FORMAT-STRING and ARGS are like for `message'."
+ (let ((txt (apply 'format format-string args)))
+ (tabkey2-maybe-delayed-message txt delay)))
+
+(defun tabkey2-show-current-message (&optional delay)
+ "Show current completion message, delayed if DELAY is non-nil."
+ (tabkey2-cancel-delayed-message)
+ (tabkey2-message delay "%s" tabkey2-current-tab-info))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Completion function selection etc
+
+(defun tabkey2-symbol-keys (comp-fun)
+ "Get a list of all key bindings for COMP-FUN."
+ (let* ((remapped (command-remapping comp-fun)))
+ (where-is-internal comp-fun
+ nil ;;overriding-local-map
+ nil nil remapped)))
+
+(defun tabkey2-get-active-completion-functions ()
+ "Get a list of active completion functions.
+Consider only those in `tabkey2-completion-functions'."
+ (delq nil
+ (mapcar (lambda (rec)
+ (let ((fun (nth 1 rec))
+ (chk (nth 2 rec)))
+ (when (tabkey2-is-active fun chk) rec)))
+ tabkey2-completion-functions)))
+
+(defun tabkey2-make-current-default ()
+ "Make current Tab completion function default.
+Set the current Tab completion function at point as default for
+the current buffer."
+ (interactive)
+ (let ((set-it
+ (y-or-n-p
+ (format
+ "Make %s default for Tab completion in current buffer? "
+ tabkey2-current-tab-function))))
+ (when set-it
+ (setq tabkey2-chosen-completion-function
+ tabkey2-current-tab-function))
+ (unless set-it
+ (when (local-variable-p 'tabkey2-chosen-completion-function)
+ (when (y-or-n-p "Use default Tab completion selection in buffer? ")
+ (setq set-it t))
+ (kill-local-variable 'tabkey2-chosen-completion-function)))
+ (when (tabkey2-completion-state-p)
+ (tabkey2-message nil "%s%s" tabkey2-current-tab-info
+ (if set-it " - Done" "")))))
+
+(defun tabkey2-activate-next-completion-function (wrap)
+ (let* ((active (mapcar (lambda (rec)
+ (nth 1 rec))
+ (tabkey2-get-active-completion-functions)))
+ (first (car active))
+ next)
+ ;;(message "is-shown=%s current=%s active=%s overlay=%s" tabkey2-message-is-shown tabkey2-current-tab-function active tabkey2-overlay)
+ (when tabkey2-current-tab-function
+ (while (and active (not next))
+ (when (eq (car active) tabkey2-current-tab-function)
+ (setq next (cadr active)))
+ (setq active (cdr active))))
+ (unless next
+ (when wrap (setq next first)))
+ ;;(if (eq first next)
+ (tabkey2-make-message-and-set-fun next)))
+
+(defun tabkey2-cycle-completion-functions (prefix)
+ "Cycle through cnd display ompletion functions.
+If 'Tab completion state' is not on then turn it on.
+
+If PREFIX is given just show what this command will do."
+ (interactive "P")
+ (if (tabkey2-read-only-p)
+ (message "Buffer is read only at point")
+ (unless tabkey2-completion-state-mode (tabkey2-completion-state-mode 1))
+ (save-match-data
+ (if prefix
+ ;; fix-me
+ (message "(TabKey2) %s: show/cycle completion function"
+ last-input-event)
+ (when tabkey2-message-is-shown
+ ;; Message is shown currently so change
+ (tabkey2-activate-next-completion-function 'wrap))
+ (tabkey2-show-current-message)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Handling of Tab and alternate key
+
+;;;###autoload
+(defun tabkey2-emma-without-tabkey2 ()
+ ;; Remove keymaps from tabkey2 in this copy:
+ (delq 'tabkey2--emul-keymap-alist
+ (copy-sequence emulation-mode-map-alists)))
+
+(defvar tabkey2-step-out-of-the-way nil)
+;;(remove-hook 'pre-command-hook 'tabkey2-pre-command)
+;;(remove-hook 'post-command-hook 'tabkey2-pre-command)
+;;(remove-hook 'post-command-hook 'tabkey2-post-command-2)
+(defun tabkey2-post-command ()
+ (setq tabkey2-step-out-of-the-way nil)
+ (condition-case err
+ (when tabkey2-mode
+ (when (and (boundp 'company-overriding-keymap-bound) company-overriding-keymap-bound)
+ (setq tabkey2-step-out-of-the-way
+ (let ((emulation-mode-map-alists (tabkey2-emma-without-tabkey2)))
+ (key-binding (this-command-keys))))
+ ;;(message "tabkey2-step-out=%s, %s" (this-command-keys) tabkey2-step-out-of-the-way)
+ ))
+ (error "tabkey2-pre-command: %s" err)))
+ ;; (and (boundp 'company-preview-overlay)
+ ;; (or company-preview-overlay
+ ;; company-pseudo-tooltip-overlay)))
+(defun tabkey2-first (prefix)
+ "Do something else after first Tab.
+This function is bound to the Tab key \(or whatever key
+`tabkey2-first-key' is) when minor mode command `tabkey2-mode' is
+on. It works like this:
+
+1. The first time Tab is pressed do whatever Tab would have done
+ if minor mode command `tabkey2-mode' was off.
+
+ Then before next command enter a new temporary 'Tab completion
+ state' for just the next command. Show this by a highlight on
+ the indentation and a marker \"Tab2\" in the mode line.
+
+ However if either
+ - the minibuffer is active and `tabkey2-in-minibuffer' is nil
+ - `major-mode' is in `tabkey2-modes-that-use-more-tabs' then
+ do not enter this temporary 'Tab completion state'.
+
+ For major modes where it make sense to press Tab several times
+ you can use `tabkey2-alternate-key' to enter 'Tab completion
+ state'.
+
+
+2. As long as point is not move do completion when Tab is pressed
+ again. Show that this state is active with a highlighting at
+ the line beginning, a marker on the mode line (Tab2) and a
+ message in the echo area which tells what kind of completion
+ will be done.
+
+ When deciding what kind of completion to do look in the table
+ below and do whatever it found first that is not nil:
+
+ - `tabkey2-preferred'
+ - `tabkey2-completion-functions'
+ - `tabkey2-fallback'
+
+3. Of course, there must be some way for you to easily determine
+ what kind of completion because there are many in Emacs. If
+ you do not turn it off this function will show that to you.
+ And if you turn it off you can still display it, see the key
+ bindings below.
+
+ If this function is used with a PREFIX argument then it just
+ shows what Tab will do.
+
+ If the default kind of completion is not what you want then
+ you can choose completion function from any of the candidates
+ in `tabkey2-completion-functions'. During the 'Tab completion
+ state' the following extra key bindings are available:
+
+\\{tabkey2-completion-state-emul-map}
+
+Of course, some languages does not have a fixed indent as is
+assumed above. You can put major modes for those in
+`tabkey2-modes-that-just-complete'.
+
+Some major modes uses tab for something else already. Those are
+in `tabkey2-modes-that-use-more-tabs'. There is an alternate
+key, `tabkey2-alternate-key' if you want to do completion
+there. Note that this key does not do completion. It however
+enters 'Tab completion state' in which you have access to the
+keys above for completion etc. \(This key also lets you cycle
+through the completion functions too choose which one to use.)
+
+-----
+NOTE: This uses `emulation-mode-map-alists' and it supposes that
+nothing else is bound to Tab there."
+ (interactive "P")
+ ;;(message "first:tabkey2-step-out=%s, %s" (this-command-keys) tabkey2-step-out-of-the-way)
+ (if tabkey2-step-out-of-the-way
+ (progn
+ (message "step-out=%s" tabkey2-step-out-of-the-way)
+ (call-interactively tabkey2-step-out-of-the-way))
+ (if (and tabkey2-keymap-overlay
+ (eq (overlay-buffer tabkey2-keymap-overlay) (current-buffer))
+ (eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window))
+ (>= (point) (overlay-start tabkey2-keymap-overlay))
+ (<= (point) (overlay-end tabkey2-keymap-overlay)))
+ ;; We should maybe not be here, but the keymap does not work at
+ ;; the end of the buffer so we call the second tab function from
+ ;; here:
+ (if (memq 'shift (event-modifiers last-input-event))
+ (call-interactively 'tabkey2-cycle-completion-functions)
+ (call-interactively 'tabkey2-complete prefix))
+ (let* ((emma-without-tabkey2 (tabkey2-emma-without-tabkey2))
+ (at-word-end (looking-at "\\_>"))
+ (just-complete (or (memq major-mode tabkey2-modes-that-just-complete)
+ at-word-end))
+ (what (if just-complete
+ 'complete
+ (if (or (unless tabkey2-in-minibuffer
+ (active-minibuffer-window))
+ (when (fboundp 'use-region-p) (use-region-p))
+ (not at-word-end)
+ (memq major-mode tabkey2-modes-that-use-more-tabs))
+ 'indent
+ 'indent-complete
+ )))
+ (to-do-1 (unless (or
+ ;; Skip action on tab if shift tab,
+ ;; backtab or a mode in the "just
+ ;; complete" list
+ (memq 'shift (event-modifiers last-input-event))
+ (equal [backtab] (this-command-keys-vector))
+ )
+ (let ((emulation-mode-map-alists emma-without-tabkey2))
+ ;; Fix-me: Is this the way to pick up "tab keys"?
+ (or (key-binding [tab] t)
+ (key-binding [?\t] t))
+ )))
+ (to-do-2 (unless (or ;;(memq what '(complete))
+ (memq what '(indent))
+ (memq to-do-1 '(widget-forward button-forward)))
+ (tabkey2-get-default-completion-fun))))
+ ;;(message "step-out-of-the-way=%s to-do=%s/%s, emmaa-without-tabkey2=%s" step-out-of-the-way to-do-1 to-do-2 emma-without-tabkey2)
+ (if prefix
+ (if (memq 'shift (event-modifiers last-input-event))
+ (message
+ "(TabKey2) First shift %s: turn on 'Tab completion state'"
+ last-input-event)
+ (message "(TabKey2) First %s: %s, next: maybe %s"
+ last-input-event to-do-1
+ (if to-do-2 to-do-2 "(same)")))
+ (when to-do-1
+ (let (xmumamo-multi-major-mode)
+ (tabkey2-call-interactively to-do-1)))
+ (unless (tabkey2-read-only-p)
+ (when to-do-2
+ (tabkey2-completion-state-mode 1))))))))
+
+(defun tabkey2-call-interactively (function)
+ "Like `call-interactively, but handle `this-command'."
+ (setq this-command function)
+ (call-interactively function))
+
+(defcustom tabkey2-choose-next-on-error t
+ "Choose next completion function on error."
+ :type 'boolean
+ :group 'tabkey2)
+
+(defun tabkey2-complete (prefix)
+ "Call current completion function.
+If used with a PREFIX argument then just show what Tab will do."
+ (interactive "P")
+ (if (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode
+ (not (mumamo-syntax-maybe-completable (point))))
+ (message "Please move out of chunk border before trying to complete.")
+ (if prefix
+ (message "(TabKey2) %s: %s"
+ last-input-event tabkey2-current-tab-function)
+ (let ((here (point))
+ (res (if tabkey2-choose-next-on-error
+ (condition-case err
+ (tabkey2-call-interactively tabkey2-current-tab-function)
+ (error (message "%s" (error-message-string err))
+ nil))
+ (tabkey2-call-interactively tabkey2-current-tab-function))))
+ (when (and (not res) (= here (point)))
+ (tabkey2-activate-next-completion-function nil)
+ ;;(message "complete.tabkey2-current-tab-function=%s" tabkey2-current-tab-function)
+ (if tabkey2-current-tab-function
+ (tabkey2-show-current-message)
+ (message "No more active completion functions in this buffer")))))))
+
+;; Fix-me: I am not sure that it really is useful with a globalized
+;; minor mode here because there are so many other ways to control
+;; what happens in a specific buffer. Maybe it would just be
+;; confusing?
+;;
+;; If found another problem with making it globalized: tabkey2-mode
+;; uses emulation-mode-map-alist. I decided to remove this therefore.
+;;
+;; (defun tabkey2-turn-on ()
+;; "Turn on `tabkey2-mode' in current buffer."
+;; (tabkey2-mode 1))
+
+;; (defvar tabkey2-turn-on-function 'tabkey2-turn-on
+;; "Function used to mabye turn on `tabkey2-mode' in current-buffer.
+;; This function is used by `tabkey2-global-mode' to turn on
+;; `tabkey2-mode'.")
+
+;; (defun tabkey2-turn-on-in-buffer ()
+;; (funcall tabkey2-turn-on-function))
+
+;; (define-globalized-minor-mode tabkey2-global-mode
+;; tabkey2-mode tabkey2-turn-on-in-buffer)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Help functions
+
+(defun tabkey2-show-completion-state-help ()
+ "Help for 'Tab completion state'.
+To get out of this state you can move out of the current line.
+
+During this state the keymap below is active. This state stops
+as soon as you leave the current row.
+
+\\{tabkey2-completion-state-emul-map}
+See function `tabkey2-mode' for more information.
+
+If you want to use Emacs normal help function then press F1
+again.")
+
+(defun tabkey2-completion-state-help ()
+ "Show help for 'Tab completion state'."
+ (interactive)
+ ;;(message "tckv=%s" (this-command-keys-vector)) ;;(sit-for 1)
+ ;; Fix-me: There seems to be an Emacs bug lurking here. Sometimes
+ ;; invoked-by-f1 is not [f1].
+ (let ((invoked-by-f1 (equal (this-command-keys-vector) [f1]))
+ normal-help)
+ ;;(message "invoked-by-f1=%s" invoked-by-f1) ;; fix-me
+ (if (not invoked-by-f1)
+ (describe-function 'tabkey2-show-completion-state-help)
+ (setq normal-help
+ (read-event
+ (propertize
+ (concat "Type a key for Emacs help."
+ " Or, wait for Tab completion state help: ")
+ 'face 'highlight)
+ nil
+ 4))
+ (case normal-help
+ ((nil)
+ ;;(message "Tab completion state help")
+ (describe-function 'tabkey2-show-completion-state-help))
+ (?c
+ (call-interactively 'describe-key-briefly))
+ (?k
+ (call-interactively 'describe-key))
+ (t
+ (tabkey2-completion-state-mode -1)
+ (setq unread-command-events
+ (reverse
+ (cons
+ normal-help
+ (append (this-command-keys) nil)))))))))
+
+(defun tabkey2-completion-function-help ()
+ "Show help for current completion function."
+ (interactive)
+ (describe-function tabkey2-current-tab-function))
+
+
+
+
+(defun tabkey2-get-key-binding (fun t2)
+ "Get key binding for FUN during 'Tab completion state'."
+ (let* ((remapped (command-remapping fun))
+ (key (where-is-internal fun
+ (when t2 tabkey2-completion-state-emul-map)
+ t
+ nil
+ remapped)))
+ key))
+
+;; (defun tabkey2-reset-completion-function (comp-fun)
+;; "Reset states for functions in `tabkey2-completion-functions'."
+;; ;; Fix-me: remove hard-coding
+;; (setq dabbrev--last-abbrev-location nil))
+
+(defun tabkey2-make-message-and-set-fun (comp-fun)
+ "Set current completion function to COMP-FUN.
+Build message but don't show it."
+ ;;(tabkey2-reset-completion-functions)
+ (let* ((chs-fun 'tabkey2-cycle-completion-functions)
+ (key (tabkey2-get-key-binding chs-fun t))
+ ;;(def-fun (tabkey2-get-default-completion-fun))
+ what
+ (comp-fun-key (tabkey2-get-key-binding comp-fun nil))
+ reset)
+ (setq tabkey2-current-tab-function comp-fun)
+ (dolist (rec tabkey2-completion-functions)
+ (let ((fun (nth 1 rec))
+ (txt (nth 0 rec))
+ (res (nth 3 rec)))
+ (when (eq fun comp-fun)
+ (eval res)
+ (setq what txt))))
+ (let ((info (concat (format "Tab: %s" what)
+ (if comp-fun-key
+ (format " (%s)" (key-description comp-fun-key))
+ "")
+ (if (cdr (tabkey2-get-active-completion-functions))
+ (format ", other %s, help F1"
+ (key-description key))
+ ""))))
+ (setq tabkey2-current-tab-info info))))
+
+(defun tabkey2-get-active-string (bnd fun buf)
+ "Get string to show for state.
+BND: means active
+FUN: function
+BUF: buffer"
+ (if bnd
+ (if (with-current-buffer buf (tabkey2-read-only-p))
+ (propertize "active, but read-only" 'face '( :foreground "red"))
+ (propertize "active" 'face '( :foreground "green3")))
+ (if (and (fboundp fun)
+ (commandp fun))
+ (propertize "not active" 'face '( :foreground "red2"))
+ (propertize "not defined" 'face '( :foreground "gray")))))
+
+(defun tabkey2-show-completion-functions ()
+ "Show what currently may be used for completion."
+ (interactive)
+ (let ((orig-buf (current-buffer))
+ (orig-mn mode-name)
+ (active-mark (concat " "
+ (propertize "<= default"
+ 'face '( :background "yellow"))))
+ (act-found nil)
+ (chosen-fun tabkey2-chosen-completion-function)
+ what
+ chosen)
+ (when chosen-fun
+ (dolist (rec tabkey2-completion-functions)
+ (let ((fun (nth 1 rec))
+ (txt (nth 0 rec)))
+ (when (eq fun chosen-fun) (setq what txt))))
+ (setq chosen (list what chosen-fun)))
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'tabkey2-show-completion-functions)
+ (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert (concat "The completion functions available for"
+ " 'Tab completion' in buffer\n'"
+ (buffer-name orig-buf)
+ "' at point with mode " orig-mn " are shown below.\n"
+ "The first active function is used by default.\n\n"))
+ (if (not chosen)
+ (insert " No completion function is set as default.")
+ (let* ((txt (nth 0 chosen))
+ (fun (nth 1 chosen))
+ (chk (nth 2 chosen))
+ (bnd (with-current-buffer orig-buf
+ (tabkey2-is-active fun chk)))
+ (act (tabkey2-get-active-string bnd fun orig-buf)))
+ (insert (format " Default is set to\n %s (%s): %s"
+ txt fun act))
+ (when bnd (insert active-mark) (setq act-found t))))
+ (insert "\n\n")
+;;; (if (not tabkey2-preferred)
+;;; (insert " None is preferred")
+;;; (let* ((txt (nth 0 tabkey2-preferred))
+;;; (fun (nth 1 tabkey2-preferred))
+;;; (chk (nth 2 chosen))
+;;; (bnd (with-current-buffer orig-buf
+;;; (tabkey2-is-active fun chk)))
+;;; (act (tabkey2-get-active-string bnd fun orig-buf)))
+;;; (insert (format " Preferred is %s (`%s')': %s"
+;;; txt fun act))
+;;; (when bnd (insert active-mark) (setq act-found t))))
+;;; (insert "\n\n")
+ (dolist (comp-fun tabkey2-completion-functions)
+ (let* ((txt (nth 0 comp-fun))
+ (fun (nth 1 comp-fun))
+ (chk (nth 2 comp-fun))
+ (bnd (with-current-buffer orig-buf
+ (tabkey2-is-active fun chk)))
+ (act (tabkey2-get-active-string bnd fun orig-buf))
+ (keys (where-is-internal fun)))
+ (if (not keys)
+ (setq keys "")
+ (setq keys (mapconcat 'key-description keys ", "))
+ (when (and (< 9 (length keys))
+ (string= "<menu-bar>" (substring keys 0 10)))
+ (setq keys "Menu"))
+ (setq keys (propertize keys 'face 'highlight))
+ (setq keys (concat ", " keys))
+ )
+ (insert
+ (format
+ " %s (`%s'%s): %s"
+ txt fun keys act))
+ (when (and (not act-found) bnd)
+ (insert active-mark) (setq act-found t))
+ (insert "\n")))
+ (insert "\n")
+ (if (not tabkey2-fallback)
+ (insert " There is no fallback")
+ (let* ((txt (nth 0 tabkey2-fallback))
+ (fun (nth 1 tabkey2-fallback))
+ (chk (nth 2 tabkey2-fallback))
+ (bnd (with-current-buffer orig-buf
+ (tabkey2-is-active fun chk)))
+ (act (tabkey2-get-active-string bnd fun orig-buf)))
+ (insert (format " Fallback is %s (`%s'): %s"
+ txt fun act))
+ (when (and (not act-found) bnd)
+ (insert active-mark)
+ (setq act-found t))))
+ (insert "\n\nYou an ")
+ (insert-text-button "customize this list"
+ 'action (lambda (button)
+ (customize-option
+ 'tabkey2-completion-functions)))
+ (insert ".\nSee function `tabkey2-mode' for more information.")
+ (with-no-warnings (print-help-return-message))))))
+
+(defvar tabkey2-completing-read 'completing-read)
+
+(defun tabkey2-set-fun (fun)
+ "Use function FUN for Tab in 'Tab completion state'."
+ (setq tabkey2-chosen-completion-function fun)
+ (unless fun
+ (setq fun (tabkey2-first-active-from-completion-functions)))
+ (tabkey2-make-message-and-set-fun fun)
+ (when (tabkey2-completion-state-p)
+ (message "%s" tabkey2-current-tab-info)))
+
+(defun tabkey2-appmenu ()
+ "Make a menu for minor mode command `appmenu-mode'."
+ (unless (tabkey2-read-only-p)
+ (let* ((cf-r (reverse (tabkey2-get-active-completion-functions)))
+ (tit "Complete")
+ (map (make-sparse-keymap tit)))
+ (define-key map [tabkey2-usage]
+ (list 'menu-item "Show Available Completion Functions for TabKey2"
+ 'tabkey2-show-completion-functions))
+ (define-key map [tabkey2-divider-1] (list 'menu-item "--"))
+ (let ((set-map (make-sparse-keymap "Set Completion")))
+ (define-key map [tabkey2-choose]
+ (list 'menu-item "Set Primary TabKey2 Tab Completion in Buffer" set-map))
+ (dolist (cf-rec cf-r)
+ (let ((dsc (nth 0 cf-rec))
+ (fun (nth 1 cf-rec)))
+ (define-key set-map
+ (vector (intern (format "tabkey2-set-%s" fun)))
+ (list 'menu-item dsc
+ `(lambda ()
+ (interactive)
+ (tabkey2-set-fun ',fun))
+ :button
+ `(:radio
+ . (eq ',fun tabkey2-chosen-completion-function))))))
+ (define-key set-map [tabkey2-set-div] (list 'menu-item "--"))
+ (define-key set-map [tabkey2-set-default]
+ (list 'menu-item "Default Tab completion"
+ (lambda ()
+ (interactive)
+ (tabkey2-set-fun nil))
+ :button
+ '(:radio . (null tabkey2-chosen-completion-function))))
+ (define-key set-map [tabkey2-set-header-div] (list 'menu-item "--"))
+ (define-key set-map [tabkey2-set-header]
+ (list 'menu-item "Set Primary Tab Completion for Buffer"))
+ )
+ (define-key map [tabkey2-divider] (list 'menu-item "--"))
+ (dolist (cf-rec cf-r)
+ (let ((dsc (nth 0 cf-rec))
+ (fun (nth 1 cf-rec)))
+ (define-key map
+ (vector (intern (format "tabkey2-call-%s" fun)))
+ (list 'menu-item dsc fun
+ :button
+ `(:toggle
+ . (eq ',fun tabkey2-chosen-completion-function))
+ ))))
+ map)))
+
+;; (defun tabkey2-completion-menu-popup ()
+;; "Pop up a menu with completion alternatives."
+;; (interactive)
+;; (let ((menu (tabkey2-appmenu)))
+;; (popup-menu-at-point menu)))
+
+;; (defun tabkey2-choose-completion-function ()
+;; "Set current completion function.
+;; Let user choose completion function from those in
+;; `tabkey2-completion-functions' that have some key binding at
+;; point.
+
+;; Let the chosen completion function be the default for subsequent
+;; completions in the current buffer."
+;; ;; Fix-me: adjust to mumamo.
+;; (interactive)
+;; (save-match-data
+;; (if (and (featurep 'popcmp)
+;; tabkey2-use-popup-menus)
+;; (tabkey2-completion-menu-popup)
+;; (when (eq 'completing-read tabkey2-completing-read) (isearch-unread 'tab))
+;; (let* ((cf-r (reverse (tabkey2-get-active-completion-functions)))
+;; (cf (cons '("- Use default Tab completion" nil) cf-r))
+;; (hist (mapcar (lambda (rec)
+;; (car rec))
+;; cf))
+;; (tit (funcall tabkey2-completing-read "Set current completion function: " cf
+;; nil ;; predicate
+;; t ;; require-match
+;; nil ;; initial-input
+;; 'hist ;; hist
+;; ))
+;; (fun-rec (assoc-string tit cf))
+;; (fun (cadr fun-rec)))
+;; (setq tabkey2-chosen-completion-function fun)
+;; (unless fun
+;; (setq fun (tabkey2-first-active-from-completion-functions)))
+;; (tabkey2-make-message-and-set-fun fun)
+;; (when (tabkey2-completion-state-p)
+;; (tabkey2-show-current-message))))))
+
+;; (defun tabkey2-add-to-appmenu ()
+;; "Add a menu to function `appmenu-mode'."
+;; (appmenu-add 'tabkey2 nil t "Completion" 'tabkey2-appmenu))
+
+
+(provide 'tabkey2)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; tabkey2.el ends here
--- /dev/null
+;;; tyda.el --- Lookup words in swe/eng dictionary at tyda.se
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-08-26T02:51:27+0200 Tue
+;; Version: 0.2
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Lookup swedish or english words in the dictionary at
+;;
+;; http://www.tyda.se/
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'appmenu))
+
+(defun tyda-lookup-word (word)
+ "Look up word WORD at URL `http://tyda.se/'.
+This site translates between English and Swedish. The site will
+be opened in your webbrowser with WORD looked up."
+ (interactive (list (or (thing-at-point 'word)
+ (read-string "Lookup word: "))))
+ ;; http://tyda.se/search?form=1&w=weird&w_lang=&x=0&y=0
+ (browse-url
+ ;;(concat "http://www.tyda.se/?rid=651940&w=" word)
+ (format "http://tyda.se/search?form=1&w=%s&w_lang=&x=0&y=0" word)
+ ))
+
+(defvar tyda-appmenu-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [tyda-lookup]
+ (list 'menu-item "Lookup word at point in Tyda"
+ 'tyda-lookup-word))
+ map))
+
+(defvar tyda-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(alt mouse-1)] 'tyda-lookup-word)
+ (define-key map [(control ?c) ?=] 'tyda-lookup-word)
+ map))
+
+;;;###autoload
+(define-minor-mode tyda-mode
+ "Minor mode for key bindings for `tyda-lookup-word'.
+It binds Alt-Mouse-1 just as the Tyda add-on does in Firefox.
+Here are all key bindings
+
+\\{tyda-mode-map}
+"
+ :global t
+ (if tyda-mode
+ (progn
+ (require 'appmenu nil t)
+ (when (featurep 'appmenu)
+ (appmenu-add 'tyda nil tyda-mode "Lookup word" tyda-appmenu-map)))))
+
+
+(provide 'tyda)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; tyda.el ends here
--- /dev/null
+;;; udev-ecb.el --- Get ECB sources and set it up
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-08-25T04:02:37+0200 Mon
+(defconst udev-ecb:version "0.2");; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+
+(eval-when-compile (require 'udev nil t))
+
+(defgroup udev-ecb nil
+ "Customization group for udev-ecb."
+ :group 'nxhtml)
+
+(defcustom udev-ecb-dir "~/.emacs.d/udev/ecb-cvs/"
+ "Directory where to put CVS ECB sources."
+ :type 'directory
+ :group 'udev-ecb)
+
+(defun udev-ecb-cvs-dir ()
+ "Return cvs root directory."
+ (file-name-as-directory (expand-file-name "ecb" udev-ecb-dir)))
+
+(defvar udev-ecb-miss-cedet nil)
+
+(defun udev-ecb-load-ecb ()
+ "Load fetched ECB."
+ (setq udev-ecb-miss-cedet nil)
+ (unless (featurep 'ecb)
+ (add-to-list 'load-path (udev-ecb-cvs-dir))
+ (let ((msg nil))
+ (unless (or msg (featurep 'cedet)) (setq msg "CEDET is not loaded"))
+ (unless (or msg (locate-library "semantic")) (setq msg "can't find CEDET Semantic"))
+ (unless (or msg (locate-library "eieio")) (setq msg "can't find CEDET eieio"))
+ (if msg
+ (progn
+ (setq udev-ecb-miss-cedet (format "Can't load ECB because %s." msg))
+ (ourcomments-warning udev-ecb-miss-cedet))
+ (require 'ecb nil t)))))
+
+(defcustom udev-ecb-load-ecb nil
+ "To load or not to load ECB..."
+ :type 'boolean
+ :require 'udev-ecb
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when val
+ (udev-ecb-load-ecb)))
+ ;; ecb-activate, ecb-customize-most-important to menu
+ :set-after '(udev-cedet-load-cedet)
+ :group 'udev-ecb)
+
+(defvar udev-ecb-steps
+ '(udev-ecb-fetch
+ udev-ecb-fix-bad-files
+ udev-ecb-fetch-diff
+ udev-ecb-check-diff
+ udev-ecb-install
+ ))
+
+(defun udev-ecb-buffer-name (mode)
+ "Return a name for current compilation buffer ignoring MODE."
+ (udev-buffer-name "*Updating ECB %s*" udev-ecb-update-buffer mode))
+
+(defvar udev-ecb-update-buffer nil)
+
+(defun udev-ecb-has-cedet ()
+ (cond
+ ((not (and (locate-library "semantic")
+ (locate-library "eieio")))
+ (message (propertize "CEDET must be installed and loaded first"
+ 'face 'secondary-selection))
+ nil)
+ ((not (featurep 'cedet))
+ (message (propertize "CEDET must be loaded first"
+ 'face 'secondary-selection))
+ nil)
+ (t t)))
+
+(defun udev-ecb-setup-when-finished (log-buffer)
+ (require 'cus-edit)
+ (let ((inhibit-read-only t))
+ (with-current-buffer log-buffer
+ (widen)
+ (goto-char (point-max))
+ (insert "\n\nYou must restart Emacs to load ECB properly.\n")
+ (let ((load-ecb-saved-value (get 'udev-ecb-load-ecb 'saved-value))
+ (here (point))
+ )
+ (if load-ecb-saved-value
+ (insert "You have setup to load ECB the next time you start Emacs.\n\n")
+ (insert (propertize "Warning:" 'face 'compilation-warning)
+ " You have not setup to load ECB the next time you start Emacs.\n\n"))
+ (insert-button " Setup "
+ 'face 'custom-button
+ 'action (lambda (btn)
+ (interactive)
+ (customize-group-other-window 'udev-ecb)))
+ (insert " Setup to load ECB from fetched sources when starting Emacs.")))))
+
+;;;###autoload
+(defun udev-ecb-update ()
+ "Fetch and install ECB from the devel sources.
+To determine where to store the sources see `udev-ecb-dir'.
+For how to start ECB see `udev-ecb-load-ecb'."
+ (interactive)
+ (when (udev-ecb-has-cedet)
+ (let* ((has-it (file-exists-p (udev-ecb-cvs-dir)))
+ (prompt (if has-it
+ "Do you want to update ECB from devel sources? "
+ "Do you want to install ECB from devel sources? ")))
+ (when (y-or-n-p prompt)
+ (setq udev-ecb-update-buffer (get-buffer-create "*Update ECB*"))
+ (udev-call-first-step udev-ecb-update-buffer udev-ecb-steps
+ "Starting updating ECB from development sources"
+ 'udev-ecb-setup-when-finished)))))
+
+;;;###autoload
+(defun udev-ecb-customize-startup ()
+ "Customize ECB dev nXhtml startup group."
+ (interactive)
+ (if (file-exists-p (udev-ecb-cvs-dir))
+ (customize-group-other-window 'udev-ecb)
+ (message (propertize "You must fetch ECB from nXhtml first"
+ 'face 'secondary-selection))))
+
+(defun udev-ecb-fetch (log-buffer)
+ "Fetch ECB sources (asynchronously)."
+ (let ((default-directory (file-name-as-directory udev-ecb-dir)))
+ (unless (file-directory-p default-directory)
+ (make-directory default-directory))
+ (with-current-buffer
+ (compilation-start
+ "cvs -z3 -d:pserver:anonymous@ecb.cvs.sourceforge.net:/cvsroot/ecb co -P ecb"
+ 'compilation-mode
+ 'udev-ecb-buffer-name)
+ (current-buffer))))
+
+;;(udev-ecb-fix-bad-files nil)
+(defun udev-ecb-fix-bad-files (log-buffer)
+ "Change files that can not be compiled."
+ (let* ((bad-file (expand-file-name "ecb/ecb-advice-test.el" udev-ecb-dir))
+ (bad-file-buffer (find-buffer-visiting bad-file))
+ (this-log-buf (get-buffer-create "*Fix bad ECB files*"))
+ (fixed-it nil))
+ (when (file-exists-p bad-file)
+ (with-current-buffer (find-file-noselect bad-file)
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (save-match-data
+ (while (re-search-forward "\r" nil t)
+ (setq fixed-it t)
+ (replace-match ""))))
+ (basic-save-buffer)
+ (with-current-buffer this-log-buf
+ (erase-buffer)
+ (if fixed-it
+ (insert "Fixed " bad-file "\n")
+ (insert "The file " bad-file " was already ok\n")))
+ (unless bad-file-buffer (kill-buffer (current-buffer)))))
+ this-log-buf))
+
+(defun udev-ecb-fetch-diff (log-buffer)
+ "Fetch diff between local ECB sources and repository."
+ (udev-fetch-cvs-diff (udev-ecb-cvs-dir) 'udev-ecb-buffer-name))
+
+(defun udev-ecb-check-diff (log-buffer)
+ "Check cvs diff output for merge conflicts."
+ (udev-check-cvs-diff (expand-file-name "your-patches.diff"
+ (udev-ecb-cvs-dir))
+ udev-ecb-update-buffer))
+
+(defun udev-ecb-install (log-buffer)
+ "Install the ECB sources just fetched.
+Note that they will not be installed in current Emacs session."
+ (udev-batch-compile "-l ecb-batch-compile.el"
+ udev-this-dir
+ 'udev-ecb-buffer-name))
+
+;;(udev-ecb-install-help (get-buffer-create "*temp online-help*"))
+(defun udev-ecb-install-help (log-buffer)
+ (let ((trc-buf (get-buffer-create "*temp online-help*")))
+ (with-current-buffer trc-buf
+ (setq default-directory (udev-ecb-cvs-dir))
+ (w32shell-with-shell "msys" (shell-command "make online-help&" trc-buf)))))
+
+(provide 'udev-ecb)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; udev-ecb.el ends here
--- /dev/null
+;;; udev-rinari.el --- Get rinary sources and set it up
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-08-24T22:32:21+0200 Sun
+(defconst udev-rinari:version "0.2");; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'udev nil t))
+
+(defgroup udev-rinari nil
+ "Customization group for udev-rinari."
+ :group 'nxhtml)
+
+(defcustom udev-rinari-dir "~/rinari-svn/"
+ "Directory where to put SVN Rinari sources."
+ :type 'directory
+ :group 'udev-rinari)
+
+(defcustom udev-rinari-load-rinari nil
+ "To load or not to load Rinari..."
+ :type '(choice (const :tag "Don't load Rinari" nil)
+ (const :tag "Load Rinari" t))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when val
+ (let* ((base-dir (expand-file-name "svn/trunk/" udev-rinari-dir))
+ (rhtml-dir (expand-file-name "rhtml/" base-dir))
+ (test-dir (expand-file-name "test/lisp/" base-dir)))
+ (unless (file-directory-p base-dir) (message "Can't find %s" base-dir))
+ (unless (file-directory-p rhtml-dir) (message "Can't find %s" rhtml-dir))
+ (unless (file-directory-p test-dir) (message "Can't find %s" test-dir))
+ (add-to-list 'load-path base-dir)
+ (add-to-list 'load-path rhtml-dir)
+ (add-to-list 'load-path test-dir))
+ (require 'rinari)
+ (require 'ruby-mode)))
+ :group 'udev-rinari)
+
+(defvar udev-rinari-steps
+ '(udev-rinari-fetch
+ udev-rinari-fetch-diff
+ udev-rinari-check-diff
+ ;;udev-rinari-install
+ ))
+
+(defvar udev-rinari-update-buffer nil)
+
+(defun udev-rinari-buffer-name (mode)
+ "Return a name for current compilation buffer ignoring MODE."
+ (udev-buffer-name "*Updating Rinari %s*" udev-rinari-update-buffer mode))
+
+(defun udev-rinari-check-conflicts ()
+ "Check if Rinari and ruby-mode already loaded and from where.
+Give an error if they are loaded from somewhere else than
+`udev-rinari-dir' tree."
+ (when (featurep 'rinari)
+ (let ((old-dir (file-name-directory (car (load-history-filename-element (load-history-regexp "rinari")))))
+ (new-dir (expand-file-name "svn/trunk/" udev-rinari-dir)))
+ (unless (string= (file-truename old-dir)
+ (file-truename new-dir))
+ (error "Rinari is already loaded from: %s" old-dir))))
+ (when (featurep 'ruby-mode)
+ (let ((old-dir (file-name-directory (car (load-history-filename-element (load-history-regexp "ruby-mode")))))
+ (new-dir (expand-file-name "svn/trunk/test/lisp/" udev-rinari-dir)))
+ (unless (string= (file-truename old-dir)
+ (file-truename new-dir))
+ (error "Ruby-mode is already loaded from: %s" old-dir))))
+ )
+
+(defun udev-rinari-setup-when-finished (log-buffer)
+ (let ((inhibit-read-only t))
+ (with-current-buffer log-buffer
+ (widen)
+ (goto-char (point-max))
+ (insert "\n\nYou must restart Emacs to load Rinari properly.\n")
+ (let ((load-rinari-saved-value (get 'udev-rinari-load-rinari 'saved-value))
+ (here (point))
+ )
+ (if load-rinari-saved-value
+ (insert "You have setup to load Rinari the next time you start Emacs.\n\n")
+ (insert (propertize "Warning:" 'face 'compilation-warning)
+ " You have not setup to load Rinari the next time you start Emacs.\n\n"))
+ (insert-button " Setup "
+ 'face 'custom-button
+ 'action (lambda (btn)
+ (interactive)
+ (customize-group-other-window 'udev-rinari)))
+ (insert " Setup to load Rinari from fetched sources when starting Emacs.")))))
+
+;;;###autoload
+(defun udev-rinari-update ()
+ "Fetch and install Rinari from the devel sources.
+To determine where to store the sources and how to start rinari
+see `udev-rinari-dir' and `udev-rinari-load-rinari'."
+ (interactive)
+ (udev-rinari-check-conflicts)
+ (setq udev-rinari-update-buffer (get-buffer-create "*Update Rinari*"))
+ (udev-call-first-step udev-rinari-update-buffer udev-rinari-steps
+ "Starting updating Rinari from development sources"
+ 'udev-rinari-setup-when-finished))
+
+(defvar udev-rinari-fetch-buffer nil)
+
+(defun udev-rinari-fetch (log-buffer)
+ "Fetch Rinari from development sources."
+ (let* ((default-directory (file-name-as-directory udev-rinari-dir)) ;; fix-me: for emacs bug
+ )
+ (unless (file-directory-p default-directory)
+ (make-directory default-directory))
+ (with-current-buffer
+ (compilation-start
+ "svn checkout http://rinari.rubyforge.org/svn/"
+ 'compilation-mode
+ 'udev-rinari-buffer-name)
+ (setq udev-rinari-fetch-buffer (current-buffer)))))
+
+(defvar udev-rinari-diff-file nil)
+(defvar udev-rinari-fetch-diff-buffer nil)
+
+(defun udev-rinari-fetch-diff (log-buffer)
+ "Fetch diff between local Rinari sources and dev repository."
+ (let ((must-fetch-diff t))
+ (setq udev-rinari-fetch-diff-buffer
+ (when must-fetch-diff
+ (let* ((default-directory (file-name-as-directory
+ (expand-file-name "svn"
+ udev-rinari-dir))))
+ (setq udev-rinari-diff-file (expand-file-name "../patches.diff"))
+ (with-current-buffer
+ (compilation-start
+ (concat "svn diff > " (shell-quote-argument udev-rinari-diff-file))
+ 'compilation-mode
+ 'udev-rinari-buffer-name)
+ (setq udev-continue-on-error-function 'udev-cvs-diff-continue)
+ (current-buffer)))))))
+
+(defun udev-rinari-check-diff (log-buffer)
+ "Check output from svn diff command for merge conflicts."
+ ;; Fix-me: How can this be checked?
+ (when udev-rinari-fetch-diff-buffer
+ (let ((buf (find-buffer-visiting udev-rinari-diff-file)))
+ (if buf
+ (with-current-buffer buf (revert-buffer nil t))
+ (setq buf (find-file-noselect udev-rinari-diff-file)))
+ (with-current-buffer buf
+ (widen)
+ (goto-char (point-min))
+ (if (search-forward "<<<<<<<" nil t)
+ ;; Merge conflict
+ (udev-call-next-step udev-rinari-update-buffer 1 nil)
+ buf)))))
+
+;; (defun udev-rinari-install ()
+;; "Install Rinari and ruby-mode for use."
+;; (if udev-rinari-load-rinari
+;; (message "Rinari should be loaded now")
+;; (when (y-or-n-p
+;; "You need to set udev-rinari-load-rinari. Do that now? ")
+;; (customize-group-other-window 'udev-rinari)))
+;; nil)
+
+
+(provide 'udev-rinari)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; udev-rinari.el ends here
--- /dev/null
+;;; udev.el --- Helper functions for updating from dev sources
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-08-24
+(defconst udev:version "0.5");; Version:
+;; Last-Updated: 2009-01-06 Tue
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+ ;; `cus-edit', `cus-face', `cus-load', `cus-start', `wid-edit'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; When you want to fetch and install sources from a repository you
+;; may have to call several async processes and wait for the answer
+;; before calling the next function. These functions may help you with
+;; this.
+;;
+;; See `udev-call-first-step' for more information. Or look in the
+;; file udev-cedet.el for examples.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'cus-edit)
+
+;;; Control/log buffer
+
+(defvar udev-log-buffer nil
+ "Log buffer pointer for sentinel function.")
+(make-variable-buffer-local 'udev-log-buffer)
+
+(defvar udev-is-log-buffer nil
+ "This is t if this is an udev log/control buffer.")
+(make-variable-buffer-local 'udev-is-log-buffer)
+
+(defun udev-check-is-log-buffer (buffer)
+ "Check that BUFFER is an udev log/control buffer."
+ (with-current-buffer buffer
+ (unless udev-is-log-buffer
+ (error "Internal error, not a log buffer: %s" buffer))))
+
+(defvar udev-this-chain nil)
+(make-variable-buffer-local 'udev-this-chain)
+
+(defvar udev-last-error nil
+ "Error found during last step.")
+(make-variable-buffer-local 'udev-last-error)
+
+(defun udev-set-last-error (log-buffer msg)
+ (with-current-buffer log-buffer
+ (setq udev-last-error msg)))
+
+;;; Chain utils
+
+(defun udev-chain (log-buffer)
+ "Return value of `udev-this-chain' in buffer LOG-BUFFER."
+ (udev-check-is-log-buffer log-buffer)
+ (with-current-buffer log-buffer
+ udev-this-chain))
+
+(defun udev-this-step (log-buffer)
+ "Return current function to call from LOG-BUFFER."
+ (let ((this-chain (udev-chain log-buffer)))
+ (caar this-chain)))
+
+(defun udev-goto-next-step (log-buffer)
+ "Set next function as current in LOG-BUFFER."
+ (let* ((this-chain (udev-chain log-buffer))
+ (this-step (car this-chain)))
+ (setcar this-chain (cdr this-step))))
+
+(defun udev-num-steps (log-buffer)
+ "Return number of steps."
+ (length (nth 2 (udev-chain log-buffer))))
+
+(defun udev-step-num (log-buffer)
+ "Return current step number."
+ (let ((this-chain (udev-chain log-buffer)))
+ (when this-chain
+ (1+ (- (udev-num-steps log-buffer)
+ (length (car this-chain)))))))
+
+(defun udev-finish-function (log-buffer)
+ "Return setup function to be called when finished."
+ (nth 3 (udev-chain log-buffer)))
+
+
+(defvar udev-control-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map button-buffer-map)
+ map))
+
+(define-derived-mode udev-control-mode nil
+ "Udev-Src"
+ "Mode for udev control buffer."
+ (setq show-trailing-whitespace nil)
+ (setq buffer-read-only t)
+ (nxhtml-menu-mode 1))
+
+;;; Calling steps
+
+;;;###autoload
+(defun udev-call-first-step (log-buffer steps header finish-fun)
+ "Set up and call first step.
+Set up buffer LOG-BUFFER to be used for log messages and
+controling of the execution of the functions in list STEPS which
+are executed one after another.
+
+Write HEADER at the end of LOG-BUFFER.
+
+Call first step.
+
+If FINISH-FUN non-nil it should be a function. This is called
+after last step with LOG-BUFFER as parameter."
+ ;;(dolist (step steps) (unless (functionp step) (error "Not a known function: %s" step)))
+ (switch-to-buffer log-buffer)
+ (udev-control-mode)
+ (setq udev-is-log-buffer t)
+ (let ((this-chain
+ (cons nil
+ (cons log-buffer
+ (cons (copy-tree steps)
+ (cons finish-fun nil))))))
+ (setcar this-chain (caddr this-chain))
+ (setq udev-this-chain this-chain))
+ (assert (eq (car steps) (udev-this-step log-buffer)) t)
+ (assert (eq finish-fun (udev-finish-function log-buffer)) t)
+ (widen)
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (unless (= (point) (point-min)) (insert "\n\n"))
+ (insert header))
+ (udev-call-this-step log-buffer nil)
+ (current-buffer))
+
+(defvar udev-step-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c) ?r] 'udev-rerun-this-step)
+ (define-key map [(control ?c) ?c] 'udev-continue-from-this-step)
+ (define-key map [(control ?c) ?s] 'udev-goto-this-step-source)
+ map))
+
+(defun udev-step-at-point ()
+ (get-text-property (point) 'udev-step))
+
+(defun udev-rerun-this-step ()
+ "Rerun this step."
+ (interactive)
+ (let ((this-step (udev-step-at-point)))
+ (udev-call-this-step (current-buffer) this-step)))
+
+(defun udev-continue-from-this-step ()
+ "Continue from this step."
+ (interactive)
+ (let ((this-step (udev-step-at-point)))
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (format "\n\nContinuing from %s..." this-step)))
+ (udev-call-this-step (current-buffer) this-step)))
+
+(defun udev-goto-this-step-source ()
+ "Find source function for this step."
+ (interactive)
+ (let ((this-step (udev-step-at-point)))
+ (find-function-other-window this-step)))
+
+(defun udev-call-this-step (log-buffer this-step)
+ "Call the current function in LOG-BUFFER.
+If this function returns a buffer and the buffer has a process
+then change the process sentinel to `udev-compilation-sentinel'.
+Otherwise continue to call the next function.
+
+Also put a log message in in LOG-BUFFER with a link to the buffer
+returned above if any."
+ (setq this-step (or this-step (udev-this-step log-buffer)))
+ (with-current-buffer log-buffer
+ (setq udev-last-error nil)
+ (widen)
+ (goto-char (point-max))
+ (let* ((inhibit-read-only t)
+ here
+ buf
+ proc)
+ (if (not this-step)
+ (let ((finish-fun (udev-finish-function log-buffer)))
+ (insert (propertize "\nFinished\n" 'face 'compilation-info))
+ (when finish-fun
+ (funcall finish-fun log-buffer)))
+ (insert (format "\nStep %s(%s): "
+ (udev-step-num log-buffer)
+ (udev-num-steps log-buffer)))
+ (setq here (point))
+ (insert (pp-to-string this-step))
+ (setq buf (funcall this-step log-buffer))
+ (when (bufferp buf)
+ (make-text-button here (point)
+ 'udev-step this-step
+ 'keymap udev-step-keymap
+ 'buffer buf
+ 'help-echo "Push RET to see log buffer, <APPS> for other actions"
+ 'action (lambda (btn)
+ (display-buffer
+ (button-get btn 'buffer))))
+ (setq proc (get-buffer-process buf)))
+ ;; Setup for next step
+ (if (and proc
+ (not udev-last-error))
+ (progn
+ (with-current-buffer buf
+ ;; Make a copy here for the sentinel function.
+ (setq udev-log-buffer log-buffer)
+ (setq udev-orig-sentinel (process-sentinel proc))
+ (set-process-sentinel proc 'udev-compilation-sentinel)))
+ ;;(message "proc is nil")
+ (if udev-last-error
+ (insert " "
+ (propertize udev-last-error 'face 'compilation-error))
+ (udev-call-next-step log-buffer 0 nil)))))))
+
+(defun udev-call-next-step (log-buffer prev-exit-status exit-status-buffer)
+ "Go to next step in LOG-BUFFER and call `udev-call-this-step'.
+However if PREV-EXIT-STATUS \(which is the exit status from the
+previous step) is not 0 and there is in EXIT-STATUS-BUFFER no
+`udev-continue-on-error-function' then stop and insert an error
+message in LOG-BUFFER."
+ (with-current-buffer log-buffer
+ (let ((inhibit-read-only t))
+ (widen)
+ (goto-char (point-max))
+ (insert " ")
+ (if (or (= 0 prev-exit-status)
+ (with-current-buffer exit-status-buffer
+ (when udev-continue-on-error-function
+ (funcall udev-continue-on-error-function exit-status-buffer))))
+ (progn
+ (insert
+ (if (= 0 prev-exit-status)
+ (propertize "Ok" 'face 'compilation-info)
+ (propertize "Warning, check next step" 'face 'compilation-warning)))
+ (udev-goto-next-step log-buffer)
+ (udev-call-this-step log-buffer nil))
+ (insert (propertize "Error" 'face 'compilation-error))))))
+
+
+;;; Sentinel
+
+(defvar udev-orig-sentinel nil
+ "Old sentinel function remembered by `udev-call-this-step'.")
+(make-variable-buffer-local 'udev-orig-sentinel)
+
+(defun udev-compilation-sentinel (proc msg)
+ "Sentinel to use for processes started by `udev-call-this-step'.
+Check for error messages and call next step. PROC and MSG have
+the same meaning as for `compilation-sentinel'."
+ ;;(message "udev-compilation-sentinel proc=%s msg=%s" proc msg)
+ (let ((buf (process-buffer proc))
+ (exit-status (process-exit-status proc)))
+ (with-current-buffer buf
+ (when udev-orig-sentinel
+ (funcall udev-orig-sentinel proc msg))
+ (when (and (eq 'exit (process-status proc))
+ (= 0 exit-status))
+ ;; Check for errors
+ (let ((here (point))
+ (err-point 1)
+ (has-error nil))
+ (widen)
+ (goto-char (point-min))
+ (setq has-error
+ (catch 'found-error
+ (while err-point
+ (setq err-point
+ (next-single-property-change err-point 'face))
+ (when err-point
+ (let ((face (get-text-property err-point 'face)))
+ (when (or (and (listp face)
+ (memq 'compilation-error face))
+ (eq 'compilation-error face))
+ (throw 'found-error t)))))))
+ (when has-error
+ (setq exit-status 1)
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (propertize "There were errors" 'font-lock-face 'compilation-error)))
+ (udev-set-compilation-end-message buf 'exit (cons "has errors" 1)))
+ (goto-char here)
+ ))
+ (unless (member proc compilation-in-progress)
+ (udev-call-next-step udev-log-buffer exit-status (current-buffer))))))
+
+(defun udev-set-compilation-end-message (buffer process-status status)
+ "Change the message shown after compilation.
+This is similar to `compilation-end-message' and BUFFER,
+PROCESS-STATUS and STATUS have the same meaning as there."
+ (with-current-buffer buffer
+ (setq mode-line-process
+ (let ((out-string (format ":%s [%s]" process-status (cdr status)))
+ (msg (format "%s %s" mode-name
+ (replace-regexp-in-string "\n?$" "" (car status)))))
+ (message "%s" msg)
+ (propertize out-string
+ 'help-echo msg 'face (if (> (cdr status) 0)
+ 'compilation-error
+ 'compilation-info))))))
+
+(defvar udev-continue-on-error-function nil
+ "One-time helper to resolve exit status error problem.
+This can be used for example after calling `cvs diff' which
+returns error exit status if there is a difference - even though
+there does not have to be an error.")
+(make-variable-buffer-local 'udev-continue-on-error-function)
+
+
+;;; Convenience functions
+
+(defun udev-buffer-name (fmt log-buffer mode)
+ "Return a name for compilation buffer.
+Use format string FMT and buffer LOG-BUFFER, but ignoring MODE."
+ (format fmt (when (buffer-live-p log-buffer)
+ (udev-this-step log-buffer))))
+
+(defvar udev-this-dir
+ (let ((this-file (or load-file-name (buffer-file-name))))
+ (file-name-directory this-file)))
+
+(defun udev-batch-compile (emacs-args defdir name-function)
+ "Compile elisp code in an inferior Emacs.
+Start Emacs with
+
+ emacs -Q -batch EMACS-ARGS
+
+in the default directory DEFDIR.
+
+Set the buffer name for the inferior process with NAME-FUNCTION
+by giving this to `compilation-start'."
+ (let ((default-directory (file-name-as-directory defdir))
+ (this-emacs (ourcomments-find-emacs)))
+ (compilation-start
+ (concat this-emacs " -Q -batch " emacs-args)
+ 'compilation-mode
+ name-function)))
+
+;;; Convenience functions for CVS
+
+(defun udev-fetch-cvs-diff (defdir name-function)
+ "Fetch cvs diff in directory DEFDIR.
+Put the diff in file 'your-patches.diff' in DEFDIR.
+Give inferior buffer name with NAME-FUNCTION."
+ (let ((default-directory (file-name-as-directory defdir)))
+ (with-current-buffer
+ (compilation-start
+ (concat "cvs diff -b -u > " (shell-quote-argument "your-patches.diff"))
+ 'compilation-mode
+ name-function)
+ (setq udev-continue-on-error-function 'udev-cvs-diff-continue)
+ (current-buffer))))
+
+(defun udev-cvs-diff-continue (cvs-diff-buffer)
+ "Return non-nil if it is ok to continue.
+Check the output from the `cvs diff' command in buffer
+CVS-DIFF-BUFFER.
+
+The cvs command exits with a failure status if there is a
+difference, which means that it is hard to know whether there was
+an error or just a difference. This function tries to find out."
+ (with-current-buffer cvs-diff-buffer
+ (let ((here (point))
+ (ret t))
+ (goto-char (point-min))
+ (when (search-forward "cvs [diff aborted]" nil t) (setq ret nil))
+ (goto-char (point-min))
+ (when (search-forward "merge conflict" nil t) (setq ret t))
+ ;; From cvs co command:
+ ;; rcsmerge: warning: conflicts during merge
+ (goto-char (point-min))
+ (when (search-forward "conflicts during merge" nil t) (setq ret t))
+ ;; cvs checkout: conflicts found in emacs/lisp/startup.el
+ (goto-char (point-min))
+ (when (search-forward "conflicts found in" nil t) (setq ret t))
+ (goto-char here)
+ ret)))
+
+(defun udev-check-cvs-diff (diff-file log-buffer)
+ "Check cvs diff output in file DIFF-FILE for merge conflicts.
+Return buffer containing DIFF-FILE."
+ (let ((buf (find-buffer-visiting diff-file)))
+ ;; Kill buffer to avoid question about revert.
+ (when buf (kill-buffer buf))
+ (setq buf (find-file-noselect diff-file))
+ (with-current-buffer buf
+ (widen)
+ (let ((here (point)))
+ (goto-char (point-min))
+ ;; Fix-me: Better pattern:
+ (if (search-forward "<<<<<<<" nil t)
+ ;; Merge conflict
+ (with-current-buffer log-buffer
+ (let ((inhibit-read-only t))
+ (setq udev-last-error "Error: merge conflict")))
+ (goto-char here))))
+ buf))
+
+;;(setq compilation-scroll-output t)
+;;(add-to-list 'compilation-error-regexp-alist 'cvs)
+;;(setq compilation-error-regexp-alist (delq 'cvs compilation-error-regexp-alist))
+
+;;; Misc
+
+(defun udev-send-buffer-process (str)
+ (interactive "sString to send to process: ")
+ (let* ((procs (process-list))
+ (proc (catch 'found
+ (dolist (p procs)
+ (when (eq (process-buffer p) (current-buffer))
+ (throw 'found p))))))
+ (unless proc (error "Can't find process in buffer"))
+ ;;(message "str=%s" str)
+ ;;(message "proc=%s" proc)
+ (process-send-string proc (concat str "\n"))
+ ))
+
+
+(provide 'udev)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; udev.el ends here
--- /dev/null
+;;; useful-commands.el --- Menu with useful Emacs commands
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2008-09-29T12:56:24+0200 Mon
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defvar useful-commands-definitions nil
+ "Defines the menus using a org like syntax.
+* Search and Replace
+** Occur in multiple buffers `multi-occur'
+** Grep in Directory `lgrep'
+** Occur `occur'
+** Grep in Directory Tree `rgrep'
+* END
+"
+)
+
+(defun useful-commands-build-menu ()
+ )
+
+(provide 'useful-commands)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; useful-commands.el ends here
--- /dev/null
+;;; viper-tut.el --- Viper tutorial
+;;
+;; Author: Lennart Borgman
+;; Created: Fri Sep 08 2006
+(defconst viper-tut:version "0.2") ;;Version: 0.2
+;; Last-Updated:
+;; Keywords:
+;; Compatibility: Emacs 22
+;;
+;; Features that might be required by this library:
+;;
+;; `button', `cus-edit', `cus-face', `cus-load', `cus-start',
+;; `help-mode', `tutorial', `view', `wid-edit'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'mumamo))
+(eval-when-compile (require 'ourcomments-util))
+(require 'tutorial)
+(require 'cus-edit)
+
+(defface viper-tut-header-top
+ '((t (:foreground "black" :background "goldenrod3")))
+ "Face for headers."
+ :group 'web-vcs)
+
+(defface viper-tut-header
+ '((t (:foreground "black" :background "goldenrod2" :height 1.8)))
+ "Face for headers."
+ :group 'web-vcs)
+
+(defvar tutorial--tab-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [tab] 'forward-button)
+ (define-key map [(shift tab)] 'backward-button)
+ (define-key map [(meta tab)] 'backward-button)
+ map)
+ "Keymap that allows tabbing between buttons.")
+
+(defconst viper-tut--emacs-part 6)
+
+(defconst viper-tut--default-keys
+ `(
+;;;;;;;;;;;;;; Part 1
+ ;; ^D Move DOWN one half-screen
+ ;;(viper-scroll-up [(control ?d)])
+ (viper-scroll-up [?\C-d])
+
+ ;; ^U Move UP one half-screen
+ ;;(viper-scroll-down [(control ?u)])
+ (viper-scroll-down [?\C-u])
+
+ ;; h Move left one character
+ (viper-backward-char [?h])
+
+ ;; j Move down one line
+ (viper-next-line [?j])
+
+ ;; k Move up one line
+ (viper-previous-line [?k])
+
+ ;; l Move right one character
+ (viper-forward-char [?l])
+
+ ;; dd DELETE one line
+ (viper-command-argument [?d])
+
+ ;; x X-OUT one character
+ (viper-delete-char [?x])
+
+ ;; u UNDO last change
+ (viper-undo [?u])
+
+ ;; :q!<RETURN> QUIT without saving changes
+ (viper-ex [?:])
+
+ ;; ZZ Exit and save any changes
+ (viper-save-kill-buffer [?Z ?Z])
+
+ ;; o OPEN a line for inserting text
+ (viper-open-line [?o])
+
+ ;; i INSERT starting at the cursor
+ (viper-insert [?i])
+
+ ;; ESC ESCAPE from insert mode
+ ;;(viper-intercept-ESC-key [(escape)])
+ ;(viper-intercept-ESC-key [27])
+ (viper-intercept-ESC-key [escape])
+ ;; chagned-keys=
+ ;; (([27]
+ ;; viper-intercept-ESC-key
+ ;; viper-intercept-ESC-key
+ ;; <escape>
+ ;; (more info current-binding (keymap (118 . cua-repeat-replace-region)) viper-intercept-ESC-key [27] <escape>)))
+
+
+;;;;;;;;;;;;;; Part 2
+ ;; w Move to the beginning of the next WORD
+ (viper-forward-word [?w])
+ ;; e Move to the END of the next word
+ (viper-end-of-word [?e])
+ ;; b Move BACK to the beginning to the previous word
+ (viper-backward-word [?b])
+
+ ;; $ Move to the end of the line
+ (viper-goto-eol [?$])
+
+ ;; ^ Move to the first non-white character on the line
+ (viper-bol-and-skip-white [?^])
+
+ ;; 0 Move to the first column on the line (column zero)
+ (viper-beginning-of-line [?0])
+ ;; #| Move to an exact column on the line (column #) e.g. 5| 12|
+ (viper-goto-col [?|])
+
+ ;; f char FIND the next occurrence of char on the line
+ (viper-find-char-forward [?f])
+ ;; t char Move 'TIL the next occurrence of char on the line
+ (viper-goto-char-forward [?t])
+
+ ;; F char FIND the previous occurrence of char on the line
+ (viper-find-char-backward [?F])
+ ;; T char Move 'TIL the previous occurrence of char on the line
+ (viper-goto-char-backward [?T])
+
+ ;; ; Repeat the last f, t, F, or T
+ (viper-repeat-find [?\;])
+ ;; , Reverse the last f, t, F, or T
+ (viper-repeat-find-opposite [?,])
+
+ ;; % Show matching () or {} or []
+ (viper-exec-mapped-kbd-macro [?%])
+
+ ;; H Move to the HIGHEST position in the window
+ (viper-window-top [?H])
+ ;; M Move to the MIDDLE position in the window
+ (viper-window-middle [?M])
+ ;; L Move to the LOWEST position in the window
+ (viper-window-bottom [?L])
+
+ ;; m char MARK this location and name it char
+ (viper-mark-point [?m])
+ ;; ' char (quote character) return to line named char
+ ;; '' (quote quote) return from last movement
+ (viper-goto-mark-and-skip-white [?'])
+
+ ;; G GO to the last line in the file
+ ;; #G GO to line #. (e.g., 3G , 5G , 175G )
+ (viper-goto-line [?G])
+
+ ;; { (left brace) Move to the beginning of a paragraph
+ ;; } (right brace) Move to the end of a paragraph
+ (viper-backward-paragraph [?{])
+ (viper-forward-paragraph [?}])
+
+ ;; ( (left paren) Move to the beginning of a sentence
+ ;; ) (right paren) Move to the beginning of the next sentence
+ (viper-backward-sentence [?\(])
+ (viper-forward-sentence [?\)])
+
+ ;; [[ Move to the beginning of a section
+ ;; ]] Move to the end of a section
+ (viper-brac-function [?\[])
+ (viper-ket-function [?\]])
+
+ ;; /string Find string looking forward
+ (viper-exec-mapped-kbd-macro [?/])
+ ;; ?string Find string looking backward
+ (viper-search-backward [??])
+
+ ;; n Repeat last / or ? command
+ ;; N Reverse last / or ? command
+ (viper-search-next [?n])
+ (viper-search-Next [?N])
+
+
+;;;;;;;;;;;;;; Part 3
+
+ ;; #movement repeat movement # times
+ (viper-digit-argument [?1])
+ (viper-digit-argument [?2])
+ (viper-digit-argument [?3])
+ (viper-digit-argument [?4])
+ (viper-digit-argument [?5])
+ (viper-digit-argument [?6])
+ (viper-digit-argument [?7])
+ (viper-digit-argument [?8])
+ (viper-digit-argument [?9])
+
+ ;; dmovement DELETE to where "movement" command specifies
+ ;; d#movement DELETE to where the #movement command specifies
+ ;; d runs the command viper-command-argument
+
+ ;; ymovement YANK to where "movement" command specifies
+ ;; y#movement YANK to where the #movement command specifies
+ (viper-command-argument [?y])
+
+ ;; P (upper p) PUT the contents of the buffer before the cursor
+ ;; p (lower p) PUT the contents of the buffer after the cursor
+ (viper-put-back [?p])
+ (viper-Put-back [?P])
+
+ ;; "#P (upper p) PUT contents of buffer # before the cursor
+ ;; "#p (lower p) PUT contents of buffer # after the cursor
+ ;;
+ ;; "aDELETE DELETE text into buffer a
+ ;; "aYANK YANK text into buffer a
+ ;; "aPUT PUT text from named buffer a
+ (viper-command-argument [?\"])
+
+ ;; :w<RETURN> WRITE contents of the file (without quitting)
+
+ ;; :e filename<RETURN> Begin EDITing the file called "filename"
+
+
+
+;;;;;;;;;;;;;; Part 4
+
+
+ ;; o OPEN a line below the cursor
+ ;; O OPEN a line above the cursor
+ (viper-open-line [?o])
+ (viper-Open-line [?O])
+
+ ;; i INSERT starting before the cursor
+ ;; I INSERT at the beginning of the line
+ (viper-insert [?i])
+ (viper-Insert [?I])
+
+ ;; a APPEND starting after the cursor
+ ;; A APPEND at the end of the line
+ (viper-append [?a])
+ (viper-Append [?A])
+
+ ;; ESC ESCAPE from insert mode
+ (viper-intercept-ESC-key [(escape)])
+
+ ;; J JOIN two lines
+ (viper-join-lines [?J])
+
+ ;; #s SUBSTITUTE for # characters
+ ;; #S SUBSTITUTE for # whole lines
+ (viper-substitute [?s])
+ (viper-substitute-line [?S])
+
+ ;; r REPLACE character (NO need to press ESC)
+ ;; R enter over-type mode
+ (viper-replace-char [?r])
+ (viper-overwrite [?R])
+
+ ;; cmovement CHANGE to where the movement commands specifies
+ (viper-command-argument [?c])
+
+
+;;;;;;;;;;;;;; Part 5
+
+ ;; ~ (tilde) Convert case of current character
+ (viper-toggle-case [?~])
+ ;; U (upper u) UNDO all changes made to the current line
+ ;; not implemented
+ ;;(viper-undo [?U])
+
+ ;; . (dot) repeat last change
+ (viper-repeat [?.])
+
+ ;; ^F Move FORWARD one full-screen
+ ;; ^B Move BACKWARD one full-screen
+ ;;(viper-scroll-screen [(control ?f)])
+ (viper-scroll-screen [?\C-f])
+ ;;(viper-scroll-screen-back [(control ?b)])
+ (viper-scroll-screen-back [?\C-b])
+
+ ;; ^E Move the window down one line without moving cursor
+ ;; ^Y Move the window up one line without moving cursor
+ ;;(viper-scroll-up-one [(control ?e)])
+ (viper-scroll-up-one [?\C-e])
+ ;;(viper-scroll-down-one [(control ?y)])
+ (viper-scroll-down-one [?\C-y])
+
+ ;; z<RETURN> Position the current line to top of window
+ ;; z. Position the current line to middle of window
+ ;; z- Position the current line to bottom of window
+ (viper-line-to-top "z\C-m")
+ (viper-line-to-middle [?z ?.])
+ (viper-line-to-bottom [?z ?-])
+
+ ;; ^G Show status of current file
+ ;;(viper-info-on-file [(control ?c)(control ?g)])
+ (viper-info-on-file [?\C-c ?\C-g])
+ ;; ^L Refresh screen
+ ;;(recenter [(control ?l)])
+ (recenter-top-bottom [?\C-l])
+
+ ;; !}fmt Format the paragraph, joining and filling lines to
+ ;; !}sort Sort lines of a paragraph alphabetically
+ (viper-command-argument [?!])
+
+ ;; >movement Shift right to where the movement command specifies
+ ;; <movement Shift left to where the movement command specifies
+ (viper-command-argument [?>])
+ (viper-command-argument [?<])
+
+ ))
+
+(defun viper-tut--detailed-help (button)
+ "Give detailed help about changed keys."
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'viper-tut--detailed-help button)
+ (interactive-p))
+ (with-current-buffer (help-buffer)
+ (let* ((tutorial-buffer (button-get button 'tutorial-buffer))
+ ;;(tutorial-arg (button-get button 'tutorial-arg))
+ (explain-key-desc (button-get button 'explain-key-desc))
+ (part (button-get button 'part))
+ (changed-keys (with-current-buffer tutorial-buffer
+ (let ((tutorial--lang "English"))
+ (tutorial--find-changed-keys
+ (if (= part viper-tut--emacs-part)
+ tutorial--default-keys
+ viper-tut--default-keys))))))
+ (when changed-keys
+ (insert
+ "The following key bindings used in the tutorial had been changed\n"
+ (if (= part viper-tut--emacs-part)
+ "from Emacs default in the "
+ "from Viper default in the ")
+ (buffer-name tutorial-buffer) " buffer:\n\n" )
+ (let ((frm " %-9s %-27s %-11s %s\n"))
+ (insert (format frm "Key" "Standard Binding" "Is Now On" "Remark")))
+ (dolist (tk changed-keys)
+ (let* ((def-fun (nth 1 tk))
+ (key (nth 0 tk))
+ (def-fun-txt (nth 2 tk))
+ (where (nth 3 tk))
+ (remark (nth 4 tk))
+ (rem-fun (command-remapping def-fun))
+ (key-txt (key-description key))
+ (key-fun (with-current-buffer tutorial-buffer (key-binding key)))
+ tot-len)
+ (unless (eq def-fun key-fun)
+ ;; Insert key binding description:
+ (when (string= key-txt explain-key-desc)
+ (put-text-property 0 (length key-txt) 'face '(:background "yellow") key-txt))
+ (insert " " key-txt " ")
+ (setq tot-len (length key-txt))
+ (when (> 9 tot-len)
+ (insert (make-string (- 9 tot-len) ? ))
+ (setq tot-len 9))
+ ;; Insert a link describing the old binding:
+ (insert-button def-fun-txt
+ 'help-echo (format "Describe function '%s" def-fun-txt)
+ 'action `(lambda(button) (interactive)
+ (describe-function ',def-fun))
+ 'follow-link t)
+ (setq tot-len (+ tot-len (length def-fun-txt)))
+ (when (> 36 tot-len)
+ (insert (make-string (- 36 tot-len) ? )))
+ (when (listp where)
+ (setq where "list"))
+ ;; Tell where the old binding is now:
+ (insert (format " %-11s " where))
+ ;; Insert a link with more information, for example
+ ;; current binding and keymap or information about
+ ;; cua-mode replacements:
+ (insert-button (car remark)
+ 'help-echo "Give more information about the changed key binding"
+ 'action `(lambda(b) (interactive)
+ (let ((value ,(cdr remark)))
+ ;; Fix-me:
+ (tutorial--describe-nonstandard-key value)))
+ 'follow-link t)
+ (insert "\n")))))
+
+
+
+ (insert "
+It is legitimate to change key bindings, but changed bindings do not
+correspond to what the tutorial says.
+\(See also " )
+ (insert-button "Key Binding Conventions"
+ 'action
+ (lambda(button) (interactive)
+ (info
+ "(elisp) Key Binding Conventions")
+ (message "Type C-x 0 to close the new window"))
+ 'follow-link t)
+ (insert ".)\n\n")
+ (with-no-warnings (print-help-return-message))))))
+
+
+(defvar viper-tut--part nil
+ "Viper tutorial part.")
+(make-variable-buffer-local 'viper-tut--part)
+
+(defun viper-tut--saved-file ()
+ "File name in which to save tutorials."
+ (let* ((file-name
+ (file-name-nondirectory (viper-tut--file viper-tut--part)))
+ (ext (file-name-extension file-name)))
+ (when (or (not ext)
+ (string= ext ""))
+ (setq file-name (concat file-name ".tut")))
+ (expand-file-name file-name (tutorial--saved-dir))))
+
+(defun viper-tut--save-tutorial ()
+ "Save the tutorial buffer.
+This saves the part of the tutorial before and after the area
+showing changed keys. It also saves point position and the
+position where the display of changed bindings was inserted.
+
+Do not save anything if not `viper-mode' is enabled in the
+tutorial buffer."
+ ;; This runs in a hook so protect it:
+ (condition-case err
+ (when (boundp 'viper-mode-string)
+ (tutorial--save-tutorial-to (viper-tut--saved-file)))
+ (error (warn "Error saving tutorial state: %s" (error-message-string err)))))
+
+
+(defvar viper-tut--parts
+ '(
+ (0 "0intro" "Introduction")
+ (1 "1basics" "Basic Editing")
+ (2 "2moving" "Moving Efficiently")
+ (3 "3cutpaste" "Cutting and Pasting")
+ (4 "4inserting" "Inserting Techniques")
+ (5 "5tricks" "Tricks and Timesavers")
+ (6 "(no file)" "Emacs tutorial for Viper Users")
+ ))
+
+(defcustom viper-tut-directory
+ (let* ((this-file (if load-file-name
+ load-file-name
+ (buffer-file-name)))
+ (this-dir (file-name-directory this-file)))
+ (file-name-as-directory
+ (expand-file-name "../etc/viper-tut" this-dir)))
+ "Directory where the Viper tutorial files lives."
+ :type 'directory
+ :group 'viper)
+
+(defun viper-tut--file(part)
+ "Get file name for part."
+ (let ((tut-file))
+ (mapc (lambda(rec)
+ (when (= part (nth 0 rec))
+ (setq tut-file
+ (if (= part viper-tut--emacs-part)
+ (let ((tf (expand-file-name (get-language-info "English" 'tutorial) tutorial-directory)))
+ (unless (file-exists-p tf)
+ (error "Can't find the English tutorial file for Emacs: %S" tf))
+ tf)
+ (expand-file-name (nth 1 rec) viper-tut-directory)))))
+ viper-tut--parts)
+ tut-file))
+
+(defun viper-tut-viper-is-on ()
+ ;;(message "viper-tut-viper-is-on, vms=%s, cb=%s" (boundp 'viper-mode-string) (current-buffer))
+ ;;(boundp 'viper-mode-string)
+ (boundp 'viper-current-state))
+
+(defun viper-tut--display-changes (changed-keys part)
+ "Display changes to some default Viper key bindings.
+If some of the default key bindings that the Viper tutorial
+depends on have been changed then display the changes in the
+tutorial buffer with some explanatory links.
+
+CHANGED-KEYS should be a list in the format returned by
+`tutorial--find-changed-keys'."
+ (when (or changed-keys
+ (viper-tut-viper-is-on))
+ ;; Need the custom button face for viper buttons:
+ ;;(when (and (boundp 'viper-mode) viper-mode) (require 'cus-edit))
+ (goto-char tutorial--point-before-chkeys)
+ (let* ((start (point))
+ end
+ (head
+ (if (viper-tut-viper-is-on)
+ (if (= part viper-tut--emacs-part)
+ "
+ NOTICE: This part of the Viper tutorial runs the Emacs tutorial.
+ Several keybindings are changed from Emacs default (either
+ because of Viper or some other customization) and doesn't
+ correspond to the tutorial.
+
+ We have inserted colored notices where the altered commands have
+ been introduced. If you change Viper state (vi state, insert
+ state, etc) these notices will be changed to reflect the new
+ state. ["
+ "
+ NOTICE: The main purpose of the Viper tutorial is to teach you
+ the most important vi commands (key bindings). However, your
+ Emacs has been customized by changing some of these basic Viper
+ editing commands, so it doesn't correspond to the tutorial. We
+ have inserted colored notices where the altered commands have
+ been introduced. [")
+ "
+ NOTICE: You have currently not turned on Viper. Nothing in this
+ tutorial \(the Viper Tutorial\) will work unless you do that. ["
+ ))
+ (head2 (if (viper-tut-viper-is-on)
+ (get-lang-string tutorial--lang 'tut-chgdhead2)
+ "More information")))
+ (when (and head head2)
+ (insert head)
+ (insert-button head2
+ 'tutorial-buffer
+ (current-buffer)
+ ;;'tutorial-arg arg
+ 'part part
+ 'action
+ (if (viper-tut-viper-is-on)
+ 'viper-tut--detailed-help
+ 'go-home-blaha)
+ 'follow-link t
+ 'echo "Click for more information"
+ 'face '(:inherit link :background "yellow"))
+ (insert "]\n\n" )
+ (when changed-keys
+ (dolist (tk changed-keys)
+ (let* ((def-fun (nth 1 tk))
+ (key (nth 0 tk))
+ (def-fun-txt (nth 2 tk))
+ (where (nth 3 tk))
+ (remark (nth 4 tk))
+ (rem-fun (command-remapping def-fun))
+ (key-txt (key-description key))
+ (key-fun (key-binding key))
+ tot-len)
+ (unless (eq def-fun key-fun)
+ ;; Mark the key in the tutorial text
+ (unless (string= "Same key" where)
+ (let* ((here (point))
+ (key-desc (key-description key))
+ (vi-char (= 1 (length key-desc)))
+ vi-char-pos
+ hit)
+ (when (string= "RET" key-desc)
+ (setq key-desc "Return"))
+ (when (string= "DEL" key-desc)
+ (setq key-desc "Delback"))
+ (while (if (not vi-char)
+ (unless hit ;; Only tell once
+ (setq hit t)
+ (re-search-forward
+ (concat "[^[:alpha:]]\\("
+ (regexp-quote key-desc)
+ "\\)[^[:alpha:]]") nil t))
+ (setq vi-char-pos
+ (next-single-property-change
+ (point) 'vi-char)))
+ (if (not vi-char)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'tutorial-remark nil) ;;'only-colored)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'face '(:background "yellow"))
+ (goto-char (1+ vi-char-pos))
+ (setq hit (string= key-desc (char-to-string (char-before))))
+ (when hit
+ (put-text-property vi-char-pos (1+ vi-char-pos)
+ 'face '(:background "yellow"))))
+ (when hit
+ (forward-line)
+ (let ((s (get-lang-string tutorial--lang 'tut-chgdkey))
+ (s2 (get-lang-string tutorial--lang 'tut-chgdkey2))
+ (start (point))
+ end)
+ ;; key-desc " has been rebound, but you can use " where " instead ["))
+ (when (and s s2)
+ (when (or (not where) (= 0 (length where)))
+ (setq where (concat "`M-x " def-fun-txt "'")))
+ (setq s (format s key-desc where s2))
+ (insert s " [")
+ (insert-button s2
+ 'tutorial-buffer
+ (current-buffer)
+ ;;'tutorial-arg arg
+ 'part part
+ 'action
+ 'viper-tut--detailed-help
+ 'explain-key-desc key-desc
+ 'follow-link t
+ 'face '(:inherit link :background "yellow"))
+ (insert "] **")
+ (insert "\n")
+ (setq end (point))
+ (put-text-property start end 'local-map tutorial--tab-map)
+ (put-text-property start end 'tutorial-remark t)
+ (put-text-property start end
+ 'face '(:background "yellow" :foreground "#c00"))
+ (put-text-property start end 'read-only t)))))
+ (goto-char here)))))))
+
+
+ (setq end (point))
+ ;; Make the area with information about change key
+ ;; bindings stand out:
+ (put-text-property start end
+ 'face
+ ;; The default warning face does not
+ ;;look good in this situation. Instead
+ ;;try something that could be
+ ;;recognized from warnings in normal
+ ;;life:
+ ;; 'font-lock-warning-face
+ (list :background "yellow" :foreground "#c00"))
+ ;; Make it possible to use Tab/S-Tab between fields in
+ ;; this area:
+ (put-text-property start end 'local-map tutorial--tab-map)
+ (put-text-property start end 'tutorial-remark t)
+ (setq tutorial--point-after-chkeys (point-marker))
+ ;; Make this area read-only:
+ (put-text-property start end 'read-only t)))))
+
+(defun viper-tut--at-change-state()
+ (condition-case err
+ (progn
+ (let ((inhibit-read-only t)
+ (here (point)))
+ ;; Delete the remarks:
+ ;;(tutorial--remove-remarks)
+ ;; Add them again
+ ;;(viper-tut--add-remarks)
+ (goto-char here)
+ )
+ )
+ (error (message "error in viper-tut--at-change-state: %s" (error-message-string err)))))
+
+
+;;;###autoload
+(defun viper-tutorial(part &optional dont-ask-for-revert)
+ "Run a tutorial for Viper.
+
+A simple classic tutorial in 5 parts that have been used by many
+people starting to learn vi keys. You may learn enough to start
+using `viper-mode' in Emacs.
+
+Some people find that vi keys helps against repetetive strain
+injury, see URL
+
+ `http://www.emacswiki.org/emacs/RepeatedStrainInjury'.
+
+Note: There might be a few clashes between vi key binding and
+Emacs standard key bindings. You will be notified about those in
+the tutorial. Even more, if your own key bindings comes in
+between you will be notified about that too."
+ (interactive (list
+ ;; (condition-case nil
+ ;; (widget-choose "The following viper tutorials are available"
+ ;; (mapcar (lambda(rec)
+ ;; (cons (nth 2 rec) (nth 0 rec)))
+ ;; viper-tut--parts))
+ ;; (error nil))
+ 0
+ ))
+ (if (not (boundp 'viper-current-state))
+ (let ((prompt
+ "
+ You can not run the Viper tutorial in this Emacs because you
+ have not enabled Viper.
+
+ Do you want to run the Viper tutorial in a new Emacs? "))
+ (if (y-or-n-p prompt)
+ (let ((ret (funcall 'emacs--no-desktop
+ "-eval"
+ (concat
+ "(progn"
+ " (setq viper-mode t)"
+ " (require 'viper)"
+ " (require 'viper-tut)"
+ " (call-interactively 'viper-tutorial))"))))
+ (message "Starting Viper tutorial in a new Emacs"))
+ (message "Viper tutorial aborted by user")))
+
+ (let* ((filename (viper-tut--file part))
+ ;; Choose a buffer name including the language so that
+ ;; several languages can be tested simultaneously:
+ (tut-buf-name "Viper TUTORIAL")
+ (old-tut-buf (get-buffer tut-buf-name))
+ (old-tut-part (when old-tut-buf
+ (with-current-buffer old-tut-buf
+ viper-tut--part)))
+ (old-tut-win (when old-tut-buf (get-buffer-window old-tut-buf t)))
+ (old-tut-is-ok (when old-tut-buf
+ (and
+ (= part old-tut-part)
+ (not (buffer-modified-p old-tut-buf)))))
+ old-tut-file
+ (old-tut-point 1))
+ (unless (file-exists-p filename) (error "Can't fine %s" filename))
+ (setq tutorial--point-after-chkeys (point-min))
+ ;; Try to display the tutorial buffer before asking to revert it.
+ ;; If the tutorial buffer is shown in some window make sure it is
+ ;; selected and displayed:
+ (if old-tut-win
+ (raise-frame
+ (window-frame
+ (select-window (get-buffer-window old-tut-buf t))))
+ ;; Else, is there an old tutorial buffer? Then display it:
+ (when old-tut-buf
+ (switch-to-buffer old-tut-buf)))
+ ;; Use whole frame for tutorial
+ ;;(delete-other-windows)
+ ;; If the tutorial buffer has been changed then ask if it should
+ ;; be reverted:
+ (when (and old-tut-buf
+ (not old-tut-is-ok)
+ (= part old-tut-part))
+ (setq old-tut-is-ok
+ (if dont-ask-for-revert
+ nil
+ (not (y-or-n-p
+ "You have changed the Tutorial buffer. Revert it? ")))))
+ ;; (Re)build the tutorial buffer if it is not ok
+ (unless old-tut-is-ok
+ (switch-to-buffer (get-buffer-create tut-buf-name))
+ (unless old-tut-buf (text-mode))
+ (setq viper-tut--part part)
+ (setq old-tut-file (file-exists-p (viper-tut--saved-file)))
+ (when (= part 0) (setq old-tut-file nil)) ;; You do not edit in the intro
+ (setq buffer-read-only nil)
+ (let ((inhibit-read-only t)) ;; For the text property
+ (erase-buffer))
+ (message "Preparing Viper tutorial ...") (sit-for 0)
+
+ ;; Do not associate the tutorial buffer with a file. Instead use
+ ;; a hook to save it when the buffer is killed.
+ (setq buffer-auto-save-file-name nil)
+ (add-hook 'kill-buffer-hook 'viper-tut--save-tutorial nil t)
+
+ ;; Insert the tutorial. First offer to resume last tutorial
+ ;; editing session.
+ (when dont-ask-for-revert
+ (setq old-tut-file nil))
+ (when old-tut-file
+ (setq old-tut-file
+ (y-or-n-p
+ (format
+ "Resume your last saved Viper tutorial part %s? "
+ part))))
+ (if old-tut-file
+ (progn
+ (insert-file-contents (viper-tut--saved-file))
+ (goto-char (point-min))
+ (setq old-tut-point
+ (string-to-number
+ (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))))
+ (forward-line)
+ (setq tutorial--point-before-chkeys
+ (string-to-number
+ (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))))
+ (forward-line)
+ (delete-region (point-min) (point))
+ (goto-char tutorial--point-before-chkeys)
+ (setq tutorial--point-before-chkeys (point-marker)))
+ ;;(insert-file-contents (expand-file-name filename data-directory))
+ (insert-file-contents filename)
+ (viper-tut--replace-links)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "'\\([][+a-zA-Z~<>!;,:.'\"%/?(){}$^0|-]\\)'" nil t)
+ (let ((matched-char (match-string 1))
+ (inhibit-read-only t))
+ (put-text-property 0 1 'vi-char t matched-char)
+ (put-text-property 0 1 'face '(:foreground "blue") matched-char)
+ (replace-match matched-char))))
+ (forward-line)
+ (setq tutorial--point-before-chkeys (point-marker)))
+
+ (viper-tut--add-remarks)
+
+ (goto-char (point-min))
+ (when old-tut-file
+ ;; Just move to old point in saved tutorial.
+ (let ((old-point
+ (if (> 0 old-tut-point)
+ (- old-tut-point)
+ (+ old-tut-point tutorial--point-after-chkeys))))
+ (when (< old-point 1)
+ (setq old-point 1))
+ (goto-char old-point)))
+
+ (viper-tut-fix-header-and-footer)
+
+ ;; Clear message:
+ (message "") (sit-for 0)
+
+ (setq buffer-undo-list nil)
+ (set-buffer-modified-p nil))
+ (setq buffer-read-only (= 0 part)))))
+
+;;(tutorial--find-changed-keys '((scroll-up [?\C-v])))
+(defun viper-tut--add-remarks()
+ ;; Check if there are key bindings that may disturb the
+ ;; tutorial. If so tell the user.
+ (let* ((tutorial--lang "English")
+ (changed-keys
+ (if (= viper-tut--part viper-tut--emacs-part)
+ (tutorial--find-changed-keys tutorial--default-keys)
+ (tutorial--find-changed-keys viper-tut--default-keys))))
+ (viper-tut--display-changes changed-keys viper-tut--part))
+
+ (if (= viper-tut--part viper-tut--emacs-part)
+ (progn
+ (add-hook 'viper-vi-state-hook 'viper-tut--at-change-state nil t)
+ (add-hook 'viper-insert-state-hook 'viper-tut--at-change-state nil t)
+ (add-hook 'viper-replace-state-hook 'viper-tut--at-change-state nil t)
+ (add-hook 'viper-emacs-state-hook 'viper-tut--at-change-state nil t)
+ )
+ (remove-hook 'viper-vi-state-hook 'viper-tut--at-change-state t)
+ (remove-hook 'viper-insert-statehook 'viper-tut--at-change-state t)
+ (remove-hook 'viper-replace-state-hook 'viper-tut--at-change-state t)
+ (remove-hook 'viper-emacs-state-hook 'viper-tut--at-change-state t)
+ ))
+
+(defun viper-tut-fix-header-and-footer ()
+ (save-excursion
+ (goto-char (point-min))
+ (add-text-properties (point) (1+ (line-end-position))
+ '( read-only t face viper-tut-header))
+ (goto-char (point-min))
+ (viper-tut--insert-goto-row nil)
+ (goto-char (point-max))
+ (viper-tut--insert-goto-row t)))
+
+(defun viper-tut--insert-goto-row(last)
+ (let ((start (point))
+ end)
+ (insert " Go to part: ")
+ (dolist (rec viper-tut--parts)
+ (let ((n (nth 0 rec))
+ (file (nth 1 rec))
+ (title (nth 2 rec)))
+ (if (= n viper-tut--part)
+ (insert (format "%s" n))
+ (insert-button (format "%s" n)
+ 'help-echo (concat "Go to part: " title)
+ 'follow-link t
+ 'action
+ `(lambda (button)
+ (viper-tutorial ,n t))))
+ (insert " ")))
+ (insert " ")
+ (insert-button "Exit Tutorial"
+ 'help-echo "Exit tutorial and close tutorial buffer"
+ 'follow-link t
+ 'action
+ (lambda (button)
+ (kill-buffer (current-buffer))))
+ (unless last (insert "\n"))
+ (setq end (point))
+ (put-text-property start end 'local-map tutorial--tab-map)
+ (put-text-property start end 'tutorial-remark t)
+ (put-text-property start end
+ 'face 'viper-tut-header-top)
+ (put-text-property start end 'read-only t)))
+
+(defun viper-tut--replace-links()
+ "Replace markers for links with actual links."
+ (let ((re-links (regexp-opt '("VIPER-MANUAL"
+ "README-FILE"
+ "DIGIT-ARGUMENT"
+ "KILL-BUFFER"
+ "ISEARCH-FORWARD"
+ "UNIVERSAL-ARGUMENT"
+ "SEARCH-COMMANDS"
+ "R-AND-R"
+ "CUA-MODE"
+ "KEYBOARD-MACROS"
+ "VIPER-TOGGLE-KEY"
+ "* EMACS-NOTICE:")))
+ (case-fold-search nil)
+ (inhibit-read-only t))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward re-links nil t)
+ (let ((matched (match-string 0))
+ start
+ end)
+ (replace-match "")
+ (setq start (point))
+ (cond
+ ((string= matched "VIPER-TOGGLE-KEY")
+ (insert-button "viper-toggle-key"
+ 'action
+ (lambda(button) (interactive)
+ (describe-variable 'viper-toggle-key))
+ 'follow-link t))
+ ((string= matched "CUA-MODE")
+ (insert-button "cua-mode"
+ 'action
+ (lambda(button) (interactive)
+ (describe-function 'cua-mode))
+ 'follow-link t))
+ ((string= matched "ISEARCH-FORWARD")
+ (insert-button "isearch-forward"
+ 'action
+ (lambda(button) (interactive)
+ (describe-function 'isearch-forward))
+ 'follow-link t))
+ ((string= matched "KILL-BUFFER")
+ (insert-button "kill-buffer"
+ 'action
+ (lambda(button) (interactive)
+ (describe-function 'kill-buffer))
+ 'follow-link t))
+ ((string= matched "UNIVERSAL-ARGUMENT")
+ (insert-button "universal-argument"
+ 'action
+ (lambda(button) (interactive)
+ (describe-function 'universal-argument))
+ 'follow-link t))
+ ((string= matched "DIGIT-ARGUMENT")
+ (insert-button "digit-argument"
+ 'action
+ (lambda(button) (interactive)
+ (describe-function 'digit-argument))
+ 'follow-link t))
+ ((string= matched "* EMACS-NOTICE:")
+ (insert "* Emacs NOTICE:")
+ (while (progn
+ (forward-line 1)
+ (not (looking-at "^$"))))
+ (put-text-property start (point)
+ 'face '(:background
+ "#ffe4b5"
+ :foreground "#999999"))
+ (put-text-property start (point) 'read-only t)
+ )
+ ((string= matched "SEARCH-COMMANDS")
+ (insert-button "search commands"
+ 'action
+ (lambda(button) (interactive)
+ (info-other-window "(emacs) Search")
+ (message "Type C-x 0 to close the new window"))
+ 'follow-link t))
+ ((string= matched "KEYBOARD-MACROS")
+ (insert-button "keyboard macros"
+ 'action
+ (lambda(button) (interactive)
+ (info-other-window "(emacs) Keyboard Macros")
+ (message "Type C-x 0 to close the new window"))
+ 'follow-link t))
+ ((string= matched "VIPER-MANUAL")
+ (insert-button "Viper manual"
+ 'action
+ (lambda(button) (interactive)
+ (info-other-window "(viper)")
+ (message "Type C-x 0 to close the new window"))
+ 'follow-link t))
+ ((string= matched "R-AND-R")
+ (insert-button "r and R"
+ 'action
+ (lambda(button) (interactive)
+ (info-other-window "(viper) Basics")
+ (message "Type C-x 0 to close the new window"))
+ 'follow-link t))
+ ((string= matched "README-FILE")
+ (insert-button "README file"
+ 'action
+ (lambda(button) (interactive)
+ (find-file-other-window (expand-file-name "README" viper-tut-directory))
+ (message "Type C-x 0 to close the new window"))
+ 'follow-link t))
+ (t
+ (error "Unmatched text: %s" matched)))
+ (put-text-property start (point) 'tutorial-remark t)
+ (put-text-property start (point) 'tutorial-orig matched)
+ (put-text-property start (point) 'local-map tutorial--tab-map)
+ (put-text-property start (point) 'read-only t))))))
+
+(provide 'viper-tut)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; viper-tut.el ends here
--- /dev/null
+;;; vline.el --- show vertical line (column highlighting) mode.
+
+;; Copyright (C) 2002, 2008, 2009 by Taiki SUGAWARA <buzz.taiki@gmail.com>
+
+;; Author: Taiki SUGAWARA <buzz.taiki@gmail.com>
+;; Keywords: faces, editing, emulating
+;; Version: 1.09
+;; Time-stamp: <2009-10-12 16:55:13 UTC taiki>
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/vline.el
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Usage
+;; put followings your .emacs
+;; (require 'vline)
+;;
+;; if you display a vertical line, type M-x vline-mode. `vline-mode' doesn't
+;; effect other buffers, because it is a buffer local minor mode. if you hide
+;; a vertical line, type M-x vline-mode again.
+;;
+;; if you display a vertical line in all buffers, type M-x vline-global-mode.
+;;
+;; `vline-style' provides a display style of vertical line. see
+;; `vline-style' docstring.
+;;
+;; if you don't want to visual line highlighting (ex. for performance issue), please to set `vline-visual' to nil.
+
+;;; Changes
+;; 2009-08-26 taiki
+;; support org-mode, outline-mode
+
+;; 2009-08-18 taiki
+;; add autoload cookies.
+
+;; 2009-08-18 taiki
+;; fix last line highlighting probrem.
+
+;; 2009-08-18 taiki
+;; support visual line highlighting.
+;; - Added face vline-visual.
+;; - Added defcustom vline-visual-face.
+;; - Added defcustom vline-visual.
+;;
+;; 2009-08-17 taiki
+;; fix continuas line problem.
+;; - Don't display vline when cursor into fringe
+;; - Don't expand eol more than window width.
+;;
+;; 2008-10-22 taiki
+;; fix coding-system problem.
+;; - Added vline-multiwidth-space-list
+;; - Use ucs code-point for japanese fullwidth space.
+;;
+;; 2008-01-22 taiki
+;; applied patch from Lennart Borgman
+;; - Added :group 'vline
+;; - Added defcustom vline-current-window-only
+;; - Added header items to simplify for users
+
+;;; TODO:
+;; - track window-scroll-functions, window-size-change-functions.
+;; - consider other minor modes (using {after,before}-string overlay).
+;; - don't use {post,after}-command-hook for performance??
+
+;;; Code:
+
+(defvar vline-overlay-table-size 200)
+(defvar vline-overlay-table (make-vector vline-overlay-table-size nil))
+(defvar vline-line-char ?|)
+(defvar vline-multiwidth-space-list
+ (list
+ ?\t
+ (decode-char 'ucs #x3000) ; japanese fullwidth space
+ ))
+
+(defcustom vline-style 'face
+ "*This variable holds vertical line display style.
+Available values are followings:
+`face' : use face.
+`compose' : use composit char.
+`mixed' : use face and composit char."
+ :type '(radio
+ (const face)
+ (const compose)
+ (const mixed))
+ :group 'vline)
+
+
+(defface vline
+ '((t (:background "light steel blue")))
+ "*A default face for vertical line highlighting."
+ :group 'vline)
+
+(defface vline-visual
+ '((t (:background "gray90")))
+ "*A default face for vertical line highlighting in visual lines."
+ :group 'vline)
+
+(defcustom vline-face 'vline
+ "*A face for vertical line highlighting."
+ :type 'face
+ :group 'vline)
+
+(defcustom vline-visual-face 'vline-visual
+ "*A face for vertical line highlighting in visual lines."
+ :type 'face
+ :group 'vline)
+
+(defcustom vline-current-window-only nil
+ "*If non-nil then show column in current window only.
+If the buffer is shown in several windows then show column only
+in the currently selected window."
+ :type 'boolean
+ :group 'vline)
+
+(defcustom vline-visual t
+ "*If non-nil then show column in visual lines.
+If you specified `force' then use force visual line highlighting even
+if `truncate-lines' is non-nil."
+ :type '(radio
+ (const nil)
+ (const t)
+ (const force))
+ :group 'vline)
+
+;;;###autoload
+(define-minor-mode vline-mode
+ "Display vertical line mode."
+ :global nil
+ :lighter " VL"
+ :group 'vline
+ (if vline-mode
+ (progn
+ (add-hook 'pre-command-hook 'vline-pre-command-hook nil t)
+ (add-hook 'post-command-hook 'vline-post-command-hook nil t))
+ (vline-clear)
+ (remove-hook 'pre-command-hook 'vline-pre-command-hook t)
+ (remove-hook 'post-command-hook 'vline-post-command-hook t)))
+
+;;;###autoload
+(define-minor-mode vline-global-mode
+ "Display vertical line mode as globally."
+ :global t
+ :lighter " VL"
+ :group 'vline
+ (if vline-global-mode
+ (progn
+ (add-hook 'pre-command-hook 'vline-global-pre-command-hook)
+ (add-hook 'post-command-hook 'vline-global-post-command-hook))
+ (vline-clear)
+ (remove-hook 'pre-command-hook 'vline-global-pre-command-hook)
+ (remove-hook 'post-command-hook 'vline-global-post-command-hook)))
+
+(defun vline-pre-command-hook ()
+ (when (and vline-mode (not (minibufferp)))
+ (vline-clear)))
+
+(defun vline-post-command-hook ()
+ (when (and vline-mode (not (minibufferp)))
+ (vline-show)))
+
+(defun vline-global-pre-command-hook ()
+ (when (and vline-global-mode (not (minibufferp)))
+ (vline-clear)))
+
+(defun vline-global-post-command-hook ()
+ (when (and vline-global-mode (not (minibufferp)))
+ (vline-show)))
+
+(defun vline-clear ()
+ (mapcar (lambda (ovr)
+ (and ovr (delete-overlay ovr)))
+ vline-overlay-table))
+
+(defsubst vline-into-fringe-p ()
+ (eq (nth 1 (posn-at-point)) 'right-fringe))
+
+(defsubst vline-visual-p ()
+ (or (eq vline-visual 'force)
+ (and (not truncate-lines)
+ vline-visual)))
+
+(defsubst vline-current-column ()
+ (if (or (not (vline-visual-p))
+ ;; margin for full-width char
+ (< (1+ (current-column)) (window-width)))
+ (current-column)
+ ;; hmm.. posn-at-point is not consider tab width.
+ (- (current-column)
+ (save-excursion
+ (vertical-motion 0)
+ (current-column)))))
+
+(defsubst vline-move-to-column (col &optional bol-p)
+ (if (or (not (vline-visual-p))
+ ;; margin for full-width char
+ (< (1+ (current-column)) (window-width)))
+ (move-to-column col)
+ (unless bol-p
+ (vertical-motion 0))
+ (let ((bol-col (current-column)))
+ (- (move-to-column (+ bol-col col))
+ bol-col))))
+
+(defsubst vline-forward (n)
+ (unless (memq n '(-1 0 1))
+ (error "n(%s) must be 0 or 1" n))
+ (if (not (vline-visual-p))
+ (progn
+ (forward-line n)
+ ;; take care of org-mode, outline-mode
+ (when (and (not (bobp))
+ (invisible-p (1- (point))))
+ (goto-char (1- (point))))
+ (when (invisible-p (point))
+ (if (< n 0)
+ (while (and (not (bobp)) (invisible-p (point)))
+ (goto-char (previous-char-property-change (point))))
+ (while (and (not (bobp)) (invisible-p (point)))
+ (goto-char (next-char-property-change (point))))
+ (forward-line 1))))
+ (vertical-motion n)))
+
+(defun vline-face (visual-p)
+ (if visual-p
+ vline-visual-face
+ vline-face))
+
+(defun vline-show (&optional point)
+ (vline-clear)
+ (save-window-excursion
+ (save-excursion
+ (if point
+ (goto-char point)
+ (setq point (point)))
+ (let* ((column (vline-current-column))
+ (lcolumn (current-column))
+ (i 0)
+ (compose-p (memq vline-style '(compose mixed)))
+ (face-p (memq vline-style '(face mixed)))
+ (line-char (if compose-p vline-line-char ? ))
+ (line-str (make-string 1 line-char))
+ (visual-line-str line-str)
+ (in-fringe-p (vline-into-fringe-p)))
+ (when face-p
+ (setq line-str (propertize line-str 'face (vline-face nil)))
+ (setq visual-line-str (propertize visual-line-str 'face (vline-face t))))
+ (goto-char (window-end nil t))
+ (vline-forward 0)
+ (while (and (not in-fringe-p)
+ (< i (window-height))
+ (< i (length vline-overlay-table))
+ (not (bobp)))
+ (let ((cur-column (vline-move-to-column column t))
+ (cur-lcolumn (current-column)))
+ ;; non-cursor line only (workaround of eol probrem.
+ (unless (= (point) point)
+ ;; if column over the cursor's column (when tab or wide char is appered.
+ (when (> cur-column column)
+ (let ((lcol (current-column)))
+ (backward-char)
+ (setq cur-column (- cur-column (- lcol (current-column))))))
+ (let* ((ovr (aref vline-overlay-table i))
+ (visual-p (or (< lcolumn (current-column))
+ (> lcolumn (+ (current-column)
+ (- column cur-column)))))
+ ;; consider a newline, tab and wide char.
+ (str (concat (make-string (- column cur-column) ? )
+ (if visual-p visual-line-str line-str)))
+ (char (char-after)))
+ ;; create overlay if not found.
+ (unless ovr
+ (setq ovr (make-overlay 0 0))
+ (overlay-put ovr 'rear-nonsticky t)
+ (aset vline-overlay-table i ovr))
+
+ ;; initialize overlay.
+ (overlay-put ovr 'face nil)
+ (overlay-put ovr 'before-string nil)
+ (overlay-put ovr 'after-string nil)
+ (overlay-put ovr 'invisible nil)
+ (overlay-put ovr 'window
+ (if vline-current-window-only
+ (selected-window)
+ nil))
+
+ (cond
+ ;; multiwidth space
+ ((memq char vline-multiwidth-space-list)
+ (setq str
+ (concat str
+ (make-string (- (save-excursion (forward-char)
+ (current-column))
+ (current-column)
+ (string-width str))
+ ? )))
+ (move-overlay ovr (point) (1+ (point)))
+ (overlay-put ovr 'invisible t)
+ (overlay-put ovr 'after-string str))
+ ;; eol
+ ((eolp)
+ (move-overlay ovr (point) (point))
+ (overlay-put ovr 'after-string str)
+ ;; don't expand eol more than window width
+ (when (and (not truncate-lines)
+ (>= (1+ column) (window-width))
+ (>= column (vline-current-column))
+ (not (vline-into-fringe-p)))
+ (delete-overlay ovr)))
+ (t
+ (cond
+ (compose-p
+ (let (str)
+ (when char
+ (setq str (compose-chars
+ char
+ (cond ((= (char-width char) 1)
+ '(tc . tc))
+ ((= cur-column column)
+ '(tc . tr))
+ (t
+ '(tc . tl)))
+ line-char))
+ (when face-p
+ (setq str (propertize str 'face (vline-face visual-p))))
+ (move-overlay ovr (point) (1+ (point)))
+ (overlay-put ovr 'invisible t)
+ (overlay-put ovr 'after-string str))))
+ (face-p
+ (move-overlay ovr (point) (1+ (point)))
+ (overlay-put ovr 'face (vline-face visual-p))))))))
+ (setq i (1+ i))
+ (vline-forward -1)))))))
+
+(provide 'vline)
+
+;;; vline.el ends here
--- /dev/null
+;; This is a test file for some enhancement to the possibilities to
+;; find out about widgets or buttons at point in a buffer.
+;;
+;; To use this just load the file. Then put point on a widget or
+;; button and do
+;;
+;; M-x describe-field
+;;
+;; You find a lot of widgets in a Custom buffer. You can find buttons
+;; in for example a help buffer. (Please tell me more places so I can
+;; test!)
+;;
+;; TODO: Add backtrace collecting to some more functions!
+
+;; For widget-get-backtrace-info
+;;(require 'debug)
+(eval-when-compile (require 'cl)) ;; gensym
+(require 'help-mode)
+
+;; Last wins!
+(require 'wid-browse)
+
+(intern ":created-in-function")
+
+(define-widget 'widget-browse-link 'item
+ "Button for creating a link style button.
+The :value of the widget shuld be the widget to be browsed."
+ :format "%[%v%]"
+ ;;:value-create 'widget-browse-value-create
+ ;;:action 'widget-browse-action
+ )
+
+(defun define-button-type (name &rest properties)
+ "Define a `button type' called NAME.
+The remaining arguments form a sequence of PROPERTY VALUE pairs,
+specifying properties to use as defaults for buttons with this type
+\(a button's type may be set by giving it a `type' property when
+creating the button, using the :type keyword argument).
+
+In addition, the keyword argument :supertype may be used to specify a
+button-type from which NAME inherits its default property values
+\(however, the inheritance happens only when NAME is defined; subsequent
+changes to a supertype are not reflected in its subtypes)."
+ (let ((catsym (make-symbol (concat (symbol-name name) "-button")))
+ (super-catsym
+ (button-category-symbol
+ (or (plist-get properties 'supertype)
+ (plist-get properties :supertype)
+ 'button))))
+ ;; Provide a link so that it's easy to find the real symbol.
+ (put name 'button-category-symbol catsym)
+ ;; Initialize NAME's properties using the global defaults.
+ (let ((default-props (symbol-plist super-catsym))
+ (where-fun (widget-get-backtrace-info 8)))
+ (setq default-props
+ (cons :created-in-function
+ (cons where-fun
+ default-props)))
+ (while default-props
+ (put catsym (pop default-props) (pop default-props))))
+ ;; Add NAME as the `type' property, which will then be returned as
+ ;; the type property of individual buttons.
+ (put catsym 'type name)
+ ;; Add the properties in PROPERTIES to the real symbol.
+ (while properties
+ (let ((prop (pop properties)))
+ (when (eq prop :supertype)
+ (setq prop 'supertype))
+ (put catsym prop (pop properties))))
+ ;; Make sure there's a `supertype' property
+ (unless (get catsym 'supertype)
+ (put catsym 'supertype 'button))
+ name))
+
+(defun define-widget (name class doc &rest args)
+ "Define a new widget type named NAME from CLASS.
+
+NAME and CLASS should both be symbols, CLASS should be one of the
+existing widget types, or nil to create the widget from scratch.
+
+After the new widget has been defined, the following two calls will
+create identical widgets:
+
+* (widget-create NAME)
+
+* (apply 'widget-create CLASS ARGS)
+
+The third argument DOC is a documentation string for the widget."
+ (put name 'widget-type (cons class args))
+ (put name 'widget-documentation doc)
+ (put name :created-in-function (widget-get-backtrace-info 8))
+ name)
+
+(defvar describe-temp-help-buffer nil)
+(defun describe-get-temp-help-buffer ()
+ (setq describe-temp-help-buffer (get-buffer-create "*Copy of *Help* Buffer for Description*")))
+
+(defun describe-field (pos)
+ "Describe field at marker POS."
+ (interactive (list (point)))
+ (unless (markerp pos) (setq pos (copy-marker pos)))
+ (when (eq (marker-buffer pos) (get-buffer (help-buffer)))
+ (with-current-buffer (describe-get-temp-help-buffer)
+ (erase-buffer)
+ (insert (with-current-buffer (help-buffer)
+ (buffer-string)))
+ (goto-char (marker-position pos))
+ (setq pos (point-marker))))
+ (let (field wbutton doc button widget)
+ (with-current-buffer (marker-buffer pos)
+ (setq field (get-char-property pos 'field))
+ (setq wbutton (get-char-property pos 'button))
+ (setq doc (get-char-property pos 'widget-doc))
+ (setq button (button-at pos))
+ (setq widget (or field wbutton doc)))
+ (cond ((and widget
+ (if (symbolp widget)
+ (get widget 'widget-type)
+ (and (consp widget)
+ (get (widget-type widget) 'widget-type))))
+ (describe-widget pos))
+ (button
+ (describe-button pos))
+ ((and (eq major-mode 'Info-mode)
+ (memq (get-text-property pos 'font-lock-face)
+ '(info-xref info-xref-visited)))
+ (message "info link"))
+ (t
+ (message "No widget or button at point")))))
+
+(defun describe-insert-header (pos)
+ (widget-insert
+ (add-string-property
+ (concat
+ (format "Description of the field at position %d in "
+ (marker-position pos))
+ (format "\"%s\"" (marker-buffer pos))
+ ":\n\n")
+ 'face '(italic))))
+
+(defun describe-widget (pos)
+ ;;(interactive (list (point-marker)))
+ (unless (markerp pos) (setq pos (copy-marker pos)))
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'describe-widget pos) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (let ((inhibit-read-only t))
+ (describe-insert-header pos)
+ (insert-text-button "This field"
+ 'action (lambda (button)
+ (let* ((m (button-get button 'field-location))
+ (p (marker-position m))
+ (b (marker-buffer m)))
+ (if (not (buffer-live-p b))
+ (message "Sorry the markers buffer is gone")
+ (switch-to-buffer b)
+ (goto-char p))))
+ 'field-location pos)
+ (princ " is of type ")
+ (insert-text-button "widget"
+ 'action (lambda (button)
+ (info "(widget)")))
+ (princ ". You can ")
+ (insert-text-button "browse the widget's properties"
+ 'action (lambda (button)
+ (widget-browse-at
+ (button-get button 'field-location)))
+ 'field-location pos))
+ (princ " to find out more about it.")
+ (fill-region (point-min) (point-max))
+ )
+ (with-no-warnings (print-help-return-message))))
+
+(defun describe-button (pos)
+ (let ((button (button-at pos)))
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'describe-button pos) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (let ((inhibit-read-only t)
+ ;;(button-marker (gensym))
+ )
+ (describe-insert-header pos)
+ (insert-text-button "This field"
+ 'action (lambda (button)
+ (let* ((m (button-get button 'field-location))
+ (p (marker-position m))
+ (b (marker-buffer m)))
+ (switch-to-buffer b)
+ (goto-char p)))
+ 'field-location pos)
+ (princ " is of type ")
+ (insert-text-button "button"
+ 'action (lambda (button)
+ (info "(elisp) Buttons")))
+ (princ ". You can ")
+ ;;(set button-marker pos)
+ (insert-text-button "browse the button's properties"
+ 'action `(lambda (button)
+ ;;(button-browse-at (symbol-value ',button-marker)))))
+ (button-browse-at ,pos))))
+ (princ " to find out more about it.")
+ (fill-region (point-min) (point-max))
+ )
+ (with-no-warnings (print-help-return-message)))))
+
+;; Obsolete
+;; (defun whelp-describe-symbol (sym)
+;; (interactive "SSymbol: ")
+;; (with-output-to-temp-buffer (help-buffer)
+;; (help-setup-xref (list #'describe-symbol sym) (interactive-p))
+;; (with-current-buffer (help-buffer)
+;; (let ((inhibit-read-only t))
+;; (if (not (symbolp sym))
+;; (progn
+;; (princ "Argument does not look like it is a ")
+;; (insert-text-button "symbol"
+;; 'action (lambda (button)
+;; (info "(elisp) Symbols")))
+;; (princ "."))
+;; (let ((n 0))
+;; (when (fboundp sym) (setq n (1+ n)))
+;; (when (boundp sym) (setq n (1+ n)))
+;; (when (facep sym) (setq n (1+ n)))
+;; (when (custom-group-p sym) (setq n (1+ n)))
+;; (if (= n 0)
+;; (progn
+;; (princ "Can't determine usage for the ")
+;; (insert-text-button "symbol"
+;; 'action (lambda (button)
+;; (info "(elisp) Symbols")))
+;; (princ " '")
+;; (princ (symbol-name sym))
+;; (princ "."))
+;; (princ "The ")
+;; (insert-text-button "symbol"
+;; 'action (lambda (button)
+;; (info "(elisp) Symbols")))
+;; (princ " '")
+;; (princ (symbol-name sym))
+;; (if (= n 1)
+;; (progn
+;; (princ " is a ")
+;; (cond ((fboundp sym)
+;; (princ "function (")
+;; (insert-text-button
+;; "describe it"
+;; 'action (lambda (button)
+;; (let ((value (button-get button 'value)))
+;; (describe-function value)))
+;; 'value sym)
+;; (insert ")"))
+;; ((boundp sym)
+;; (insert "variable (")
+;; (insert-text-button
+;; "describe it"
+;; 'action (lambda (button)
+;; (let ((value (button-get button 'value)))
+;; (describe-variable value)))
+;; 'value sym)
+;; (insert ")"))
+;; ((facep sym)
+;; (insert "face (")
+;; (insert-text-button
+;; "describe it"
+;; 'action (lambda (button)
+;; (let ((value (button-get button 'value)))
+;; (describe-face value)))
+;; 'value sym)
+;; (insert ")"))
+;; ((custom-group-p sym)
+;; (insert "customize group (")
+;; (insert-text-button
+;; "customize it"
+;; 'action (lambda (button)
+;; (let ((value (button-get button 'value)))
+;; (customize-group value)))
+;; 'value sym)
+;; (insert ")")))
+;; (princ "."))
+;; (princ " has several usages currently.")
+;; (princ " It can be:\n\n")
+;; (when (fboundp sym)
+;; (princ " - A function (")
+;; (insert-text-button "describe it"
+;; 'action (lambda (button)
+;; (let ((value (button-get button 'value)))
+;; (describe-function value)))
+;; 'value sym)
+;; (princ ")\n"))
+;; (when (boundp sym)
+;; (princ " - A variable (")
+;; (insert-text-button "describe it"
+;; 'action (lambda (button)
+;; (let ((value (button-get button 'value)))
+;; (describe-variable value)))
+;; 'value sym)
+;; (princ ")\n"))
+;; (when (facep sym)
+;; (princ " - A face (")
+;; (insert-text-button "describe it"
+;; 'action (lambda (button)
+;; (let ((value (button-get button 'value)))
+;; (describe-face value)))
+;; 'value sym)
+;; (princ ")\n"))
+;; (when (custom-group-p sym)
+;; (princ " - A customization group (")
+;; (insert-text-button "customize it"
+;; 'action (lambda (button)
+;; (let ((value (button-get button 'value)))
+;; (customize-group value)))
+;; 'value sym)
+;; (princ ")\n"))
+;; )))
+;; (princ "\n\nSymbol's property list:\n\n")
+;; (let ((pl (symbol-plist sym))
+;; key
+;; val)
+;; (princ (format " %25s %s\n" "Key" "Value"))
+;; (princ (format " %25s %s\n" "---" "-----"))
+;; (while pl
+;; (setq key (car pl))
+;; (setq pl (cdr pl))
+;; (setq val (car pl))
+;; (setq pl (cdr pl))
+;; (let ((first (point-marker))
+;; last)
+;; (princ (format " %25s - %s" key val))
+;; (setq last (point-marker))
+;; (let ((adaptive-fill-function
+;; (lambda ()
+;; (format " %25s - " key))))
+;; (fill-region first last)
+;; ))
+;; (princ "\n")
+;; )))
+;; (with-no-warnings (print-help-return-message))))))
+
+
+
+(defun widget-browse-sexp (widget key value)
+ "Insert description of WIDGET's KEY VALUE.
+Nothing is assumed about value."
+ (let ((pp (condition-case signal
+ (pp-to-string value)
+ (error (prin1-to-string signal)))))
+ (when (string-match "\n\\'" pp)
+ (setq pp (substring pp 0 (1- (length pp)))))
+ (if (cond ((string-match "\n" pp)
+ nil)
+ ((> (length pp) (- (window-width) (current-column)))
+ nil)
+ (t t))
+ (cond
+ ( (and value
+ (symbolp value)
+ (or (fboundp value)
+ (boundp value)
+ (facep value)))
+ (widget-create 'push-button
+ :tag pp
+ :value value
+ :action '(lambda (widget &optional event)
+ (let ((value (widget-get widget :value))
+ (n 0))
+ (when (fboundp value) (setq n (1+ n)))
+ (when (boundp value) (setq n (1+ n)))
+ (when (facep value) (setq n (1+ n)))
+ (if (= n 1)
+ (cond ((fboundp value)
+ (describe-function value))
+ ((boundp value)
+ (describe-variable value))
+ ((facep value)
+ (describe-face value)))
+ (describe-symbol value))))))
+ ( (markerp value)
+ (widget-create 'push-button
+ :tag pp
+ :value (list (marker-position value) (marker-buffer value))
+ :action '(lambda (widget &optional event)
+ (let ((value (widget-get widget :value)))
+ (let ((pos (car value))
+ (buf (cadr value)))
+ (switch-to-buffer-other-window buf)
+ (goto-char pos))))))
+ ( (overlayp value)
+ (widget-create 'push-button
+ :tag pp
+ :value (list (overlay-start value) (overlay-buffer value))
+ :action '(lambda (widget &optional event)
+ (let ((value (widget-get widget :value)))
+ (let ((pos (car value))
+ (buf (cadr value)))
+ (switch-to-buffer-other-window buf)
+ (goto-char pos))))))
+ ( t
+ (widget-insert pp)))
+
+ (widget-create 'push-button
+ :tag "show"
+ :action (lambda (widget &optional event)
+ (with-output-to-temp-buffer
+ "*Pp Eval Output*"
+ (princ (widget-get widget :value))))
+ pp))))
+
+
+(defvar widget-get-backtrace-active t
+ "Whether to collect backtrace info for widgets and buttons.
+Turn this on only for debugging purposes.
+
+Note: This must be t when Emacs is loading to collect the needed
+information.")
+
+(defun widget-get-backtrace-info (n)
+ (if widget-get-backtrace-active
+ (let ((frame-n t)
+ fun)
+ (while (and frame-n
+ (not fun))
+ (setq frame-n (backtrace-frame n))
+ (when frame-n
+ ;;(message "**BT %s: %s" n (cadr frame-n))
+ (when (car frame-n)
+ (setq fun (cadr frame-n))
+ (when (or (listp fun)
+ (member fun
+ '(
+ backtrace-frame
+ widget-get-backtrace-info
+
+ eval
+ eval-expression
+ call-interactively
+ apply
+ funcall
+ ;;lambda
+
+ if
+ when
+ cond
+ condition
+ mapc
+ mapcar
+ while
+
+ let
+ let*
+ set
+ setq
+ set-variable
+ set-default
+
+ widget-create
+ widget-create-child-and-convert
+ widget-create-child
+ widget-create-child-value
+ define-button-type
+ define-widget
+ make-text-button
+ insert-text-button
+ make-button
+ insert-button
+ )))
+ (setq fun)))
+ (setq n (1+ n))))
+ ;;(message "---------- fun=%s" fun)
+ fun)
+ "Set widget-get-backtrace-info to show this"))
+
+(defun widget-create (type &rest args)
+ "Create widget of TYPE.
+The optional ARGS are additional keyword arguments."
+ (unless (keywordp :created-in-function) (error ":wcw not interned"))
+ (let ((where-fun (widget-get-backtrace-info 8))
+ yargs)
+ (setq args
+ (cons :created-in-function
+ (cons where-fun
+ args)))
+ (let ((widget (apply 'widget-convert type args)))
+ (widget-apply widget :create)
+ widget)))
+
+
+(defun widget-create-child-and-convert (parent type &rest args)
+ "As part of the widget PARENT, create a child widget TYPE.
+The child is converted, using the keyword arguments ARGS."
+ (let ((widget (apply 'widget-convert type args)))
+ (widget-put widget :parent parent)
+ (widget-put widget :created-in-function (widget-get-backtrace-info 15))
+ (unless (widget-get widget :indent)
+ (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
+ (or (widget-get widget :extra-offset) 0)
+ (widget-get parent :offset))))
+ (widget-apply widget :create)
+ widget))
+
+(defun widget-create-child (parent type)
+ "Create widget of TYPE."
+ (let ((widget (widget-copy type)))
+ (widget-put widget :parent parent)
+ (widget-put widget :created-in-function (widget-get-backtrace-info 15))
+ (unless (widget-get widget :indent)
+ (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
+ (or (widget-get widget :extra-offset) 0)
+ (widget-get parent :offset))))
+ (widget-apply widget :create)
+ widget))
+
+(defun widget-create-child-value (parent type value)
+ "Create widget of TYPE with value VALUE."
+ (let ((widget (widget-copy type)))
+ (widget-put widget :value (widget-apply widget :value-to-internal value))
+ (widget-put widget :parent parent)
+ (widget-put widget :created-in-function (widget-get-backtrace-info 15))
+ (unless (widget-get widget :indent)
+ (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
+ (or (widget-get widget :extra-offset) 0)
+ (widget-get parent :offset))))
+ (widget-apply widget :create)
+ widget))
+
+(defvar widget-browse-fb-history nil
+ "Forward/backward history.")
+(setq widget-browse-fb-history nil)
+
+(defun widget-fb-button-action (widget &ignore)
+ (let* ((num (widget-get widget :history-number))
+ (rec (nth num widget-browse-fb-history))
+ (fun (nth 0 rec))
+ (val (nth 1 rec))
+ (loc (nth 2 rec)))
+ ;;(message "fun=%s, val=%s, loc=%s" fun val loc)(sit-for 4)
+ (funcall fun num)))
+
+(defun widget-insert-fb-buttons (current-number)
+ ;;(message "current-number=%s" current-number)(sit-for 2)
+ (if (<= 0 (1- current-number))
+ (widget-create 'push-button
+ :action 'widget-fb-button-action
+ :history-number (1- current-number)
+ :format "%[%v%]"
+ "back")
+ (widget-insert (add-string-property "[back]"
+ 'face 'shadow)))
+ (widget-insert " ")
+ (if (< (1+ current-number) (length widget-browse-fb-history))
+ (widget-create 'push-button
+ :action 'widget-fb-button-action
+ :history-number (1+ current-number)
+ :format "%[%v%]"
+ "forward")
+ (widget-insert (add-string-property "[forward]"
+ 'face 'shadow)))
+ (widget-insert "\n"))
+
+(defun widget-add-fb-history (elt)
+ (let ((last (car widget-browse-fb-history)))
+ (unless (equal elt last)
+ (setq widget-browse-fb-history
+ (reverse (cons elt
+ (reverse widget-browse-fb-history)))))))
+
+(defun widget-browse (widget &optional location)
+ "Create a widget browser for WIDGET."
+ (interactive (list (completing-read "Widget: "
+ obarray
+ (lambda (symbol)
+ (get symbol 'widget-type))
+ t nil 'widget-browse-history)))
+ (let (history-number)
+ (if (integerp widget)
+ (progn
+ ;;(message "was integer=%s" widget)(sit-for 2)
+ (setq history-number widget)
+ (setq widget (nth 1 (nth widget widget-browse-fb-history))))
+ ;;(message "was NOT integer=%s" widget)(sit-for 2)
+ (widget-add-fb-history (list 'widget-browse widget location))
+ (setq history-number (1- (length widget-browse-fb-history))))
+ ;;(message "history-number=%s" history-number)(sit-for 2)
+
+ (if (stringp widget)
+ (setq widget (intern widget)))
+ (unless (if (symbolp widget)
+ (get widget 'widget-type)
+ (and (consp widget)
+ (get (widget-type widget) 'widget-type)))
+ (error "Not a widget"))
+
+ ;; Create the buffer.
+ (if (symbolp widget)
+ (let ((buffer (format "*Browse %s Widget*" widget)))
+ (kill-buffer (get-buffer-create buffer))
+ (switch-to-buffer (get-buffer-create buffer)))
+ (kill-buffer (get-buffer-create "*Browse Widget*"))
+ (switch-to-buffer (get-buffer-create "*Browse Widget*")))
+ (widget-browse-mode)
+
+ (make-local-variable 'widget-button-face)
+ (setq widget-button-face 'link)
+ (set (make-local-variable 'widget-push-button-prefix) "")
+ (set (make-local-variable 'widget-push-button-suffix) "")
+ (set (make-local-variable 'widget-link-prefix) "")
+ (set (make-local-variable 'widget-link-suffix) "")
+
+ ;; Top text indicating whether it is a class or object browser.
+ (widget-insert-fb-buttons history-number)
+ (widget-insert "----------------\n")
+ (if (listp widget)
+ (progn
+ (widget-insert (add-string-property
+ "Widget object browser"
+ 'face 'widget-browse-h1))
+ (widget-insert "\n\n")
+ (when location
+ (let ((b (marker-buffer location))
+ (p (marker-position location)))
+ (widget-insert (add-string-property "Location: "
+ 'face 'italic))
+ (widget-create 'push-button
+ :tag (format "position %s in buffer %s" p b)
+ :value (list p b)
+ :action '(lambda (widget &optional event)
+ (let ((value (widget-get widget :value)))
+ (let ((pos (car value))
+ (buf (cadr value)))
+ (switch-to-buffer-other-window buf)
+ (goto-char pos)))))
+ (widget-insert "\n\n")))
+ (widget-insert (add-string-property "Class: "
+ 'face 'italic)))
+ (widget-insert (add-string-property "Widget class browser"
+ 'face 'widget-browse-h1))
+ (widget-insert ".\n\n")
+ (widget-insert (add-string-property "Class: " 'face 'italic))
+ (widget-insert (add-string-property (format "%s\n" widget)
+ 'face '(bold)))
+ (widget-insert (format "%s" (get widget 'widget-documentation)))
+ (unless (eq (preceding-char) ?\n) (widget-insert "\n"))
+ (widget-insert (add-string-property "\nSuper: " 'face 'italic))
+ (setq widget (get widget 'widget-type))
+ )
+
+ ;(widget-insert (format "%s\n" widget))
+
+ ;; Now show the attributes.
+ (let ((name (car widget))
+ (items (cdr widget))
+ key value printer)
+ (if (not name)
+ (widget-insert "none\n")
+ (let ((ancestors (list name))
+ a
+ (i1 7)
+ i
+ )
+ (setq i i1)
+ (while name
+ (setq a (intern-soft name))
+ (if a
+ (progn
+ (setq a (get a 'widget-type))
+ (setq name (car a))
+ (when (intern-soft name)
+ (push name ancestors)))
+ (setq name)))
+ ;;(widget-insert (format "ancestors=%s\n" ancestors))
+ (mapc (lambda (w)
+ (widget-insert (make-string (if (= i i1) 0 i) ? ))
+ (widget-create 'widget-browse
+ :format "%[%v%]"
+ w)
+ (widget-insert "\n")
+ (setq i (+ i 2)))
+ ancestors)))
+ (while items
+ (setq key (nth 0 items)
+ value (nth 1 items)
+ printer (or (get key 'widget-keyword-printer)
+ 'widget-browse-sexp)
+ items (cdr (cdr items)))
+ (widget-insert "\n"
+ (add-string-property (symbol-name key)
+ 'face 'italic))
+ (when (widget-browse-explained key)
+ (widget-insert " (")
+ (widget-create
+ ;;'push-button
+ ;;:tag "explain"
+ ;;:format "%[%v%]"
+ ;;:button-prefix ""
+ ;;:button-suffix ""
+ 'widget-browse-link
+ :value key
+ :tag "explain"
+ :format "%[%t%]"
+ :action '(lambda (widget &optional event)
+ (widget-browse-explain
+ ;;(widget-get widget :value)
+ (widget-value widget)
+ ))
+ )
+ (widget-insert ")"))
+ (widget-insert "\n\t")
+ (funcall printer widget key value)
+ (widget-insert "\n")))
+
+ (widget-insert "\n-----------\n")
+ (widget-insert-fb-buttons history-number)
+
+ (widget-setup)
+ (goto-char (point-min))
+;; (when wid-to-history
+;; (setq widget-browse-fb-history
+;; (reverse (cons (list 'widget-browse wid-to-history location)
+;; (reverse widget-browse-fb-history)))))
+ ))
+
+(defun widget-browse-at (pos)
+ "Browse the widget under point."
+ (interactive "d")
+ (let ((mp pos)
+ (b (if (markerp pos) (marker-buffer pos)
+ (current-buffer))))
+ (if (not (buffer-live-p b))
+ (message "Sorry the markers buffer is gone")
+ (with-current-buffer b
+ (when (markerp pos)
+ (setq pos (marker-position pos)))
+ (let* ((field (get-char-property pos 'field))
+ (button (get-char-property pos 'button))
+ (doc (get-char-property pos 'widget-doc))
+ (text (cond (field "This is an editable text area.")
+ (button "This is an active area.")
+ (doc "This is documentation text.")
+ (t "This is unidentified text.")))
+ (widget (or field button doc)))
+ (when widget
+ (widget-browse widget mp))
+ (message text))))))
+
+(defun button-at (pos)
+ "Return the button at marker or position POS, or nil.
+If not a marker use the current buffer."
+ (with-current-buffer (if (markerp pos) (marker-buffer pos)
+ (current-buffer))
+ (when (markerp pos)
+ (setq pos (marker-position pos)))
+ (let ((button (get-char-property pos 'button)))
+ (if (or (overlayp button) (null button))
+ button
+ ;; Must be a text-property button; return a marker pointing to it.
+ (copy-marker pos t)))))
+
+(defun button-browse-at (pos)
+ (interactive "d")
+ (let ((b (if (markerp pos) (marker-buffer pos)
+ (current-buffer))))
+ (if (not (buffer-live-p b))
+ (message "Sorry the button's buffer is gone")
+ (button-browse (button-at pos)))))
+
+(defun button-browse (button)
+ "Create a widget browser for WIDGET."
+ (interactive (list (completing-read "Button: "
+ obarray
+ (lambda (symbol)
+ (or (get symbol 'button-category-symbol)
+ (get symbol 'supertype)))
+ t nil 'button-browse-history)))
+ (let (history-number)
+ (if (integerp button)
+ (progn
+ (setq history-number button)
+ (setq button (nth 1 (nth button widget-browse-fb-history))))
+ (widget-add-fb-history (list 'button-browse button))
+ (setq history-number (1- (length widget-browse-fb-history))))
+
+ (when (stringp button)
+ (setq button (intern-soft button)))
+ (when (symbolp button)
+ (unless (and button
+ (or (eq button 'default-button)
+ (get button 'supertype)
+ (get button 'button-category-symbol)
+ (save-match-data
+ (string-match "-button$" (symbol-name button)))))
+ (error "Not a button")))
+ ;; Create the buffer.
+ (kill-buffer (get-buffer-create "*Browse Button*"))
+ (switch-to-buffer (get-buffer-create "*Browse Button*"))
+ (widget-browse-mode)
+
+ (make-local-variable 'widget-button-face)
+ (setq widget-button-face 'link)
+
+ (widget-insert-fb-buttons history-number)
+ (widget-insert "----------------\n")
+
+ ;; Top text indicating whether it is a class or object browser.
+ (if (or (overlayp button)
+ (markerp button))
+ (progn
+ (widget-insert (add-string-property "Button object browser"
+ 'face 'widget-browse-h1))
+ (widget-insert "\n\n")
+ (let ((b (if (markerp button)
+ (marker-buffer button)
+ (overlay-buffer button)))
+ (p (if (markerp button)
+ (marker-position button)
+ (overlay-start button))))
+ (widget-insert (add-string-property "Location: "
+ 'face 'italic))
+ (widget-create 'push-button
+ :tag (format "position %s in buffer %s" p b)
+ :value (list p b)
+ :action '(lambda (widget &optional event)
+ (let ((value (widget-get widget :value)))
+ (let ((pos (car value))
+ (buf (cadr value)))
+ (switch-to-buffer-other-window buf)
+ (goto-char pos)))))
+ (widget-insert "\n\n")))
+ (widget-insert (add-string-property "Button class browser"
+ 'face 'widget-browse-h1))
+ (widget-insert "\n\n")
+ (widget-insert (add-string-property "Type: "
+ 'face 'italic))
+ (widget-insert (add-string-property (symbol-name button)
+ 'face 'bold))
+ (widget-insert "\n"))
+
+ ;; Now show the attributes.
+ (let (
+ (items
+ (if (symbolp button)
+ (if (get button 'button-category-symbol)
+ (symbol-plist (get button 'button-category-symbol))
+ (symbol-plist button))
+ (if (markerp button)
+ (let ((pos (marker-position button))
+ (buf (marker-buffer button)))
+ (text-properties-at pos buf))
+ (overlay-properties button))))
+ rest-items
+ name
+ key value printer)
+ ;;(insert (format "\n%s\n\n" items))
+ (let ((copied-items (copy-seq items)))
+ (while copied-items
+ (setq key (nth 0 copied-items)
+ value (nth 1 copied-items)
+ copied-items (cdr (cdr copied-items)))
+ (if (eq key 'category)
+ (setq name value)
+ (if (eq key 'supertype)
+ (setq name (make-symbol (concat (symbol-name value) "-button")))
+ (push value rest-items)
+ (push key rest-items)))))
+ ;;(insert "\nname=" (symbol-name value) "\n\n")
+ (when name
+ (widget-insert (add-string-property
+ (if (symbolp button)
+ (if (get button 'supertype)
+ "Supertype: "
+ "")
+ "Category: ")
+ 'face 'italic))
+ (let* (a
+ (ancestors
+ (list name))
+ (i1 11)
+ (i i1))
+ (while name
+ (setq a (or (get name 'supertype)
+ (get name :supertype)))
+ ;;(message "name=%s, a=%s\n name plist=%s" name a (symbol-plist name));(sit-for 4)
+ (if (or (not a)
+ (eq a 'default-button))
+ (setq name)
+ (setq name (make-symbol (concat (symbol-name a) "-button")))
+ (setq ancestors (cons name ancestors))))
+ ;;(message "ancestors=%s" ancestors)(sit-for 2)
+ (mapc (lambda (w)
+ (widget-insert (make-string (if (= i i1) 0 i) ? ))
+ (widget-create 'button-browse
+ :format "%[%v%]"
+ w)
+ (widget-insert "\n")
+ (setq i (+ i 2)))
+ ancestors)))
+ (while rest-items
+ (setq key (nth 0 rest-items)
+ value (nth 1 rest-items)
+ printer (or (get key 'widget-keyword-printer)
+ 'widget-browse-sexp)
+ rest-items (cdr (cdr rest-items)))
+ (widget-insert "\n"
+ (add-string-property (symbol-name key)
+ 'face 'italic))
+ (when (widget-browse-explained key)
+ (widget-insert " (")
+ (widget-create 'push-button
+ :tag "explain"
+ :value key
+ :action '(lambda (widget &optional event)
+ (widget-browse-explain
+ (widget-get widget :value))))
+ (widget-insert ")"))
+ (widget-insert "\n\t")
+ (funcall printer button key value)
+ (widget-insert "\n")))
+ (widget-setup)
+ (goto-char (point-min))
+
+;; (when button-to-history
+;; (setq widget-browse-fb-history
+;; (reverse (cons (list 'button-browse button-to-history)
+;; (reverse widget-browse-fb-history)))))
+ ))
+
+
+;;;###autoload
+(defgroup whelp nil
+ "Customization group for whelp."
+ :group 'emacs)
+
+(defface widget-browse-h1
+ '((t (:weight bold :height 1.5)))
+ "Face for top header in widget/button browse buffers."
+ :group 'whelp)
+
+(defun add-string-property (str prop val)
+ (let ((s (copy-seq str)))
+ (put-text-property 0 (length s)
+ prop val
+ s)
+ s))
+
+;;; The `button-browse' Widget.
+
+(define-widget 'button-browse 'push-button
+ "Widget button for creating a button browser.
+The :value of the widget shuld be the button to be browsed."
+ :format "%[[%v]%]"
+ :value-create 'widget-browse-button-value-create
+ :action 'widget-browse-button-action)
+
+(defun widget-browse-button-action (widget &optional event)
+ ;; Create widget browser for WIDGET's :value.
+ (button-browse (widget-get widget :value)))
+
+(defun widget-browse-button-value-create (widget)
+ ;; Insert type name.
+ (let ((value (widget-get widget :value)))
+ (cond ((symbolp value)
+ (insert (symbol-name value)))
+ ((consp value)
+ (insert (symbol-name (widget-type value))))
+ (t
+ (insert "strange")))))
+
+
+(defun widget-browse-explained (property)
+ (memq property
+ '(
+ :created-in-function
+ )))
+
+(defun widget-browse-explain (property)
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'widget-browse-explain property) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (let ((inhibit-read-only t))
+ (cond
+ ( (eq property :created-in-function)
+ (princ "Property :created-in-function tells where a field object or class is created.")
+ )
+ ( t
+ (princ (format "No explanation found for %s" property))
+ )
+ )
+ (with-no-warnings (print-help-return-message))))))
+
+(provide 'whelp)
--- /dev/null
+;;; winsav.el --- Save and restore window structure
+;;
+;; Author: Lennart Borgman
+;; Created: Sun Jan 14 2007
+(defconst winsav:version "0.77") ;;Version: 0.77
+;; Last-Updated: 2009-08-04 Tue
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This library contains both user level commands and options and
+;; functions for use in other elisp libraries.
+;;
+;;;; User level commands and options
+;;
+;; The user level commands and options are for saving frame, windows
+;; and buffers between Emacs sessions. To do that you can customize
+;; the options `desktop-save-mode' and `winsav-save-mode' or put this
+;; at the end of your .emacs:
+;;
+;; (desktop-save-mode 1)
+;; (winsav-save-mode 1)
+;;
+;; You can also save configurations that you later switch between.
+;; For more information see the command `winsav-save-mode'.
+;;
+;; (There is also a command in this library for rotating window
+;; borders in a frame, `winsav-rotate'. It is here just because the
+;; needed support functions lives here.)
+;;
+;;
+;;
+;;;; Commands for other elisp libraries
+;;
+;; This library was orignally written to solve the problem of adding a
+;; window to the left of some windows in a frame like the one below
+;;
+;; ___________
+;; | | |
+;; | 1 | 2 |
+;; |____|____|
+;; | |
+;; | 3 |
+;; |_________|
+;;
+;; so that the window structure on the frame becomes
+;;
+;; ___________
+;; | | | |
+;; | | 1| 2 |
+;; | B|__|___|
+;; | A| |
+;; | R| 3 |
+;; |__|______|
+;;
+;;
+;; This problem can be solved by this library. However the solution in
+;; this library is a bit more general: You first copy the window
+;; structure and then restore that into another window. To do the
+;; above you first copy the window structure in the first frame above
+;; with `winsav-get-window-tree'. Then you create windows like this:
+;;
+;; ___________
+;; | | |
+;; | | |
+;; | B| |
+;; | A| |
+;; | R| |
+;; |__|______|
+;;
+;;
+;; Finally you use `winsav-put-window-tree' to put the window
+;; structure into the right window. (Of course you could have put BAR
+;; above, under etc.)
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Bugs and limitations:
+;;
+;; Juanma Barranquero has pointed out there is a serious limitation in
+;; this way of doing it when overlays with 'window properties are
+;; used. The problem is that any pointers to windows are made invalid
+;; since they are deleted. So in fact any code that relies on saved
+;; pointers to windows will have problem if the window is one of those
+;; that are involved here.
+;;
+;; To overcome this problem when doing something like inserting a BAR
+;; window (see above) a new window has to be inserted in the existing
+;; window tree on a frame in a way that is currently not supported in
+;; Emacs.
+;;
+;; It would be nice to be have primitives to manipulate the window
+;; tree more generally from elisp. That requires implementation of
+;; them at the C level of course.
+;;
+;; However it is probably much easier to implement it quite a bit less
+;; general. The concept of splitting is maybe then the right level to
+;; search for primitives at.
+;;
+;; My conclusion is that it will take some time to find suitable
+;; primitives for this.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; Version 0.72:
+;;
+;; - Format of window structure changed in Emacs 23. Adopted to that.
+;; - Added save and restore of frame/window configurations between
+;; Emacs sessions.
+;; - Added named winsav configurations for save and restore of frames,
+;; windows, buffers and files.
+;;
+;; Version 0.71:
+;;
+;; - Added rotation of window structure.
+;;
+;; Version 0.70:
+;;
+;; - Support for save and restore from file.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+
+(eval-when-compile (require 'cl))
+(eval-and-compile (require 'desktop))
+
+;; (defun winsav-upper-left-window(&optional frame w)
+;; (let* ((tree (if w w (car (window-tree frame))))
+;; (is-split (not (windowp tree))))
+;; (if (not is-split)
+;; tree
+;; (winsav-upper-left-window frame (nth 2 tree)))))
+
+
+(defcustom winsav-after-get-hook nil
+ "Hook to run after at the end of `winsav-get-window-tree'.
+The functions in this hook are called with one parameter which is
+the same as the return value from the function above."
+ :type 'hook
+ :group 'winsav)
+
+(defcustom winsav-after-put-hook nil
+ "Hook to run after at the end of `winsav-put-window-tree'.
+The functions in this hook are called with one parameter which is
+a list where each element is a list \(old-win new-win) where
+OLD-WIN are the window from `winsav-get-window-tree' and NEW-WIN
+is the newly created corresponding window. This list is the same
+as the return value from the function above."
+ :type 'hook
+ :group 'winsav)
+
+(defun winsav-get-window-tree(&optional frame)
+ "Get window structure.
+This returns an object with current windows with values, buffers,
+points and the selected window.
+
+FRAME is the frame to save structure from. If nil use selected.
+
+At the very end of this function the hook `winsav-after-get' is
+run."
+ ;;(let* ((upper-left (winsav-upper-left-window frame))
+ (let* ((upper-left (frame-first-window frame))
+ (num -1)
+ sel-num)
+ (dolist (w (window-list frame nil upper-left))
+ (setq num (1+ num))
+ (when (eq w (selected-window))
+ (setq sel-num num)))
+ (let ((ret (list sel-num
+ (winsav-get-window-tree-1 frame nil))))
+ (run-hook-with-args 'winsav-after-get-hook ret)
+ ret)))
+
+;; Fix-me: add window-hscroll
+(defun winsav-get-window-tree-1(frame w)
+ (let ((tree (if w w (car (window-tree frame)))))
+ (if (windowp tree)
+ ;; Note: Desktop is used for saving buffers.
+ (with-current-buffer (window-buffer tree)
+ (list (window-buffer tree)
+ ;; buffer
+ (buffer-name)
+ (buffer-file-name)
+ ;;buffer-read-only
+ ;;(if mumamo-multi-major-mode mumamo-multi-major-mode major-mode)
+ ;;minor-modes
+ ;;buffer locals
+ ;;(cons (+ 0 (mark-marker)) (mark-active))
+ ;; window
+ (window-point tree)
+ (window-edges tree)
+ (window-scroll-bars tree)
+ (window-fringes tree)
+ (window-margins tree)
+ (window-hscroll tree)
+ ;; misc
+ (window-dedicated-p tree)
+ (when (fboundp 'window-redisplay-end-trigger)
+ (window-redisplay-end-trigger tree))
+ (window-start tree)
+ tree))
+ (let* ((dir (nth 0 tree))
+ (split (nth 1 tree))
+ (wt (cddr tree))
+ (wsubs (mapcar (lambda(wc)
+ (winsav-get-window-tree-1 nil wc))
+ wt)))
+ (append (list dir split) wsubs)))))
+
+;;;###autoload
+(defun winsav-put-window-tree (saved-tree window &optional copy-win-ovl win-ovl-all-bufs)
+ "Put window structure SAVED-TREE into WINDOW.
+Restore a structure SAVED-TREE returned from
+`winsav-get-window-tree' into window WINDOW.
+
+If COPY-WIN-OVL is non-nil then overlays having a 'window
+property pointing to one of the windows in SAVED-TREE where this
+window still is shown will be copied to a new overlay with
+'window property pointing to the corresponding new window.
+
+If WIN-OVL-ALL-BUFS is non-nil then all buffers will be searched
+for overlays with a 'window property of the kind above.
+
+At the very end of this function the hook `winsav-after-put' is
+run."
+ (let* ((sel-num (nth 0 saved-tree))
+ (tree (nth 1 saved-tree))
+ nsiz
+ nh
+ nw
+ osiz
+ oh
+ ow
+ scale-w
+ scale-h
+ first-win
+ winsav-put-return)
+ (unless (or (bufferp (car tree))
+ (eq 'buffer (car tree)))
+ (setq nsiz (window-edges window))
+ (setq nh (- (nth 3 nsiz) (nth 1 nsiz)))
+ (setq nw (- (nth 2 nsiz) (nth 0 nsiz)))
+ (setq osiz (cadr tree))
+ (setq oh (- (nth 3 osiz) (nth 1 osiz)))
+ (setq ow (- (nth 2 osiz) (nth 0 osiz)))
+ (setq scale-w (unless (= ow nw) (/ nw (float ow))))
+ (setq scale-h (unless (= oh nh) (/ nh (float oh)))))
+ (setq first-win (winsav-put-window-tree-1 tree window scale-w scale-h t 1))
+ (select-window first-win)
+ (when sel-num (other-window sel-num))
+ (winsav-fix-win-ovl winsav-put-return copy-win-ovl win-ovl-all-bufs)
+ (run-hook-with-args 'winsav-after-put-hook winsav-put-return)
+ winsav-put-return))
+
+(defun winsav-put-window-tree-1 (saved-tree window scale-w scale-h first-call level)
+ "Helper for `winsav-put-window-tree'.
+For the arguments SAVED-TREE and WINDOW see that function.
+
+The arguments SCALE-W and SCALE-H are used to make the saved
+window config fit into its new place. FIRST-CALL is a state
+variable telling if this is the first round. LEVEL helps
+debugging by tells how far down we are in the call chain."
+ (if (or (bufferp (car saved-tree))
+ ;;(not (car saved-tree))
+ (eq 'buffer (car saved-tree))
+ )
+ (let ((buffer (nth 0 saved-tree))
+ ;; buffer
+ (bufnam (nth 1 saved-tree))
+ (filnam (nth 2 saved-tree))
+ ;;(mark (nth 3 saved-tree))
+ ;; window
+ (point (nth 3 saved-tree))
+ (edges (nth 4 saved-tree))
+ (scroll (nth 5 saved-tree))
+ (fringe (nth 6 saved-tree))
+ (margs (nth 7 saved-tree))
+ (hscroll (nth 8 saved-tree))
+ (dedic (nth 9 saved-tree))
+ (trigger (nth 10 saved-tree))
+ (start (nth 11 saved-tree))
+ (ovlwin (nth 12 saved-tree))
+ scr2
+ (misbuf " *Winsav information: Buffer is gone*"))
+ (or (windowp ovlwin)
+ (not ovlwin)
+ (error "Parameter mismatch, ovlwin not window: %s" ovlwin))
+ (when first-call
+ (add-to-list 'winsav-put-return (list ovlwin window))
+ (when (eq 'buffer buffer)
+ (when filnam
+ (setq buffer (winsav-find-file-noselect filnam)))
+ (if (buffer-live-p buffer)
+ (or (string= bufnam (buffer-name buffer))
+ (eq (string-to-char bufnam) 32) ;; Avoid system buffer names
+ (rename-buffer bufnam))
+ (when (eq (string-to-char bufnam) 32)
+ (setq bufnam " *Winsav dummy buffer*"))
+ ;; Fix-me, this might need some tweaking: Don't restore
+ ;; buffers without a file name and without
+ ;; content. (desktop-mode will make that when
+ ;; necessary.) Just show the scratch buffer instead.
+ (setq buffer (get-buffer bufnam))
+ (unless (and buffer
+ (< 0 (buffer-size buffer)))
+ (setq buffer (get-buffer-create "*scratch*")))))
+ (set-window-buffer window buffer)
+ (set-window-dedicated-p window dedic)
+ ;; Strange incompatibility in scroll args:
+ (setq scr2 (list (nth 0 scroll) (nth 2 scroll) (nth 3 scroll)))
+ (apply 'set-window-scroll-bars (append (list window) scr2))
+ (apply 'set-window-fringes (append (list window) fringe))
+ (set-window-margins window (car margs) (cdr margs))
+ (set-window-hscroll window hscroll)
+ (unless (>= emacs-major-version 23)
+ (with-no-warnings
+ (set-window-redisplay-end-trigger window trigger))))
+ (let* ((nsiz (window-edges window))
+ (nh (- (nth 3 nsiz) (nth 1 nsiz)))
+ (nw (- (nth 2 nsiz) (nth 0 nsiz)))
+ (osiz edges) ;(nth 2 saved-tree))
+ (oh (- (nth 3 osiz) (nth 1 osiz)))
+ (ow (- (nth 2 osiz) (nth 0 osiz)))
+ (diff-w (- (if scale-w
+ (round (* scale-w ow))
+ ow)
+ nw))
+ (diff-h (- (if scale-h
+ (round (* scale-h oh))
+ oh)
+ nh)))
+ ;; Avoid rounding naggings:
+ (when (> (abs diff-h) 1)
+ (bw-adjust-window window diff-h nil))
+ (when (> (abs diff-w) 1)
+ (bw-adjust-window window diff-w t)))
+ ;; Fix-me: there were some problems getting point correctly. Don't know why...
+ (with-selected-window window
+ (with-current-buffer (window-buffer window)
+ (goto-char point))
+ (set-window-point window point)
+ ;;(unless (buffer-live-p buffer) (setq point 1) (setq start 1))
+ (set-window-start window start)
+ ;; Maybe point got off screen?
+ (when (/= point (window-point window))
+ (set-window-point window point)))
+ window)
+ (let* ((ver (car saved-tree))
+ (wtree (list (cons window (caddr saved-tree))))
+ (nwin window)
+ pwin
+ pdelta
+ (first-win nwin))
+ ;; First split to get it in correct order
+ (when first-call
+ (dolist (subtree (cdddr saved-tree))
+ (setq pwin nwin)
+ ;;(message "nwin edges=%s, ver=%s" (window-edges nwin) ver)
+ (let ((split-err nil)
+ (window-min-height 1)
+ (window-min-width 1))
+ (setq nwin (split-window nwin nil (not ver))))
+ ;; Make the previous window as small as permitted to allow
+ ;; splitting as many times as possible
+ (setq pdelta (-
+ (if ver
+ window-min-height
+ window-min-width)
+ (if ver
+ (window-width pwin)
+ (window-height pwin))))
+ ;;(message "pwin=%s, edges=%s, pdelta=%s, ver=%s" pwin (window-edges pwin) pdelta ver)
+ ;; No reason to fail here:
+ (condition-case err
+ (adjust-window-trailing-edge pwin pdelta (not ver))
+ (error
+ ;;(message "awt=>%s" (error-message-string err))
+ nil
+ ))
+ ;; Add to traverse
+ (add-to-list 'wtree
+ (cons nwin subtree)
+ t)))
+ ;; Now traverse. Sizing is a bit tricky, multiple runs have to
+ ;; be done (as in balance-windows).
+ (let (tried-sizes
+ last-sizes
+ (windows (window-list (selected-frame))))
+ (while (not (member last-sizes tried-sizes))
+ (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
+ (setq last-sizes (mapcar (lambda (w)
+ (window-edges w))
+ windows))
+ (dolist (wsub (reverse wtree))
+ (select-window (car wsub))
+ (winsav-put-window-tree-1 (cdr wsub) (selected-window)
+ scale-w scale-h
+ first-call
+ (1+ level)
+ ))
+ (setq first-call nil)
+ ))
+ first-win)))
+
+(defun winsav-fix-win-ovl(win-list copy-win-ovl win-ovl-all-bufs)
+ (let ((oldwins (mapcar (lambda(elt)
+ (car elt))
+ win-list))
+ ovlwin
+ window)
+ (let (buffers)
+ (if win-ovl-all-bufs
+ (setq buffers (buffer-list))
+ (mapc (lambda(w)
+ (when (window-live-p w)
+ (add-to-list 'buffers (window-buffer w))))
+ oldwins))
+ (dolist (buf buffers)
+ (with-current-buffer buf
+ (save-restriction
+ (widen)
+ (dolist (overlay (overlays-in (point-min) (point-max)))
+ (when (setq ovlwin (car (memq (overlay-get overlay 'window) oldwins)))
+ (setq window (cadr (assoc ovlwin win-list)))
+ ;; If the old window is still alive then maybe copy
+ ;; overlay, otherwise change the 'window prop. However
+ ;; copy only if COPY-WIN-OVL is non-nil.
+ (if (not (and (window-live-p ovlwin)
+ (window-frame ovlwin)))
+ (overlay-put overlay 'window window)
+ (when copy-win-ovl
+ (let* ((props (overlay-properties overlay))
+ (start (overlay-start overlay))
+ (end (overlay-end overlay))
+ ;; Fix-me: start and end marker props
+ (newovl (make-overlay start end)))
+ (while props
+ (let ((key (car props))
+ (val (cadr props)))
+ (setq props (cddr props))
+ (when (eq key 'window)
+ (setq val window))
+ (overlay-put newovl key val))))))))))))))
+
+
+
+(defun winsav-transform-edges (edges)
+ "Just rotate the arguments in EDGES to make them fit next function."
+ (let ((le (nth 0 edges))
+ (te (nth 1 edges))
+ (re (nth 2 edges))
+ (be (nth 3 edges)))
+ (list te le be re)))
+
+(defun winsav-transform-1 (tree mirror transpose)
+ "Mirroring of the window tree TREE.
+MIRROR could be 'mirror-top-bottom or 'mirror-left-right which I
+think explain what it does here. TRANSPOSE shifts the tree
+between a horisontal and vertical tree."
+ (let* ((vertical (nth 0 tree))
+ (edges (nth 1 tree))
+ (subtrees (nthcdr 2 tree))
+ )
+ ;;(winsav-log "tree 1" tree)
+ (when transpose
+ (cond
+ ((eq vertical nil)
+ (setcar tree t))
+ ((eq vertical t)
+ (setcar tree nil))
+ (t
+ (error "Uh? vertical=%S" vertical))))
+ (setcar (nthcdr 1 tree) (winsav-transform-edges edges))
+ (dolist (subtree subtrees)
+ (if (bufferp (car subtree))
+ (when transpose
+ (let ((edges (nth 4 subtree)))
+ ;;(winsav-log "subtree 1" subtree)
+ (setcar (nthcdr 4 subtree) (winsav-transform-edges edges))
+ ;;(winsav-log "subtree 2" subtree)
+ ))
+ (winsav-transform-1 subtree mirror transpose)))
+ (when (case mirror
+ ('mirror-top-bottom vertical)
+ ('mirror-left-right (not vertical))
+ (nil) ;; Don't mirror
+ (t
+ (error "Uh? mirror=%s" mirror)))
+ (setcdr (nthcdr 1 tree) (reverse subtrees))
+ )
+ ))
+
+(defun winsav-find-file-noselect (filename)
+ "Read file FILENAME into a buffer and return the buffer.
+Like `find-file-noselect', but if file is not find then creates a
+buffer with a message about that."
+ (let ((buf (find-file-noselect filename)))
+ (unless buf
+ (setq buf (generate-new-buffer filename))
+ (with-current-buffer buf
+ (insert "Winsav could not find the file " filename)
+ (set-buffer-modified-p nil)))
+ buf))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Session saving and restore etc
+
+;;;###autoload
+(defgroup winsav nil
+ "Save frames and windows when you exit Emacs."
+ :group 'frames)
+
+;;;###autoload
+(define-minor-mode winsav-save-mode
+ "Toggle winsav configuration saving mode.
+With numeric ARG, turn winsav saving on if ARG is positive, off
+otherwise.
+
+When this mode is turned on, winsav configurations are saved from
+one session to another. A winsav configuration consists of
+frames, windows and visible buffers configurations plus
+optionally buffers and files managed by the functions used by
+option `desktop-save-mode'
+
+By default this is integrated with `desktop-save-mode'. If
+`desktop-save-mode' is on and `winsav-handle-also-desktop' is
+non-nil then save and restore also desktop.
+
+See the command `winsav-switch-config' for more information and
+other possibilities.
+
+Note: If you want to avoid saving when you exit just turn off
+this minor mode.
+
+For information about what is saved and restored and how to save
+and restore additional information see the function
+`winsav-save-configuration'."
+ :global t
+ :group 'winsav)
+
+(defun winsav-save-mode-on ()
+ "Ensable option `winsav-save-mode'. Provided for use in hooks."
+ (winsav-save-mode 1))
+
+(defun winsav-save-mode-off ()
+ "Disable option `winsav-save-mode'. Provided for use in hooks."
+ (winsav-save-mode -1))
+
+(defcustom winsav-save 'ask-if-new
+ "Specifies whether the winsav config should be saved when it is killed.
+A winsav config \(winsav frame configuration) is killed when the
+user changes winsav directory or quits Emacs.
+
+Possible values are:
+ t -- always save.
+ ask -- always ask.
+ ask-if-new -- ask if no winsav file exists, otherwise just save.
+ ask-if-exists -- ask if winsav file exists, otherwise don't save.
+ if-exists -- save if winsav file exists, otherwise don't save.
+ nil -- never save.
+The winsav config is never saved when the option `winsav-save-mode' is nil.
+The variables `winsav-dirname' and `winsav-base-file-name'
+determine where the winsav config is saved."
+ :type
+ '(choice
+ (const :tag "Always save" t)
+ (const :tag "Always ask" ask)
+ (const :tag "Ask if winsav file is new, else do save" ask-if-new)
+ (const :tag "Ask if winsav file exists, else don't save" ask-if-exists)
+ (const :tag "Save if winsav file exists, else don't" if-exists)
+ (const :tag "Never save" nil))
+ :group 'winsav)
+
+(defcustom winsav-handle-also-desktop t
+ "If this is non-nil then desktop is also saved and restored.
+See option `winsav-save-mode' for more information."
+ :type 'boolean
+ :group 'winsav)
+
+(defcustom winsav-base-file-name
+ (convert-standard-filename ".emacs.winsav")
+ "Base name of file for Emacs winsav, excluding directory part.
+The actual file name will have a system identifier added too."
+ :type 'file
+ :group 'winsav)
+
+(defvar winsav-dirname nil
+ "The directory in which the winsav file should be saved.")
+
+(defun winsav-current-default-dir ()
+ "Current winsav configuration directory."
+ (or winsav-dirname "~/"))
+
+;;(find-file (winsav-full-file-name))
+(defun winsav-default-file-name ()
+ "Default winsav save file name.
+The file name consist of `winsav-base-file-name' with a system
+identifier added. This will be '-nw' for a terminal and '-' +
+the value of `window-system' otherwise."
+ (let ((sys-id (if (not window-system)
+ "nw"
+ (format "%s" window-system))))
+ (concat winsav-base-file-name "-" sys-id)))
+
+(defun winsav-full-file-name (&optional dirname)
+ "Return the full name of the winsav session file in DIRNAME.
+DIRNAME omitted or nil means use `~'.
+
+The file name part is given by `winsav-default-file-name'."
+ ;; Fix-me: Different frames in different files? Can multi-tty be handled??
+ (expand-file-name (winsav-default-file-name) (or dirname
+ (winsav-current-default-dir))))
+
+
+
+(defun winsav-serialize (obj)
+ "Return a string with the printed representation of OBJ.
+This should be possible to eval and get a similar object like OBJ
+again."
+ ;;(message "winsav-serialize a")
+ (prin1-to-string obj)
+ ;;(message "winsav-serialize b")
+ )
+
+(defcustom winsav-before-save-configuration-hook nil
+ "Hook called before saving frames.
+Hook for writing elisp code at the beginning of a winsav
+configuration file. When this hook is called the current buffer
+and point is where the code should be written.
+
+This is a normal hook. For more information see
+`winsav-save-configuration'."
+ :type 'hook
+ :group 'winsav)
+
+(defcustom winsav-after-save-configuration-hook nil
+ "Hook called after saving frames.
+Hook for writing elisp code at the end of a winsav configuration
+file. When this hook is called the current buffer and point is
+where the code should be written.
+
+This is a normal hook. For more information see
+`winsav-save-configuration'."
+ :type 'hook
+ :group 'winsav)
+
+(defcustom winsav-after-save-frame-hook nil
+ "Hook called when saving a frame after saving frame data.
+Hook for writing elisp code in a winsav configuration file after
+each frame creation. When this hook is called code for restoring
+a frame has been written and code that sets
+`winsav-last-loaded-frame' to point to it. Point is in the
+configuration file buffer right after this.
+
+This is a normal hook. For more information see
+`winsav-save-configuration'."
+ :type 'hook
+ :group 'winsav)
+
+(defvar winsav-loaded-frames nil)
+(defvar winsav-last-loaded-frame nil)
+
+(defun winsav-restore-frame (frame-params
+ window-tree-params
+ use-minibuffer-frame
+ window-state
+ window-visible)
+ "Restore a frame with specified values.
+If this is a minibuffer only frame then just apply the frame
+parameters FRAME-PARAMS. Otherwise create a new frame using
+FRAME-PARAMS and set up windows and buffers according to
+WINDOW-TREE-PARAMS. Also, if USE-MINIBUFFER-FRAME let the new
+frame have this minibuffer frame.
+
+WINDOW-STATE is 1 for minimized, 2 for normal and 3 for
+maximized."
+ (let* ((default-minibuffer-frame use-minibuffer-frame)
+ (frame-name (cdr (assoc 'name frame-params)))
+ (minibuffer-val (cdr (assoc 'minibuffer frame-params)))
+ (minibuffer-only (eq 'only minibuffer-val))
+ (mini-frames
+ (delq nil (mapcar (lambda (frm)
+ (when (eq 'only (frame-parameter frm 'minibuffer))
+ frm))
+ (frame-list))))
+ (frame-with-that-name
+ (when (and frame-name minibuffer-only)
+ (catch 'frame
+ (dolist (frame (frame-list))
+ (when (string= frame-name (frame-parameter frame 'name))
+ (throw 'frame frame))))))
+ ;; If this is a minibuffer only frame then if it is already
+ ;; there under a correct name then do not create it because
+ ;; there might be variables pointing to it; just set the
+ ;; parameters. Perhaps even better: if it is not already
+ ;; there give an error - because it might be impossible to
+ ;; set things up correctly then.
+ (frame-with-that-name-has-mini
+ (when frame-with-that-name
+ (eq 'only
+ (frame-parameter frame-with-that-name 'minibuffer))))
+ (this-mini-frame (when minibuffer-only
+ (or frame-with-that-name
+ (and (= 1 (length mini-frames))
+ (car mini-frames)))))
+ (create-new
+ (if minibuffer-only
+ (if this-mini-frame ;frame-with-that-name-has-mini
+ nil
+ (error "Winsav: Can't find minibuffer only frame with name %s"
+ frame-name))
+ t))
+ (this-frame (if create-new
+ (make-frame frame-params)
+ this-mini-frame))
+ (win (frame-first-window this-frame)))
+ ;;(message "create-new=%s, frame-with-that-name=%s" create-new frame-with-that-name)
+ ;; (when was-max
+ ;; (winsav-set-maximized-size this-frame)
+ ;; ;; Wait for maximize to occur so horizontal scrolling gets ok.
+ ;; (sit-for 1.5)
+ ;; )
+ (case window-state
+ (1 (winsav-set-minimized-state this-frame))
+ (3 (winsav-set-maximized-state this-frame)))
+ (unless window-visible
+ (make-frame-invisible this-frame))
+ (if create-new
+ (winsav-put-window-tree window-tree-params win)
+ (modify-frame-parameters this-frame frame-params))
+ (setq winsav-last-loaded-frame this-frame)
+ (setq winsav-loaded-frames (cons this-frame winsav-loaded-frames))
+ ))
+
+(defcustom winsav-frame-parameters-to-save
+ '(
+ ;;explicit-name
+ ;;name
+ ;;parent-id
+ ;;title
+ alpha
+ auto-lower
+ auto-raise
+ background-color
+ background-mode
+ border-color
+ border-width
+ buffer-predicate
+ cursor-color
+ cursor-type
+ font
+ font-backend
+ foreground-color
+ fullscreen
+ icon-name
+ icon-type
+ icon-left
+ icon-top
+ internal-border-width
+ left-fringe
+ line-spacing
+ menu-bar-lines
+ modeline
+ mouse-color
+ right-fringe
+ screen-gamma
+ scroll-bar-width
+ tool-bar-lines
+ top left width height
+ tty-color-mode ;; ??
+ unsplittable
+ user-position
+ user-size
+ vertical-scroll-bars
+ visibility
+ )
+ "Parameters saved for frames by `winsav-save-configuration'.
+Parameters are those returned by `frame-parameters'."
+ :type '(repeat (symbol :tag "Frame parameter"))
+ :group 'winsav)
+
+(defun frame-visible-really-p (frame)
+ "Return t if FRAME is visible.
+This tries to be more corrent on w32 than `frame-visible-p'."
+ (cond ((fboundp 'w32-frame-placement)
+ (< 0 (nth 4 (w32-frame-placement frame))))
+ (t
+ (frame-visible-p frame))))
+
+(defun frame-maximized-p (frame)
+ "Return t if it is known that frame is maximized."
+ (cond ((fboundp 'w32-frame-placement)
+ (= 3 (abs (nth 4 (w32-frame-placement frame)))))
+ (t nil)))
+
+(defun frame-minimized-p (frame)
+ "Return t if it is known that frame is minimized."
+ (cond ((fboundp 'w32-frame-placement)
+ (= 3 (abs (nth 4 (w32-frame-placement frame)))))
+ (t nil)))
+
+;;(winsav-set-restore-size nil)
+;; (defun winsav-set-restore-size (frame)
+;; (when (fboundp 'w32-send-sys-command)
+;; (let ((cur-frm (selected-frame)))
+;; (select-frame-set-input-focus frame)
+;; (w32-send-sys-command #xf120)
+;; ;; Note: sit-for must be used, not sleep-for. Using the latter
+;; ;; prevents the fetching of the new size (for some reason I do not
+;; ;; understand).
+;; (sit-for 1.5)
+;; (select-frame-set-input-focus cur-frm))
+;; t))
+
+(defun winsav-set-maximized-state (frame)
+ (when (fboundp 'w32-send-sys-command)
+ (select-frame-set-input-focus frame)
+ (w32-send-sys-command #xf030)
+ (sit-for 1.0)
+ t))
+
+(defun winsav-set-minimized-state (frame)
+ (when (fboundp 'w32-send-sys-command)
+ (select-frame-set-input-focus frame)
+ (w32-send-sys-command #xf020)
+ (sit-for 1.0)
+ t))
+
+(defun winsav-save-frame (frame mb-frm-nr buffer)
+ "Write into buffer BUFFER elisp code to recreate frame FRAME.
+If MB-FRM-NR is a number then it is the order number of the frame
+whose minibuffer should be used."
+ (message "winsav-save-frame buffer=%s" buffer)
+ (message "winsav-save-frame buffer 2=%s" (current-buffer))
+ (let* ((start nil)
+ (end nil)
+ (obj (winsav-get-window-tree frame))
+ (dummy (message "winsav-save-frame buffer 3=%s" (current-buffer)))
+ (frm-size-now (cons (frame-pixel-height frame)
+ (frame-pixel-width frame)))
+ (dummy (message "winsav-save-frame buffer 4=%s" (current-buffer)))
+ (placement (when (fboundp 'w32-frame-placement) (w32-frame-placement frame)))
+ ;; (was-max (and frm-size-rst
+ ;; (not (equal frm-size-now frm-size-rst))))
+ (window-state (abs (nth 4 placement)))
+ ;; (frm-size-rst (when (winsav-set-restore-size frame)
+ ;; (cons (frame-pixel-height frame)
+ ;; (frame-pixel-width frame))))
+ ;;(frm-size-rst (when was-max))
+ ;;(frm-size-rst (when (= 3 (abs (nth 4 placement)))))
+ (dummy (message "winsav-save-frame buffer 5=%s" (current-buffer)))
+ (frm-par (frame-parameters frame))
+ (dummy (message "winsav-save-frame buffer 6=%s" (current-buffer)))
+ )
+ (message "winsav-save-frame a1 cb=%s" (current-buffer))
+ (with-current-buffer buffer
+ ;;(y-or-n-p (format "was-max=%s" was-max))
+ (message "winsav-save-frame a2 cb=%s" (current-buffer))
+ (setq frm-par
+ (delq nil
+ (mapcar (lambda (elt)
+ (cond
+ ((memq (car elt) winsav-frame-parameters-to-save)
+ elt)
+ ((eq (car elt) 'minibuffer)
+ (let ((val (cdr elt)))
+ (if (not (windowp val))
+ elt
+ (if (eq (window-frame val) frame)
+ nil
+ (cons 'minibuffer nil)))))))
+ frm-par)))
+ (message "winsav-save-frame b cb=%s" (current-buffer))
+ (insert "(winsav-restore-frame\n'"
+ ;;make-frame-params
+ (winsav-serialize frm-par))
+ (message "winsav-save-frame b.0.1")
+ ;;window-tree-params
+ (setq start (point))
+ (insert "'" (winsav-serialize obj) "\n")
+ (message "winsav-save-frame b.0.2")
+ (setq end (copy-marker (point) t))
+ (message "winsav-save-frame b.0.3")
+ (message "winsav-save-frame b.1")
+ ;; (replace-regexp (rx "#<buffer "
+ ;; (1+ (not (any ">")))
+ ;; (1+ ">")) ;; 1+ for indirect buffers ...
+ ;; "buffer"
+ ;; nil start end)
+ (goto-char start)
+ (while (re-search-forward (rx "#<buffer "
+ (1+ (not (any ">")))
+ (1+ ">")) ;; 1+ for indirect buffers ...
+ end t)
+ (replace-match "buffer" nil t))
+ (message "winsav-save-frame b.2")
+ ;; (replace-regexp (rx "#<window "
+ ;; (1+ (not (any ">")))
+ ;; (1+ ">"))
+ ;; "nil"
+ ;; nil start end)
+ (goto-char start)
+ (while (re-search-forward (rx "#<window "
+ (1+ (not (any ">")))
+ (1+ ">")) ;; 1+ for indirect buffers ...
+ end t)
+ (replace-match "nil" nil t))
+ (message "winsav-save-frame c")
+ (goto-char end)
+ ;;use-minibuffer-frame
+ (insert (if mb-frm-nr
+ (format "(nth %s (reverse winsav-loaded-frames))" mb-frm-nr)
+ "nil")
+ (format " %s" window-state)
+ (if (frame-visible-really-p frame) " t " " nil ")
+ ")\n\n")
+
+ (insert " ;; ---- before after-save-frame-hook ----\n")
+ ;; (dolist (fun winsav-after-save-frame-hook)
+ ;; (funcall fun frame (current-buffer)))
+ (run-hooks winsav-after-save-frame-hook)
+ (message "winsav-save-frame d")
+ (insert " ;; ---- after after-save-frame-hook ----\n")
+
+ ;;(insert " )\n\n\n")
+ )))
+
+(defvar winsav-file-version "1"
+ "Version number of winsav file format.
+Written into the winsav file and used at winsav read to provide
+backward compatibility.")
+
+
+;; fix-me: This should be in desktop.el
+;; Fix-me: incomplete, not ready.
+(defun winsav-restore-indirect-file-buffer (file name)
+ "Make indirect buffer from file buffer visiting file FILE.
+Give it the name NAME."
+ (let* ((fbuf (find-file-noselect file)))
+ (when fbuf
+ (make-indirect-buffer fbuf name))))
+
+(defun winsav-save-indirect-buffers (to-buffer)
+ "Save information about indirect buffers.
+Only file visiting buffers currently. Clone the base buffers."
+ (with-current-buffer to-buffer
+ (dolist (buf (buffer-list))
+ (when (buffer-base-buffer buf)
+ (let* ((base-buf (buffer-base-buffer buf))
+ (file (buffer-file-name base-buf)))
+ (when file
+ (insert "(winsav-restore-indirect-file-buffer \""
+ file "\" \"" (buffer-name buf) "\")\n")))))))
+
+;; Fix-me: test
+;; (defun winsav-restore-minibuffer (frame-num frm-num win-num)
+;; (let* ((frame (nth (1- frame-num) winsav-loaded-frames))
+;; (mini-frm (nth (1- frm-num) winsav-loaded-frames))
+;; (mini-win (nth (1- win-num) (reverse (window-list mini-frm))))
+;; )
+;; (with-selected-frame frame
+;; (set-minibuffer-window mini-win))))
+
+(defvar winsav-minibuffer-alist nil)
+(defun winsav-save-minibuffers (sorted-frames to-buffer)
+ "Save information about minibuffer frames.
+SORTED-FRAMES should be a list of all frames sorted using
+`winsav-frame-sort-predicate'."
+ (with-current-buffer to-buffer
+ (setq winsav-minibuffer-alist nil)
+ (dolist (frame sorted-frames)
+ (let* ((num-frames (length sorted-frames))
+ (mini-win (minibuffer-window frame))
+ (mini-frm (window-frame mini-win))
+ (win-num (length
+ (memq mini-win
+ (window-list mini-frm t (frame-first-window mini-frm)))))
+ (frm-num (- num-frames (length (memq mini-frm sorted-frames))))
+ (frame-num (- num-frames (length (memq frame sorted-frames)))))
+ (unless (and (eq mini-frm frame)
+ (= win-num 1))
+ ;; Not the normal minibuffer window
+ ;;(insert (format ";;(winsav-restore-minibuffer %s %s %s)\n"
+ ;;(insert (format "'(%s %s)\n" frame-num frm-num)
+ (setq winsav-minibuffer-alist (cons (list frame-num frm-num) winsav-minibuffer-alist))
+ )))
+ (insert "(setq winsav-minibuffer-alist '"
+ (winsav-serialize winsav-minibuffer-alist)
+ ")\n")))
+
+(defun winsav-restore-dedicated-window (frame-num win-num dedicate-flag)
+ "Set dedicated window flag.
+On frame number FRAME-NUM in `winsav-loaded-frames' set the
+dedicated flag on window number WIN-NUM to DEDICATE-FLAG."
+ (let* ((frame (nth (1- frame-num) winsav-loaded-frames))
+ (win (nth (1- win-num) (reverse (window-list frame t
+ (frame-first-window frame))))))
+ (set-window-dedicated-p win dedicate-flag)))
+
+(defun winsav-save-dedicated-windows (sorted-frames)
+ "Save information about dedicated windows on frames in SORTED-FRAMES.
+Write this to current buffer."
+ (dolist (frame sorted-frames)
+ (dolist (win (window-list frame))
+ (when (window-dedicated-p win)
+ (let ((frame-num (length (memq frame sorted-frames)))
+ (win-num (length
+ (memq win
+ (window-list frame t (frame-first-window frame)))))
+ (flag (window-dedicated-p win)))
+ (insert (format "(winsav-restore-dedicated-window %s %s %S)\n" frame-num win-num flag))
+ )))))
+
+(defun winsav-restore-ecb (frame-num layout-ecb)
+ "Restore ECB.
+On frame number FRAME-NUM-ECB in `winsav-loaded-frames' restore
+ECB layout LAYOUT-ECB."
+ (when (boundp 'ecb-minor-mode)
+ (let* ((frame (nth (1- frame-num) winsav-loaded-frames)))
+ (select-frame frame)
+ (unless (string= layout-ecb ecb-layout-name)
+ (setq ecb-layout-name layout-ecb))
+ (ecb-minor-mode 1))))
+
+(defun winsav-save-ecb (frame-ecb layout-ecb sorted-frames)
+ "Save information about ECB layout on frames in SORTED-FRAMES.
+Write this in current buffer."
+ (dolist (frame sorted-frames)
+ (when (eq frame frame-ecb)
+ (let ((frame-num (length (memq frame sorted-frames))))
+ (insert (format "(winsav-restore-ecb %s %S)\n" frame-num layout-ecb))))))
+
+;; (make-frame '((minibuffer)))
+;; (sort (frame-list) 'winsav-frame-sort-predicate)
+(defun winsav-frame-sort-predicate (a b)
+ "Compare frame A and B for sorting.
+Sort in the order frames can be created.
+
+- Frames without minibuffers will come later since the need to
+ refer to the minibuffer frame when they are created.
+
+- Invisible frames comes last since there must be at least one
+ visible frame from the beginning."
+ (let* ((a-mbw (minibuffer-window a))
+ (a-mbw-frm (window-frame a-mbw))
+ (b-mbw (minibuffer-window b))
+ (b-mbw-frm (window-frame b-mbw))
+ (a-visible (frame-visible-really-p a))
+ (b-visible (frame-visible-really-p b))
+ )
+ ;;(message "a-mbw-frm=%s, b=%s" a-mbw-frm b)
+ ;;(message "b-mbw-frm=%s, a=%s" a-mbw-frm b)
+ (when (or (not b-visible)
+ (eq a-mbw-frm b)
+ (not (eq b-mbw-frm b)))
+ ;;(message "a > b")
+ t
+ )))
+
+(defun winsav-can-read-config (config-version)
+ "Return t we can read config file version CONFIG-VERSION."
+ (when (<= config-version 1)
+ t))
+
+(defvar winsav-file-modtime nil)
+
+;; Like desktop-save, fix-me
+(defun winsav-save-configuration (&optional dirname release)
+ "Write elisp code to recreate all frames.
+Write into the file name computed by `winsav-full-file-name'
+given the argument DIRNAME.
+
+The information that is saved for each frame is its size and
+position, the window configuration including buffers and the
+parameters in `winsav-frame-parameters-to-save'. If you want save
+more information for frames you can do that in the hook
+`winsav-after-save-frame-hook'.
+
+See also the hook variables
+`winsav-before-save-configuration-hook' and
+`winsav-after-save-configuration-hook'.
+
+Fix-me: RELEASE is not implemented."
+ (winsav-save-config-to-file (winsav-full-file-name dirname)))
+
+(defun winsav-save-config-to-file (conf-file)
+ "Write elisp code to recreate all frames to CONF-FILE."
+ (let (start
+ end
+ (sorted-frames (sort (frame-list) 'winsav-frame-sort-predicate))
+ (frm-nr 0)
+ frame-ecb
+ layout-ecb)
+ ;; Recreating invisible frames hits Emacs bug 3859
+ (setq sorted-frames
+ (delq nil
+ (mapcar (lambda (f)
+ (when (frame-parameter f 'visibility) f))
+ sorted-frames)))
+ (when (and (boundp 'ecb-minor-mode) ecb-minor-mode)
+ (when (frame-live-p ecb-frame)
+ (setq layout-ecb ecb-layout-name)
+ (setq frame-ecb ecb-frame))
+ (ecb-minor-mode -1)
+ (sit-for 0) ;; Fix-me: is this needed?
+ )
+ (message "winsav-save-config:here a")
+ (with-temp-buffer
+ (let ((this-buffer (current-buffer)))
+ (message "winsav-save-config:here b")
+ ;;(erase-buffer)
+ (insert
+ ";; -*- mode: emacs-lisp; coding: utf-8; -*-\n"
+ ";; --------------------------------------------------------------------------\n"
+ ";; Winsav File for Emacs\n"
+ ";; --------------------------------------------------------------------------\n"
+ ";; Created " (current-time-string) "\n"
+ ";; Winsav file format version " winsav-file-version "\n"
+ ";; Emacs version " emacs-version "\n\n"
+ "(if (not (winsav-can-read-config " winsav-file-version "))\n\n"
+ " (message \"Winsav: Can't read config file with version " winsav-file-version "\")\n")
+ (message "winsav-save-config:here c")
+ (insert ";; ---- indirect buffers ------------------------\n")
+ (winsav-save-indirect-buffers this-buffer)
+ (message "winsav-save-config:here c.1")
+ ;;(insert ";; ---- special minibuffers ------------------------\n")
+ (winsav-save-minibuffers sorted-frames this-buffer)
+ (message "winsav-save-config:here c.2")
+ (insert "(setq winsav-loaded-frames nil)\n")
+ (insert ";; ---- before winsav-before-save-configuration-hook ------------------------\n")
+ (run-hooks 'winsav-before-save-configuration-hook)
+ (message "winsav-save-config:here c.2a cb=%s" (current-buffer))
+ (insert ";; ---- after winsav-before-save-configuration-hook ------------------------\n\n")
+ (dolist (frm sorted-frames)
+ (let ((mb-frm-nr (cadr (assoc frm-nr winsav-minibuffer-alist)))
+ ;;(mb-frm (when mb-frm-nr (nth mb-frm-nr sorted-frames)))
+ )
+ (message "winsav-save-config:here c.2b.1 tb=%s cb=%s frm=%s" this-buffer (current-buffer) frm)
+ (winsav-save-frame frm mb-frm-nr this-buffer)
+ (message "winsav-save-config:here c.2b.2")
+ (setq frm-nr (1+ frm-nr))))
+ (message "winsav-save-config:here c.2c cb=%s" (current-buffer))
+ (insert ";; ---- dedicated windows ------------------------\n")
+ (winsav-save-dedicated-windows sorted-frames)
+ (message "winsav-save-config:here c.3")
+ (insert ";; ---- ECB --------------------------------------\n")
+ (winsav-save-ecb frame-ecb layout-ecb sorted-frames)
+ (message "winsav-save-config:here c.4")
+ (insert "\n\n;; ---- before winsav-after-save-configuration-hook ------------------------\n")
+ (run-hooks 'winsav-after-save-configuration-hook)
+ (message "winsav-save-config:here c.5")
+ (insert "\n\n;; ---- before winsav-after-save-configuration-hook ------------------------\n")
+ (run-hooks 'winsav-after-save-configuration-hook)
+ (message "winsav-save-config:here c.6")
+ (insert ";; ---- after winsav-after-save-configuration-hook ------------------------\n")
+ (insert "\n)\n")
+ (message "winsav-save-config:here d")
+ ;; For pp-buffer:
+ (let (emacs-lisp-mode-hook
+ after-change-major-mode-hook
+ change-major-mode-hook)
+ (font-lock-mode -1)
+ (emacs-lisp-mode))
+ (message "winsav-save-config:here e")
+ (pp-buffer)
+ (message "winsav-save-config:here f")
+ (indent-region (point-min) (point-max))
+ (message "winsav-save-config:here g")
+ ;;(save-buffer 0) ;; No backups
+ ;;(kill-buffer)
+
+ ;;(with-current-buffer (find-file-noselect file)
+ (let ((coding-system-for-write 'utf-8))
+ (write-region (point-min) (point-max) conf-file nil 'nomessage))
+ (setq winsav-file-modtime (nth 5 (file-attributes conf-file)))
+ (setq winsav-dirname (file-name-as-directory (file-name-directory conf-file)))
+ (message "winsav-save-config:here h")
+ ))))
+
+(defvar winsav-current-config-name nil)
+
+;;(winsav-restore-configuration)
+;;(winsav-full-file-name "~")
+;; (defun winsav-restore-winsav-configuration ()
+;; )
+
+(defcustom winsav-after-restore-hook nil
+ "Normal hook run after a successful `winsav-restore-configuration'."
+ :type 'hook
+ :group 'winsav)
+
+;; Like desktop-read, fix-me
+(defun winsav-restore-configuration (&optional dirname)
+ "Restore frames from default file in directory DIRNAME.
+The default file is given by `winsav-default-file-name'.
+
+The file was probably written by `winsav-save-configuration'.
+Delete the frames that were used before."
+ ;;(message "winsav-restore-configuration %s" dirname)
+ (winsav-restore-config-from-file (winsav-full-file-name dirname)))
+
+(defun winsav-restore-config-from-file (conf-file)
+ "Restore frames from configuration file CONF-FILE.
+The file was probably written by `winsav-save-configuration'.
+Delete the frames that were used before."
+ (let ((old-frames (sort (frame-list) 'winsav-frame-sort-predicate))
+ (num-old-deleted 0)
+ ;; Avoid winsav saving during restore.
+ (winsav-save nil))
+ ;;(message "winsav:conf-file=%s" conf-file)
+ (if (or (not conf-file)
+ (not (file-exists-p conf-file)))
+ (progn
+ (message (propertize "Winsav: No default configuration file found"
+ 'face 'secondary-selection))
+ t) ;; Ok
+ (setq debug-on-error t) ;; fix-me
+ (if (file-exists-p conf-file)
+ (progn
+ (load conf-file nil nil t)
+ (setq winsav-file-modtime (nth 5 (file-attributes conf-file)))
+ (setq winsav-dirname (file-name-as-directory (file-name-directory conf-file)))
+ (when (< 0 (length winsav-loaded-frames))
+ (dolist (old (reverse old-frames))
+ (unless (eq 'only (frame-parameter old 'minibuffer))
+ (setq num-old-deleted (1+ num-old-deleted))
+ (delete-frame old)))
+ )
+ (message "winsav-after-restore-hook =%S" winsav-after-restore-hook)
+ (run-hooks 'winsav-after-restore-hook)
+ (message "Winsav: %s frame(s) restored" (length winsav-loaded-frames))
+ t)
+ ;; No winsav file found
+ ;;(winsav-clear)
+ (message "No winsav file: %s" conf-file)
+ nil))))
+
+;; (defcustom winsav-add-to-desktop nil
+;; "Set this to let desktop save and restore also winsav configurations."
+;; :type 'boolean
+;; :set (lambda (sym val)
+;; (set-default sym val)
+;; (if value
+;; (progn
+;; (add-hook 'desktop-after-read-hook 'winsav-restore-configuration)
+;; (add-hook 'desktop-save-hook 'winsav-save-configuration))
+;; (remove-hook 'desktop-after-read-hook 'winsav-restore-configuration)
+;; (remove-hook 'desktop-save-hook 'winsav-save-configuration)) )
+;; :group 'winsav)
+
+(defun winsav-restore-configuration-protected (&optional dirname)
+ "Like `winsav-restore-configuration' but protect for errors.
+DIRNAME has the same meaning."
+ (condition-case err
+ (winsav-restore-configuration dirname)
+ (error
+ (message "winsav-restore-configuration: %s" err))))
+
+(defun winsav-relative-~-or-full (dirname)
+ (let* ((rel-dir (file-relative-name dirname
+ (file-name-directory
+ (winsav-full-file-name "~"))))
+ (confname (if (string= ".." (substring rel-dir 0 2))
+ winsav-dirname
+ (if (string= rel-dir "./")
+ "(default)"
+ (concat "~/" rel-dir)))))
+ confname))
+
+(defun winsav-tell-configuration ()
+ "Tell which winsav configuration that is used."
+ (interactive)
+ (save-match-data ;; runs in timer
+ (let ((confname (if (not winsav-dirname)
+ "(none)"
+ (winsav-relative-~-or-full winsav-dirname))))
+ (if t ;;(called-interactively-p)
+ (message (propertize (format "Current winsav config is '%s'" confname)
+ 'face 'secondary-selection))
+ (save-window-excursion
+ (delete-other-windows)
+ (set-window-buffer (selected-window)
+ (get-buffer-create " *winsav*"))
+ (with-current-buffer (window-buffer)
+ (momentary-string-display
+ (propertize
+ (format "\n\n\n Current winsav config is '%s'\n\n\n\n" confname)
+ 'face 'secondary-selection)
+ (window-start)
+ (kill-buffer))))))))
+
+(defun winsav-tell-configuration-request ()
+ "Start an idle timer to call `winsav-tell-configuration'."
+ (run-with-idle-timer 1 nil 'winsav-tell-configuration))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Startup and shut down
+
+;; Run after desktop at startup so that desktop has loaded files and
+;; buffers.
+(defun winsav-after-init ()
+ "Restore frames and windows.
+Run this once after Emacs startup, after desktop in the
+`after-init-hook'."
+ ;; Turn off with --no-deskttop:
+ (unless desktop-save-mode (winsav-save-mode -1))
+ (when winsav-save-mode
+ ;;(run-with-idle-timer 0.1 nil 'winsav-restore-configuration-protected)
+ ;;(message "winsav-after-init")
+ ;;(winsav-restore-configuration-protected)
+ ;; In case of error make sure winsav-save-mode is turned off
+ (setq inhibit-startup-screen t)
+ (winsav-save-mode -1)
+ (winsav-restore-configuration)
+ (winsav-save-mode 1)
+ ))
+
+(add-hook 'after-init-hook 'winsav-after-init t)
+
+(add-hook 'kill-emacs-hook 'winsav-kill)
+;;(remove-hook 'kill-emacs-hook 'winsav-kill)
+
+(defun winsav-kill ()
+ "Save winsav frame configuration.
+Run this before Emacs exits."
+ ;; (when winsav-save-mode
+ ;; (let ((conf-dir (when winsav-current-config-name
+ ;; (winsav-full-config-dir-name winsav-current-config-name))))
+ ;; (winsav-save-configuration conf-dir))))
+ (when (and winsav-save-mode
+ (let ((exists (file-exists-p (winsav-full-file-name))))
+ (or (eq winsav-save t)
+ (and exists (memq winsav-save '(ask-if-new if-exists)))
+ (and
+ (or (memq winsav-save '(ask ask-if-new))
+ (and exists (eq winsav-save 'ask-if-exists)))
+ (y-or-n-p "Save winsav? ")))))
+ (unless winsav-dirname
+ ;; Fix-me: Since this can be a new user of winsav I think the
+ ;; best thing to do here is to encourage the user to save in the
+ ;; default directory since otherwise the winsav file will not be
+ ;; loaded at startup. Desktop does not currently do that however
+ ;; (report that!).
+ (when (y-or-n-p "Winsav was not loaded from file. Save it to file? ")
+ (let* ((full-file (winsav-full-file-name))
+ (default-directory (directory-file-name
+ (file-name-directory full-file))))
+ (setq winsav-dirname
+ (file-name-as-directory
+ (expand-file-name
+ (read-directory-name "Directory for winsav file: " nil nil t)))))))
+ (when winsav-dirname
+ (condition-case err
+ ;;(winsav-save winsav-dirname t)
+ (winsav-save-configuration winsav-dirname)
+ (file-error
+ (unless (yes-or-no-p
+ (format "Error while saving winsav config: %s Save anyway? "
+ (error-message-string err)))
+ (signal (car err) (cdr err)))))))
+ ;; If we own it, we don't anymore.
+ ;;(when (eq (emacs-pid) (winsav-owner)) (winsav-release-lock))
+ )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Switching configurations
+
+(defun winsav-restore-full-config (dirname)
+ "Restore the winsav configuration in directory DIRNAME.
+If NAME is nil then restore the startup configuration."
+ ;;(desktop-change-dir dirname)
+ (when (and winsav-handle-also-desktop desktop-save-mode)
+ (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock))
+ (desktop-clear)
+ (desktop-read dirname))
+ (winsav-restore-configuration dirname)
+ ;;(setq winsav-current-config-name name)
+ (winsav-tell-configuration-request))
+
+(defun winsav-full-config-dir-name (name)
+ "Return full directory path where configuration NAME is stored."
+ (let* ((base-dir (concat (winsav-full-file-name) ".d"))
+ (conf-dir (expand-file-name name base-dir)))
+ (setq conf-dir (file-name-as-directory conf-dir))
+ ;;(message "conf-dir=%s" conf-dir)
+ conf-dir))
+
+;;;###autoload
+(defun winsav-save-full-config (dirname)
+ "Saved current winsav configuration in directory DIRNAME.
+Then change to this configuration.
+
+See also `winsav-switch-config'."
+ (unless (file-name-absolute-p dirname)
+ (error "Directory ame must be absolute: %s" dirname))
+ (let* ((conf-dir (or dirname "~"))
+ (old-conf-dir winsav-dirname))
+ (make-directory conf-dir t)
+ (winsav-save-configuration conf-dir)
+ (when (and winsav-handle-also-desktop desktop-save-mode)
+ (desktop-release-lock)
+ (desktop-save conf-dir))
+ ;;(unless (string= winsav-current-config-name name)
+ (unless (string= old-conf-dir conf-dir)
+ ;;(setq winsav-current-config-name name)
+ (winsav-tell-configuration-request))))
+
+;; Fix-me: remove named configurations, use just dir as desktop
+(defun winsav-switch-to-default-config ()
+ "Change to default winsav configuration.
+See also `winsav-switch-config'."
+ (interactive)
+ (winsav-switch-config "~"))
+
+;;;###autoload
+(defun winsav-switch-config (dirname)
+ "Change to winsav configuration in directory DIRNAME.
+If DIRNAME is the current winsav configuration directory then
+offer to save it or restore it from saved values.
+
+Otherwise, before switching offer to save the current winsav
+configuration. Then finally switch to the new winsav
+configuration, creating it if it does not exist.
+
+If option `desktop-save-mode' is on then buffers and files are also
+restored and saved the same way.
+
+See also option `winsav-save-mode' and command
+`winsav-tell-configuration'."
+ (interactive
+ (list
+ (let ((default-directory (or winsav-dirname default-directory))
+ (base-dir (concat (winsav-full-file-name) ".d"))
+ new-dir)
+ (make-directory base-dir t)
+ (setq new-dir
+ (read-directory-name "Winsav: Switch config directory: "))
+ (when (string= "" new-dir) (setq new-dir nil))
+ (or new-dir
+ "~"))))
+ (setq dirname (file-name-as-directory (expand-file-name dirname)))
+ (catch 'stop
+ (let ((conf-file (expand-file-name winsav-base-file-name dirname))
+ config-exists)
+ (if (file-exists-p conf-file)
+ (setq config-exists t)
+ (unless (y-or-n-p (format "%s was not found. Create it? " conf-file))
+ (throw 'stop nil)))
+ (if (string= winsav-dirname dirname)
+ (if (y-or-n-p "You are already using this configuration, restore it from saved values? ")
+ (winsav-restore-full-config winsav-dirname)
+ (when (y-or-n-p "You are already using this winsav configuration, save it? ")
+ (winsav-save-full-config winsav-dirname)))
+ (when (y-or-n-p
+ (format "Save current config, %s,\n first before switching to %s? "
+ (if (and winsav-dirname
+ (not (string= winsav-dirname
+ (file-name-directory (winsav-full-file-name "~")))))
+ winsav-dirname
+ "the startup config")
+ dirname))
+ (winsav-save-full-config winsav-dirname))
+ (if config-exists
+ (winsav-restore-full-config dirname)
+ (winsav-save-full-config dirname))))))
+
+
+
+
+;;; Old things
+
+;; (defun winsav-log-buffer ()
+;; (get-buffer-create "winsav log buffer"))
+
+;; (defun winsav-log (mark obj)
+;; (with-current-buffer (winsav-log-buffer)
+;; (insert "=== " mark "===\n" (pp-to-string obj))))
+
+;; (global-set-key [f2] 'winsav-test-get)
+;; (global-set-key [f3] 'winsav-test-put)
+;; (defvar winsav-saved-window-tree nil)
+
+;; (defun winsav-test-get()
+;; (interactive)
+;; (setq winsav-saved-window-tree (winsav-get-window-tree)))
+
+;; (defun winsav-test-put()
+;; (interactive)
+;; (let ((ret (winsav-put-window-tree winsav-saved-window-tree
+;; (selected-window))))
+;; ;;(message "ret=%s" ret)
+;; ))
+
+;; (defun winsav-serialize-to-file (obj file)
+;; (with-current-buffer (find-file-noselect file)
+;; ;;(erase-buffer)
+;; (save-restriction
+;; (widen)
+;; (goto-char (point-max))
+;; (insert (winsav-serialize obj)
+;; "\n"))
+;; ;;(basic-save-buffer)
+;; ))
+
+;;(global-set-key [f11] 'winsav-rotate)
+
+;; (defun winsav-de-serialize-window-tree-from-file (file)
+;; (with-current-buffer (find-file-noselect file)
+;; (save-restriction
+;; (widen)
+;; (let ((start (point))
+;; (end nil))
+;; (forward-list)
+;; (setq end (point))
+;; ;;(goto-char (point-min))
+;; (winsav-de-serialize-window-tree (buffer-substring-no-properties start end))))))
+
+;; (defun winsav-restore-from-file (file)
+;; (winsav-put-window-tree
+;; (winsav-de-serialize-window-tree-from-file file)
+;; (selected-window)))
+
+;; (defun winsav-de-serialize-window-tree (str)
+;; (save-match-data
+;; (let ((read-str
+;; (replace-regexp-in-string (rx "#<buffer "
+;; (1+ (not (any ">")))
+;; ">")
+;; "buffer"
+;; str))
+;; obj-last
+;; obj
+;; last)
+;; (setq read-str
+;; (replace-regexp-in-string (rx "#<window "
+;; (1+ (not (any ">")))
+;; ">")
+;; "nil"
+;; read-str))
+;; (setq obj-last (read-from-string read-str))
+;; (setq obj (car obj-last))
+;; (setq last (cdr obj-last))
+;; ;; Fix me, maby check there are only spaces left (or trim them above...)
+;; obj)))
+
+(provide 'winsav)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; winsav.el ends here
--- /dev/null
+;;; winsize.el --- Interactive window structure editing
+;;
+;; Author: Lennart Borgman <lennart dot borgman at gmail dot com >
+;; Maintainer:
+;; Created: Wed Dec 07 15:35:09 2005
+(defconst winsize:version "0.98") ;;Version: 0.97
+;; Lxast-Updated: Sun Nov 18 02:14:52 2007 (3600 +0100)
+;; Keywords:
+;; Compatibility:
+;;
+;; Fxeatures that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This file contains functions for interactive resizing of Emacs
+;; windows. To use it put it in your `load-path' and add the following
+;; to your .emacs:
+;;
+;; (require 'winsize)
+;; (global-set-key [(control x) ?+] 'resize-windows)
+;;
+;; For more information see `resize-windows'.
+;;
+;; These functions are a slightly rewritten version of the second part
+;; of the second part my proposal for a new `balance-windows' function
+;; for Emacs 22. The rewrite is mostly a restructure to more easily
+;; add new functions. All functions and variables have been renamed.
+;; The file was originally named bw-interactive.el.
+;;
+;; New ideas for functionality have been to a large part adopted from
+;; the Emacs Devel mailing list. Probably most of them originated from
+;; Drew Adams and Bastien.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; TODO: Change mouse pointer shape during resizing.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'windmove))
+(eval-when-compile (require 'view))
+(eval-when-compile (require 'winsav nil t))
+(eval-when-compile (require 'ourcomments-widgets))
+(eval-when-compile (require 'ring))
+
+;;; Custom variables
+
+(defcustom winsize-juris-way t
+ ""
+ :type 'boolean
+ :group 'winsize)
+
+(defcustom winsize-autoselect-borders t
+ "Determines how borders are selected by default.
+If nil hever select borders automatically (but keep them on the
+same side while changing window). If 'when-single select border
+automatically if there is only one possible choice. If t alwasy
+select borders automatically if they are not selected."
+ :type '(choice (const :tag "Always" t)
+ (const :tag "When only one possbility" when-single)
+ (const :tag "Never" nil))
+ :group 'winsize)
+
+(defcustom winsize-mode-line-colors (list t (list "green" "green4"))
+ "Mode line colors used during resizing."
+ :type '(list (boolean :tag "Enable mode line color changes during resizing")
+ (list
+ (color :tag "- Active window mode line color")
+ (color :tag "- Inactive window mode line color")))
+ :group 'winsize)
+
+(defcustom winsize-mark-selected-window t
+ "Mark selected window if non-nil."
+ :type 'boolean
+ :group 'winsize)
+
+(defcustom winsize-make-mouse-prominent t
+ "Try to make mouse more visible during resizing.
+The mouse is positioned next to the borders that you can move.
+It can however be hard to see if where it is. Setting this to on
+makes the mouse jump a few times."
+ :type 'boolean
+ :group 'winsize)
+
+(defvar widget-command-prompt-value-history nil
+ "History of input to `widget-function-prompt-value'.")
+
+(defvar winsize-keymap nil
+ "Keymap used by `resize-windows'.")
+
+(defun winsize-make-keymap (let-me-use)
+ "Build the keymap that should be used by `winsize-keymap'."
+ (let ((map (make-sparse-keymap "Window Resizing")))
+ (when (featurep 'winsav)
+ (define-key map [menu-bar bw rotate]
+ '("Rotate window configuration" . winsav-rotate))
+ (define-key map [menu-bar bw sep3] '(menu-item "--")))
+ (define-key map [menu-bar bw]
+ (cons "Resize" (make-sparse-keymap "second")))
+ (define-key map [menu-bar bw save-config]
+ '("Save window configuration" . winsize-save-window-configuration))
+ (define-key map [menu-bar bw next-config]
+ '("Next saved window configuration" . winsize-next-window-configuration))
+ (define-key map [menu-bar bw prev-config]
+ '("Previous saved window configuration" . winsize-previous-window-configuration))
+ (define-key map [menu-bar bw sep2] '(menu-item "--"))
+ (define-key map [menu-bar bw fit]
+ '("Fit Window to Buffer" . fit-window-to-buffer))
+ (define-key map [menu-bar bw shrink]
+ '("Shrink Window to Buffer" . shrink-window-if-larger-than-buffer))
+ (define-key map [menu-bar bw sep1] '(menu-item "--"))
+ (define-key map [menu-bar bw siblings]
+ '("Balance Window Siblings" . winsize-balance-siblings))
+ (define-key map [menu-bar bw balance]
+ '("Balance Windows" . balance-windows))
+
+ (when (featurep 'winsav)
+ (define-key map [?|] 'winsav-rotate))
+ (define-key map [?+] 'balance-windows)
+ (define-key map [?.] 'winsize-balance-siblings)
+ (define-key map [?=] 'fit-window-to-buffer)
+ (define-key map [?-] 'shrink-window-if-larger-than-buffer)
+
+ (define-key map [(up)] 'winsize-move-border-up)
+ (define-key map [(down)] 'winsize-move-border-down)
+ (define-key map [(left)] 'winsize-move-border-left)
+ (define-key map [(right)] 'winsize-move-border-right)
+
+ (define-key map [(shift up)] 'winsize-move-other-border-up)
+ (define-key map [(shift down)] 'winsize-move-other-border-down)
+ (define-key map [(shift left)] 'winsize-move-other-border-left)
+ (define-key map [(shift right)] 'winsize-move-other-border-right)
+
+ (define-key map [(meta left)] 'winsize-to-border-or-window-left)
+ (define-key map [(meta up)] 'winsize-to-border-or-window-up)
+ (define-key map [(meta right)] 'winsize-to-border-or-window-right)
+ (define-key map [(meta down)] 'winsize-to-border-or-window-down)
+
+ (define-key map [?0] 'delete-window)
+ (define-key map [?1] 'delete-other-windows)
+ (define-key map [?2] 'split-window-vertically)
+ (define-key map [?3] 'split-window-horizontally)
+ (define-key map [?4] 'other-window)
+
+ (define-key map [?!] 'winsize-save-window-configuration)
+ (define-key map [?>] 'winsize-next-window-configuration)
+ (define-key map [?<] 'winsize-previous-window-configuration)
+
+ ;; Fix-me: These keys could also be set to nil
+ (define-key map [mouse-1] 'mouse-set-point)
+ ;;(define-key map [down-mouse-1] 'mouse-set-point)
+ (define-key map [(mode-line) (down-mouse-1)] 'mouse-drag-mode-line)
+ (define-key map [(vertical-line) (down-mouse-1)] 'mouse-drag-vertical-line)
+ (define-key map [(vertical-scroll-bar) (mouse-1)] 'scroll-bar-toolkit-scroll)
+
+ (define-key map [??] 'winsize-help)
+ (define-key map [(control ?g)] 'winsize-quit)
+ (define-key map [(control return)] 'winsize-stop-go-back)
+ (define-key map [(return)] 'winsize-stop)
+ (define-key map [t] 'winsize-stop-and-execute)
+
+ (dolist (ks let-me-use)
+ (if (and (not (vectorp ks))
+ (not (stringp ks))
+ (commandp ks))
+ (let ((ks-list (where-is-internal ks)))
+ (dolist (ks ks-list)
+ (unless (lookup-key map ks)
+ (define-key map ks nil))))
+ (unless (lookup-key map ks)
+ (define-key map ks nil))))
+
+ (setq winsize-keymap map)))
+
+(defcustom winsize-let-me-use '(next-line ;;[(control ?n)]
+ previous-line ;;[(control ?p)]
+ forward-char ;;[(control ?f)]
+ backward-char ;;[(control ?b)]
+ [(home)]
+ [(end)]
+ ;; Fix-me: replace this with something
+ ;; pulling in help-event-list:
+ [(f1)]
+ execute-extended-command
+ eval-expression)
+ "Key sequences or commands that should not be overriden during resize.
+The purpose is to make it easier to switch windows. The functions
+`windmove-left' etc depends on the position when chosing the
+window to move to."
+ :type '(repeat
+ (choice
+ ;; Note: key-sequence must be before command here, since
+ ;; the key sequences seems to match command too.
+ key-sequence command))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (winsize-make-keymap val))
+ :group 'winsize)
+
+(defcustom winsize-selected-window-face 'winsize-selected-window-face
+ "Variable holding face for marking selected window.
+This variable may be nil or a face symbol."
+ :type '(choice (const :tag "Do not mark selected window" nil)
+ face)
+ :group 'winsize)
+
+(defface winsize-selected-window-face
+ '((t (:inherit secondary-selection)))
+ "Face for marking selected window."
+ :group 'winsize)
+
+
+;;; These variables all holds values to be reset when exiting resizing:
+
+(defvar winsize-old-mode-line-bg nil)
+(defvar winsize-old-mode-line-inactive-bg nil)
+(defvar winsize-old-overriding-terminal-local-map nil)
+(defvar winsize-old-overriding-local-map-menu-flag nil)
+(defvar winsize-old-temp-buffer-show-function nil)
+(defvar winsize-old-mouse-avoidance-mode nil
+ "Hold the value of `mouse-avoidance-mode' at resizing start.")
+(defvar winsize-old-view-exit-action nil)
+(make-variable-buffer-local 'winsize-old-view-exit-action)
+
+(defvar winsize-message-end nil
+ "Marker, maybe at end of message buffer.")
+
+(defvar winsize-resizing nil
+ "t during resizing, nil otherwise.")
+
+(defvar winsize-window-config-init nil
+ "Hold window configuration from resizing start.")
+
+(defvar winsize-frame nil
+ "Frame that `resize-windows' is operating on.")
+
+
+;;; Borders
+
+(defvar winsize-window-for-side-hor nil
+ "Window used internally for resizing in vertical direction.")
+
+(defvar winsize-window-for-side-ver nil
+ "Window used internally for resizing in horizontal direction.")
+
+(defvar winsize-border-hor nil
+ "Use internally to remember border choice.
+This is set by `winsize-pre-command' and checked by
+`winsize-post-command', see the latter for more information.
+
+The value should be either nil, 'left or 'right.")
+
+(defvar winsize-border-ver nil
+ "Use internally to remember border choice.
+This is set by `winsize-pre-command' and checked by
+`winsize-post-command', see the latter for more information.
+
+The value should be either nil, 'up or 'down.")
+
+(defvar winsize-window-at-entry nil
+ "Window that was selected when `resize-windows' started.")
+
+
+;;; Keymap, interactive functions etc
+
+(defun winsize-pre-command ()
+ "Do this before every command.
+Runs this in `pre-command-hook'.
+
+Remember the currently used border sides for resizing. Also
+remember position in message buffer to be able to see if next
+command outputs some message.
+
+For more information see `winsize-post-command'."
+ (setq winsize-message-end (winsize-message-end))
+ (setq winsize-border-hor (winsize-border-used-hor))
+ (setq winsize-border-ver (winsize-border-used-ver)))
+
+(defun winsize-post-command ()
+ "Done after every command.
+Run this in `post-command-hook'.
+
+Check the border sides \(left/right, up/down) remembered in
+`winsize-pre-command' and use the the same side if possible,
+otherwise the opposite side if that is possible. \(This check is
+of course not done if the last command changed the border side.)
+
+The reason for selecting borders this way is to try to give the
+user a coherent and easy picture of what is going on when
+changing window or when window structure is changed. \(Note that
+the commands moving to another window or changing the window
+structure does not have to belong to this package. Those commands
+can therefore not select the border sides.)
+
+Give the user feedback about selected window and borders. Also
+give a short help message unless last command gave some message."
+ (unless winsize-juris-way
+ (unless winsize-border-hor
+ (winsize-select-initial-border-hor))
+ (when winsize-border-hor
+ (winsize-set-border winsize-border-hor t))
+ (unless winsize-border-ver
+ (winsize-select-initial-border-ver))
+ (when winsize-border-ver
+ (winsize-set-border winsize-border-ver t)))
+ (winsize-tell-user))
+
+;;;###autoload
+(defun resize-windows ()
+ "Start window resizing.
+During resizing a window is selected. You can move its
+borders. In the default configuration the arrow keys moves the
+right or bottom border if they are there. To move the opposite
+border use S-arrowkeys.
+
+You can also do other window operations, like splitting, deleting
+and balancing the sizes. The keybindings below describes the key
+bindings during resizing:\\<winsize-keymap>
+
+ `balance-windows' \\[balance-windows]
+ `winsize-balance-siblings' \\[winsize-balance-siblings]
+ `fit-window-to-buffer' \\[fit-window-to-buffer]
+ `shrink-window-if-larger-than-buffer' \\[shrink-window-if-larger-than-buffer]
+
+ `winsav-rotate' \\[winsav-rotate]
+
+ `winsize-move-border-up' \\[winsize-move-border-up]
+ `winsize-move-border-down' \\[winsize-move-border-down]
+ `winsize-move-border-left' \\[winsize-move-border-left]
+ `winsize-move-border-right' \\[winsize-move-border-right]
+
+ `winsize-to-border-or-window-left' \\[winsize-to-border-or-window-left]
+ `winsize-to-border-or-window-up' \\[winsize-to-border-or-window-up]
+ `winsize-to-border-or-window-right' \\[winsize-to-border-or-window-right]
+ `winsize-to-border-or-window-down' \\[winsize-to-border-or-window-down]
+
+ Note that you can also use your normal keys for
+ `forward-char', `backward-char', `next-line', `previous-line'
+ and what you have on HOME and END to move in the windows. That
+ might sometimes be necessary to directly select a
+ window. \(You may however also use `other-window' or click
+ with the mouse, see below.)
+
+ `delete-window' \\[delete-window]
+ `delete-other-windows' \\[delete-other-windows]
+ `split-window-vertically' \\[split-window-vertically]
+ `split-window-horizontally' \\[split-window-horizontally]
+ `other-window' \\[other-window]
+
+ `winsize-save-window-configuration' \\[winsize-save-window-configuration]
+ `winsize-next-window-configuration' \\[winsize-next-window-configuration]
+ `winsize-previous-window-configuration' \\[winsize-previous-window-configuration]
+
+ `mouse-set-point' \\[mouse-set-point]
+
+ `winsize-quit' \\[winsize-quit]
+ `winsize-stop-go-back' \\[winsize-stop-go-back]
+ `winsize-stop' \\[winsize-stop]
+ `winsize-stop-and-execute' \\[winsize-stop-and-execute]
+
+ `winsize-help' \\[winsize-help]
+ `describe-key' \\[describe-key]
+ `describe-key-briefly' \\[describe-key-briefly]
+ (All the normal help keys work, and at least those above will
+ play well with resizing.)
+
+Nearly all other keys exits window resizing and they are also
+executed. However, the key sequences in `winsize-let-me-use' and
+dito for commands there are also executed without exiting
+resizing.
+
+The colors of the modelines are changed to those given in
+`winsize-mode-line-colors' to indicate that you are resizing
+windows. To make this indication more prominent the text in the
+selected window is marked with the face hold in the variable
+`winsize-selected-window-face'.
+
+The option `winsize-juris-way' decides how the borders to move
+are selected. If this option is non-nil then the right or bottom
+border are the ones that are moved with the arrow keys and the
+opposite border with shift arrow keys.
+
+If `winsize-juris-way' is nil then the following apply:
+
+As you select other borders or move to new a window the mouse
+pointer is moved inside the selected window to show which borders
+are beeing moved. The mouse jumps a little bit to make its
+position more visible. You can turn this off by customizing
+`winsize-make-mouse-prominent'.
+
+Which borders initially are choosen are controlled by the
+variable `winsize-autoselect-borders'.
+
+** Example: Border selection, movements and windows.
+
+ Suppose you have a frame divided into windows like in the
+ figure below. If window B is selected when you start resizing
+ then \(with default settings) the borders marked with 'v' and
+ 'h' will be the ones that the arrow keys moves. To indicate
+ this the mouse pointer is placed in the right lower corner of
+ the selected window B.
+
+ +----------+-----------+--------+
+ | | v |
+ | | v |
+ | A | _B_ v |
+ | | v |
+ | | v |
+ | | x v |
+ +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ +----------+---------+----------+
+
+ Now if you press M-<left> then the picture below shows what has
+ happened. Note that the selected vertical border is now the one
+ between A and B. The mouse pointer has moved to the
+ corresponding corner in the window B, which is still selected.
+
+ +----------+-----------+--------+
+ | v | |
+ | v | |
+ | A v _B_ | |
+ | v | |
+ | v | |
+ | v x | |
+ +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ +----------+---------+----------+
+
+ Press M-<left> once again. This gives this picture:
+
+ +----------+-----------+--------+
+ | v | |
+ | v | |
+ | _A_ v B | |
+ | v | |
+ | v | |
+ | x v | |
+ +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ +----------+---------+----------+
+
+ Note that the window A is now selected. However there is no
+ border that could be moved to the left of this window \(which
+ would otherwise be chosen now) so the border between A and B is
+ still the one that <left> and <right> moves. The mouse has
+ moved to A.
+
+ If we now delete window A the new situation will look like
+ this:
+
+ +----------+-----------+--------+
+ | | |
+ | | |
+ | _B_ | |
+ | | |
+ | | |
+ | x | |
+ +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ | | |
+ +----------+---------+----------+
+
+
+
+>>>> testing stuff >>>>
+`help-mode-hook'
+`temp-buffer-show-function'
+`view-exit-action'
+<<<<<<<<<<<<<<<<<<<<<<<
+"
+ (interactive)
+ (setq winsize-resizing t)
+ ;; Save old values:
+ (unless winsize-old-mouse-avoidance-mode
+ (setq winsize-old-mouse-avoidance-mode mouse-avoidance-mode))
+ ;; Setup user feedback things:
+ (mouse-avoidance-mode 'none)
+ (winsize-set-mode-line-colors t)
+ (winsize-create-short-help-message)
+ (setq winsize-message-end (winsize-message-end))
+ ;; Save config for exiting:
+ (setq winsize-window-config-init (current-window-configuration))
+ (setq winsize-window-at-entry (selected-window))
+ (setq winsize-frame (selected-frame))
+ ;; Setup keymap and command hooks etc:
+ (winsize-setup-local-map)
+ (winsize-add-command-hooks)
+ (setq winsize-window-for-side-hor nil)
+ (setq winsize-window-for-side-ver nil))
+
+
+(defun winsize-setup-local-map ()
+ "Setup an overriding keymap and use this during resizing.
+Save current keymaps."
+ ;; Fix-me: use copy-keymap for old?
+ (unless winsize-old-overriding-terminal-local-map
+ (setq winsize-old-overriding-terminal-local-map overriding-terminal-local-map))
+ (setq overriding-terminal-local-map (copy-keymap winsize-keymap))
+ (setq winsize-old-overriding-local-map-menu-flag overriding-local-map-menu-flag)
+ (setq overriding-local-map-menu-flag t))
+
+(defun winsize-restore-local-map ()
+ "Restore keymaps saved by `winsize-setup-local-map'."
+ (setq overriding-terminal-local-map winsize-old-overriding-terminal-local-map)
+ (setq winsize-old-overriding-terminal-local-map nil)
+ (setq overriding-local-map-menu-flag winsize-old-overriding-local-map-menu-flag)
+ (setq winsize-old-overriding-local-map-menu-flag nil))
+
+
+(defvar winsize-window-config-help nil
+ "Hold window configuration when help is shown.")
+
+(defvar winsize-window-config-init-help nil
+ "Hold window configuration from resizing start during help.")
+
+(defvar winsize-help-frame nil
+ "The frame from which help was called.")
+
+(defun winsize-restore-after-help (buffer)
+ "Restore window configuration after help.
+Raise frame and reactivate resizing."
+ (remove-hook 'temp-buffer-setup-hook 'winsize-help-mode-hook-function)
+ (setq temp-buffer-show-function winsize-old-temp-buffer-show-function)
+ ;; Get rid of the view exit action and the extra text in the help
+ ;; buffer:
+ (with-current-buffer (help-buffer)
+ (setq view-exit-action winsize-old-view-exit-action)
+ (setq winsize-old-view-exit-action nil)
+ (let ((here (point-marker))
+ (inhibit-read-only t))
+ (goto-char (point-min))
+ (forward-line 2)
+ (delete-region (point-min) (point))
+ (goto-char (point-max))
+ (forward-line -2)
+ (delete-region (point) (point-max))
+ (goto-char here)))
+ ;; Restart resizing, restoring window configurations:
+ (when (select-frame winsize-help-frame)
+ (raise-frame)
+ (set-window-configuration winsize-window-config-help)
+ (resize-windows)
+ (setq winsize-window-config-init winsize-window-config-init-help)))
+
+(defun winsize-help-mode-hook-function ()
+ "Setup temp buffer show function to only run second step.
+The first step, `winsize-temp-buffer-show-function', has already been run."
+ (setq temp-buffer-show-function 'winsize-temp-buffer-show-function-1))
+
+(defun winsize-temp-buffer-show-function (buffer)
+ "First step of setup for showing help during resizing.
+This step is run when showing help during resizing.
+
+Save window configuration etc to be able to resume resizing. Stop
+resizing. Delete other windows.
+
+Run second step (`winsize-temp-buffer-show-function-1') and
+arrange so that second step is run when following help links."
+ (setq winsize-window-config-help (current-window-configuration))
+ (setq winsize-window-config-init-help winsize-window-config-init)
+ (setq winsize-help-frame (selected-frame))
+ (winsize-stop)
+ (delete-other-windows)
+ (winsize-temp-buffer-show-function-1 buffer)
+ (add-hook 'temp-buffer-setup-hook 'winsize-help-mode-hook-function))
+
+(defun winsize-temp-buffer-show-function-1 (buffer)
+ "Second step of setup for showing help during resizing.
+This is run after the first step when accessing help during
+resizing. It is also when following help links."
+ (with-current-buffer buffer
+ (let ((inhibit-read-only t)
+ (buffer-read-only t) ;; It is reverted in `help-mode-finish'
+ )
+ (run-hooks 'temp-buffer-show-hook))
+ (let ((here (point-marker))
+ (str "*** Type q to return to window resizing ***"))
+ (put-text-property 0 (length str) 'face 'highlight str)
+ (goto-char (point-min))
+ (insert str "\n\n")
+ (goto-char (point-max))
+ (insert "\n\n" str)
+ (goto-char here)
+ (setq buffer-read-only t))
+ (unless winsize-old-view-exit-action
+ (setq winsize-old-view-exit-action view-exit-action)
+ (setq view-exit-action 'winsize-restore-after-help)))
+ (set-window-buffer (selected-window) buffer)
+ (message "Type q to return to window resizing"))
+
+(defun winsize-help ()
+ "Give help during resizing.
+Save current window configuration and pause resizing."
+ (interactive)
+ (if pop-up-frames
+ (progn
+ (winsize-exit-resizing nil)
+ (describe-function 'resize-windows))
+ ;; Fix-me: move setup of view-exit-action etc here. Or was it
+ ;; temp-buffer-show-function?
+ ;; Setup help hooks etc:
+ (unless (or winsize-old-temp-buffer-show-function
+ ;; These things should not happen... :
+ (eq temp-buffer-show-function 'winsize-temp-buffer-show-function)
+ (eq temp-buffer-show-function 'winsize-temp-buffer-show-function-1))
+ (setq winsize-old-temp-buffer-show-function temp-buffer-show-function))
+ (setq temp-buffer-show-function 'winsize-temp-buffer-show-function)
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer (help-buffer)
+ (insert "resize-windows is ")
+ (describe-function-1 'resize-windows)))))
+
+(defun winsize-quit ()
+ "Quit resing, restore window configuration at start."
+ (interactive)
+ (set-window-configuration winsize-window-config-init)
+ (winsize-exit-resizing nil))
+
+(defun winsize-stop-go-back ()
+ "Exit window resizing. Go back to the window started in."
+ (interactive)
+ (winsize-exit-resizing nil t))
+
+(defun winsize-stop-and-execute ()
+ "Exit window resizing and put last key on the input queue.
+Select the window marked during resizing before putting back the
+last key."
+ ;; Fix-me: maybe replace this with a check of this-command in
+ ;; post-command-hook instead?
+ (interactive)
+ (winsize-exit-resizing t))
+
+(defun winsize-stop ()
+ "Exit window resizing.
+Select the window marked during resizing."
+ (interactive)
+ (winsize-exit-resizing nil))
+
+;;;###autoload
+(defun winsize-balance-siblings ()
+ "Make current window siblings the same height or width.
+It works the same way as `balance-windows', but only for the
+current window and its siblings."
+ (interactive)
+ (balance-windows (selected-window)))
+
+(defun winsize-to-border-or-window-left ()
+ "Switch to border leftwards, maybe moving to next window.
+If already at the left border, then move to left window, the same
+way `windmove-left' does."
+ (interactive) (winsize-switch-border 'left t))
+
+(defun winsize-to-border-or-window-right ()
+ "Switch to border rightwards, maybe moving to next window.
+For more information see `winsize-to-border-or-window-left'."
+ (interactive) (winsize-switch-border 'right t))
+
+(defun winsize-to-border-or-window-up ()
+ "Switch to border upwards, maybe moving to next window.
+For more information see `winsize-to-border-or-window-left'."
+ (interactive) (winsize-switch-border 'up t))
+
+(defun winsize-to-border-or-window-down ()
+ "Switch to border downwards, maybe moving to next window.
+For more information see `winsize-to-border-or-window-left'."
+ (interactive) (winsize-switch-border 'down t))
+
+
+(defun winsize-move-border-left ()
+ "Move border left, but select border first if not done."
+ (interactive) (winsize-resize 'left nil))
+
+(defun winsize-move-border-right ()
+ "Move border right, but select border first if not done."
+ (interactive) (winsize-resize 'right nil))
+
+(defun winsize-move-border-up ()
+ "Move border up, but select border first if not done."
+ (interactive) (winsize-resize 'up nil))
+
+(defun winsize-move-border-down ()
+ "Move border down, but select border first if not done."
+ (interactive) (winsize-resize 'down nil))
+
+
+(defun winsize-move-other-border-left ()
+ "Move border left, but select border first if not done."
+ (interactive) (winsize-resize 'left t))
+
+(defun winsize-move-other-border-right ()
+ "Move border right, but select border first if not done."
+ (interactive) (winsize-resize 'right t))
+
+(defun winsize-move-other-border-up ()
+ "Move border up, but select border first if not done."
+ (interactive) (winsize-resize 'up t))
+
+(defun winsize-move-other-border-down ()
+ "Move border down, but select border first if not done."
+ (interactive) (winsize-resize 'down t))
+
+
+;;; Internals
+
+
+
+(defun winsize-exit-resizing (put-back-last-event &optional stay)
+ "Stop window resizing.
+Put back mode line colors and keymaps that were changed.
+
+Upon exit first select window. If STAY is non-nil then select
+the window which was selected when `resize-windows' was called,
+otherwise select the last window used during resizing. After
+that, if PUT-BACK-LAST-EVENT is non-nil, put back the last input
+event on the input queue."
+ (setq winsize-resizing nil)
+ ;; Reset user feedback things:
+ (mouse-avoidance-mode winsize-old-mouse-avoidance-mode)
+ (setq winsize-old-mouse-avoidance-mode nil)
+ (winsize-set-mode-line-colors nil)
+ (winsize-mark-selected-window nil)
+ ;; Remove all hooks etc for help:
+ (if (or (eq winsize-old-temp-buffer-show-function 'winsize-temp-buffer-show-function)
+ (eq winsize-old-temp-buffer-show-function 'winsize-temp-buffer-show-function-1))
+ (setq temp-buffer-show-function nil)
+ (setq temp-buffer-show-function winsize-old-temp-buffer-show-function))
+ (setq winsize-old-temp-buffer-show-function nil)
+ (remove-hook 'help-mode-hook 'winsize-help-mode-hook-function)
+ (remove-hook 'temp-buffer-setup-hook 'winsize-help-mode-hook-function)
+ ;; Restore keymap and command hooks:
+ (winsize-restore-local-map)
+ (winsize-remove-command-hooks)
+ ;; Exit:
+ (when stay (select-window winsize-window-at-entry))
+ (message "Exited window resizing")
+ (when (and put-back-last-event)
+ ;; Add this to the input queue again:
+ (isearch-unread last-command-event)))
+
+(defun winsize-add-command-hooks ()
+ (add-hook 'pre-command-hook 'winsize-pre-command)
+ (add-hook 'post-command-hook 'winsize-post-command))
+
+(defun winsize-remove-command-hooks ()
+ (remove-hook 'pre-command-hook 'winsize-pre-command)
+ (remove-hook 'post-command-hook 'winsize-post-command))
+
+
+;;; Borders
+
+(defun winsize-border-used-hor ()
+ "Return the border side used for horizontal resizing."
+ (let ((hor (when winsize-window-for-side-hor
+ (if (eq (selected-window) winsize-window-for-side-hor)
+ 'right
+ 'left))))
+ hor))
+
+(defun winsize-border-used-ver ()
+ "Return the border side used for vertical resizing."
+ (let ((ver (when winsize-window-for-side-ver
+ (if (eq (selected-window) winsize-window-for-side-ver)
+ 'down
+ 'up))))
+ ver))
+
+(defun winsize-switch-border (dir allow-windmove)
+ "Switch border that is beeing resized.
+Switch to border in direction DIR. If ALLOW-WINDMOVE is non-nil
+then change window if necessary, otherwise stay and do not change
+border."
+ (let* ((window-in-that-dir (windmove-find-other-window
+ dir nil (selected-window))))
+ (when (window-minibuffer-p window-in-that-dir)
+ (setq window-in-that-dir nil))
+ (if winsize-juris-way
+ (if (not window-in-that-dir)
+ (message "No window in that direction")
+ (windmove-do-window-select dir nil))
+ (if (not window-in-that-dir)
+ (message "No window or border in that direction")
+ (let* ((is-hor (memq dir '(left right)))
+ (border-used (if is-hor
+ (winsize-border-used-hor)
+ (winsize-border-used-ver)))
+ (using-dir-border (eq dir border-used)))
+ (if using-dir-border
+ (when allow-windmove
+ (setq winsize-window-for-side-hor nil)
+ (setq winsize-window-for-side-ver nil)
+ (windmove-do-window-select dir nil)
+ (message "Moved to new window"))
+ (winsize-select-border dir)
+ (message "Switched to border %swards" dir)))))))
+
+
+(defun winsize-select-initial-border-hor ()
+ "Select a default border horizontally."
+ (if winsize-juris-way
+ (winsize-set-border 'right t)
+ (let ((has-left (winsize-window-beside (selected-window) 'left))
+ (has-right (winsize-window-beside (selected-window) 'right)))
+ (cond
+ ((not winsize-autoselect-borders) t)
+ ((eq winsize-autoselect-borders 'when-single)
+ (when (= 1 (length (delq nil (list has-left has-right))))
+ (winsize-select-border 'right)))
+ (t
+ (winsize-select-border 'right))))))
+
+(defun winsize-select-initial-border-ver ()
+ "Select a default border vertically."
+ (if winsize-juris-way
+ (winsize-set-border 'up t)
+ (let ((has-up (winsize-window-beside (selected-window) 'up))
+ (has-down (winsize-window-beside (selected-window) 'down)))
+ (cond
+ ((not winsize-autoselect-borders) t)
+ ((eq winsize-autoselect-borders 'when-single)
+ (when (= 1 (length (delq nil (list has-up has-down))))
+ (winsize-select-border 'up)))
+ (t
+ (winsize-select-border 'up))))))
+
+(defun winsize-select-border (dir)
+ "Select border to be set for resizing.
+The actually setting is done in `post-command-hook'."
+ (cond
+ ((memq dir '(left right))
+ (setq winsize-border-hor dir))
+ ((memq dir '(up down))
+ (setq winsize-border-ver dir))
+ (t (error "Bad DIR=%s" dir))))
+
+(defun winsize-set-border (dir allow-other-side)
+ "Set border for resizing."
+ (let ((window-beside (winsize-window-beside (selected-window) dir))
+ (horizontal (memq dir '(left right))))
+ (unless window-beside
+ (when allow-other-side
+ (setq dir (winsize-other-side dir))
+ (setq window-beside
+ (winsize-window-beside (selected-window) dir))))
+ (if horizontal
+ (progn
+ (setq winsize-border-hor nil)
+ (setq winsize-window-for-side-hor nil))
+ (setq winsize-border-ver nil)
+ (setq winsize-window-for-side-ver nil))
+ (when window-beside
+ (let ((window-for-side (if (memq dir '(right down))
+ (selected-window)
+ window-beside)))
+ (if horizontal
+ (setq winsize-window-for-side-hor window-for-side)
+ (setq winsize-window-for-side-ver window-for-side))))))
+
+(defun winsize-resize (dir other-side)
+ "Choose border to move. Or if border is chosen move that border.
+Used by `winsize-move-border-left' etc."
+ (when winsize-juris-way
+ (let ((bside (if (memq dir '(left right))
+ (if other-side 'left 'right)
+ (if other-side 'up 'down))))
+ (winsize-set-border bside t)))
+ (let* ((horizontal (memq dir '(left right)))
+ (arg (if (memq dir '(left up)) -1 1))
+ (window-for-side (if horizontal 'winsize-window-for-side-hor 'winsize-window-for-side-ver))
+ (window-for-side-val (symbol-value window-for-side)))
+ (if (not window-for-side-val)
+ (winsize-select-border dir)
+ (when (and winsize-resizing
+ (not (eq window-for-side-val 'checked)))
+ (condition-case err
+ (adjust-window-trailing-edge (symbol-value window-for-side) arg horizontal)
+ (error (message "%s" (error-message-string err))))))))
+
+(defun winsize-other-side (side)
+ "Return other side for 'left etc, ie 'left => 'right."
+ (cond
+ ((eq side 'left) 'right)
+ ((eq side 'right) 'left)
+ ((eq side 'up) 'down)
+ ((eq side 'down) 'up)
+ (t (error "Invalid SIDE=%s" side))))
+
+(defun winsize-window-beside (window side)
+ "Return a window directly beside WINDOW at side SIDE.
+That means one whose edge on SIDE is touching WINDOW. SIDE
+should be one of 'left, 'up, 'right and 'down."
+ (require 'windmove)
+ (let* ((windmove-wrap-around nil)
+ (win (windmove-find-other-window side nil window)))
+ (unless (window-minibuffer-p win)
+ win)))
+
+
+;;; Window configs
+
+(defconst winsize-window-configuration-ring (make-ring 20)
+ "Hold window configurations.")
+
+(defun winsize-ring-rotate (ring forward)
+ (when (< 1 (ring-length ring))
+ (if forward
+ (ring-insert ring (ring-remove ring nil))
+ (ring-insert-at-beginning ring (ring-remove ring 0)))))
+
+(defun winsize-ring-index (ring elem)
+ (let ((memb (member elem (ring-elements ring))))
+ (when memb
+ (- (ring-length ring)
+ (length memb)))))
+
+(defun winsize-previous-window-configuration ()
+ (interactive)
+ (winsize-goto-window-configuration nil))
+
+(defun winsize-next-window-configuration ()
+ (interactive)
+ (winsize-goto-window-configuration t))
+
+(defun winsize-goto-window-configuration (forward)
+ (let* ((curr-conf (current-window-configuration))
+ (ring winsize-window-configuration-ring)
+ (idx (winsize-ring-index ring curr-conf)))
+ (if idx
+ (progn
+ (setq idx (if forward (1- idx) (1+ idx)))
+ (set-window-configuration (ring-ref ring idx)))
+ ;; Unfortunately idx often seems to be nil so we will have to
+ ;; rotate the ring (or something similar).
+ (winsize-ring-rotate ring forward)
+ (set-window-configuration (ring-ref ring 0)))))
+
+;;;###autoload
+(defun winsize-save-window-configuration ()
+ (interactive)
+ (let* ((curr-conf (current-window-configuration))
+ (ring winsize-window-configuration-ring))
+ (if (winsize-ring-index ring curr-conf)
+ (error "Current configuration was already stored")
+ (ring-insert ring curr-conf)
+ (message "Saved window config, use '<' or '>' to get it back"))))
+
+
+;;; User feedback
+
+;;;###autoload
+(defun winsize-set-mode-line-colors (on)
+ "Turn mode line colors on if ON is non-nil, otherwise off."
+ (if on
+ (progn
+ (unless winsize-old-mode-line-inactive-bg
+ (setq winsize-old-mode-line-inactive-bg (face-attribute 'mode-line-inactive :background)))
+ (unless winsize-old-mode-line-bg
+ (setq winsize-old-mode-line-bg (face-attribute 'mode-line :background)))
+ (let* ((use-colors (car winsize-mode-line-colors))
+ (colors (cadr winsize-mode-line-colors))
+ (active-color (elt colors 0))
+ (inactive-color (elt colors 1)))
+ (when use-colors
+ (set-face-attribute 'mode-line-inactive nil :background inactive-color)
+ (set-face-attribute 'mode-line nil :background active-color))))
+ (when winsize-old-mode-line-inactive-bg
+ (set-face-attribute 'mode-line-inactive nil :background winsize-old-mode-line-inactive-bg))
+ (setq winsize-old-mode-line-inactive-bg nil)
+ (when winsize-old-mode-line-bg
+ (set-face-attribute 'mode-line nil :background winsize-old-mode-line-bg))
+ (setq winsize-old-mode-line-bg nil)))
+
+(defvar winsize-short-help-message nil
+ "Short help message shown in echo area.")
+
+(defun winsize-create-short-help-message ()
+ "Create short help message to show in echo area."
+ (let ((msg ""))
+ (mapc (lambda (rec)
+ (let ((fun (elt rec 0))
+ (desc (elt rec 1))
+ (etc (elt rec 2)))
+ (when (< 0 (length msg))
+ (setq msg (concat msg ", ")))
+ (setq msg (concat msg
+ desc
+ ":"
+ (key-description
+ (where-is-internal fun winsize-keymap t))
+ (if etc " etc" "")))))
+ '(
+ (balance-windows "balance" nil)
+ (winsize-move-border-left "resize" t)
+ (winsize-to-border-or-window-left "border" nil)
+ ))
+ (setq msg (concat msg ", exit:RET, help:?"))
+ (setq winsize-short-help-message msg)))
+
+(defun winsize-move-mouse-to-resized ()
+ "Move mouse to show which border(s) are beeing moved."
+ (let* ((edges (window-edges (selected-window)))
+ (L (nth 0 edges))
+ (T (nth 1 edges))
+ (R (nth 2 edges))
+ (B (nth 3 edges))
+ (x (/ (+ L R) 2))
+ (y (/ (+ T B) 2)))
+ (when (and winsize-window-for-side-hor
+ (not (eq winsize-window-for-side-hor 'checked)))
+ (setq x (if (eq (selected-window) winsize-window-for-side-hor) (- R 6) (+ L 2))))
+ (when (and winsize-window-for-side-ver
+ (not (eq winsize-window-for-side-ver 'checked)))
+ (setq y (if (eq (selected-window) winsize-window-for-side-ver) (- B 2) (+ T 0))))
+ (set-mouse-position (selected-frame) x y)))
+
+(defvar winsize-selected-window-overlay nil)
+
+(defun winsize-mark-selected-window (active)
+ (when winsize-selected-window-overlay
+ (delete-overlay winsize-selected-window-overlay)
+ (setq winsize-selected-window-overlay nil))
+ (when active
+ (with-current-buffer (window-buffer (selected-window))
+ (let ((ovl (make-overlay (point-min) (point-max) nil t)))
+ (setq winsize-selected-window-overlay ovl)
+ (overlay-put ovl 'window (selected-window))
+ (overlay-put ovl 'pointer 'arrow)
+ (overlay-put ovl 'priority 1000)
+ (when winsize-selected-window-face
+ (overlay-put ovl 'face winsize-selected-window-face))))))
+
+(defun winsize-message-end ()
+ "Return a marker at the end of the message buffer."
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (point-max-marker)))
+
+(defvar winsize-move-mouse 1)
+
+(defvar winsize-make-mouse-prominent-timer nil)
+
+(defun winsize-move-mouse ()
+ ;;(setq winsize-move-mouse (- winsize-move-mouse))
+ (save-match-data ;; runs in timer
+ (let* ((fxy (mouse-pixel-position))
+ (f (car fxy))
+ (x (cadr fxy))
+ (y (cddr fxy))
+ (m (mod winsize-move-mouse 2))
+ (d (* (if (= 0 m) 1 -1) 1)))
+ (set-mouse-pixel-position f (+ d x) (+ d y))
+ (when (< 1 winsize-move-mouse)
+ (setq winsize-move-mouse (1- winsize-move-mouse))
+ (setq winsize-make-mouse-prominent-timer
+ (run-with-timer 0.2 nil 'winsize-move-mouse))))))
+
+(defun winsize-make-mouse-prominent-f (doit)
+ (when (and winsize-make-mouse-prominent-timer
+ (timerp winsize-make-mouse-prominent-timer))
+ (cancel-timer winsize-make-mouse-prominent-timer))
+ (when doit
+ (setq winsize-move-mouse 3)
+ (setq winsize-make-mouse-prominent-timer
+ (run-with-idle-timer 0.1 nil 'winsize-move-mouse))))
+
+(defun winsize-tell-user ()
+ "Give the user feedback."
+ (when winsize-mark-selected-window
+ (winsize-mark-selected-window t))
+ (unless winsize-juris-way
+ (let ((move-mouse (not (member this-command
+ '(mouse-drag-mode-line
+ mouse-drag-vertical-line
+ scroll-bar-toolkit-scroll)))))
+ ;;(message "%s, move-mouse=%s" this-command move-mouse);(sit-for 2)
+ (when move-mouse
+ (winsize-move-mouse-to-resized))
+ (when winsize-make-mouse-prominent
+ (winsize-make-mouse-prominent-f move-mouse))))
+ (when (= winsize-message-end (winsize-message-end))
+ (message "%s" winsize-short-help-message)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Window rotating and mirroring
+
+;;;###autoload
+(defun winsav-rotate (mirror transpose)
+ "Rotate window configuration on selected frame.
+MIRROR should be either 'mirror-left-right, 'mirror-top-bottom or
+nil. In the first case the window configuration is mirrored
+vertically and in the second case horizontally. If MIRROR is nil
+the configuration is not mirrored.
+
+If TRANSPOSE is non-nil then the window structure is transposed
+along the diagonal from top left to bottom right (in analogy with
+matrix transosition).
+
+If called interactively MIRROR will is 'mirror-left-right by
+default, but 'mirror-top-bottom if called with prefix. TRANSPOSE
+is t. This mean that the window configuration will be turned one
+quarter clockwise (or counter clockwise with prefix)."
+ (interactive (list
+ (if current-prefix-arg
+ 'mirror-left-right
+ 'mirror-top-bottom)
+ t))
+ (require 'winsav)
+ (let* ((wintree (winsav-get-window-tree))
+ (tree (cadr wintree))
+ (win-config (current-window-configuration)))
+ ;;(winsav-log "old-wintree" wintree)
+ (winsav-transform-1 tree mirror transpose)
+ ;;(winsav-log "new-wintree" wintree)
+ ;;
+ ;; Fix-me: Stay in corresponding window. How?
+ (delete-other-windows)
+ (condition-case err
+ (winsav-put-window-tree wintree (selected-window))
+ (error
+ (set-window-configuration win-config)
+ (message "Can't rotate: %s" (error-message-string err))))
+ ))
+
+
+(provide 'winsize)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; winsize.el ends here
--- /dev/null
+;;; wrap-to-fill.el --- Make a fill-column wide space for editing
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-08-12 Wed
+;; Version:
+;; Last-Updated: x
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'mumamo))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Wrapping
+
+;;;###autoload
+(defgroup wrap-to-fill nil
+ "Customizing of `wrap-to-fill-column-mode'."
+ :group 'convenience)
+
+;;;###autoload
+(defcustom wrap-to-fill-left-marg nil
+ "Left margin handling for `wrap-to-fill-column-mode'.
+Used by `wrap-to-fill-column-mode'. If nil then center the
+display columns. Otherwise it should be a number which will be
+the left margin."
+ :type '(choice (const :tag "Center" nil)
+ (integer :tag "Left margin"))
+ :group 'wrap-to-fill)
+(make-variable-buffer-local 'wrap-to-fill-left-marg)
+
+(defvar wrap-to-fill--saved-state nil)
+;;(make-variable-buffer-local 'wrap-to-fill--saved-state)
+(put 'wrap-to-fill--saved-state 'permanent-local t)
+
+;;;###autoload
+(defcustom wrap-to-fill-left-marg-modes
+ '(text-mode
+ fundamental-mode)
+ "Major modes where `wrap-to-fill-left-margin' may be nil."
+ :type '(repeat command)
+ :group 'wrap-to-fill)
+
+
+ ;;ThisisaVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryLongWord ThisisaVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryLongWord
+
+(defun wrap-to-fill-wider ()
+ "Increase `fill-column' with 10."
+ (interactive)
+ (setq fill-column (+ fill-column 10))
+ (wrap-to-fill-set-values-in-buffer-windows))
+
+(defun wrap-to-fill-narrower ()
+ "Decrease `fill-column' with 10."
+ (interactive)
+ (setq fill-column (- fill-column 10))
+ (wrap-to-fill-set-values-in-buffer-windows))
+
+(defun wrap-to-fill-normal ()
+ "Reset `fill-column' to global value."
+ (interactive)
+ ;;(setq fill-column (default-value 'fill-column))
+ (kill-local-variable 'fill-column)
+ (wrap-to-fill-set-values-in-buffer-windows))
+
+(defvar wrap-to-fill-column-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c) ?+] 'wrap-to-fill-wider)
+ (define-key map [(control ?c) ?-] 'wrap-to-fill-narrower)
+ (define-key map [(control ?c) ?0] 'wrap-to-fill-normal)
+ map))
+
+;; Fix-me: Maybe make the `wrap-prefix' behavior an option or separate
+;; minor mode.
+
+;; Fix-me: better handling of left-column in mumamo buffers (and other
+;; if possible).
+
+;;;###autoload
+(define-minor-mode wrap-to-fill-column-mode
+ "Use `fill-column' display columns in buffer windows.
+By default the display columns are centered, but see the option
+`wrap-to-fill-left-marg'.
+
+Fix-me:
+Note 1: When turning this on `visual-line-mode' is also turned on. This
+is not reset when turning off this mode.
+
+Note 2: The text properties 'wrap-prefix and 'wrap-to-fill-prefix
+is set by this mode to indent continuation lines.
+
+Key bindings added by this minor mode:
+
+\\{wrap-to-fill-column-mode-map}"
+ :lighter " WrapFill"
+ :group 'wrap-to-fill
+ ;; (message "wrap-to-fill-column-mode %s, cb=%s, major=%s, multi=%s" wrap-to-fill-column-mode (current-buffer)
+ ;; major-mode mumamo-multi-major-mode)
+ (if wrap-to-fill-column-mode
+ (progn
+ ;; Old values (idea from visual-line-mode)
+ (set (make-local-variable 'wrap-to-fill--saved-state) nil)
+ (dolist (var '(visual-line-mode
+ ;;left-margin-width
+ ;;right-margin-width
+ ))
+ (push (list var (symbol-value var) (local-variable-p var))
+ wrap-to-fill--saved-state))
+ ;; Hooks
+ (add-hook 'window-configuration-change-hook 'wrap-to-fill-set-values nil t)
+ ;; Wrapping
+ (visual-line-mode 1)
+ (wrap-to-fill-set-values-in-buffer-windows))
+ ;; Hooks
+ (remove-hook 'window-configuration-change-hook 'wrap-to-fill-set-values t)
+ ;; Old values
+ (dolist (saved wrap-to-fill--saved-state)
+ (let ((var (nth 0 saved))
+ (val (nth 1 saved))
+ (loc (nth 2 saved)))
+ (cond
+ ((eq var 'visual-line-mode)
+ (unless val (visual-line-mode -1)))
+ (t
+ (if loc
+ (set (make-local-variable var) val)
+ (kill-local-variable var))))))
+ (kill-local-variable 'wrap-to-fill--saved-state)
+ ;; Margins
+ (dolist (win (get-buffer-window-list (current-buffer)))
+ (set-window-margins win left-margin-width right-margin-width))
+ ;; Indentation
+ (let ((here (point))
+ (inhibit-field-text-motion t)
+ beg-pos
+ end-pos)
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (setq beg-pos (point))
+ (setq end-pos (line-end-position))
+ (when (equal (get-text-property beg-pos 'wrap-prefix)
+ (get-text-property beg-pos 'wrap-to-fill-prefix))
+ (remove-list-of-text-properties
+ beg-pos end-pos
+ '(wrap-prefix)))
+ (forward-line))
+ (remove-list-of-text-properties
+ (point-min) (point-max)
+ '(wrap-to-fill-prefix)))
+ (goto-char here))))
+ (wrap-to-fill-font-lock wrap-to-fill-column-mode))
+(put 'wrap-to-fill-column-mode 'permanent-local t)
+
+(defcustom wrap-to-fill-major-modes '(org-mode
+ html-mode
+ nxhtml-mode)
+ "Major modes where to turn on `wrap-to-fill-column-mode'"
+ ;;:type '(repeat major-mode)
+ :type '(repeat command)
+ :group 'wrap-to-fill)
+
+(defun wrap-to-fill-turn-on-in-buffer ()
+ "Turn on fun for globalization."
+ (when (catch 'turn-on
+ (dolist (m wrap-to-fill-major-modes)
+ (when (derived-mode-p m)
+ (throw 'turn-on t))))
+ (wrap-to-fill-column-mode 1)))
+
+(define-globalized-minor-mode wrap-to-fill-column-global-mode wrap-to-fill-column-mode
+ wrap-to-fill-turn-on-in-buffer
+ :group 'wrap-to-fill)
+
+;; Fix-me: There is a confusion between buffer and window margins
+;; here. Also the doc says that left-margin-width and dito right may
+;; be nil. However they seem to be 0 by default, but when displaying a
+;; buffer in a window then window-margins returns (nil).
+
+(defvar wrap-to-fill-timer nil)
+(make-variable-buffer-local 'wrap-to-fill-timer)
+
+(defun wrap-to-fill-set-values ()
+ (when (timerp wrap-to-fill-timer)
+ (cancel-timer wrap-to-fill-timer))
+ (setq wrap-to-fill-timer
+ (run-with-idle-timer 0 nil 'wrap-to-fill-set-values-in-timer
+ (selected-window) (current-buffer))))
+(put 'wrap-to-fill-set-values 'permanent-local-hook t)
+
+(defun wrap-to-fill-set-values-in-timer (win buf)
+ (condition-case err
+ (when (buffer-live-p buf)
+ (wrap-to-fill-set-values-in-buffer-windows buf))
+ (error (message "ERROR wrap-to-fill-set-values-in-timer: %s"
+ (error-message-string err)))))
+
+(defun wrap-to-fill-set-values-in-timer-old (win buf)
+ (when (and (window-live-p win) (buffer-live-p buf)
+ (eq buf (window-buffer win)))
+ (condition-case err
+ (with-current-buffer buf
+ (when wrap-to-fill-column-mode
+ (wrap-to-fill-set-values-in-window win)))
+ (error (message "ERROR wrap-to-fill-set-values: %s"
+ (error-message-string err))))))
+
+(defun wrap-to-fill-set-values-in-buffer-windows (&optional buffer)
+ "Use `fill-column' display columns in buffer windows."
+ (let ((buf-windows (get-buffer-window-list (or buffer
+ (current-buffer))
+ nil
+ t)))
+ (dolist (win buf-windows)
+ (if wrap-to-fill-column-mode
+ (wrap-to-fill-set-values-in-window win)
+ (set-window-buffer nil (current-buffer))))))
+
+(defvar wrap-old-win-width nil)
+(make-variable-buffer-local 'wrap-old-win-width)
+;; Fix-me: compensate for left-margin-width etc
+(defun wrap-to-fill-set-values-in-window (win)
+ (with-current-buffer (window-buffer win)
+ (when wrap-to-fill-column-mode
+ (let* ((win-width (window-width win))
+ (win-margs (window-margins win))
+ (win-full (+ win-width
+ (or (car win-margs) 0)
+ (or (cdr win-margs) 0)))
+ (extra-width (- win-full fill-column))
+ (fill-left-marg (unless (memq major-mode wrap-to-fill-left-marg-modes)
+ (or (when (> left-margin-width 0) left-margin-width)
+ wrap-to-fill-left-marg)))
+ (left-marg (if fill-left-marg
+ fill-left-marg
+ (- (/ extra-width 2) 1)))
+ ;; Fix-me: Why do I have to subtract 1 here...???
+ (right-marg (- win-full fill-column left-marg 1))
+ (need-update nil)
+ )
+ ;; (when wrap-old-win-width
+ ;; (unless (= wrap-old-win-width win-width)
+ ;; (message "-")
+ ;; (message "win-width 0: %s => %s, win-full=%s, e=%s l/r=%s/%s %S %S %S" wrap-old-win-width win-width win-full extra-width left-marg right-marg (window-edges) (window-inside-edges) (window-margins))
+ ;; ))
+ (setq wrap-old-win-width win-width)
+ (unless (> left-marg 0) (setq left-marg 0))
+ (unless (> right-marg 0) (setq right-marg 0))
+ (unless nil;(= left-marg (or left-margin-width 0))
+ ;;(setq left-margin-width left-marg)
+ (setq need-update t))
+ (unless nil;(= right-marg (or right-margin-width 0))
+ ;;(setq right-margin-width right-marg)
+ (setq need-update t))
+ ;;(message "win-width a: %s => %s, win-full=%s, e=%s l/r=%s/%s %S %S %S" wrap-old-win-width win-width win-full extra-width left-margin-width right-margin-width (window-edges) (window-inside-edges) (window-margins))
+ (when need-update
+ ;;(set-window-buffer win (window-buffer win))
+ ;;(run-with-idle-timer 0 nil 'set-window-buffer win (window-buffer win))
+ ;;(dolist (win (get-buffer-window-list (current-buffer)))
+ ;; Fix-me: check window width...
+ (set-window-margins win left-marg right-marg)
+ ;;)
+ ;;(message "win-width b: %s => %s, win-full=%s, e=%s l/r=%s/%s %S %S %S" wrap-old-win-width win-width win-full extra-width left-marg right-marg (window-edges) (window-inside-edges) (window-margins))
+ )
+ ))))
+
+;; (add-hook 'post-command-hook 'my-win-post-command nil t)
+;; (remove-hook 'post-command-hook 'my-win-post-command t)
+(defun my-win-post-command ()
+ (message "win-post-command: l/r=%s/%s %S %S %S" left-margin-width right-margin-width (window-edges) (window-inside-edges) (window-margins))
+ )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Font lock
+
+(defun wrap-to-fill-fontify (bound)
+ (save-restriction
+ (widen)
+ (while (< (point) bound)
+ (let ((this-bol (if (bolp) (point)
+ (1+ (line-end-position)))))
+ (unless (< this-bol bound) (setq this-bol nil))
+ (when this-bol
+ (goto-char (+ this-bol 0))
+ (let (ind-str
+ ind-str-fill
+ (beg-pos this-bol)
+ (end-pos (line-end-position)))
+ (when (equal (get-text-property beg-pos 'wrap-prefix)
+ (get-text-property beg-pos 'wrap-to-fill-prefix))
+ ;; Find indentation
+ (skip-chars-forward "[:blank:]")
+ (setq ind-str (buffer-substring-no-properties beg-pos (point)))
+ ;; Any special markers like -, * etc
+ (if (and (< (1+ (point)) (point-max))
+ (memq (char-after) '(?- ;; 45
+ ?– ;; 8211
+ ?*
+ ))
+ (eq (char-after (1+ (point))) ?\ ))
+ (setq ind-str-fill (concat " " ind-str))
+ (setq ind-str-fill ind-str))
+ ;;(setq ind-str-fill (concat " " ind-str))
+ (mumamo-with-buffer-prepared-for-jit-lock
+ (put-text-property beg-pos end-pos 'wrap-prefix ind-str-fill)
+ (put-text-property beg-pos end-pos 'wrap-to-fill-prefix ind-str-fill))))))
+ (forward-line 1))
+ ;; Note: doing it line by line and returning t gave problem in mumamo.
+ (when nil ;this-bol
+ (set-match-data (list (point) (point)))
+ t)))
+
+(defun wrap-to-fill-font-lock (on)
+ ;; See mlinks.el
+ (let* ((add-or-remove (if on 'font-lock-add-keywords 'font-lock-remove-keywords))
+ (fontify-fun 'wrap-to-fill-fontify)
+ (args (list nil `(( ,fontify-fun ( 0 'font-lock-warning-face t ))))))
+ (when fontify-fun
+ (when on (setq args (append args (list t))))
+ (apply add-or-remove args)
+ (font-lock-mode -1)
+ (font-lock-mode 1))))
+
+(provide 'wrap-to-fill)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; wrap-to-fill.el ends here
--- /dev/null
+;;; zencoding-mode.el --- Unfold CSS-selector-like expressions to markup
+;;
+;; Copyright (C) 2009, Chris Done
+;;
+;; Author: Chris Done <chrisdone@gmail.com>
+(defconst zencoding-mode:version "0.5")
+;; Last-Updated: 2009-11-20 Fri
+;; Keywords: convenience
+;;
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Unfold CSS-selector-like expressions to markup. Intended to be used
+;; with sgml-like languages; xml, html, xhtml, xsl, etc.
+;;
+;; See `zencoding-mode' for more information.
+;;
+;; Copy zencoding-mode.el to your load-path and add to your .emacs:
+;;
+;; (require 'zencoding-mode)
+;;
+;; Example setup:
+;;
+;; (add-to-list 'load-path "~/Emacs/zencoding/")
+;; (require 'zencoding-mode)
+;; (add-hook 'sgml-mode-hook 'zencoding-mode) ;; Auto-start on any markup modes
+;;
+;; Enable the minor mode with M-x zencoding-mode.
+;;
+;; See ``Test cases'' section for a complete set of expression types.
+;;
+;; If you are hacking on this project, eval (zencoding-test-cases) to
+;; ensure that your changes have not broken anything. Feel free to add
+;; new test cases if you add new features.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; History:
+;;
+;; Modified by Lennart Borgman.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Generic parsing macros and utilities
+
+(eval-when-compile (require 'cl))
+
+(defcustom zencoding-preview-default t
+ "If non-nil then preview is the default action.
+This determines how `zencoding-expand-line' works by default."
+ :type 'boolean
+ :group 'zencoding)
+
+(defcustom zencoding-insert-flash-time 0.5
+ "Time to flash insertion.
+Set this to a negative number if you do not want flashing the
+expansion after insertion."
+ :type '(number :tag "Seconds")
+ :group 'zencoding)
+
+(defmacro zencoding-aif (test-form then-form &rest else-forms)
+ "Anaphoric if. Temporary variable `it' is the result of test-form."
+ `(let ((it ,test-form))
+ (if it ,then-form ,@(or else-forms '(it)))))
+
+(defmacro zencoding-pif (test-form then-form &rest else-forms)
+ "Parser anaphoric if. Temporary variable `it' is the result of test-form."
+ `(let ((it ,test-form))
+ (if (not (eq 'error (car it))) ,then-form ,@(or else-forms '(it)))))
+
+(defmacro zencoding-parse (regex nums label &rest body)
+ "Parse according to a regex and update the `input' variable."
+ `(zencoding-aif (zencoding-regex ,regex input ',(number-sequence 0 nums))
+ (let ((input (elt it ,nums)))
+ ,@body)
+ `,`(error ,(concat "expected " ,label))))
+
+(defmacro zencoding-run (parser then-form &rest else-forms)
+ "Run a parser and update the input properly, extract the parsed
+ expression."
+ `(zencoding-pif (,parser input)
+ (let ((input (cdr it))
+ (expr (car it)))
+ ,then-form)
+ ,@(or else-forms '(it))))
+
+(defmacro zencoding-por (parser1 parser2 then-form &rest else-forms)
+ "OR two parsers. Try one parser, if it fails try the next."
+ `(zencoding-pif (,parser1 input)
+ (let ((input (cdr it))
+ (expr (car it)))
+ ,then-form)
+ (zencoding-pif (,parser2 input)
+ (let ((input (cdr it))
+ (expr (car it)))
+ ,then-form)
+ ,@else-forms)))
+
+(defun zencoding-regex (regexp string refs)
+ "Return a list of (`ref') matches for a `regex' on a `string' or nil."
+ (if (string-match (concat "^" regexp "\\([^\n]*\\)$") string)
+ (mapcar (lambda (ref) (match-string ref string))
+ (if (sequencep refs) refs (list refs)))
+ nil))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Zen coding parsers
+
+(defun zencoding-expr (input)
+ "Parse a zen coding expression. This pretty much defines precedence."
+ (zencoding-run zencoding-siblings
+ it
+ (zencoding-run zencoding-parent-child
+ it
+ (zencoding-run zencoding-multiplier
+ it
+ (zencoding-run zencoding-pexpr
+ it
+ (zencoding-run zencoding-tag
+ it
+ '(error "no match, expecting ( or a-zA-Z0-9")))))))
+
+(defun zencoding-multiplier (input)
+ (zencoding-por zencoding-pexpr zencoding-tag
+ (let ((multiplier expr))
+ (zencoding-parse "\\*\\([0-9]+\\)" 2 "*n where n is a number"
+ (let ((multiplicand (read (elt it 1))))
+ `((list ,(make-list multiplicand multiplier)) . ,input))))
+ '(error "expected *n multiplier")))
+
+(defun zencoding-tag (input)
+ "Parse a tag."
+ (zencoding-run zencoding-tagname
+ (let ((result it)
+ (tagname (cdr expr)))
+ (zencoding-pif (zencoding-run zencoding-identifier
+ (zencoding-tag-classes
+ `(tag ,tagname ((id ,(cddr expr)))) input)
+ (zencoding-tag-classes `(tag ,tagname ()) input))
+ (let ((expr-and-input it) (expr (car it)) (input (cdr it)))
+ (zencoding-pif (zencoding-tag-props expr input)
+ it
+ expr-and-input))))
+ '(error "expected tagname")))
+
+(defun zencoding-tag-props (tag input)
+ (zencoding-run zencoding-props
+ (let ((tagname (cadr tag))
+ (existing-props (caddr tag))
+ (props (cdr expr)))
+ `((tag ,tagname
+ ,(append existing-props props))
+ . ,input))))
+
+(defun zencoding-props (input)
+ "Parse many props."
+ (zencoding-run zencoding-prop
+ (zencoding-pif (zencoding-props input)
+ `((props . ,(cons expr (cdar it))) . ,(cdr it))
+ `((props . ,(list expr)) . ,input))))
+
+(defun zencoding-prop (input)
+ (zencoding-parse
+ " " 1 "space"
+ (zencoding-run
+ zencoding-name
+ (let ((name (cdr expr)))
+ (zencoding-parse "=\\([^\\,\\+\\>\\ )]*\\)" 2
+ "=property value"
+ (let ((value (elt it 1))
+ (input (elt it 2)))
+ `((,(read name) ,value) . ,input)))))))
+
+(defun zencoding-tag-classes (tag input)
+ (zencoding-run zencoding-classes
+ (let ((tagname (cadr tag))
+ (props (caddr tag))
+ (classes `(class ,(mapconcat
+ (lambda (prop)
+ (cdadr prop))
+ (cdr expr)
+ " "))))
+ `((tag ,tagname ,(append props (list classes))) . ,input))
+ `(,tag . ,input)))
+
+(defun zencoding-tagname (input)
+ "Parse a tagname a-zA-Z0-9 tagname (e.g. html/head/xsl:if/br)."
+ (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9:-]*\\)" 2 "tagname, a-zA-Z0-9"
+ `((tagname . ,(elt it 1)) . ,input)))
+
+(defun zencoding-pexpr (input)
+ "A zen coding expression with parentheses around it."
+ (zencoding-parse "(" 1 "("
+ (zencoding-run zencoding-expr
+ (zencoding-aif (zencoding-regex ")" input '(0 1))
+ `(,expr . ,(elt it 1))
+ '(error "expecting `)'")))))
+
+(defun zencoding-parent-child (input)
+ "Parse an tag>e expression, where `n' is an tag and `e' is any
+ expression."
+ (zencoding-run zencoding-multiplier
+ (let* ((items (cadr expr))
+ (rest (zencoding-child-sans expr input)))
+ (if (not (eq (car rest) 'error))
+ (let ((child (car rest))
+ (input (cdr rest)))
+ (cons (cons 'list
+ (cons (mapcar (lambda (parent)
+ `(parent-child ,parent ,child))
+ items)
+ nil))
+ input))
+ '(error "expected child")))
+ (zencoding-run zencoding-tag
+ (zencoding-child expr input)
+ '(error "expected parent"))))
+
+(defun zencoding-child-sans (parent input)
+ (zencoding-parse ">" 1 ">"
+ (zencoding-run zencoding-expr
+ it
+ '(error "expected child"))))
+
+(defun zencoding-child (parent input)
+ (zencoding-parse ">" 1 ">"
+ (zencoding-run zencoding-expr
+ (let ((child expr))
+ `((parent-child ,parent ,child) . ,input))
+ '(error "expected child"))))
+
+(defun zencoding-sibling (input)
+ (zencoding-por zencoding-pexpr zencoding-multiplier
+ it
+ (zencoding-run zencoding-tag
+ it
+ '(error "expected sibling"))))
+
+(defun zencoding-siblings (input)
+ "Parse an e+e expression, where e is an tag or a pexpr."
+ (zencoding-run zencoding-sibling
+ (let ((parent expr))
+ (zencoding-parse "\\+" 1 "+"
+ (zencoding-run zencoding-expr
+ (let ((child expr))
+ `((zencoding-siblings ,parent ,child) . ,input))
+ '(error "expected second sibling"))))
+ '(error "expected first sibling")))
+
+(defun zencoding-name (input)
+ "Parse a class or identifier name, e.g. news, footer, mainimage"
+ (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9-_]*\\)" 2 "class or identifer name"
+ `((name . ,(elt it 1)) . ,input)))
+
+(defun zencoding-class (input)
+ "Parse a classname expression, e.g. .foo"
+ (zencoding-parse "\\." 1 "."
+ (zencoding-run zencoding-name
+ `((class ,expr) . ,input)
+ '(error "expected class name"))))
+
+(defun zencoding-identifier (input)
+ "Parse an identifier expression, e.g. #foo"
+ (zencoding-parse "#" 1 "#"
+ (zencoding-run zencoding-name
+ `((identifier . ,expr) . ,input))))
+
+(defun zencoding-classes (input)
+ "Parse many classes."
+ (zencoding-run zencoding-class
+ (zencoding-pif (zencoding-classes input)
+ `((classes . ,(cons expr (cdar it))) . ,(cdr it))
+ `((classes . ,(list expr)) . ,input))
+ '(error "expected class")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Zen coding transformer from AST to HTML
+
+;; Fix-me: make mode specific
+(defvar zencoding-single-tags
+ '("br"
+ "img"))
+
+(defvar zencoding-inline-tags
+ '("a"
+ "abbr"
+ "acronym"
+ "cite"
+ "code"
+ "dfn"
+ "em"
+ "h1" "h2" "h3" "h4" "h5" "h6"
+ "kbd"
+ "q"
+ "span"
+ "strong"
+ "var"))
+
+(defvar zencoding-block-tags
+ '("p"))
+
+;; li
+;; a
+;; em
+;; p
+
+(defvar zencoding-leaf-function nil
+ "Function to execute when expanding a leaf node in the
+ Zencoding AST.")
+
+(defun zencoding-make-tag (tag &optional content)
+ (let* ((name (car tag))
+ (lf (if
+ (or
+ (member name zencoding-block-tags)
+ (and
+ (> (length name) 1)
+ (not (member name zencoding-inline-tags))
+ ))
+ "\n" ""))
+ (single (member name zencoding-single-tags))
+ (props (apply 'concat (mapcar
+ (lambda (prop)
+ (concat " " (symbol-name (car prop))
+ "=\"" (cadr prop) "\""))
+ (cadr tag)))))
+ (concat lf "<" name props ">" lf
+ (if single
+ ""
+ (concat
+ (if content content
+ (if zencoding-leaf-function
+ (funcall zencoding-leaf-function)
+ ""))
+ lf "</" name ">")))))
+
+(defun zencoding-transform (ast)
+ (let ((type (car ast)))
+ (cond
+ ((eq type 'list)
+ (mapconcat 'zencoding-transform (cadr ast) ""))
+ ((eq type 'tag)
+ (zencoding-make-tag (cdr ast)))
+ ((eq type 'parent-child)
+ (let ((parent (cdadr ast))
+ (children (zencoding-transform (caddr ast))))
+ (zencoding-make-tag parent children)))
+ ((eq type 'zencoding-siblings)
+ (let ((sib1 (zencoding-transform (cadr ast)))
+ (sib2 (zencoding-transform (caddr ast))))
+ (concat sib1 sib2))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Test-cases
+
+(defun zencoding-test-cases ()
+ (let ((tests '(;; Tags
+ ("a" "<a></a>")
+ ("a.x" "<a class=\"x\"></a>")
+ ("a#q.x" "<a id=\"q\" class=\"x\"></a>")
+ ("a#q.x.y.z" "<a id=\"q\" class=\"x y z\"></a>")
+ ;; Siblings
+ ("a+b" "<a></a><b></b>")
+ ("a+b+c" "<a></a><b></b><c></c>")
+ ("a.x+b" "<a class=\"x\"></a><b></b>")
+ ("a#q.x+b" "<a id=\"q\" class=\"x\"></a><b></b>")
+ ("a#q.x.y.z+b" "<a id=\"q\" class=\"x y z\"></a><b></b>")
+ ("a#q.x.y.z+b#p.l.m.n" "<a id=\"q\" class=\"x y z\"></a><b id=\"p\" class=\"l m n\"></b>")
+ ;; Parent > child
+ ("a>b" "<a><b></b></a>")
+ ("a>b>c" "<a><b><c></c></b></a>")
+ ("a.x>b" "<a class=\"x\"><b></b></a>")
+ ("a#q.x>b" "<a id=\"q\" class=\"x\"><b></b></a>")
+ ("a#q.x.y.z>b" "<a id=\"q\" class=\"x y z\"><b></b></a>")
+ ("a#q.x.y.z>b#p.l.m.n" "<a id=\"q\" class=\"x y z\"><b id=\"p\" class=\"l m n\"></b></a>")
+ ("a>b+c" "<a><b></b><c></c></a>")
+ ("a>b+c>d" "<a><b></b><c><d></d></c></a>")
+ ;; Multiplication
+ ("a*1" "<a></a>")
+ ("a*2" "<a></a><a></a>")
+ ("a*2+b*2" "<a></a><a></a><b></b><b></b>")
+ ("a*2>b*2" "<a><b></b><b></b></a><a><b></b><b></b></a>")
+ ("a>b*2" "<a><b></b><b></b></a>")
+ ("a#q.x>b#q.x*2" "<a id=\"q\" class=\"x\"><b id=\"q\" class=\"x\"></b><b id=\"q\" class=\"x\"></b></a>")
+ ;; Properties
+ ("a x=y" "<a x=\"y\"></a>")
+ ("a x=y m=l" "<a x=\"y\" m=\"l\"></a>")
+ ("a#foo x=y m=l" "<a id=\"foo\" x=\"y\" m=\"l\"></a>")
+ ("a.foo x=y m=l" "<a class=\"foo\" x=\"y\" m=\"l\"></a>")
+ ("a#foo.bar.mu x=y m=l" "<a id=\"foo\" class=\"bar mu\" x=\"y\" m=\"l\"></a>")
+ ("a x=y+b" "<a x=\"y\"></a><b></b>")
+ ("a x=y+b x=y" "<a x=\"y\"></a><b x=\"y\"></b>")
+ ("a x=y>b" "<a x=\"y\"><b></b></a>")
+ ("a x=y>b x=y" "<a x=\"y\"><b x=\"y\"></b></a>")
+ ("a x=y>b x=y+c x=y" "<a x=\"y\"><b x=\"y\"></b><c x=\"y\"></c></a>")
+ ;; Parentheses
+ ("(a)" "<a></a>")
+ ("(a)+(b)" "<a></a><b></b>")
+ ("a>(b)" "<a><b></b></a>")
+ ("(a>b)>c" "<a><b></b></a>")
+ ("(a>b)+c" "<a><b></b></a><c></c>")
+ ("z+(a>b)+c+k" "<z></z><a><b></b></a><c></c><k></k>")
+ ("(a)*2" "<a></a><a></a>")
+ ("((a)*2)" "<a></a><a></a>")
+ ("((a)*2)" "<a></a><a></a>")
+ ("(a>b)*2" "<a><b></b></a><a><b></b></a>")
+ ("(a+b)*2" "<a></a><b></b><a></a><b></b>")
+ )))
+ (mapc (lambda (input)
+ (let ((expected (cadr input))
+ (actual (zencoding-transform (car (zencoding-expr (car input))))))
+ (if (not (equal expected actual))
+ (error (concat "Assertion " (car input) " failed:"
+ expected
+ " == "
+ actual)))))
+ tests)
+ (concat (number-to-string (length tests)) " tests performed. All OK.")))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Zencoding minor mode
+
+;;;###autoload
+(defgroup zencoding nil
+ "Customization group for zencoding-mode."
+ :group 'convenience)
+
+(defun zencoding-expr-on-line ()
+ "Extract a zencoding expression and the corresponding bounds
+ for the current line."
+ (let* ((start (line-beginning-position))
+ (end (line-end-position))
+ (line (buffer-substring-no-properties start end))
+ (expr (zencoding-regex "\\([ \t]*\\)\\([^\n]+\\)" line 2)))
+ (if (first expr)
+ (list (first expr) start end))))
+
+(defun zencoding-prettify (markup indent)
+ (save-match-data
+ ;;(setq markup (replace-regexp-in-string "><" ">\n<" markup))
+ (setq markup (replace-regexp-in-string "\n\n" "\n" markup))
+ (setq markup (replace-regexp-in-string "^\n" "" markup)))
+ (with-temp-buffer
+ (indent-to indent)
+ (insert "<i></i>")
+ (insert "\n")
+ (let ((here (point)))
+ (insert markup)
+ (sgml-mode)
+ (indent-region here (point-max))
+ (buffer-substring-no-properties here (point-max)))))
+
+;;;###autoload
+(defun zencoding-expand-line (arg)
+ "Replace the current line's zencode expression with the corresponding expansion.
+If prefix ARG is given or region is visible call `zencoding-preview' to start an
+interactive preview.
+
+Otherwise expand line directly.
+
+For more information see `zencoding-mode'."
+ (interactive "P")
+ (let* ((here (point))
+ (preview (if zencoding-preview-default (not arg) arg))
+ (beg (if preview
+ (progn
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (point))
+ (when mark-active (region-beginning))))
+ (end (if preview
+ (progn
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (point))
+ (when mark-active (region-end)))))
+ (if beg
+ (progn
+ (goto-char here)
+ (zencoding-preview beg end))
+ (let ((expr (zencoding-expr-on-line)))
+ (if expr
+ (let* ((markup (zencoding-transform (car (zencoding-expr (first expr)))))
+ (pretty (zencoding-prettify markup (current-indentation))))
+ (save-excursion
+ (delete-region (second expr) (third expr))
+ (zencoding-insert-and-flash pretty))))))))
+
+(defvar zencoding-mode-keymap nil
+ "Keymap for zencode minor mode.")
+
+(if zencoding-mode-keymap
+ nil
+ (progn
+ (setq zencoding-mode-keymap (make-sparse-keymap))
+ (define-key zencoding-mode-keymap (kbd "<C-return>") 'zencoding-expand-line)))
+
+;;;###autoload
+(define-minor-mode zencoding-mode
+ "Minor mode for writing HTML and CSS markup.
+With zen coding for HTML and CSS you can write a line like
+
+ ul#name>li.item*2
+
+and have it expanded to
+
+ <ul id=\"name\">
+ <li class=\"item\"></li>
+ <li class=\"item\"></li>
+ </ul>
+
+This minor mode defines keys for quick access:
+
+\\{zencoding-mode-keymap}
+
+Home page URL `http://www.emacswiki.org/emacs/ZenCoding'.
+
+See also `zencoding-expand-line'."
+ :lighter " Zen"
+ :keymap zencoding-mode-keymap)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Zencoding yasnippet integration
+
+(defun zencoding-transform-yas (ast)
+ (let* ((leaf-count 0)
+ (zencoding-leaf-function
+ (lambda ()
+ (format "$%d" (incf leaf-count)))))
+ (zencoding-transform ast)))
+
+;;;###autoload
+(defun zencoding-expand-yas ()
+ (interactive)
+ (let ((expr (zencoding-expr-on-line)))
+ (if expr
+ (let* ((markup (zencoding-transform-yas (car (zencoding-expr (first expr)))))
+ (filled (replace-regexp-in-string "><" ">\n<" markup)))
+ (delete-region (second expr) (third expr))
+ (insert filled)
+ (indent-region (second expr) (point))
+ (yas/expand-snippet
+ (buffer-substring (second expr) (point))
+ (second expr) (point))))))
+
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Real-time preview
+;;
+
+;;;;;;;;;;
+;; Lennart's version
+
+(defvar zencoding-preview-input nil)
+(make-local-variable 'zencoding-preview-input)
+(defvar zencoding-preview-output nil)
+(make-local-variable 'zencoding-preview-output)
+(defvar zencoding-old-show-paren nil)
+(make-local-variable 'zencoding-old-show-paren)
+
+(defface zencoding-preview-input
+ '((default :box t :inherit secondary-selection))
+ "Face for preview input field."
+ :group 'zencoding)
+
+(defface zencoding-preview-output
+ '((default :inherit highlight))
+ "Face for preview output field."
+ :group 'zencoding)
+
+(defvar zencoding-preview-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<return>") 'zencoding-preview-accept)
+ (define-key map [(control ?g)] 'zencoding-preview-abort)
+ map))
+
+(defun zencoding-preview-accept ()
+ (interactive)
+ (let ((ovli zencoding-preview-input))
+ (if (not (and (overlayp ovli)
+ (bufferp (overlay-buffer ovli))))
+ (message "Preview is not active")
+ (let* ((indent (current-indentation))
+ (markup (zencoding-preview-transformed indent)))
+ (when markup
+ (delete-region (line-beginning-position) (overlay-end ovli))
+ (zencoding-insert-and-flash markup)))))
+ (zencoding-preview-abort))
+
+(defvar zencoding-flash-ovl nil)
+(make-variable-buffer-local 'zencoding-flash-ovl)
+
+(defun zencoding-remove-flash-ovl (buf)
+ (with-current-buffer buf
+ (when (overlayp zencoding-flash-ovl)
+ (delete-overlay zencoding-flash-ovl))
+ (setq zencoding-flash-ovl nil)))
+
+(defun zencoding-insert-and-flash (markup)
+ (zencoding-remove-flash-ovl (current-buffer))
+ (let ((here (point)))
+ (insert markup)
+ (setq zencoding-flash-ovl (make-overlay here (point)))
+ (overlay-put zencoding-flash-ovl 'face 'zencoding-preview-output)
+ (when (< 0 zencoding-insert-flash-time)
+ (run-with-idle-timer zencoding-insert-flash-time
+ nil 'zencoding-remove-flash-ovl (current-buffer)))))
+
+;;;###autoload
+(defun zencoding-preview (beg end)
+ "Expand zencode between BEG and END interactively.
+This will show a preview of the expanded zen code and you can
+accept it or skip it."
+ (interactive (if mark-active
+ (list (region-beginning) (region-end))
+ (list nil nil)))
+ (zencoding-preview-abort)
+ (if (not beg)
+ (message "Region not active")
+ (setq zencoding-old-show-paren show-paren-mode)
+ (show-paren-mode -1)
+ (let ((here (point)))
+ (goto-char beg)
+ (forward-line 1)
+ (unless (= 0 (current-column))
+ (insert "\n"))
+ (let* ((opos (point))
+ (ovli (make-overlay beg end nil nil t))
+ (ovlo (make-overlay opos opos))
+ (info (propertize " Zen preview. Choose with RET. Cancel by stepping out. \n"
+ 'face 'tooltip)))
+ (overlay-put ovli 'face 'zencoding-preview-input)
+ (overlay-put ovli 'keymap zencoding-preview-keymap)
+ (overlay-put ovlo 'face 'zencoding-preview-output)
+ (overlay-put ovlo 'before-string info)
+ (setq zencoding-preview-input ovli)
+ (setq zencoding-preview-output ovlo)
+ (add-hook 'before-change-functions 'zencoding-preview-before-change t t)
+ (goto-char here)
+ (add-hook 'post-command-hook 'zencoding-preview-post-command t t)))))
+
+(defvar zencoding-preview-pending-abort nil)
+(make-variable-buffer-local 'zencoding-preview-pending-abort)
+
+(defun zencoding-preview-before-change (beg end)
+ (when
+ (or (> beg (overlay-end zencoding-preview-input))
+ (< beg (overlay-start zencoding-preview-input))
+ (> end (overlay-end zencoding-preview-input))
+ (< end (overlay-start zencoding-preview-input)))
+ (setq zencoding-preview-pending-abort t)))
+
+(defun zencoding-preview-abort ()
+ "Abort zen code preview."
+ (interactive)
+ (setq zencoding-preview-pending-abort nil)
+ (remove-hook 'before-change-functions 'zencoding-preview-before-change t)
+ (when (overlayp zencoding-preview-input)
+ (delete-overlay zencoding-preview-input))
+ (setq zencoding-preview-input nil)
+ (when (overlayp zencoding-preview-output)
+ (delete-overlay zencoding-preview-output))
+ (setq zencoding-preview-output nil)
+ (remove-hook 'post-command-hook 'zencoding-preview-post-command t)
+ (when zencoding-old-show-paren (show-paren-mode 1)))
+
+(defun zencoding-preview-post-command ()
+ (condition-case err
+ (zencoding-preview-post-command-1)
+ (error (message "zencoding-preview-post: %s" err))))
+
+(defun zencoding-preview-post-command-1 ()
+ (if (and (not zencoding-preview-pending-abort)
+ (<= (point) (overlay-end zencoding-preview-input))
+ (>= (point) (overlay-start zencoding-preview-input)))
+ (zencoding-update-preview (current-indentation))
+ (zencoding-preview-abort)))
+
+(defun zencoding-preview-transformed (indent)
+ (let* ((string (buffer-substring-no-properties
+ (overlay-start zencoding-preview-input)
+ (overlay-end zencoding-preview-input)))
+ (ast (car (zencoding-expr string))))
+ (when (not (eq ast 'error))
+ (zencoding-prettify (zencoding-transform ast)
+ indent))))
+
+(defun zencoding-update-preview (indent)
+ (let* ((pretty (zencoding-preview-transformed indent))
+ (show (when pretty
+ (propertize pretty 'face 'highlight))))
+ (when show
+ (overlay-put zencoding-preview-output 'after-string
+ (concat show "\n")))))
+;; a+bc
+
+;;;;;;;;;;
+;; Chris's version
+
+;; (defvar zencoding-realtime-preview-keymap
+;; (let ((map (make-sparse-keymap)))
+;; (define-key map "\C-c\C-c" 'zencoding-delete-overlay-pair)
+
+;; map)
+;; "Keymap used in zencoding realtime preview overlays.")
+
+;; ;;;###autoload
+;; (defun zencoding-realtime-preview-of-region (beg end)
+;; "Construct a real-time preview for the region BEG to END."
+;; (interactive "r")
+;; (let ((beg2)
+;; (end2))
+;; (save-excursion
+;; (goto-char beg)
+;; (forward-line)
+;; (setq beg2 (point)
+;; end2 (point))
+;; (insert "\n"))
+;; (let ((input-and-output (zencoding-make-overlay-pair beg end beg2 end2)))
+;; (zencoding-handle-overlay-change (car input-and-output) nil nil nil)))
+;; )
+
+;; (defun zencoding-make-overlay-pair (beg1 end1 beg2 end2)
+;; "Construct an input and an output overlay for BEG1 END1 and BEG2 END2"
+;; (let ((input (make-overlay beg1 end1 nil t t))
+;; (output (make-overlay beg2 end2)))
+;; ;; Setup input overlay
+;; (overlay-put input 'face '(:underline t))
+;; (overlay-put input 'modification-hooks
+;; (list #'zencoding-handle-overlay-change))
+;; (overlay-put input 'output output)
+;; (overlay-put input 'keymap zencoding-realtime-preview-keymap)
+;; ;; Setup output overlay
+;; (overlay-put output 'face '(:overline t))
+;; (overlay-put output 'intangible t)
+;; (overlay-put output 'input input)
+;; ;; Return the overlays.
+;; (list input output))
+;; )
+
+;; (defun zencoding-delete-overlay-pair (&optional one)
+;; "Delete a pair of input and output overlays based on ONE."
+;; (interactive) ;; Since called from keymap
+;; (unless one
+;; (let ((overlays (overlays-at (point))))
+;; (while (and overlays
+;; (not (or (overlay-get (car overlays) 'input)
+;; (overlay-get (car overlays) 'output))))
+;; (setq overlays (cdr overlays)))
+;; (setq one (car overlays))))
+;; (when one
+;; (let ((other (or (overlay-get one 'input)
+;; (overlay-get one 'output))))
+;; (delete-overlay one)
+;; (delete-overlay other)))
+;; )
+
+;; (defun zencoding-handle-overlay-change (input del beg end &optional old)
+;; "Update preview after overlay change."
+;; (let* ((output (overlay-get input 'output))
+;; (start (overlay-start output))
+;; (string (buffer-substring-no-properties
+;; (overlay-start input)
+;; (overlay-end input)))
+;; (ast (car (zencoding-expr string)))
+;; (markup (when (not (eq ast 'error))
+;; (zencoding-transform ast))))
+;; (save-excursion
+;; (delete-region start (overlay-end output))
+;; (goto-char start)
+;; (if markup
+;; (insert markup)
+;; (insert (propertize "error" 'face 'font-lock-error-face)))
+;; (move-overlay output start (point))))
+;; )
+
+(provide 'zencoding-mode)
+
+;;; zencoding-mode.el ends here
--- /dev/null
+;;; web-autoload.el --- Autoload from web site
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-12-26 Sat
+;; Version:
+;; Last-Updated:
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Experimental code. Not ready to use at all.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;(eval-when-compile (require 'web-vcs)) ;; Gives recursion
+;;(eval-when-compile (require 'nxhtml-base))
+
+(defcustom web-autoload-autocompile t
+ "Byt compile downloaded files if t."
+ :type 'boolean
+ :group 'web-vcs)
+
+(defun web-autoload (fun src docstring interactive type)
+ "Set up FUN to be autoloaded from SRC.
+This works similar to `autoload' and the arguments DOCSTRING,
+INTERACTIVE and TYPE are handled similary.
+
+However loading can be done from a web url.
+In that case SRC should have the format
+
+ (WEB-VCS BASE-URL RELATIVE-URL BASE-DIR)
+
+where
+
+ - WEB-VCS is specifies a web repository type, see
+ `web-vcs-get-files-from-root'.
+ - BASE-URL is the base url, similar to the URL argument to the
+ function above.
+
+ - RELATIVE-URL is relative location. This will be relative to
+ BASE-DIR in file tree and to BASE-URL on the web \(only
+ logically in the latter case).
+
+Loading will be done from the file resulting from expanding
+RELATIVE-URL relative to BASE-DIR. If this file exists load it
+directly, otherwise download it first."
+ (unless (functionp fun)
+ (let ((int (when interactive '(interactive))))
+ (cond
+ ((eq type 'macro)
+ (setq type 'defmacro))
+ (t
+ (setq type 'defun)))
+ (put fun 'web-autoload src)
+ (eval
+ `(web-autoload-1 ,fun ,src ,docstring ,int ,type)))))
+
+;; (defun web-autoload-default-filename-element ()
+;; ;; Fix-me: el or elc?
+;; ;; Fix-me: remove nxhtml binding
+;; (expand-file-name "nxhtml-loaddefs.elc" nxhtml-install-dir))
+
+;; Fix-me: change name
+(defvar web-autoload-skip-require-advice nil)
+
+;; Fix-me: Use TYPE
+(defmacro web-autoload-1 (fun src docstring interactive type)
+ `(progn
+ (,type ,fun (&rest args)
+ ,(concat docstring
+ "\n\nArguments are not yet known since the real function is not loaded."
+ "\nFunction is defined by `web-autoload' to be loaded using definition\n\n "
+ (format "%S"
+ src))
+ ,interactive
+ ;; (find-lisp-object-file-name 'chart-complete 'defun)
+ (let* ((lib-web (or (find-lisp-object-file-name ',fun 'defun)
+ ;;(web-autoload-default-filename-element)
+ ))
+ (old-hist-elt (when lib-web (load-history-filename-element lib-web)))
+ (auto-fun (symbol-function ',fun))
+ err)
+ ;; Fix-me: Can't do this because we may have to go back here again...
+ ;;(fset ',fun nil)
+ (if (not (listp ',src))
+ ;; Just a local file, for testing of logics.
+ (let ((lib-file (locate-library ',src)))
+ (load ',src)
+ (unless (symbol-function ',fun)
+ (setq err (format "%s is not in library %s" ',fun lib-file))))
+ ;; If file is a list then it should be a web url:
+ ;; (web-vcs base-url relative-url base-dir)
+ ;; Convert from repository url to file download url.
+ (let* (;;(vcs (nth 0 ',src))
+ ;;(base-url (nth 1 ',src))
+ (rel-url (nth 2 ',src))
+ ;;(base-dir (nth 3 ',src))
+ ;;(rel-url-el (concat rel-url ".el"))
+ ;;file-url
+ ;;dl-file
+ )
+ ;;(unless (stringp base-url) (setq base-url (symbol-value base-url)))
+ ;;(unless (stringp base-dir) (setq base-dir (symbol-value base-dir)))
+ ;;(setq dl-file (expand-file-name rel-url-el base-dir))
+ (web-vcs-message-with-face 'web-vcs-gold "web-autoload-1: BEG fun=%s" ',fun)
+ ;; Fix-me: assume we can do require (instead of load, so
+ ;; we do not have to defadvice load to).
+ (unless (ad-is-advised 'require)
+ (error "web-autoload-1: require is not advised"))
+ (unless (ad-is-active 'require)
+ (error "web-autoload-1: require advice is not active"))
+ (when (catch 'web-autoload-comp-restart
+ (require (intern (file-name-nondirectory rel-url)))
+ nil)
+ (web-autoload-byte-compile-queue))
+ (when (equal (symbol-function ',fun) auto-fun)
+ (error "Couldn't web autoload function %s" ',fun))
+ (web-vcs-message-with-face 'web-vcs-gold "web-autoload-1: END fun=%s" ',fun)
+ (web-vcs-log-save)
+ ))
+ ;; Fix-me: Wrong place to do the cleanup! It must be done
+ ;; after loading a file. All autoload in that file must be
+ ;; deleted from the nxhtml-loaddefs entry.
+ ;;
+ ;; Delete old load-history entry for ,fun. A new entry
+ ;; has been added.
+ (let* ((tail (cdr old-hist-elt))
+ (new-tail (when tail (delete (cons 'defun ',fun) tail))))
+ (when tail (setcdr old-hist-elt new-tail)))
+ ;; Finally call the real function
+ (if (called-interactively-p ',fun)
+ (call-interactively ',fun)
+ (if (functionp ',fun)
+ (apply ',fun args)
+ ;; It is a macro
+ (let ((the-macro (append '(,fun) args nil)))
+ (eval the-macro))))))))
+
+;; Fix-me: Set up a byte compilation queue. Move function for byte compiling here.
+
+(defvar web-autoload-cleanup-dummy-el
+ (let* ((this-dir (file-name-directory (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))))
+ (expand-file-name "temp-cleanup.el" this-dir)))
+
+(defun web-autoload-try-cleanup-after-failed-compile (active-comp)
+ (let* ((bc-input-buffer (get-buffer " *Compiler Input*"))
+ (bc-outbuffer (get-buffer " *Compiler Output*"))
+ ;;(active-comp (car web-autoload-compile-queue))
+ (active-file (car active-comp))
+ (active-elc (byte-compile-dest-file active-file)))
+ ;; Delete bytecomp buffers
+ (display-buffer "*Messages*")
+ (web-vcs-message-with-face 'web-vcs-red "Trying to cleanup (%s %s %s)" bc-input-buffer bc-outbuffer active-elc)
+ (when bc-input-buffer (kill-buffer bc-input-buffer))
+ (when bc-outbuffer
+ (kill-buffer bc-outbuffer)
+ (setq bytecomp-outbuffer nil))
+ ;; Delete half finished elc file
+ (when (file-exists-p active-elc)
+ (delete-file active-elc))
+ ;; Delete load-history entry
+ (when nil
+ (setq load-history (cdr load-history)))
+ ;; Try to reset some variables (just guesses)
+ (when nil
+ (setq byte-compile-constants nil)
+ (setq byte-compile-variables nil)
+ (setq byte-compile-bound-variables nil)
+ (setq byte-compile-const-variables nil)
+ ;;(setq byte-compile-macro-environment byte-compile-initial-macro-environment)
+ (setq byte-compile-function-environment nil)
+ (setq byte-compile-unresolved-functions nil)
+ (setq byte-compile-noruntime-functions nil)
+ (setq byte-compile-tag-number 0)
+ (setq byte-compile-output nil)
+ (setq byte-compile-depth 0)
+ (setq byte-compile-maxdepth 0)
+ ;;(setq byte-code-vector nil)
+ (setq byte-compile-current-form nil)
+ (setq byte-compile-dest-file nil)
+ (setq byte-compile-current-file nil)
+ (setq byte-compile-current-group nil)
+ (setq byte-compile-current-buffer nil)
+ (setq byte-compile-read-position nil)
+ (setq byte-compile-last-position nil)
+ (setq byte-compile-last-warned-form nil)
+ (setq byte-compile-last-logged-file nil)
+ ;;(defvar bytecomp-outbuffer)
+ ;;(defvar byte-code-meter)
+ )
+ ;; Try compiling something go get right state ...
+ (when nil
+ (unless (file-exists-p web-autoload-cleanup-dummy-el)
+ (let ((buf (find-file-noselect web-autoload-cleanup-dummy-el)))
+ (with-current-buffer buf
+ (insert ";; Dummy")
+ (basic-save-buffer)
+ (kill-buffer))))
+ (byte-compile-file web-autoload-cleanup-dummy-el nil))))
+
+(defun big-trace ()
+ (setq trace-buffer "*Messages*")
+ (trace-function-background 'byte-compile-form)
+ (trace-function-background 'byte-compile-file-form)
+ (trace-function-background 'byte-optimize-form)
+ (trace-function-background 'byte-compile-normal-call)
+ (trace-function-background 'byte-compile-cl-warn)
+ (trace-function-background 'byte-compile-const-symbol-p)
+ (trace-function-background 'byte-compile-warn)
+ (trace-function-background 'byte-compile-warning-enabled-p)
+ (trace-function-background 'byte-compile-callargs-warn)
+ (trace-function-background 'byte-compile-splice-in-already-compiled-code)
+ (trace-function-background 'byte-inline-lapcode)
+ (trace-function-background 'byte-decompile-bytecode-1)
+ )
+
+(defvar web-autoload-require-list nil)
+
+(defun web-autoload-require (feature web-vcs base-url relative-url base-dir compile-fun)
+ "Prepare to download file if necessary when `require' is called.
+WEB-VCS BASE-URL RELATIVE-URL"
+ (add-to-list 'web-autoload-require-list `(,feature ,web-vcs ,base-url ,relative-url ,base-dir ,compile-fun)))
+
+;;(big-trace)
+
+(provide 'web-autoload)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; web-autoload.el ends here
--- /dev/null
+;;; web-vcs.el --- Download file trees from VCS web pages
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: 2009-11-26 Thu
+(defconst web-vcs:version "0.61") ;; Version:
+;; Last-Updated: 2009-12-11 Fri
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Update file trees within Emacs from VCS systems using information
+;; on their web pages.
+;;
+;; Available download commands are currently:
+;;
+;; `web-vcs-nxhtml'
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-and-compile (require 'cus-edit))
+(eval-and-compile (require 'mm-decode))
+(eval-when-compile (require 'url-http))
+
+(require 'advice)
+(require 'web-autoload nil t)
+;; (require 'url-util)
+;; (require 'url)
+;;(require 'url-parse)
+
+(defvar web-vcs-comp-dir nil)
+
+(defgroup web-vcs nil
+ "Customization group for web-vcs."
+ :group 'nxhtml)
+
+(defcustom web-vcs-links-regexp
+ `(
+ (lp ;; Id
+ ;; Comment:
+ "http://www.launchpad.com/ uses this 2009-11-29 with Loggerhead 1.10 (generic?)"
+ ;; Files URL regexp:
+ ;;
+ ;; Extend this format to catch date/time too.
+ ;;
+ ;; ((patt (rx ...))
+ ;; ;; use subexp numbers
+ ;; (url 1)
+ ;; (time 2)
+ ;; (rev 3))
+
+ ((time 1)
+ (url 2)
+ (patt ,(rx "<td class=\"date\">"
+ (submatch (regexp "[^<]*"))
+ "</td>"
+ (0+ space)
+ "<td class=\"timedate2\">"
+ (regexp ".+")
+ "</td>"
+ (*? (regexp ".\\|\n"))
+ "href=\""
+ (submatch (regexp ".*/download/[^\"]*"))
+ "\"")))
+
+ ;; ,(rx "href=\""
+ ;; (submatch (regexp ".*/download/[^\"]*"))
+ ;; "\"")
+
+ ;; Dirs URL regexp:
+ ,(rx "href=\""
+ (submatch (regexp ".*%3A/[^\"]*/"))
+ "\"")
+ ;; File name URL part regexp:
+ "\\([^\/]*\\)$"
+ ;; Page revision regexp:
+ ,(rx "for revision"
+ (+ whitespace)
+ "<span>"
+ (submatch (+ digit))
+ "</span>")
+ ;; Release revision regexp:
+ ,(rx "/"
+ (submatch (+ digit))
+ "\"" (+ (not (any ">"))) ">"
+ (optional "Release ")
+ (+ digit) "." (+ digit) "<")
+ )
+ )
+ "Regexp patterns for matching links on a VCS web page.
+The patterns are grouped by VCS web system type.
+
+*Note: It is always sub match 1 from these patterns that are
+ used."
+ :type '(repeat
+ (list
+ (symbol :tag "VCS web system type specifier")
+ (string :tag "Description")
+ (regexp :tag "Files URL regexp")
+ (regexp :tag "Dirs URL regexp")
+ (regexp :tag "File name URL part regexp")
+ (regexp :tag "Page revision regexp")
+ (regexp :tag "Release revision regexp")
+ ))
+ :group 'web-vcs)
+
+(defface web-vcs-mode-line
+ '((t (:foreground "black" :background "OrangeRed")))
+ "Mode line face during download."
+ :group 'web-vcs)
+
+(defface web-vcs-mode-line-inactive
+ '((t (:foreground "black" :background "Orange")))
+ "Mode line face during download."
+ :group 'web-vcs)
+
+(defface web-vcs-gold
+ '((t (:foreground "black" :background "gold")))
+ "Face for web-vcs messages."
+ :group 'web-vcs)
+
+(defface web-vcs-red
+ '((t (:foreground "black" :background "#f86")))
+ "Face for web-vcs messages."
+ :group 'web-vcs)
+
+(defface web-vcs-green
+ '((t (:foreground "black" :background "#8f6")))
+ "Face for web-vcs messages."
+ :group 'web-vcs)
+
+(defface web-vcs-yellow
+ '((t (:foreground "black" :background "yellow")))
+ "Face for web-vcs messages."
+ :group 'web-vcs)
+
+(defface web-vcs-pink
+ '((t (:foreground "black" :background "pink")))
+ "Face for web-vcs messages."
+ :group 'web-vcs)
+
+(defcustom web-vcs-default-download-directory
+ '~/.emacs.d/
+ "Default download directory."
+ :type '(choice (const :tag "~/.emacs.d/" '~/.emacs.d/)
+ (const :tag "Fist site-lisp in `load-path'" 'site-lisp-dir)
+ (const :tag "Directory where `site-run-file' lives" 'site-run-dir)
+ (string :tag "Specify directory"))
+ :group 'web-vcs)
+
+;;(web-vcs-default-download-directory)
+;;;###autoload
+(defun web-vcs-default-download-directory ()
+ "Try to find a suitable place.
+Considers site-start.el, site-
+"
+ (let ((site-run-dir (when site-run-file
+ (file-name-directory (locate-library site-run-file))))
+ (site-lisp-dir (catch 'first-site-lisp
+ (dolist (d load-path)
+ (let ((dir (file-name-nondirectory (directory-file-name d))))
+ (when (string= dir "site-lisp")
+ (throw 'first-site-lisp (file-name-as-directory d)))))))
+ )
+ (message "site-run-dir=%S site-lisp-dir=%S" site-run-dir site-lisp-dir)
+ (case web-vcs-default-download-directory
+ ('~/.emacs.d/ "~/.emacs.d/")
+ ('site-lisp-dir site-lisp-dir)
+ ('site-run-dir site-run-dir)
+ (t web-vcs-default-download-directory))
+ ))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Logging
+
+(defcustom web-vcs-log-file "~/.emacs.d/web-vcs-log.org"
+ "Log file for web-vcs."
+ :type 'file
+ :group 'web-vcs)
+
+;;;###autoload
+(defun web-vcs-log-edit ()
+ "Open log file."
+ (interactive)
+ (find-file web-vcs-log-file))
+
+(defvar web-vcs-log-save-timer nil)
+
+(defun web-vcs-log-save-when-idle ()
+ (when (timerp web-vcs-log-save-timer) (cancel-timer web-vcs-log-save-timer))
+ (run-with-idle-timer 0 nil 'web-vcs-log-save))
+
+(defun web-vcs-log-save ()
+ (let ((log-buf (find-buffer-visiting web-vcs-log-file)))
+ (when (and log-buf (buffer-modified-p log-buf))
+ (with-current-buffer log-buf
+ (basic-save-buffer)))
+ log-buf))
+
+(defun web-vcs-log-close ()
+ (let ((log-buf (web-vcs-log-save)))
+ (when log-buf
+ (kill-buffer log-buf))))
+
+;; Fix-me: Add some package descriptor to log
+(defun web-vcs-log (url dl-file msg)
+ (unless (file-exists-p web-vcs-log-file)
+ (let ((dir (file-name-directory web-vcs-log-file)))
+ (unless (file-directory-p dir)
+ (make-directory dir))))
+ (with-current-buffer (find-file-noselect web-vcs-log-file)
+ (setq buffer-save-without-query t)
+ (web-vcs-log-save-when-idle)
+ (save-restriction
+ (widen)
+ (let ((today-entries (format-time-string "* %Y-%m-%d"))
+ (now (format-time-string "%H:%M:%S GMT" nil t)))
+ (goto-char (point-max))
+ (unless (re-search-backward (concat "^" today-entries) nil t)
+ (goto-char (point-max))
+ (insert "\n" today-entries "\n"))
+ (goto-char (point-max))
+ (when url
+ (insert "** Downloading file " now "\n"
+ (format " file [[file:%s][%s]]\n from %s\n" dl-file dl-file url)
+ ))
+ (cond
+ ((stringp msg)
+ (goto-char (point-max))
+ (insert msg "\n"))
+ (msg (basic-save-buffer)))))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Finding and downloading files
+
+;;;###autoload
+(defun web-vcs-get-files-from-root (web-vcs url dl-dir)
+ "Download a file tree from VCS system using the web interface.
+Use WEB-VCS entry in variable `web-vcs-links-regexp' to download
+files via http from URL to directory DL-DIR.
+
+Show URL first and offer to visit the page. That page will give
+you information about version control system \(VCS) system used
+etc."
+ (unless (web-vcs-contains-moved-files dl-dir)
+ (when (if (not (y-or-n-p (concat "Download files from \"" url "\".\n"
+ "You can see on that page which files will be downloaded.\n\n"
+ "Visit that page before downloading? ")))
+ t
+ (browse-url url)
+ (if (y-or-n-p "Start downloading? ")
+ t
+ (message "Aborted")
+ nil))
+ (message "")
+ (web-vcs-get-files-on-page web-vcs url t (file-name-as-directory dl-dir) nil)
+ t)))
+
+(defun web-vcs-get-files-on-page (web-vcs url recursive dl-dir test)
+ "Download files listed by WEB-VCS on web page URL.
+WEB-VCS is a specifier in `web-vcs-links-regexp'.
+
+If RECURSIVE go into sub folders on the web page and download
+files from them too.
+
+Place the files under DL-DIR.
+
+Before downloading check if the downloaded revision already is
+the same as the one on the web page. This is stored in the file
+web-vcs-revision.txt. After downloading update this file.
+
+If TEST is non-nil then do not download, just list the files."
+ (unless (string= dl-dir (file-name-as-directory (expand-file-name dl-dir)))
+ (error "Download dir dl-dir=%S must be a full directory path" dl-dir))
+ (catch 'command-level
+ (when (web-vcs-contains-moved-files dl-dir)
+ (throw 'command-level nil))
+ (let ((vcs-rec (or (assq web-vcs web-vcs-links-regexp)
+ (error "Does not know web-cvs %S" web-vcs)))
+ (start-time (current-time)))
+ (unless (file-directory-p dl-dir)
+ (if (yes-or-no-p (format "Directory %S does not exist, create it? "
+ (file-name-as-directory
+ (expand-file-name dl-dir))))
+ (make-directory dl-dir t)
+ (message "Can't download then")
+ (throw 'command-level nil)))
+ ;; (let ((old-win (selected-window)))
+ ;; (unless (eq (get-buffer "*Messages*") (window-buffer old-win))
+ ;; (switch-to-buffer-other-window "*Messages*"))
+ ;; (goto-char (point-max))
+ ;; (insert "\n")
+ ;; (insert (propertize (format "\n\nWeb-Vcs Download: %S\n" url) 'face 'web-vcs-gold))
+ ;; (insert "\n")
+ ;; (redisplay t)
+ ;; (set-window-point (selected-window) (point-max))
+ ;; (select-window old-win))
+ (web-vcs-message-with-face 'web-vcs-gold "\n\nWeb-Vcs Download: %S\n" url)
+ (web-vcs-display-messages nil)
+ (let* ((rev-file (expand-file-name "web-vcs-revision.txt" dl-dir))
+ (rev-buf (find-file-noselect rev-file))
+ ;; Fix-me: Per web vcs speficier.
+ (old-rev-range (with-current-buffer rev-buf
+ (widen)
+ (goto-char (point-min))
+ (when (re-search-forward (format "%s:\\(.*\\)\n" web-vcs) nil t)
+ ;;(buffer-substring-no-properties (point-min) (line-end-position))
+ ;;(match-string 1)
+ (cons (match-beginning 1) (match-end 1))
+ )))
+ (old-revision (when old-rev-range
+ (with-current-buffer rev-buf
+ (buffer-substring-no-properties (car old-rev-range)
+ (cdr old-rev-range)))))
+ (dl-revision (web-vcs-get-revision-on-page vcs-rec url))
+ ret
+ moved)
+ (when (and old-revision (string= old-revision dl-revision))
+ (when (y-or-n-p (format "You already have revision %s. Quit? " dl-revision))
+ (message "Aborted")
+ (kill-buffer rev-buf)
+ (throw 'command-level nil)))
+ ;; We do not have a revision number once we start download.
+ (with-current-buffer rev-buf
+ (when old-rev-range
+ (delete-region (car old-rev-range) (cdr old-rev-range))
+ (basic-save-buffer)))
+ (setq ret (web-vcs-get-files-on-page-1
+ vcs-rec url
+ dl-dir
+ ""
+ nil
+ (if recursive 0 nil)
+ dl-revision test))
+ (setq moved (nth 1 ret))
+ ;; Now we have a revision number again.
+ (with-current-buffer rev-buf
+ (when (= 0 (buffer-size))
+ (insert "WEB VCS Revisions\n\n"))
+ (goto-char (point-max))
+ (unless (eolp) (insert "\n"))
+ (insert (format "%s:%s\n" web-vcs dl-revision))
+ (basic-save-buffer)
+ (kill-buffer))
+ (message "-----------------")
+ (web-vcs-message-with-face 'web-vcs-gold "Web-Vcs Download Ready: %S" url)
+ (web-vcs-message-with-face 'web-vcs-gold " Time elapsed: %S"
+ (web-vcs-nice-elapsed start-time (current-time)))
+ (when (> moved 0)
+ (web-vcs-message-with-face 'web-vcs-yellow
+ " %i files updated (old versions renamed to *.moved)"
+ moved))))))
+
+(defun web-vcs-get-files-on-page-1 (vcs-rec url dl-root dl-relative file-mask recursive dl-revision test)
+ "Download files listed by VCS-REC on web page URL.
+VCS-REC should be an entry like the entries in the list
+`web-vcs-links-regexp'.
+
+If FILE-MASK is non nil then it is used to match a file path.
+Only matching files will be downloaded. FILE-MASK can have two
+forms, a regular expression or a function.
+
+If FILE-MASK is a regular expression then each part of the path
+may be a regular expresion \(not containing /).
+
+If FILE-MASK is a function then this function is called in each
+directory under DL-ROOT. The function is called with the
+directory as a parameter and should return a cons. The first
+element of the cons should be a regular expression matching file
+names in that directory that should be downloaded. The cdr
+should be t if subdirectories should be visited.
+
+If RECURSIVE go into sub folders on the web page and download
+files from them too.
+
+Place the files under DL-DIR.
+
+The revision on the page URL should match DL-REVISION if this is non-nil.
+
+If TEST is non-nil then do not download, just list the files"
+ ;;(web-vcs-message-with-face 'font-lock-comment-face "web-vcs-get-files-on-page-1 %S %S %S %S" url dl-root dl-relative file-mask)
+ (let* ((files-matcher (nth 2 vcs-rec))
+ (dirs-href-regexp (nth 3 vcs-rec))
+ (revision-regexp (nth 5 vcs-rec))
+ (dl-dir (file-name-as-directory (expand-file-name dl-relative dl-root)))
+ (lst-dl-relative (web-vcs-file-name-as-list dl-relative))
+ (lst-file-mask (when (stringp file-mask) (web-vcs-file-name-as-list file-mask)))
+ ;;(url-buf (url-retrieve-synchronously url))
+ this-page-revision
+ files
+ suburls
+ (moved 0)
+ (temp-file-base (expand-file-name "web-vcs-temp-list.tmp" dl-dir))
+ temp-list-file
+ temp-list-buf
+ folder-res
+ http-sts)
+ ;; Fix-me: It looks like there is maybe a bug in url-copy-file so
+ ;; that it runs synchronously. Try to workaround the problem by
+ ;; making a new file temp file name.
+ (web-vcs-display-messages nil)
+ (unless (file-directory-p dl-dir) (make-directory dl-dir t))
+ ;;(message "TRACE: dl-dir=%S" dl-dir)
+ (setq temp-list-file (make-temp-name temp-file-base))
+ (setq temp-list-buf (web-vcs-ass-folder-cache url))
+ (unless temp-list-buf
+ ;;(setq temp-list-buf (generate-new-buffer "web-wcs-folder"))
+ ;;(web-vcs-url-copy-file-and-check url temp-list-file nil)
+ (setq folder-res (web-vcs-url-retrieve-synch url))
+ ;; (with-current-buffer temp-list-buf
+ ;; (insert-file-contents temp-list-file))
+ (unless (memq (cdr folder-res) '(200 201))
+ (web-vcs-message-with-face 'web-vcs-red "Could not get %S" url)
+ (web-vcs-display-messages t)
+ (throw 'command-level nil)))
+ ;;(with-current-buffer temp-list-buf
+ (with-current-buffer (car folder-res)
+ ;;(delete-file temp-list-file)
+ ;;(find-file-noselect temp-list-file)
+ (when dl-revision
+ (setq this-page-revision (web-vcs-get-revision-from-url-buf vcs-rec (current-buffer) url)))
+ (when dl-revision
+ (unless (string= dl-revision this-page-revision)
+ (web-vcs-message-with-face 'web-vcs-red "Revision on %S is %S, but should be %S"
+ url this-page-revision dl-revision)
+ (web-vcs-display-messages t)
+ (throw 'command-level nil)))
+ ;; Find files
+ (goto-char (point-min))
+ (let ((files-href-regexp (nth 1 (assq 'patt files-matcher)))
+ (url-num (nth 1 (assq 'url files-matcher)))
+ (time-num (nth 1 (assq 'time files-matcher))))
+ (while (re-search-forward files-href-regexp nil t)
+ (let ((file (match-string url-num))
+ (time (match-string time-num)))
+ (add-to-list 'files (list file time)))))
+ ;; Find subdirs
+ (when recursive
+ (goto-char (point-min))
+ (while (re-search-forward dirs-href-regexp nil t)
+ (let ((suburl (match-string 1))
+ (lenurl (length url)))
+ (when (and (> (length suburl) lenurl)
+ (string= (substring suburl 0 lenurl) url))
+ (add-to-list 'suburls suburl)))))
+ (kill-buffer))
+ ;; Download files
+ ;;(message "TRACE: files=%S" files)
+ (web-vcs-download-files vcs-rec files dl-dir dl-root file-mask)
+ ;; Download subdirs
+ (when suburls
+ (dolist (suburl (reverse suburls))
+ (let* ((dl-sub-dir (substring suburl (length url)))
+ (full-dl-sub-dir (file-name-as-directory
+ (expand-file-name dl-sub-dir dl-dir)))
+ (rel-dl-sub-dir (file-relative-name full-dl-sub-dir dl-root)))
+ ;;(message "web-vcs-get-revision-from-url-buf dir: %S %S" file-mask rel-dl-sub-dir)
+ (when (or (not file-mask)
+ (not (stringp file-mask))
+ (web-vcs-match-folderwise file-mask rel-dl-sub-dir))
+ ;;(message "matched dir %S" rel-dl-sub-dir)
+ (unless (web-vcs-contains-file dl-dir full-dl-sub-dir)
+ (error "Subdir %S not in %S" dl-sub-dir dl-dir))
+ (let* ((ret (web-vcs-get-files-on-page-1 vcs-rec
+ suburl
+ dl-root
+ rel-dl-sub-dir
+ file-mask
+ (1+ recursive)
+ this-page-revision
+ test)))
+ (setq moved (+ moved (nth 1 ret))))))))
+ (list this-page-revision moved)))
+
+(defun web-vcs-get-missing-matching-files (web-vcs url dl-dir file-mask)
+ "Download missing files from VCS system using the web interface.
+Use WEB-VCS entry in variable `web-vcs-links-regexp' to download
+files via http from URL to directory DL-DIR.
+
+Before downloading offer to visit the page from which the
+downloading will be made.
+"
+ (let ((vcs-rec (or (assq web-vcs web-vcs-links-regexp)
+ (error "Does not know web-cvs %S" web-vcs))))
+ (web-vcs-get-files-on-page-1 vcs-rec url dl-dir "" file-mask 0 nil nil)))
+
+
+;; (web-vcs-get-files-on-page 'lp "http://bazaar.launchpad.net/%7Enxhtml/nxhtml/main/files/head%3A/" t "c:/test/temp13/" t)
+
+(defvar web-vcs-folder-cache nil) ;; dyn var
+(defun web-vcs-add-folder-cache (url buf)
+ (add-to-list 'web-vcs-folder-cache (list url buf)))
+(defun web-vcs-ass-folder-cache (url)
+ (assoc url web-vcs-folder-cache))
+(defun web-vcs-clear-folder-cache ()
+ (while web-vcs-folder-cache
+ (let ((ub (car web-vcs-folder-cache)))
+ (setq web-vcs-folder-cache (cdr web-vcs-folder-cache))
+ (kill-buffer (nth 1 ub)))))
+
+(defun web-vcs-url-copy-file-and-check (url dl-file dest-file)
+ "Copy URL to DL-FILE.
+Log what happened. Use DEST-FILE in the log, not DL-FILE which is
+a temporary file."
+ (let ((http-sts nil)
+ (file-nonempty nil)
+ (fail-reason nil))
+ (when dest-file (web-vcs-log url dest-file nil))
+ (web-vcs-display-messages nil)
+ ;;(message "before url-copy-file %S" dl-file)
+ (setq http-sts (web-vcs-url-copy-file url dl-file nil t)) ;; don't overwrite, keep time
+ ;;(message "after url-copy-file %S" dl-file)
+ (if (and (file-exists-p dl-file)
+ (setq file-nonempty (< 0 (nth 7 (file-attributes dl-file)))) ;; file size 0
+ (memq http-sts '(200 201)))
+ (when dest-file
+ (web-vcs-log nil nil " Done.\n"))
+ (setq fail-reason
+ (cond
+ (http-sts (format "HTTP %s" http-sts))
+ (file-nonempty "File looks bad")
+ (t "Server did not respond")))
+ (unless dest-file (web-vcs-log url dl-file "TEMP FILE"))
+ (web-vcs-log nil nil (format " *Failed:* %s\n" fail-reason))
+ ;; Requires user attention and intervention
+ (web-vcs-message-with-face 'web-vcs-red "Download failed: %s, %S" fail-reason url)
+ (web-vcs-display-messages t)
+ (message "\n")
+ (web-vcs-message-with-face 'web-vcs-yellow "Please retry what you did before!\n")
+ (throw 'command-level nil))))
+
+(defvar web-autoload-temp-file-prefix "TEMPORARY-WEB-AUTO-LOAD-")
+(defvar web-autoload-active-file-sub-url) ;; Dyn var, active during file download check
+(defun web-autoload-acvtive ()
+ (and (boundp 'web-autoload-active-file-sub-url)
+ web-autoload-active-file-sub-url))
+
+(defun web-vcs-download-files (vcs-rec files dl-dir dl-root file-mask)
+ (dolist (file (reverse files))
+ (let* ((url-file (nth 0 file))
+ (url-file-time-str (nth 1 file))
+ ;; date-to-time assumes GMT so this is ok:
+ (url-file-time (when url-file-time-str (date-to-time url-file-time-str)))
+ (url-file-name-regexp (nth 4 vcs-rec))
+ (url-file-rel-name (progn
+ (when (string-match url-file-name-regexp url-file)
+ (match-string 1 url-file))))
+ (dl-file-name (expand-file-name url-file-rel-name dl-dir))
+ (dl-file-time (nth 5 (file-attributes dl-file-name)))
+ (file-rel-name (file-relative-name dl-file-name dl-root))
+ (file-name (file-name-nondirectory dl-file-name))
+ (temp-file (expand-file-name (concat web-autoload-temp-file-prefix file-name) dl-dir))
+ temp-buf)
+ (cond
+ ((and file-mask (not (web-vcs-match-folderwise file-mask file-rel-name))))
+ ((and dl-file-time
+ url-file-time
+ (progn
+ ;;(message "dl-file-time =%s" (when dl-file-time (current-time-string dl-file-time)))
+ ;;(message "url-file-time=%s" (when url-file-time (current-time-string url-file-time)))
+ ;;(message "url-file-tstr=%s" (when url-file-time url-file-time-str))
+ t)
+ (time-less-p url-file-time
+ (time-add dl-file-time (seconds-to-time 1))))
+ (web-vcs-message-with-face 'web-vcs-green "Local file %s is newer or same age" file-rel-name))
+ ;;(test (progn (message "TEST url-file=%S" url-file) (message "TEST url-file-rel-name=%S" url-file-rel-name) (message "TEST dl-file-name=%S" dl-file-name) ))
+ (t
+ ;; Avoid trouble with temp file
+ (while (setq temp-buf (find-buffer-visiting temp-file))
+ (set-buffer-modified-p nil) (kill-buffer temp-buf))
+ (when (file-exists-p temp-file) (delete-file temp-file))
+ ;;(web-vcs-message-with-face 'font-lock-comment-face "Starting url-copy-file %S %S t t" url-file temp-file)
+ (web-vcs-url-copy-file-and-check url-file temp-file dl-file-name)
+ ;;(web-vcs-message-with-face 'font-lock-comment-face "Finished url-copy-file %S %S t t" url-file temp-file)
+ (let* ((time-after-url-copy (current-time))
+ (old-buf-open (find-buffer-visiting dl-file-name)))
+ (when (and old-buf-open (buffer-modified-p old-buf-open))
+ (save-excursion
+ (switch-to-buffer old-buf-open)
+ (when (y-or-n-p (format "Buffer %S is modified, save to make a backup? " dl-file-name))
+ (save-buffer))))
+ (if (and dl-file-time (web-vcs-equal-files dl-file-name temp-file))
+ (progn
+ (delete-file temp-file)
+ (when url-file-time (set-file-times dl-file-name url-file-time))
+ (web-vcs-message-with-face 'web-vcs-green "File %S was ok" dl-file-name))
+ (when dl-file-time
+ (let ((backup (concat dl-file-name ".moved")))
+ (rename-file dl-file-name backup t)))
+ ;; Be paranoid and let user check here. I actually
+ ;; believe that is a very good thing here.
+ (web-vcs-be-paranoid temp-file dl-file-name file-rel-name)
+ (rename-file temp-file dl-file-name)
+ (when url-file-time (set-file-times dl-file-name url-file-time))
+ ;; (let ((buf (find-buffer-visiting dl-file-name)))
+ ;; (when buf
+ ;; (with-current-buffer buf
+ ;; (message "before revert-buffer")
+ ;; (revert-buffer nil t t)
+ ;; (message "after revert-buffer")
+ ;; )))
+ (if dl-file-time
+ (web-vcs-message-with-face 'web-vcs-yellow "Updated %S" dl-file-name)
+ (web-vcs-message-with-face 'web-vcs-green "Downloaded %S" dl-file-name))
+ (when old-buf-open
+ (with-current-buffer old-buf-open
+ (set-buffer-modified-p nil)
+ (revert-buffer nil t t)))
+ (with-current-buffer (find-file-noselect dl-file-name)
+ (setq header-line-format
+ (propertize (format-time-string "This file was downloaded %Y-%m-%d %H:%M")
+ 'face 'web-vcs-green))))
+ (web-vcs-display-messages nil)
+ ;; This is both for user and remote server load. Do not remove this.
+ (redisplay t) (sit-for (- 1.0 (float-time (time-subtract (current-time) time-after-url-copy))))
+ ;; (unless old-buf-open
+ ;; (when old-buf
+ ;; (kill-buffer old-buf)))
+ )))
+ (redisplay t))))
+
+(defun web-vcs-get-revision-on-page (vcs-rec url)
+ "Get revision number using VCS-REC on page URL.
+VCS-REC should be an entry like the entries in the list
+`web-vcs-links-regexp'."
+ ;; url-insert-file-contents
+ (let ((url-buf (url-retrieve-synchronously url)))
+ (web-vcs-get-revision-from-url-buf vcs-rec url-buf url)))
+
+(defun web-vcs-get-revision-from-url-buf (vcs-rec url-buf url)
+ "Get revision number using VCS-REC.
+VCS-REC should be an entry in the list `web-vcs-links-regexp'.
+The buffer URL-BUF should contain the content on page URL."
+ (let ((revision-regexp (nth 5 vcs-rec)))
+ ;; Get revision number
+ (with-current-buffer url-buf
+ (goto-char (point-min))
+ (if (not (re-search-forward revision-regexp nil t))
+ (progn
+ (web-vcs-message-with-face 'web-vcs-red "Can't find revision number on %S" url)
+ (web-vcs-display-messages t)
+ (throw 'command-level nil))
+ (match-string 1)))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Auto Download
+
+
+;; fix-me: To emulation-mode-map
+;; Fix-me: put this on better keys
+(defvar web-vcs-paranoid-state-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c)(control ?c)] 'exit-recursive-edit)
+ (define-key map [(control ?c)(control ?n)] 'web-autoload-continue-no-stop)
+ (define-key map [(control ?c)(control ?r)] 'web-vcs-investigate-elisp-file)
+ (define-key map [(control ?c)(control ?q)] 'web-vcs-quit-auto-download)
+ map))
+
+(defun web-vcs-quit-auto-download ()
+ "Quit download process.
+This stops the current web autoload processing."
+ (interactive)
+ ;; Fix-me.
+ (when (y-or-n-p "Stop web autoload processing? You can resume it later. ")
+ (web-vcs-message-with-face 'web-vcs-red
+ "Stopped autoloading in process. It will be resumed when necessary again.")
+ (web-vcs-log nil nil "User stopped autoloading")
+ (throw 'top-level 'web-autoload-stop)))
+
+(define-minor-mode web-vcs-paranoid-state-mode
+ "Mode used temporarily during user check of downloaded file.
+Do not turn on this yourself."
+ :lighter (concat " " (propertize "Download file check" 'face 'font-lock-warning-face))
+ :global t
+ :group 'web-vcs
+ (or (not web-vcs-paranoid-state-mode)
+ (web-autoload-acvtive)
+ (error "This mode can't be used when not downloading")))
+
+(defcustom web-autoload-paranoid t
+ "Be paranoid and break to check each file after download."
+ :type 'boolean
+ :group 'web-vcs)
+
+(defun web-autoload-continue-no-stop ()
+ "Continue web auto download.
+This is used after inspecting downloaded elisp files. Set
+`web-autoload-paranoid' to nil before contiuning to avoid further
+breaks to check downloaded files."
+ (interactive)
+ (setq web-autoload-paranoid nil)
+ (web-autoload-continue))
+
+(defun web-autoload-continue ()
+ "Continue web auto download.
+This is used after inspecting downloaded elisp files."
+ (interactive)
+ (if (< 0 (recursion-depth))
+ (exit-recursive-edit)
+ (web-autoload-byte-compile-queue)))
+
+(defun web-vcs-be-paranoid (temp-file file-dl-name file-sub-url)
+ "Be paranoid and check FILE-DL-NAME."
+ (when (or (not (boundp 'web-autoload-paranoid))
+ web-autoload-paranoid)
+ (save-window-excursion
+ (let* ((comp-buf (get-buffer "*Compilation*"))
+ (comp-win (and comp-buf
+ (get-buffer-window comp-buf)))
+ (msg-win (web-vcs-display-messages nil))
+ temp-buf
+ (kf-desc (lambda (fun)
+ (let* ((key (where-is-internal fun nil t))
+ (k-desc (when key (key-description key)))
+ (fmt-kf "\n %s (or %s)")
+ (fmt-f "\n %s"))
+ (if key
+ (format fmt-kf k-desc fun)
+ (format fmt-f fun)
+ )))))
+ (if comp-win
+ (progn
+ (select-window comp-win)
+ (find-file file-dl-name))
+ (select-window msg-win)
+ (find-file-other-window temp-file))
+ (setq temp-buf (current-buffer))
+ (web-vcs-log-save)
+ (message "-")
+ (message "")
+ (with-selected-window msg-win
+ (goto-char (point-max)))
+ (let ((proceed nil)
+ (web-autoload-active-file-sub-url file-sub-url)) ;; Dyn var, active during file download check
+ (web-vcs-paranoid-state-mode 1)
+ (web-vcs-message-with-face
+ 'secondary-selection
+ (concat "Please check the downloaded file and then continue by doing"
+ (funcall kf-desc 'exit-recursive-edit)
+ (if (fboundp 'web-autoload-continue-no-stop)
+ (concat
+ "\n\nOr, for no more breaks to check files do"
+ (funcall kf-desc 'web-autoload-continue-no-stop))
+ "")
+ "\n\nTo stop the web autoloading process for now do"
+ (funcall kf-desc 'web-autoload-quit-download)
+ "\n\nTo see the log file you can do"
+ (funcall kf-desc 'web-vcs-log-edit)
+ "\n"))
+ (message "")
+ (while (not proceed)
+ (condition-case err
+ (when (eq 'web-autoload-stop
+ (catch 'top-level
+ ;; Fix-me: review file before rename!
+ (setq header-line-format
+ (propertize
+ (format "Review for downloading. Continue: C-c C-c%s. Destination: %S"
+ (if (string= "el" (file-name-extension file-dl-name))
+ ", Check: C-c C-r"
+ "")
+ file-dl-name)
+ 'face 'web-vcs-red))
+ (unwind-protect
+ (progn
+ (recursive-edit))
+ (web-vcs-paranoid-state-mode -1))
+ (with-current-buffer temp-buf
+ (set-buffer-modified-p nil)
+ (kill-buffer temp-buf))
+ (setq proceed t)))
+ (throw 'top-level t))
+ (error (message "%s" (error-message-string err))))))
+ (web-vcs-display-messages t)
+ ))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Auto Download Compile Queue
+;;
+;; Downloaded elisp files are placed in a compile queue. They are not
+;; compiled until all required elisp files are downloaded (and
+;; optionally compiled).
+;;
+;; This mechanism works through
+;; - reading (eval-when-compile ...) etc in the files
+;; - a defadviced require that is the driver of the process
+
+(defvar web-autoload-compile-queue nil)
+
+(defvar web-autoload-byte-compile-queue-active nil) ;; Dyn var
+
+(defun web-autoload-byte-compile-file (file load comp-fun)
+ (if nil ;;(file-exists-p file)
+ (byte-compile-file file load)
+ (let ((added-entry (list file load comp-fun nil)))
+ (if (member added-entry web-autoload-compile-queue)
+ (setq added-entry nil)
+ (web-vcs-message-with-face 'web-vcs-gold "Add to compile queue (%S %s)" file load)
+ (setq web-autoload-compile-queue (cons added-entry
+ web-autoload-compile-queue)))
+ (when added-entry
+ (if web-autoload-byte-compile-queue-active
+ (throw 'web-autoload-comp-restart t)
+ (web-autoload-byte-compile-queue))))))
+
+;;(web-autoload-byte-compile-queue)
+(defun web-autoload-byte-compile-queue ()
+ (let ((top-entry)
+ (web-autoload-byte-compile-queue-active t))
+ (while (and web-autoload-compile-queue
+ (not (equal top-entry
+ (car web-autoload-compile-queue))))
+ (setq top-entry (car web-autoload-compile-queue))
+ (catch 'web-autoload-comp-restart
+ (web-autoload-byte-compile-first)
+ (setq web-autoload-compile-queue (cdr web-autoload-compile-queue))))))
+
+(defun web-autoload-byte-compile-first ()
+ "Compile first file on compile queue and maybe load it.
+Compile the car of `web-autoload-compile-queue' and load if this
+entry says so."
+ (let* ((compiled-it nil)
+ (first-entry (car web-autoload-compile-queue))
+ (el-file (nth 0 first-entry))
+ (load (nth 1 first-entry))
+ (comp-fun (nth 2 first-entry))
+ (req-done (nth 3 first-entry))
+ (elc-file (byte-compile-dest-file el-file))
+ (need-compile (or (not (file-exists-p elc-file))
+ (file-newer-than-file-p el-file elc-file))))
+ (if (not need-compile)
+ nil ;;(when load (load elc-file))
+ (unless req-done
+ (web-autoload-do-eval-requires el-file)
+ (setcar (nthcdr 3 first-entry) t))
+ (when (catch 'web-autoload-comp-restart
+ (condition-case err
+ (progn
+ (web-vcs-message-with-face 'font-lock-comment-face "Start byte compiling %S" el-file)
+ (web-vcs-message-with-face 'web-vcs-pink "Compiling QUEUE: %S" web-autoload-compile-queue)
+ (let ((web-autoload-skip-require-advice t)) (funcall comp-fun el-file load))
+ (web-vcs-message-with-face 'font-lock-comment-face "Ready byte compiling %S" el-file)
+ ;; Return nil to tell there are no known problems
+ (if (file-exists-p elc-file)
+ nil
+ (web-vcs-message-with-face
+ 'web-vcs-red "Error: byte compiling did not produce %S" elc-file)
+ (web-vcs-display-messages nil)
+ ;; Clean up before restart
+ (web-autoload-try-cleanup-after-failed-compile first-entry)
+ t))
+ (error
+ (web-vcs-message-with-face
+ 'web-vcs-red "Error in byte compiling %S: %s" el-file (error-message-string err))
+ (web-vcs-display-messages nil)
+ ;; Clean up before restart
+ (web-autoload-try-cleanup-after-failed-compile first-entry)
+ t ;; error
+ )))
+ (throw 'web-autoload-comp-restart t)
+ ))))
+
+(defun web-autoload-do-eval-requires (el-file)
+ "Do eval-when-compile and eval-and-compile."
+ ;;(message "web-autoload-do-eval-requires %S" el-file)
+ (let ((old-buf (find-buffer-visiting el-file)))
+ (with-current-buffer (or old-buf (find-file-noselect el-file))
+ (let ((here (point))
+ (web-autoload-require-skip-noerror-entries t))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ ;;(message "web-autoload-do-eval-requires cb=%s" (current-buffer))
+ (while (progn
+ (while (progn (skip-chars-forward " \t\n\^l")
+ (looking-at ";"))
+ (forward-line 1))
+ (not (eobp)))
+ (let ((form (read (current-buffer))))
+ (when (memq (car form) '(eval-when-compile eval-and-compile))
+ (web-vcs-message-with-face 'web-vcs-gold " eval %S" form)
+ (eval form))
+ )))
+ (if old-buf (kill-buffer) (goto-char here))))))
+
+
+;; Fix-me: protect against deep nesting
+(defun web-autoload-do-require (feature filename noerror)
+ (let* ((feat-name (symbol-name feature))
+ (lib (or filename feat-name)))
+ (if (load lib noerror t)
+ (progn
+ (unless (featurep feature)
+ (error "web-autoload: Required feature `%s' was not provided" feature))
+ feature)
+ nil
+ )))
+
+(defvar web-autoload-require-skip-noerror-entries nil)
+
+(defadvice require (around
+ web-autoload-ad-require)
+ (let ((feature (ad-get-arg 0))
+ (filename (ad-get-arg 1))
+ (noerror (ad-get-arg 2)))
+ (if (featurep feature)
+ feature
+ (if (or filename
+ (and noerror
+ (or (not (boundp 'web-autoload-skip-require-advice))
+ web-autoload-skip-require-advice)))
+ (progn
+ (message "Doing nearly original require %s, because skipping" (ad-get-arg 0))
+ ;; Can't ad-do-it because defadviced functions in load
+ ;;(web-autoload-do-require feature filename noerror)
+ ;;
+ ;; Fix-me: Implement lazy loading here? Could it be done with while-no-input?
+ ;;
+ ;;(when (assq feature web-autoload-require-list) )
+ ad-do-it)
+ (unless (and noerror
+ web-autoload-require-skip-noerror-entries)
+ (let* ((auto-rec (assq feature web-autoload-require-list))
+ (web-vcs (nth 1 auto-rec))
+ (base-url (nth 2 auto-rec))
+ (relative-url (nth 3 auto-rec))
+ (base-dir (nth 4 auto-rec))
+ (comp-fun (nth 5 auto-rec)))
+ (if (not auto-rec)
+ ad-do-it
+ (let* ((full-el (concat (expand-file-name relative-url base-dir) ".el"))
+ (full-elc (byte-compile-dest-file full-el))
+ (our-buffer (current-buffer)) ;; Need to come back here
+ (our-wcfg (current-window-configuration))
+ (mode-line-old (web-vcs-redefine-face 'mode-line 'web-vcs-mode-line))
+ (mode-line-inactive-old (web-vcs-redefine-face 'mode-line-inactive 'web-vcs-mode-line-inactive))
+ (header-line-format-old (with-current-buffer "*Messages*"
+ (prog1
+ header-line-format
+ (setq header-line-format
+ (propertize "Downloading needed files..."
+ 'face 'web-vcs-mode-line
+ ;;'face '(:height 1.5) ;; does not work
+ ))))))
+ ;; Fix-me: can't update while accessing the menus
+ ;;(message "trying (redisplay t) ;; mode line")
+ ;;(sit-for 1) (redisplay t) ;; mode line
+ (unwind-protect
+ (progn
+ (web-vcs-message-with-face 'web-vcs-gold "Doing the really adviced require for %s" feature)
+ ;; Check if already downloaded first
+ (unless (file-exists-p full-el)
+ (setq base-url (eval base-url))
+ ;; Download and try again
+ (setq relative-url (concat relative-url ".el"))
+ (web-vcs-message-with-face 'web-vcs-green "Need to download feature '%s" feature)
+ (catch 'web-autoload-comp-restart
+ (web-vcs-get-missing-matching-files web-vcs base-url base-dir relative-url)))
+ (set-buffer our-buffer) ;; Before we load..
+ (when web-autoload-autocompile
+ (unless (file-exists-p full-elc)
+ ;; Byte compile the downloaded file
+ (web-autoload-byte-compile-file full-el t comp-fun)))
+ (web-vcs-message-with-face 'web-vcs-gold "Doing finally require for %s" feature)
+ (set-buffer our-buffer) ;; ... and after we load
+ (set-window-configuration our-wcfg))
+ (with-current-buffer "*Messages*" (setq header-line-format header-line-format-old))
+ (web-vcs-redefine-face 'mode-line mode-line-old)
+ (web-vcs-redefine-face 'mode-line-inactive mode-line-inactive-old)))
+ ad-do-it)))))))
+
+;; (setq x (web-vcs-redefine-face 'mode-line (setq z (face-all-attributes 'web-vcs-mode-line (selected-frame)))))
+;; (setq x (web-vcs-redefine-face 'mode-line 'web-vcs-mode-line))
+;; (setq y (web-vcs-redefine-face 'mode-line x))
+;; (describe-face 'web-vcs-mode-line)
+(defun web-vcs-redefine-face (face as-new)
+ "Redefine FACE to use the attributes in AS-NEW.
+AS-NEW may be either a face or a list returned by `face-all-attributes'.
+Return an alist with old attributes."
+ (let ((ret (face-all-attributes face (selected-frame)))
+ (new-face-att (if (facep as-new)
+ (face-all-attributes as-new (selected-frame))
+ as-new))
+ new-at-prop-list
+ )
+ (dolist (at new-face-att)
+ (let ((sym (car at))
+ (val (cdr at)))
+ (unless (eq val 'unspecified)
+ (setq new-at-prop-list (cons sym
+ (cons val
+ new-at-prop-list)))
+ ;;(message "new=%S" new-at-prop-list)
+ )))
+ (apply 'set-face-attribute face (selected-frame) new-at-prop-list)
+ ret
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Web Autoload Define
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Helpers
+
+;;(web-vcs-file-name-as-list "/a/b/c.el")
+;;(web-vcs-file-name-as-list "a/b/c.el")
+;;(web-vcs-file-name-as-list "c:/a/b/c.el")
+;;(web-vcs-file-name-as-list ".*/a/c/")
+;;(web-vcs-file-name-as-list "[^/]*/a/c/") ;; Just avoid this.
+(defun web-vcs-file-name-as-list (filename)
+ "Split file name FILENAME into a list with file names."
+ ;; We can't use the primitives since they converts \ to / and
+ ;; therefore damages the reg exps. Just use our knowledge of the
+ ;; internal file name representation instead.
+ (split-string filename "/"))
+;; (let ((lst-name nil)
+;; (head filename)
+;; (old-head ""))
+;; (while (and (not (string= old-head head))
+;; (> (length head) 0))
+;; (let* ((file-head (directory-file-name head))
+;; (tail (file-name-nondirectory (directory-file-name head))))
+;; (setq old-head head)
+;; (setq head (file-name-directory file-head))
+;; ;; For an abs path the final tail is "", use root instead:
+;; (when (= 0 (length tail))
+;; (setq tail head))
+;; (setq lst-name (cons tail lst-name))))
+;; lst-name))
+
+;;(web-vcs-match-folderwise ".*/util/mum.el" "top/util/mum.el")
+;;(web-vcs-match-folderwise ".*/util/mu.el" "top/util/mum.el")
+;;(web-vcs-match-folderwise ".*/ut/mum.el" "top/util/mum.el")
+;;(web-vcs-match-folderwise ".*/ut../mum.el" "top/util/mum.el")
+;;(web-vcs-match-folderwise ".*/ut../mum.el" "top/util")
+;;(web-vcs-match-folderwise ".*/ut../mum.el" "top")
+;;(web-vcs-match-folderwise "top/ut../mum.el" "top")
+(defun web-vcs-match-folderwise (regex file)
+ "Split REGEXP as a file path and match against FILE parts."
+ ;;(message "folderwise %S %S" regex file)
+ (let ((lst-regex (web-vcs-file-name-as-list regex))
+ (lst-file (web-vcs-file-name-as-list file)))
+ (when (>= (length lst-regex) (length lst-file))
+ (catch 'match
+ (while lst-file
+ (let ((head-file (car lst-file))
+ (head-regex (car lst-regex)))
+ (unless (or (= 0 (length head-file)) ;; Last /, if present, gives ""
+ (string-match-p (concat "^" head-regex "$") head-file))
+ (throw 'match nil)))
+ (setq lst-file (cdr lst-file))
+ (setq lst-regex (cdr lst-regex)))
+ t))))
+
+(defun web-vcs-contains-file (dir file)
+ "Return t if DIR contain FILE."
+ (assert (string= dir (file-name-as-directory (expand-file-name dir))) t)
+ (assert (or (string= file (file-name-as-directory (expand-file-name file)))
+ (string= file (expand-file-name file))) t)
+ (let ((dir-len (length dir)))
+ (assert (string= "/" (substring dir (1- dir-len))))
+ (when (> (length file) dir-len)
+ (string= dir (substring file 0 dir-len)))))
+
+(defun web-vcs-nice-elapsed (start-time end-time)
+ "Format elapsed time between START-TIME and END-TIME nicely.
+Those times should have the same format as time returned by
+`current-time'."
+ (format-seconds "%h h %m m %z%s s" (float-time (time-subtract end-time start-time))))
+
+;; (web-vcs-equal-files "web-vcs.el" "temp.tmp")
+;; (web-vcs-equal-files "../.nosearch" "temp.tmp")
+(defun web-vcs-equal-files (file-a file-b)
+ "Return t if files FILE-A and FILE-B are equal."
+ (let* ((cmd (if (eq system-type 'windows-nt)
+ (list "fc" nil nil nil
+ "/B" "/OFF"
+ (convert-standard-filename file-a)
+ (convert-standard-filename file-b))
+ (list diff-command nil nil nil
+ "--binary" "-q" file-a file-b)))
+ (ret (apply 'call-process cmd)))
+ ;;(message "ret=%s, cmd=%S" ret cmd) (sit-for 2)
+ (cond
+ ((= 1 ret)
+ nil)
+ ((= 0 ret)
+ t)
+ (t
+ (error "%S returned %d" cmd ret)))))
+
+(defun web-vcs-display-messages (select)
+ "Display *Messages* buffer. Select its window if SELECT."
+ (let ((msg-win (display-buffer "*Messages*")))
+ (with-selected-window msg-win (goto-char (point-max)))
+ (when select (select-window msg-win))
+ msg-win))
+
+;; (web-vcs-message-with-face 'secondary-selection "I am saying: %s and %s" "Hi" "Farwell!")
+;;;###autoload
+(defun web-vcs-message-with-face (face format-string &rest args)
+ "Display a colored message at the bottom of the string.
+FACE is the face to use for the message.
+FORMAT-STRING and ARGS are the same as for `message'.
+
+Also put FACE on the message in *Messages* buffer."
+ (with-current-buffer "*Messages*"
+ (save-restriction
+ (widen)
+ (let* ((start (let ((here (point)))
+ (goto-char (point-max))
+ (prog1
+ (copy-marker
+ (if (bolp) (point-max)
+ (1+ (point-max))))
+ (goto-char here))))
+ (msg-with-face (propertize (apply 'format format-string args)
+ 'face face)))
+ ;; This is for the echo area:
+ (message "%s" msg-with-face)
+ ;; This is for the buffer:
+ (when (< 0 (length msg-with-face))
+ (goto-char (1- (point-max)))
+ ;;(backward-char)
+ ;;(unless (eolp) (goto-char (line-end-position)))
+ (put-text-property start (point)
+ 'face face))))))
+
+(defun web-vcs-num-moved (root)
+ "Return nof files matching *.moved inside directory ROOT."
+ (let* ((file-regexp ".*\\.moved$")
+ (files (directory-files root t file-regexp))
+ (subdirs (directory-files root t)))
+ (dolist (subdir subdirs)
+ (when (and (file-directory-p subdir)
+ (not (or (string= "/." (substring subdir -2))
+ (string= "/.." (substring subdir -3)))))
+ (setq files (append files (web-vcs-rdir-get-files subdir file-regexp) nil))))
+ (length files)))
+
+;; Copy of rdir-get-files in ourcomment-util.el
+(defun web-vcs-rdir-get-files (root file-regexp)
+ (let ((files (directory-files root t file-regexp))
+ (subdirs (directory-files root t)))
+ (dolist (subdir subdirs)
+ (when (and (file-directory-p subdir)
+ (not (or (string= "/." (substring subdir -2))
+ (string= "/.." (substring subdir -3)))))
+ (setq files (append files (web-vcs-rdir-get-files subdir file-regexp) nil))))
+ files))
+
+(defun web-vcs-contains-moved-files (dl-dir)
+ "Return t if there are *.moved files in DL-DIR."
+ (let ((num-moved (web-vcs-num-moved dl-dir)))
+ (when (> num-moved 0)
+ (web-vcs-message-with-face 'font-lock-warning-face
+ (concat "There are %d *.moved files (probably from prev download)\n"
+ "in %S.\nPlease delete them first.")
+ num-moved dl-dir)
+ t)))
+
+
+(defun web-vcs-set&save-option (symbol value)
+ (customize-set-variable symbol value)
+ (customize-set-value symbol value)
+ (when (condition-case nil (custom-file) (error nil))
+ (customize-mark-to-save symbol)
+ (custom-save-all)
+ (message "web-vcs: Saved option %s with value %s" symbol value)))
+
+(defvar web-vcs-el-this (or load-file-name
+ (when (boundp 'bytecomp-filename) bytecomp-filename)
+ buffer-file-name))
+
+
+(require 'bytecomp)
+(defun web-vcs-byte-compile-newer-file (el-file load)
+ (let ((elc-file (byte-compile-dest-file el-file)))
+ (when (or (not (file-exists-p elc-file))
+ (file-newer-than-file-p el-file elc-file))
+ (byte-compile-file el-file load))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Compiling
+
+;;;###autoload
+(defun web-vcs-byte-compile-file (file &optional load extra-load-path comp-dir)
+ "Byte compile FILE in a new Emacs sub process.
+EXTRA-LOAD-PATH is added to the front of `load-path' during
+compilation.
+
+FILE is set to `buffer-file-name' when called interactively.
+If LOAD"
+ (interactive (list (buffer-file-name)
+ t))
+ (when (with-no-warnings (called-interactively-p))
+ (unless (eq major-mode 'emacs-lisp-mode)
+ (error "Must be in emacs-lisp-mode")))
+ (let* ((old-env-load-path (getenv "EMACSLOADPATH"))
+ (sub-env-load-path (or old-env-load-path
+ ;;(mapconcat 'identity load-path ";")))
+ (mapconcat 'identity load-path path-separator)))
+ ;; Fix-me: name of compile log buffer. When should it be
+ ;; deleted? How do I bind it to byte-compile-file? Or do I?
+ (file-buf (find-buffer-visiting file))
+ (out-buf (get-buffer-create "*Compile-Log*"))
+ (elc-file (byte-compile-dest-file file))
+ (this-emacs-exe (locate-file invocation-name
+ (list invocation-directory)
+ exec-suffixes))
+ (default-directory (or comp-dir default-directory))
+ (debug-on-error t)
+ start)
+ ;; (when (and file-buf
+ ;; (buffer-modified-p file-buf))
+ ;; (switch-to-buffer file-buf)
+ ;; (error "Buffer must be saved first: %S" file-buf))
+ (dolist (full-p extra-load-path)
+ ;;(setq sub-env-load-path (concat full-p ";" sub-env-load-path)))
+ (setq sub-env-load-path (concat full-p path-separator sub-env-load-path)))
+ (unless (get-buffer-window out-buf (selected-frame))
+ (if (string= file (buffer-file-name))
+ (display-buffer out-buf)
+ (unless (eq (current-buffer) out-buf)
+ (switch-to-buffer out-buf))))
+ (with-selected-window (get-buffer-window out-buf)
+ (with-current-buffer out-buf
+ (unless (local-variable-p 'web-vcs-comp-dir)
+ (set (make-local-variable 'web-vcs-comp-dir) (or comp-dir default-directory)))
+ (setq default-directory web-vcs-comp-dir)
+ (widen)
+ (goto-char (point-max))
+ (when (or (= 0 (buffer-size))
+ (not (derived-mode-p 'compilation-mode)))
+ (insert (propertize "\nWeb VCS compilation output" 'font-lock-face 'font-lock-comment-face))
+ (compilation-mode)
+ (setq font-lock-verbose nil)
+ (font-lock-add-keywords nil
+ '(("\\<Compile\\>" . 'compilation-info))))
+ (let ((inhibit-read-only t)
+ (rel-file (file-relative-name file)))
+ (insert "\n\n")
+ (insert "** Compile " rel-file "\n"))
+ (setq start (point))
+ (when (file-exists-p elc-file) (delete-file elc-file))
+ (if (or (not window-system)
+ (< emacs-major-version 23))
+ (byte-compile-file file)
+ ;;(message "web-vcs-byte-compile-file:sub-env-load-path=%s" sub-env-load-path)
+ (unless (file-exists-p this-emacs-exe)
+ (error "Can't find this-emacs-exe=%s" this-emacs-exe))
+ (unless (stringp sub-env-load-path) (error "I did it again, sub-env-load-path=%S" sub-env-load-path))
+ (setenv "EMACSLOADPATH" sub-env-load-path)
+ ;; Fix-me: status
+ (let* ((inhibit-read-only t)
+ (ret (apply 'call-process this-emacs-exe nil out-buf t
+ "-Q" "--batch"
+ "--eval" "(setq debug-on-error t)"
+ "--eval" "(remove-hook 'find-file-hook 'vc-find-file-hook)"
+ "--file" file
+ "-f" "emacs-lisp-byte-compile"
+ nil)))
+ ;;(insert (format "call-process returned: %s\n" ret))
+ )
+ (setenv "EMACSLOADPATH" old-env-load-path))
+ (goto-char start)
+ (while (re-search-forward "^\\([a-zA-Z0-9/\._-]+\\):[0-9]+:[0-9]+:" nil t)
+ (let ((rel-file (file-relative-name file))
+ (inhibit-read-only t))
+ (replace-match rel-file nil nil nil 1)))
+ (goto-char (point-max))))
+ (when (file-exists-p elc-file)
+ (when (and load window-system) (load elc-file))
+ t)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Temporary helpers, possibly included in Emacs
+
+;; (setq x (web-vcs-url-retrieve-synch "http://emacswiki.org/"))
+(defun web-vcs-url-retrieve-synch (url)
+ "Retrieve URL, return cons with buffer and http status."
+ (let* ((url-show-status nil) ;; just annoying showing status here
+ (buffer (url-retrieve-synchronously url))
+ (handle nil)
+ (http-status nil))
+ (if (not buffer)
+ (error "Retrieving url %s gave no buffer" url))
+ (with-current-buffer buffer
+ (if (= 0 (buffer-size))
+ (progn
+ (kill-buffer)
+ nil)
+ (require 'url-http)
+ (setq http-status (url-http-parse-response))
+ (if (memq http-status '(200 201))
+ (progn
+ (goto-char (point-min))
+ (unless (search-forward "\n\n" nil t)
+ (error "Could not find header end in buffer for %s" url))
+ (delete-region (point-min) (point))
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))
+ (kill-buffer buffer)
+ (setq buffer nil))))
+ (cons buffer http-status)))
+
+;; Modified just to return http status
+(defun web-vcs-url-copy-file (url newname &optional ok-if-already-exists
+ keep-time preserve-uid-gid)
+ "Copy URL to NEWNAME. Both args must be strings.
+Signals a `file-already-exists' error if file NEWNAME already exists,
+unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
+A number as third arg means request confirmation if NEWNAME already exists.
+This is what happens in interactive use with M-x.
+Fourth arg KEEP-TIME non-nil means give the new file the same
+last-modified time as the old one. (This works on only some systems.)
+Fifth arg PRESERVE-UID-GID is ignored.
+A prefix arg makes KEEP-TIME non-nil."
+ (if (and (file-exists-p newname)
+ (not ok-if-already-exists))
+ (error "Opening output file: File already exists, %s" newname))
+ (let ((buffer (url-retrieve-synchronously url))
+ (handle nil)
+ (ret nil))
+ (if (not buffer)
+ (error "Retrieving url %s gave no buffer" url))
+ (with-current-buffer buffer
+ (if (= 0 (buffer-size))
+ (progn
+ (kill-buffer)
+ nil)
+ (require 'url-http)
+ (setq ret (url-http-parse-response))
+ (setq handle (mm-dissect-buffer t))
+ (mm-save-part-to-file handle newname)
+ (kill-buffer buffer)
+ (mm-destroy-parts handle)))
+ ret))
+
+(defun web-vcs-read-and-accept-key (prompt accepted &optional reject-message help-function)
+ (let ((key nil)
+ rejected)
+ (while (not (member key accepted))
+ (if (and help-function
+ (or (member key help-event-list)
+ (eq key ??)))
+ (funcall help-function)
+ (unless rejected
+ (setq rejected t)
+ (setq prompt (concat (or reject-message "Please answer with one of the alternatives.")
+ "\n\n"
+ prompt))
+ (setq key (web-vcs-read-key prompt)))))
+ key))
+
+(defconst web-vcs-read-key-empty-map (make-sparse-keymap))
+
+(defvar web-vcs-read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
+
+(defun web-vcs-read-key (&optional prompt)
+ "Read a key from the keyboard.
+Contrary to `read-event' this will not return a raw event but instead will
+obey the input decoding and translations usually done by `read-key-sequence'.
+So escape sequences and keyboard encoding are taken into account.
+When there's an ambiguity because the key looks like the prefix of
+some sort of escape sequence, the ambiguity is resolved via `web-vcs-read-key-delay'."
+ (let ((overriding-terminal-local-map web-vcs-read-key-empty-map)
+ (overriding-local-map nil)
+ (old-global-map (current-global-map))
+ (timer (run-with-idle-timer
+ ;; Wait long enough that Emacs has the time to receive and
+ ;; process all the raw events associated with the single-key.
+ ;; But don't wait too long, or the user may find the delay
+ ;; annoying (or keep hitting more keys which may then get
+ ;; lost or misinterpreted).
+ ;; This is only relevant for keys which Emacs perceives as
+ ;; "prefixes", such as C-x (because of the C-x 8 map in
+ ;; key-translate-table and the C-x @ map in function-key-map)
+ ;; or ESC (because of terminal escape sequences in
+ ;; input-decode-map).
+ web-vcs-read-key-delay t
+ (lambda ()
+ (let ((keys (this-command-keys-vector)))
+ (unless (zerop (length keys))
+ ;; `keys' is non-empty, so the user has hit at least
+ ;; one key; there's no point waiting any longer, even
+ ;; though read-key-sequence thinks we should wait
+ ;; for more input to decide how to interpret the
+ ;; current input.
+ (throw 'read-key keys)))))))
+ (unwind-protect
+ (progn
+ (use-global-map web-vcs-read-key-empty-map)
+ (message (concat (apply 'propertize prompt (member 'face minibuffer-prompt-properties))
+ (propertize " " 'face 'cursor)))
+ (aref (catch 'read-key (read-key-sequence-vector nil nil t)) 0))
+ (cancel-timer timer)
+ (use-global-map old-global-map))))
+
+;; End temp helpers
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;(web-vcs-existing-files-matcher default-directory)
+(defun web-vcs-existing-files-matcher (dir)
+ (let ((files-and-dirs (directory-files dir nil "[^#~]$"))
+ files
+ (default-directory dir))
+ (dolist (df files-and-dirs)
+ (unless (file-directory-p df)
+ (setq files (cons df files))))
+ (cons (regexp-opt files) t)))
+
+(defun web-vcs-update-existing-files (vcs base-url dl-dir this-dir)
+ (let ((files-and-dirs (directory-files this-dir nil "\\(?:\\.elc\\|\\.moved\\|[^#~]\\)$"))
+ files
+ dirs
+ (this-rel (file-relative-name this-dir dl-dir))
+ file-mask)
+ (when (string= "./" this-rel) (setq this-rel ""))
+ (dolist (df files-and-dirs)
+ (if (and (file-directory-p df)
+ (not (member df '("." ".."))))
+ (setq dirs (cons df dirs))
+ (setq files (cons df files))))
+ ;;(web-vcs-message-with-face 'hi-blue "this-rel=%S %S %S" this-rel dl-dir this-dir)
+ (setq file-mask (concat this-rel (regexp-opt files)))
+ ;;(web-vcs-message-with-face 'hi-blue "r=%S" file-mask)
+ (web-vcs-get-missing-matching-files vcs base-url dl-dir file-mask)
+ (dolist (d dirs)
+ (web-vcs-update-existing-files vcs base-url dl-dir
+ (file-name-as-directory
+ (expand-file-name d this-dir))))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Some small bits for security and just overview.
+
+(defun web-vcs-fontify-as-ps-print()
+ (save-restriction
+ (widen)
+ (let ((start (point-min))
+ (end (point-max)))
+ (cond ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
+ (jit-lock-fontify-now start end))
+ ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
+ (lazy-lock-fontify-region start end))))))
+
+
+;;(web-vcs-get-fun-details 'describe-function)
+;;(web-vcs-get-fun-details 'require)
+;;(describe-function 'describe-function)
+(defun web-vcs-get-fun-details (function)
+ (unless (symbolp function) (error "Not a symbol: %s" function))
+ (unless (functionp function) (error "Not a function: %s" function))
+ ;; Do as in `describe-function':
+ (let* ((advised (and (symbolp function) (featurep 'advice)
+ (ad-get-advice-info function)))
+ ;; If the function is advised, use the symbol that has the
+ ;; real definition, if that symbol is already set up.
+ (real-function
+ (or (and advised
+ (let ((origname (cdr (assq 'origname advised))))
+ (and (fboundp origname) origname)))
+ function))
+ ;; Get the real definition.
+ (def (if (symbolp real-function)
+ (symbol-function real-function)
+ function))
+ errtype file-name (beg "") string)
+ ;; Just keep this as it is to more easily compare with `describe-function-1'.
+ (setq string
+ (cond ((or (stringp def)
+ (vectorp def))
+ "a keyboard macro")
+ ((subrp def)
+ (if (eq 'unevalled (cdr (subr-arity def)))
+ (concat beg "special form")
+ (concat beg "built-in function")))
+ ((byte-code-function-p def)
+ (concat beg "compiled Lisp function"))
+ ((symbolp def)
+ (while (and (fboundp def)
+ (symbolp (symbol-function def)))
+ (setq def (symbol-function def)))
+ ;; Handle (defalias 'foo 'bar), where bar is undefined.
+ (or (fboundp def) (setq errtype 'alias))
+ (format "an alias for `%s'" def))
+ ((eq (car-safe def) 'lambda)
+ (concat beg "Lisp function"))
+ ((eq (car-safe def) 'macro)
+ "a Lisp macro")
+ ((eq (car-safe def) 'autoload)
+ ;;(setq file-name-auto (nth 1 def))
+ ;;(setq file-name-auto (find-lisp-object-file-name function def))
+ ;;(setq file-auto-noext (file-name-sans-extension file-name-auto))
+ (format "%s autoloaded %s"
+ (if (commandp def) "an interactive" "an")
+ (if (eq (nth 4 def) 'keymap) "keymap"
+ (if (nth 4 def) "Lisp macro" "Lisp function"))))
+ ((keymapp def)
+ (let ((is-full nil)
+ (elts (cdr-safe def)))
+ (while elts
+ (if (char-table-p (car-safe elts))
+ (setq is-full t
+ elts nil))
+ (setq elts (cdr-safe elts)))
+ (if is-full
+ "a full keymap"
+ "a sparse keymap")))
+ (t "")))
+ (setq file-name (find-lisp-object-file-name function def))
+ (list errtype advised file-name string)
+ ))
+
+;;(web-vcs-investigate-read "c:/emacsw32/nxhtml/nxhtml/nxhtml-autoload.el" "*Messages*")
+(defun web-vcs-investigate-read (elisp out-buf)
+ "Check forms in buffer by reading it."
+ (let* ((here (point))
+ unsafe-eval re-fun re-var
+ elisp-el-file
+ (is-same-file (lambda (file)
+ (when file
+ (setq file (concat (file-name-sans-extension file) ".el"))
+ (string= (file-truename file) elisp-el-file)))))
+ (with-current-buffer elisp
+ (setq elisp-el-file (when (buffer-file-name)
+ (file-truename (buffer-file-name))))
+ (save-restriction
+ (widen)
+ (web-vcs-fontify-as-ps-print)
+ (goto-char (point-min))
+ (while (progn
+ (while (progn (skip-chars-forward " \t\n\^l")
+ (looking-at ";"))
+ (forward-line 1))
+ (not (eobp)))
+ (let* ((pos (point))
+ (form (read (current-buffer)))
+ (def (nth 0 form))
+ (sym (and (listp form)
+ (symbolp (nth 1 form))
+ (nth 1 form)))
+ (form-fun (and sym
+ (functionp sym)
+ (symbol-function sym)))
+ (form-var (boundp sym))
+ (safe-forms '( defun defmacro
+ define-minor-mode define-globalized-minor-mode
+ defvar defconst
+ defcustom
+ defface defgroup
+ ;; fix-me: check if these do re-fun too:
+ define-derived-mode
+ define-global-minor-mode
+ define-globalized-minor-mode
+
+ make-local-variable make-variable-buffer-local
+ provide
+ require
+ message))
+ (safe-eval (or (memq def safe-forms)
+ (and (memq def '( eval-when-compile eval-and-compile))
+ (or (not (consp (nth 1 form)))
+ (memq (car (nth 1 form)) safe-forms)))))
+ )
+ (cond
+ ((not safe-eval)
+ (setq unsafe-eval
+ (cons (list form (copy-marker pos) (buffer-substring pos (point)))
+ unsafe-eval)))
+ ((and form-fun
+ (memq def '( defun defmacro define-minor-mode define-globalized-minor-mode)))
+ (setq re-fun (cons (cons sym pos) re-fun)))
+ ((and form-var
+ (memq def '( defvar defconst defcustom))
+ (or (not (eq sym 'defvar))
+ (< 2 (length form))))
+ (setq re-var (cons sym re-var)))))))
+ (goto-char here))
+ (with-current-buffer out-buf
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ (unless (bobp) (insert "\n\n"))
+ (insert (propertize "Found these possible problems when reading the file:\n"
+ 'face '(:height 1.5)))
+ (or unsafe-eval
+ re-fun
+ (insert "\n"
+ "Found no problems (but there may still be)"
+ "\n"))
+
+ ;; Fix-me: Link
+ (when unsafe-eval
+ (insert (propertize
+ (format "\n* Forms that are executed when loading the file (found %s):\n\n"
+ (length unsafe-eval))
+ 'face '(:height 1.2)))
+ (dolist (u unsafe-eval)
+ (insert-text-button "Go to form below"
+ 'action
+ `(lambda (button)
+ (let* ((marker ,(nth 1 u))
+ (buf (marker-buffer marker)))
+ (switch-to-buffer-other-window buf)
+ (unless (and (< marker (point-max))
+ (> marker (point-min)))
+ (widen))
+ (goto-char marker))))
+ (insert "\n")
+ (insert (nth 2 u) "\n\n"))
+ (insert "\n"))
+ (when re-fun
+ (insert (propertize
+ (format "\n* The file will possibly redefine these functions that are currently defined (%s):\n"
+ (length re-fun))
+ 'face '(:height 1.2)))
+ (setq re-fun (sort re-fun (lambda (a b) (string< (symbol-name (car a)) (symbol-name (car b))))))
+ (let ((row 0)
+ (re-fun-with-info (mapcar (lambda (fun)
+ (cons fun (web-vcs-get-fun-details (car fun))))
+ re-fun))
+ re-fun-other-files
+ (n-same 0)
+ (n-web-auto 0))
+ ;; Check same file
+ (dolist (info re-fun-with-info)
+ (let* ((file-name (nth 3 info))
+ (fun (car (nth 0 info)))
+ (web-auto (get fun 'web-autoload)))
+ (cond ((funcall is-same-file file-name)
+ (setq n-same (1+ n-same)))
+ (web-auto
+ (setq n-web-auto (1+ n-web-auto))
+ (setq re-fun-other-files (cons info re-fun-other-files)))
+ (t
+ (setq re-fun-other-files (cons info re-fun-other-files))))))
+
+ (when (< 0 n-same)
+ (insert "\n "
+ (propertize (format "%s functions alreay defined by this file (which seems ok)" n-same)
+ 'face 'web-vcs-green)
+ "\n"))
+
+ (dolist (info re-fun-other-files)
+ (let* ((fun-rec (nth 0 info))
+ (errtype (nth 1 info))
+ (advised (nth 2 info))
+ (file-name (nth 3 info))
+ (string (nth 4 info))
+ (fun (car fun-rec))
+ (fun-pos (cdr fun-rec))
+ (fun-web-auto (get fun 'web-autoload))
+ )
+ (when (= 0 (% row 5)) (insert "\n"))
+ (setq row (1+ row))
+ (insert " `")
+ (insert-text-button (format "%s" fun)
+ 'action
+ `(lambda (button)
+ (describe-function ',fun)))
+ (insert "'")
+ (insert " (" string)
+ (when fun-web-auto
+ (insert " autoloaded from web, ")
+ (insert-text-button "info"
+ 'action
+ `(lambda (button)
+ ;; Fix-me: maybe a bit more informative ... ;-)
+ (message "%S" ',fun-web-auto))))
+ (insert ")")
+ (when advised (insert ", " (propertize "adviced" 'face 'font-lock-warning-face)))
+ (insert ", "
+ (cond
+ ((funcall is-same-file file-name)
+ (propertize "defined in this file" 'face 'web-vcs-green)
+ )
+ (fun-web-auto
+ (if (not (web-autoload-acvtive))
+ (propertize "web download not active" 'face 'web-vcs-yellow)
+ ;; See if file matches
+ (let ((active-sub-url web-autoload-active-file-sub-url)
+ (fun-sub-url (nth 2 fun-web-auto)))
+ (setq active-sub-url (file-name-sans-extension active-sub-url))
+ (if (string-match-p fun-sub-url active-sub-url)
+ (propertize "web download, matches" 'face 'web-vcs-yellow)
+ (propertize "web download, doesn't matches" 'face 'web-vcs-red)
+ ))))
+ (t
+ (propertize "defined in other file" 'face 'web-vcs-red))))
+ (unless (funcall is-same-file file-name)
+ (insert " (")
+ (insert-text-button "go to new definition"
+ 'action
+ `(lambda (button)
+ (interactive)
+ (let ((m-pos ,(with-current-buffer elisp
+ (copy-marker fun-pos))))
+ (switch-to-buffer-other-window (marker-buffer m-pos))
+ (goto-char m-pos))))
+ (insert ")"))
+ (insert "\n")
+ ))))))))
+
+;; I am quite tired of doing this over and over again. Why is this not
+;; in Emacs?
+(defvar web-vcs-button-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [tab] 'forward-button)
+ (define-key map [(shift tab)] 'backward-button)
+ map))
+(define-minor-mode web-vcs-button-mode
+ "Just to bind `forward-button' etc"
+ :lighter nil)
+
+(defvar web-vcs-eval-output-start nil)
+
+;;(web-vcs-investigate-file)
+;;;###autoload
+(defun web-vcs-investigate-elisp-file (file-or-buffer)
+ (interactive (list
+ (if (derived-mode-p 'emacs-lisp-mode)
+ (current-buffer)
+ (read-file-name "Elisp file to check: "))))
+ (let* ((elisp (if (bufferp file-or-buffer)
+ file-or-buffer
+ (find-file-noselect file-or-buffer)))
+ (elisp-file (with-current-buffer elisp (buffer-file-name)))
+ (out-buf (get-buffer-create "Web VCS Sec Inv")))
+ (if (not (with-current-buffer elisp (derived-mode-p 'emacs-lisp-mode)))
+ (progn
+ (unless (eq (current-buffer) elisp)
+ (display-buffer elisp))
+ (message "Buffer %s is not in emacs-lisp-mode" (buffer-name elisp)))
+ (switch-to-buffer-other-window out-buf)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (setq buffer-read-only t)
+ (web-vcs-button-mode 1)
+ (insert "A quick look for problems in ")
+ (if elisp-file
+ (progn
+ (insert "file\n ")
+ (insert-text-button elisp-file
+ 'action
+ `(lambda (button)
+ (interactive)
+ (find-file-other-window ,elisp-file))))
+ (insert "buffer ")
+ (insert-text-button (buffer-name elisp)
+ 'action
+ `(lambda (button)
+ (interactive)
+ (switch-to-buffer-other-window ,elisp))))
+ (insert "\n")
+ (let ((here (point)))
+ (insert
+ "\n"
+ (propertize
+ (concat "Note that this is just a quick look at the file."
+ " You have to investigate the file more carefully yourself"
+ " (or be sure someone else has done it for you)."
+ " The following are checked for here:"
+ "\n")
+ 'face font-lock-comment-face))
+ (fill-region here (point)))
+ (insert
+ (propertize
+ (concat
+ "- Top level forms that might be executed when loading the file.\n"
+ "- Redefinition of functions.\n")
+ 'face font-lock-comment-face))
+ (web-vcs-investigate-read elisp out-buf)
+ (when elisp-file
+ (insert "\n\n\n")
+ (let ((here (point)))
+ (insert "If you want to see what will actually be added to `load-history'"
+ " and which functions will be defined you can\n")
+ (insert-text-button "click here to try to eval the file"
+ 'action `(lambda (button) (interactive)
+ (if (y-or-n-p "Load the file in a batch Emacs session? ")
+ (web-vcs-investigate-eval ,elisp-file ,out-buf)
+ (message "Aborted"))))
+ (insert ".\n\nThis will load the file in a batch Emacs"
+ " which runs the same init files as you have run now"
+ (cond
+ ((not init-file-user) " (with -Q, ie no init files will run)")
+ ((not site-run-file) " (with -q, ie .emacs will not furn)")
+ (t " (your normal setup files will be run)"
+ ))
+ " and send back that information."
+ " The variable `load-path' is set to match the downloading"
+ " to make the loading possible before your setup is ready."
+ "\n\nYour current Emacs will not be affected by the loading,"
+ " but please be aware that this does not mean your computer can not be."
+ " So please look at the file first.")
+ (fill-region here (point))
+ (setq web-vcs-eval-output-start (point))
+ ))
+ (set-buffer-modified-p nil)
+ (goto-char (point-min))))))
+
+(make-variable-buffer-local 'web-vcs-eval-output-start)
+
+;;(web-vcs-investigate-eval "c:/emacsw32/nxhtml/nxhtml/nxhtml-autoload.el" "*Messages*")
+;;(web-vcs-investigate-eval "c:/emacsw32/nxhtml/autostart.el" "*Messages*")
+(defun web-vcs-investigate-eval (elisp-file out-buf)
+ "Get compile loads when evaling buffer.
+For security reasons do this in a fresh Emacs and return the
+resulting load-history entry."
+ (let* ((emacs-exe (locate-file invocation-name
+ (list invocation-directory)
+ exec-suffixes))
+ ;; see custom-load-symbol
+ (get-lhe '(let ((lhe (or (assoc buffer-file-name load-history)
+ (assoc (concat (file-name-sans-extension buffer-file-name) ".elc")
+ load-history))))
+ (prin1 "STARTHERE\n")
+ (prin1 lhe)))
+ (elisp-file-name (file-name-sans-extension (file-name-nondirectory elisp-file)))
+ (elisp-el-file (file-truename (concat (file-name-sans-extension elisp-file) ".el")))
+ (temp-prefix web-autoload-temp-file-prefix)
+ (temp-prefix-len (length temp-prefix))
+ (is-downloading (and (boundp 'web-autoload-paranoid)
+ web-autoload-paranoid))
+ (is-temp-file (and is-downloading
+ (< (length temp-prefix) (length elisp-file-name))
+ (string= temp-prefix
+ (substring elisp-file-name 0 temp-prefix-len))))
+ (elisp-feature-name (if is-temp-file
+ (substring elisp-file-name temp-prefix-len)
+ elisp-file-name))
+ (is-same-file (lambda (file)
+ (when file ;; self protecting
+ (setq file (concat (file-name-sans-extension file) ".el"))
+ (string= (file-truename file) elisp-el-file))))
+ (active-sub-url (when (web-autoload-acvtive)
+ (file-name-sans-extension web-autoload-active-file-sub-url)))
+ whole-result
+ batch-error
+ result)
+ (with-current-buffer out-buf
+ (let ((here (point))
+ (inhibit-read-only t))
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ (delete-region web-vcs-eval-output-start (point)))
+ (goto-char here)))
+ ;; Fix-me: do not use temp buffer so we can check errors
+ (with-temp-buffer
+ (let ((old-loadpath (getenv "EMACSLOADPATH"))
+ ;;(new-loadpath (mapconcat 'identity load-path ";"))
+ (new-loadpath (mapconcat 'identity load-path path-separator))
+ ret-val)
+ (setenv new-loadpath)
+ (message "Loading file in batch Emacs...")
+ (setq ret-val
+ (call-process emacs-exe nil
+ (current-buffer)
+ t "--batch"
+ ;; fix-me: "-Q" - should be run in the users current environment.
+ ;; init-file-user nil => -Q
+ ;; site-run-file nil => -q
+ (cond
+ ((not init-file-user) "-Q")
+ ((not site-run-file) "-q")
+ (t "--debug-init")) ;; have to have something here...
+ "-l" elisp-file
+ elisp-file
+ "-eval" (format "%S" get-lhe)))
+ (message "Loading file in batch Emacs... done, returned %S" ret-val)
+ (setenv old-loadpath))
+ ;; Fix-me: how do you check the exit status on different platforms?
+ (setq whole-result (buffer-substring-no-properties (point-min) (point-max)))
+ (condition-case err
+ (progn
+ (goto-char (point-min))
+ (search-forward "STARTHERE")
+ (search-forward "(")
+ (backward-char)
+ (setq result (read (current-buffer))))
+ (error (message "")
+ ;; Process should probably have failed if we are here,
+ ;; but anyway... ;-)
+ (setq batch-error
+ (concat "Sorry, batch Emacs failed. It returned this message:\n\n"
+ whole-result
+ (if is-downloading
+ (concat
+ "\n--------\n"
+ "The error may depend on that not all needed files are yet downloaded.\n")
+ "\n")))
+ )))
+ (with-current-buffer out-buf
+ (let ((here (point))
+ (inhibit-read-only t))
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ (if batch-error
+ (progn
+ (insert "\n\n")
+ (insert (propertize batch-error 'face 'web-vcs-red)))
+ (insert (propertize "\n\nThis file added the following to `load-history':\n\n"
+ 'face '(:height 1.5)))
+ (insert " (\"" (car result) "\"\n")
+ (dolist (e (cdr result))
+ (insert (format " %S" e))
+ (cond ((stringp e)) ;; Should not happen...
+ ;; Variables
+ ((symbolp e)
+ (insert " - ")
+ (insert (if (not (boundp e))
+ (propertize "New" 'face 'web-vcs-yellow)
+ (let ((e-file (symbol-file e)))
+ (if (funcall is-same-file e-file)
+ (propertize "Same file now" 'face 'web-vcs-green)
+ (let* ((fun-web-auto (get e 'web-autoload))
+ (fun-sub-url (nth 2 fun-web-auto)))
+ (if (and fun-sub-url
+ (string= fun-sub-url active-sub-url))
+ (propertize "Web download, matches current download"
+ 'face 'web-vcs-yellow)
+ (propertize (format "Loaded from %S now" e-file)
+ 'face 'web-vcs-red))))))))
+ ;; provide
+ ((eq (car e) 'provide)
+ (insert " - ")
+ (let* ((feat (car e))
+ (feat-name (symbol-name feat)))
+ (insert (cond
+ ((not (featurep feat))
+ (if (or (string= elisp-feature-name
+ (symbol-name (cdr e))))
+ (propertize "Web download, matches file name" 'face 'web-vcs-green)
+ (propertize "Does not match file name" 'face 'web-vcs-red)))
+ (t
+ ;; symbol-file will be where it is loaded
+ ;; so check load-path instead.
+ (let ((file (locate-library feat-name)))
+ (if (funcall is-same-file file)
+ (propertize "Probably loaded from same file now" 'face 'web-vcs-yellow)
+ (propertize (format "Probably loaded from %S now" file)
+ 'face 'web-vcs-yellow))))))))
+ ;; require
+ ((eq (car e) 'require)
+ (if (featurep (cdr e))
+ (insert " - " (propertize "Loaded now" 'face 'web-vcs-green))
+ (insert " - " (propertize "Not loaded now" 'face 'web-vcs-yellow))))
+ ;; Functions
+ ((memq (car e) '( defun macro))
+ (insert " - ")
+ (let ((fun (cdr e)))
+ (insert (if (functionp fun)
+ (let ((e-file (symbol-file e)))
+ (if (funcall is-same-file e-file)
+ (propertize "Same file now" 'face 'web-vcs-green)
+ (let* ((fun-web-auto (get fun 'web-autoload))
+ (fun-sub-url (nth 2 fun-web-auto)))
+ ;; Fix-me: check for temp download file.
+ (if (string= fun-sub-url active-sub-url)
+ (propertize "Web download, matches current download"
+ 'face 'web-vcs-yellow)
+ (propertize (format "Loaded from %S now" e-file)
+ 'face 'web-vcs-yellow)))))
+ ;; Note that web autoloaded functions are already defined.
+ (propertize "New" 'face 'web-vcs-yellow))))))
+ (insert "\n"))
+ (insert " )\n")
+ (goto-char here))))
+ (set-buffer-modified-p nil))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Specific for nXhtml
+
+(defvar nxhtml-web-vcs-base-url "http://bazaar.launchpad.net/%7Enxhtml/nxhtml/main/")
+
+;; Fix-me: make gen for 'lp etc
+(defun nxhtml-download-root-url (revision)
+ (let* ((base-url nxhtml-web-vcs-base-url)
+ (files-url (concat base-url "files/"))
+ (rev-part (if revision (number-to-string revision) "head%3A/")))
+ (concat files-url rev-part)))
+
+(defun web-vcs-nxhtml ()
+ "Install nXhtml.
+Download and install nXhtml."
+ (interactive)
+ (catch 'command-level
+ (setq debug-on-error t)
+ (let* ((this-dir (file-name-directory web-vcs-el-this))
+ (root-url (nxhtml-download-root-url nil))
+ ;;(files '("nxhtml-web-vcs.el" "nxhtml-base.el"))
+ (files '("nxhtml-web-vcs.el"))
+ (files2 (mapcar (lambda (file)
+ (cons file (expand-file-name file this-dir)))
+ files))
+ need-dl)
+ (dolist (file files2)
+ (unless (file-exists-p (cdr file))
+ (setq need-dl t)))
+ (when need-dl
+ (let ((prompt
+ (concat "Welcome to install nXhtml."
+ "\nFirst the nXhtml specific web install file must be downloaded."
+ "\nYou will get a chance to review it before it is used."
+ "\n\nDo you want to continue? ")))
+ (unless (y-or-n-p prompt)
+ (message "Aborted")
+ (throw 'command-level nil))))
+ (message nil)
+ (unless (get-buffer-window "*Messages*")
+ (web-vcs-display-messages t)
+ (delete-other-windows))
+ (dolist (file files2)
+ (unless (file-exists-p (cdr file))
+ (web-vcs-get-missing-matching-files 'lp root-url this-dir (car file))))
+ (load (cdr (car files2))))
+ (call-interactively 'nxhtml-setup-install)))
+
+
+(provide 'web-vcs)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; web-vcs.el ends here
--- /dev/null
+;;; -*- Mode: Emacs-Lisp; outline-regexp: "\f\n;;;;+" -*-
+
+;;;;;; Paredit: Parenthesis-Editing Minor Mode
+;;;;;; Version 21
+
+;;; Copyright (c) 2008, Taylor R. Campbell
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;;
+;;; * Redistributions in binary form must reproduce the above copyright
+;;; notice, this list of conditions and the following disclaimer in
+;;; the documentation and/or other materials provided with the
+;;; distribution.
+;;;
+;;; * Neither the names of the authors nor the names of contributors
+;;; may be used to endorse or promote products derived from this
+;;; software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; This file is permanently stored at
+;;; <http://mumble.net/~campbell/emacs/paredit-21.el>.
+;;;
+;;; The currently released version of paredit is available at
+;;; <http://mumble.net/~campbell/emacs/paredit.el>.
+;;;
+;;; The latest beta version of paredit is available at
+;;; <http://mumble.net/~campbell/emacs/paredit-beta.el>.
+;;;
+;;; Release notes are available at
+;;; <http://mumble.net/~campbell/emacs/paredit.release>.
+\f
+;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a
+;;; directory of your choice, and adding to your .emacs file:
+;;;
+;;; (add-to-list 'load-path "/path/to/elisp")
+;;; (autoload 'paredit-mode "paredit"
+;;; "Minor mode for pseudo-structurally editing Lisp code."
+;;; t)
+;;;
+;;; Toggle Paredit Mode with `M-x paredit-mode RET', or enable it
+;;; always in a major mode `M' (e.g., `lisp' or `scheme') with:
+;;;
+;;; (add-hook M-mode-hook (lambda () (paredit-mode +1)))
+;;;
+;;; Customize paredit using `eval-after-load':
+;;;
+;;; (eval-after-load 'paredit
+;;; '(progn ...redefine keys, &c....))
+;;;
+;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5 or
+;;; later. Paredit is highly unlikely to work in earlier versions of
+;;; GNU Emacs, and it may have obscure problems in earlier versions of
+;;; XEmacs due to the way its syntax parser reports conditions, as a
+;;; result of which the code that uses the syntax parser must mask all
+;;; error conditions, not just those generated by the syntax parser.
+;;;
+;;; Questions, bug reports, comments, feature suggestions, &c., may be
+;;; addressed via email to the author's surname at mumble.net or via
+;;; IRC to the user named Riastradh on irc.freenode.net in the #paredit
+;;; channel.
+;;;
+;;; Please contact the author rather than forking your own versions, to
+;;; prevent the dissemination of random variants floating about the
+;;; internet unbeknownst to the author. Laziness is not an excuse:
+;;; your laziness costs me confusion and time trying to support
+;;; paredit, so if you fork paredit, you make the world a worse place.
+;;;
+;;; *** WARNING *** IMPORTANT *** DO NOT SUBMIT BUGS BEFORE READING ***
+;;;
+;;; If you plan to submit a bug report, where some sequence of keys in
+;;; Paredit Mode, or some sequence of paredit commands, doesn't do what
+;;; you wanted, then it is helpful to isolate an example in a very
+;;; small buffer, and it is **ABSOLUTELY**ESSENTIAL** that you supply,
+;;; along with the sequence of keys or commands,
+;;;
+;;; (1) the version of Emacs,
+;;; (2) the version of paredit.el[*], and
+;;; (3) the **COMPLETE** state of the buffer used to reproduce the
+;;; problem, including major mode, minor modes, local key
+;;; bindings, entire contents of the buffer, leading line breaks
+;;; or spaces, &c.
+;;;
+;;; It is often extremely difficult to reproduce problems, especially
+;;; with commands like `paredit-kill'. If you do not supply **ALL** of
+;;; this information, then it is highly probable that I cannot
+;;; reproduce your problem no matter how hard I try, and the effect of
+;;; submitting a bug without this information is only to waste your
+;;; time and mine. So, please, include all of the above information.
+;;;
+;;; [*] If you are using a beta version of paredit, be sure that you
+;;; are using the *latest* edition of the beta version, available
+;;; at <http://mumble.net/~campbell/emacs/paredit-beta.el>. If you
+;;; are not using a beta version, then upgrade either to that or to
+;;; the latest release version; I cannot support older versions,
+;;; and I can't fathom any reason why you might be using them. So
+;;; the answer to item (2) should be either `release' or `beta'.
+\f
+;;; The paredit minor mode, Paredit Mode, binds a number of simple
+;;; keys, notably `(', `)', `"', and `\', to commands that more
+;;; carefully insert S-expression structures in the buffer. The
+;;; parenthesis delimiter keys (round or square) are defined to insert
+;;; parenthesis pairs and move past the closing delimiter,
+;;; respectively; the double-quote key is multiplexed to do both, and
+;;; also to insert an escape if within a string; and backslashes prompt
+;;; the user for the next character to input, because a lone backslash
+;;; can break structure inadvertently. These all have their ordinary
+;;; behaviour when inside comments, and, outside comments, if truly
+;;; necessary, you can insert them literally with `C-q'.
+;;;
+;;; The key bindings are designed so that when typing new code in
+;;; Paredit Mode, you can generally use exactly the same keystrokes as
+;;; you would have used without Paredit Mode. Earlier versions of
+;;; paredit.el did not conform to this, because Paredit Mode bound `)'
+;;; to a command that would insert a newline. Now `)' is bound to a
+;;; command that does not insert a newline, and `M-)' is bound to the
+;;; command that inserts a newline. To revert to the former behaviour,
+;;; add the following forms to an `eval-after-load' form for paredit.el
+;;; in your .emacs file:
+;;;
+;;; (define-key paredit-mode-map (kbd ")")
+;;; 'paredit-close-round-and-newline)
+;;; (define-key paredit-mode-map (kbd "M-)")
+;;; 'paredit-close-round)
+;;;
+;;; Paredit Mode also binds the usual keys for deleting and killing, so
+;;; that they will not destroy any S-expression structure by killing or
+;;; deleting only one side of a parenthesis or quote pair. If the
+;;; point is on a closing delimiter, `DEL' will move left over it; if
+;;; it is on an opening delimiter, `C-d' will move right over it. Only
+;;; if the point is between a pair of delimiters will `C-d' or `DEL'
+;;; delete them, and in that case it will delete both simultaneously.
+;;; `M-d' and `M-DEL' kill words, but skip over any S-expression
+;;; structure. `C-k' kills from the start of the line, either to the
+;;; line's end, if it contains only balanced expressions; to the first
+;;; closing delimiter, if the point is within a form that ends on the
+;;; line; or up to the end of the last expression that starts on the
+;;; line after the point.
+;;;
+;;; The behaviour of the commands for deleting and killing can be
+;;; overridden by passing a `C-u' prefix argument: `C-u DEL' will
+;;; delete a character backward, `C-u C-d' will delete a character
+;;; forward, and `C-u C-k' will kill text from the point to the end of
+;;; the line, irrespective of the S-expression structure in the buffer.
+;;; This can be used to fix mistakes in a buffer, but should generally
+;;; be avoided.
+;;;
+;;; Paredit performs automatic reindentation as locally as possible, to
+;;; avoid interfering with custom indentation used elsewhere in some
+;;; S-expression. Only the advanced S-expression manipulation commands
+;;; automatically reindent, and only the forms that were immediately
+;;; operated upon (and their subforms).
+;;;
+;;; This code is written for clarity, not efficiency. It frequently
+;;; walks over S-expressions redundantly. If you have problems with
+;;; the time it takes to execute some of the commands, let me know, but
+;;; first be sure that what you're doing is reasonable: it is
+;;; preferable to avoid immense S-expressions in code anyway.
+
+;;; This assumes Unix-style LF line endings.
+
+(defconst paredit-version 21)
+(defconst paredit-beta-p nil)
+\f
+(eval-and-compile
+
+ (defun paredit-xemacs-p ()
+ ;; No idea where I got this definition from. Edward O'Connor
+ ;; (hober in #emacs) suggested the current definition.
+ ;; (and (boundp 'running-xemacs)
+ ;; running-xemacs)
+ (featurep 'xemacs))
+
+ (defun paredit-gnu-emacs-p ()
+ ;++ This could probably be improved.
+ (not (paredit-xemacs-p)))
+
+ (defmacro xcond (&rest clauses)
+ "Exhaustive COND.
+Signal an error if no clause matches."
+ `(cond ,@clauses
+ (t (error "XCOND lost."))))
+
+ (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message))
+
+ (defvar paredit-sexp-error-type
+ (with-temp-buffer
+ (insert "(")
+ (condition-case condition
+ (backward-sexp)
+ (error (if (eq (car condition) 'error)
+ (paredit-warn "%s%s%s%s%s"
+ "Paredit is unable to discriminate"
+ " S-expression parse errors from"
+ " other errors. "
+ " This may cause obscure problems. "
+ " Please upgrade Emacs."))
+ (car condition)))))
+
+ (defmacro paredit-handle-sexp-errors (body &rest handler)
+ `(condition-case ()
+ ,body
+ (,paredit-sexp-error-type ,@handler)))
+
+ (put 'paredit-handle-sexp-errors 'lisp-indent-function 1)
+
+ (defmacro paredit-ignore-sexp-errors (&rest body)
+ `(paredit-handle-sexp-errors (progn ,@body)
+ nil))
+
+ (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0)
+
+ nil)
+\f
+;;;; Minor Mode Definition
+
+(defvar paredit-mode-map (make-sparse-keymap)
+ "Keymap for the paredit minor mode.")
+
+(define-minor-mode paredit-mode
+ "Minor mode for pseudo-structurally editing Lisp code.
+\\<paredit-mode-map>"
+ :lighter " Paredit"
+ ;; If we're enabling paredit-mode, the prefix to this code that
+ ;; DEFINE-MINOR-MODE inserts will have already set PAREDIT-MODE to
+ ;; true. If this is the case, then first check the parentheses, and
+ ;; if there are any imbalanced ones we must inhibit the activation of
+ ;; paredit mode. We skip the check, though, if the user supplied a
+ ;; prefix argument interactively.
+ (if (and paredit-mode
+ (not current-prefix-arg))
+ (if (not (fboundp 'check-parens))
+ (paredit-warn "`check-parens' is not defined; %s"
+ "be careful of malformed S-expressions.")
+ (condition-case condition
+ (check-parens)
+ (error (setq paredit-mode nil)
+ (signal (car condition) (cdr condition)))))))
+
+;;; Old functions from when there was a different mode for emacs -nw.
+
+(defun enable-paredit-mode ()
+ "Turn on pseudo-structural editing of Lisp code.
+
+Deprecated: use `paredit-mode' instead."
+ (interactive)
+ (paredit-mode +1))
+
+(defun disable-paredit-mode ()
+ "Turn off pseudo-structural editing of Lisp code.
+
+Deprecated: use `paredit-mode' instead."
+ (interactive)
+ (paredit-mode -1))
+
+(defvar paredit-backward-delete-key
+ (xcond ((paredit-xemacs-p) "BS")
+ ((paredit-gnu-emacs-p) "DEL")))
+
+(defvar paredit-forward-delete-keys
+ (xcond ((paredit-xemacs-p) '("DEL"))
+ ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>"))))
+\f
+;;;; Paredit Keys
+
+;;; Separating the definition and initialization of this variable
+;;; simplifies the development of paredit, since re-evaluating DEFVAR
+;;; forms doesn't actually do anything.
+
+(defvar paredit-commands nil
+ "List of paredit commands with their keys and examples.")
+
+;;; Each specifier is of the form:
+;;; (key[s] function (example-input example-output) ...)
+;;; where key[s] is either a single string suitable for passing to KBD
+;;; or a list of such strings. Entries in this list may also just be
+;;; strings, in which case they are headings for the next entries.
+
+(progn (setq paredit-commands
+ `(
+ "Basic Insertion Commands"
+ ("(" paredit-open-round
+ ("(a b |c d)"
+ "(a b (|) c d)")
+ ("(foo \"bar |baz\" quux)"
+ "(foo \"bar (|baz\" quux)"))
+ (")" paredit-close-round
+ ("(a b |c )" "(a b c)|")
+ ("; Hello,| world!"
+ "; Hello,)| world!"))
+ ("M-)" paredit-close-round-and-newline
+ ("(defun f (x| ))"
+ "(defun f (x)\n |)")
+ ("; (Foo.|"
+ "; (Foo.)|"))
+ ("[" paredit-open-square
+ ("(a b |c d)"
+ "(a b [|] c d)")
+ ("(foo \"bar |baz\" quux)"
+ "(foo \"bar [baz\" quux)"))
+ ("]" paredit-close-square
+ ("(define-key keymap [frob| ] 'frobnicate)"
+ "(define-key keymap [frob]| 'frobnicate)")
+ ("; [Bar.|"
+ "; [Bar.]|"))
+ ("\"" paredit-doublequote
+ ("(frob grovel |full lexical)"
+ "(frob grovel \"|\" full lexical)")
+ ("(foo \"bar |baz\" quux)"
+ "(foo \"bar \\\"|baz\" quux)"))
+ ("M-\"" paredit-meta-doublequote
+ ("(foo \"bar |baz\" quux)"
+ "(foo \"bar baz\"\n |quux)")
+ ("(foo |(bar #\\x \"baz \\\\ quux\") zot)"
+ ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\"
+ "\\\\ quux\\\")\" zot)")))
+ ("\\" paredit-backslash
+ ("(string #|)\n ; Escaping character... (x)"
+ "(string #\\x|)")
+ ("\"foo|bar\"\n ; Escaping character... (\")"
+ "\"foo\\\"|bar\""))
+ ("M-;" paredit-comment-dwim
+ ("(foo |bar) ; baz"
+ "(foo bar) ; |baz")
+ ("(frob grovel)|"
+ "(frob grovel) ;|")
+ (" (foo bar)\n|\n (baz quux)"
+ " (foo bar)\n ;; |\n (baz quux)")
+ (" (foo bar) |(baz quux)"
+ " (foo bar)\n ;; |\n (baz quux)")
+ ("|(defun hello-world ...)"
+ ";;; |\n(defun hello-world ...)"))
+\f
+ ("C-j" paredit-newline
+ ("(let ((n (frobbotz))) |(display (+ n 1)\nport))"
+ ,(concat "(let ((n (frobbotz)))"
+ "\n |(display (+ n 1)"
+ "\n port))")))
+
+ "Deleting & Killing"
+ (("C-d" ,@paredit-forward-delete-keys)
+ paredit-forward-delete
+ ("(quu|x \"zot\")" "(quu| \"zot\")")
+ ("(quux |\"zot\")"
+ "(quux \"|zot\")"
+ "(quux \"|ot\")")
+ ("(foo (|) bar)" "(foo | bar)")
+ ("|(foo bar)" "(|foo bar)"))
+ (,paredit-backward-delete-key
+ paredit-backward-delete
+ ("(\"zot\" q|uux)" "(\"zot\" |uux)")
+ ("(\"zot\"| quux)"
+ "(\"zot|\" quux)"
+ "(\"zo|\" quux)")
+ ("(foo (|) bar)" "(foo | bar)")
+ ("(foo bar)|" "(foo bar|)"))
+ ("C-k" paredit-kill
+ ("(foo bar)| ; Useless comment!"
+ "(foo bar)|")
+ ("(|foo bar) ; Useful comment!"
+ "(|) ; Useful comment!")
+ ("|(foo bar) ; Useless line!"
+ "|")
+ ("(foo \"|bar baz\"\n quux)"
+ "(foo \"|\"\n quux)"))
+ ("M-d" paredit-forward-kill-word
+ ("|(foo bar) ; baz"
+ "(| bar) ; baz"
+ "(|) ; baz"
+ "() ;|")
+ (";;;| Frobnicate\n(defun frobnicate ...)"
+ ";;;|\n(defun frobnicate ...)"
+ ";;;\n(| frobnicate ...)"))
+ (,(concat "M-" paredit-backward-delete-key)
+ paredit-backward-kill-word
+ ("(foo bar) ; baz\n(quux)|"
+ "(foo bar) ; baz\n(|)"
+ "(foo bar) ; |\n()"
+ "(foo |) ; \n()"
+ "(|) ; \n()"))
+
+ "Movement & Navigation"
+ ("C-M-f" paredit-forward
+ ("(foo |(bar baz) quux)"
+ "(foo (bar baz)| quux)")
+ ("(foo (bar)|)"
+ "(foo (bar))|"))
+ ("C-M-b" paredit-backward
+ ("(foo (bar baz)| quux)"
+ "(foo |(bar baz) quux)")
+ ("(|(foo) bar)"
+ "|((foo) bar)"))
+;;;("C-M-u" backward-up-list) ; These two are built-in.
+;;;("C-M-d" down-list)
+ ("C-M-p" backward-down-list) ; Built-in, these are FORWARD-
+ ("C-M-n" up-list) ; & BACKWARD-LIST, which have
+ ; no need given C-M-f & C-M-b.
+\f
+ "Depth-Changing Commands"
+ ("M-(" paredit-wrap-round
+ ("(foo |bar baz)"
+ "(foo (|bar) baz)"))
+ ("M-s" paredit-splice-sexp
+ ("(foo (bar| baz) quux)"
+ "(foo bar| baz quux)"))
+ (("M-<up>" "ESC <up>")
+ paredit-splice-sexp-killing-backward
+ ("(foo (let ((x 5)) |(sqrt n)) bar)"
+ "(foo (sqrt n) bar)"))
+ (("M-<down>" "ESC <down>")
+ paredit-splice-sexp-killing-forward
+ ("(a (b c| d e) f)"
+ "(a b c f)"))
+ ("M-r" paredit-raise-sexp
+ ("(dynamic-wind in (lambda () |body) out)"
+ "(dynamic-wind in |body out)"
+ "|body"))
+
+ "Barfage & Slurpage"
+ (("C-)" "C-<right>")
+ paredit-forward-slurp-sexp
+ ("(foo (bar |baz) quux zot)"
+ "(foo (bar |baz quux) zot)")
+ ("(a b ((c| d)) e f)"
+ "(a b ((c| d) e) f)"))
+ (("C-}" "C-<left>")
+ paredit-forward-barf-sexp
+ ("(foo (bar |baz quux) zot)"
+ "(foo (bar |baz) quux zot)"))
+ (("C-(" "C-M-<left>" "ESC C-<left>")
+ paredit-backward-slurp-sexp
+ ("(foo bar (baz| quux) zot)"
+ "(foo (bar baz| quux) zot)")
+ ("(a b ((c| d)) e f)"
+ "(a (b (c| d)) e f)"))
+ (("C-{" "C-M-<right>" "ESC C-<right>")
+ paredit-backward-barf-sexp
+ ("(foo (bar baz |quux) zot)"
+ "(foo bar (baz |quux) zot)"))
+
+ "Miscellaneous Commands"
+ ("M-S" paredit-split-sexp
+ ("(hello| world)"
+ "(hello)| (world)")
+ ("\"Hello, |world!\""
+ "\"Hello, \"| \"world!\""))
+ ("M-J" paredit-join-sexps
+ ("(hello)| (world)"
+ "(hello| world)")
+ ("\"Hello, \"| \"world!\""
+ "\"Hello, |world!\"")
+ ("hello-\n| world"
+ "hello-|world"))
+ ("C-c C-M-l" paredit-recentre-on-sexp)
+ ("M-q" paredit-reindent-defun)
+ ))
+ nil) ; end of PROGN
+\f
+;;;;; Command Examples
+
+(eval-and-compile
+ (defmacro paredit-do-commands (vars string-case &rest body)
+ (let ((spec (nth 0 vars))
+ (keys (nth 1 vars))
+ (fn (nth 2 vars))
+ (examples (nth 3 vars)))
+ `(dolist (,spec paredit-commands)
+ (if (stringp ,spec)
+ ,string-case
+ (let ((,keys (let ((k (car ,spec)))
+ (cond ((stringp k) (list k))
+ ((listp k) k)
+ (t (error "Invalid paredit command %s."
+ ,spec)))))
+ (,fn (cadr ,spec))
+ (,examples (cddr ,spec)))
+ ,@body)))))
+
+ (put 'paredit-do-commands 'lisp-indent-function 2))
+
+(defun paredit-define-keys ()
+ (paredit-do-commands (spec keys fn examples)
+ nil ; string case
+ (dolist (key keys)
+ (define-key paredit-mode-map (read-kbd-macro key) fn))))
+
+(defun paredit-function-documentation (fn)
+ (let ((original-doc (get fn 'paredit-original-documentation))
+ (doc (documentation fn 'function-documentation)))
+ (or original-doc
+ (progn (put fn 'paredit-original-documentation doc)
+ doc))))
+
+(defun paredit-annotate-mode-with-examples ()
+ (let ((contents
+ (list (paredit-function-documentation 'paredit-mode))))
+ (paredit-do-commands (spec keys fn examples)
+ (push (concat "\n\f\n" spec "\n")
+ contents)
+ (let ((name (symbol-name fn)))
+ (if (string-match (symbol-name 'paredit-) name)
+ (push (concat "\n\n\\[" name "]\t" name
+ (if examples
+ (mapconcat (lambda (example)
+ (concat
+ "\n"
+ (mapconcat 'identity
+ example
+ "\n --->\n")
+ "\n"))
+ examples
+ "")
+ "\n (no examples)\n"))
+ contents))))
+ (put 'paredit-mode 'function-documentation
+ (apply 'concat (reverse contents))))
+ ;; PUT returns the huge string we just constructed, which we don't
+ ;; want it to return.
+ nil)
+
+(defun paredit-annotate-functions-with-examples ()
+ (paredit-do-commands (spec keys fn examples)
+ nil ; string case
+ (put fn 'function-documentation
+ (concat (paredit-function-documentation fn)
+ "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n"
+ (mapconcat (lambda (example)
+ (concat "\n"
+ (mapconcat 'identity
+ example
+ "\n ->\n")
+ "\n"))
+ examples
+ "")))))
+\f
+;;;;; HTML Examples
+
+(defun paredit-insert-html-examples ()
+ "Insert HTML for a paredit quick reference table."
+ (interactive)
+ (let ((insert-lines
+ (lambda (&rest lines)
+ (mapc (lambda (line) (insert line) (newline))
+ lines)))
+ (html-keys
+ (lambda (keys)
+ (mapconcat 'paredit-html-quote keys ", ")))
+ (html-example
+ (lambda (example)
+ (concat "<table><tr><td><pre>"
+ (mapconcat 'paredit-html-quote
+ example
+ (concat "</pre></td></tr><tr><td>"
+ " --->"
+ "</td></tr><tr><td><pre>"))
+ "</pre></td></tr></table>")))
+ (firstp t))
+ (paredit-do-commands (spec keys fn examples)
+ (progn (if (not firstp)
+ (insert "</table>\n")
+ (setq firstp nil))
+ (funcall insert-lines
+ (concat "<h3>" spec "</h3>")
+ "<table border=\"1\" cellpadding=\"1\">"
+ " <tr>"
+ " <th>Command</th>"
+ " <th>Keys</th>"
+ " <th>Examples</th>"
+ " </tr>"))
+ (let ((name (symbol-name fn)))
+ (if (string-match (symbol-name 'paredit-) name)
+ (funcall insert-lines
+ " <tr>"
+ (concat " <td><tt>" name "</tt></td>")
+ (concat " <td align=\"center\">"
+ (funcall html-keys keys)
+ "</td>")
+ (concat " <td>"
+ (if examples
+ (mapconcat html-example examples
+ "<hr>")
+ "(no examples)")
+ "</td>")
+ " </tr>")))))
+ (insert "</table>\n"))
+
+(defun paredit-html-quote (string)
+ (with-temp-buffer
+ (dotimes (i (length string))
+ (insert (let ((c (elt string i)))
+ (cond ((eq c ?\<) "<")
+ ((eq c ?\>) ">")
+ ((eq c ?\&) "&")
+ ((eq c ?\') "'")
+ ((eq c ?\") """)
+ (t c)))))
+ (buffer-string)))
+\f
+;;;; Delimiter Insertion
+
+(eval-and-compile
+ (defun paredit-conc-name (&rest strings)
+ (intern (apply 'concat strings)))
+
+ (defmacro define-paredit-pair (open close name)
+ `(progn
+ (defun ,(paredit-conc-name "paredit-open-" name) (&optional n)
+ ,(concat "Insert a balanced " name " pair.
+With a prefix argument N, put the closing " name " after N
+ S-expressions forward.
+If the region is active, `transient-mark-mode' is enabled, and the
+ region's start and end fall in the same parenthesis depth, insert a
+ " name " pair around the region.
+If in a string or a comment, insert a single " name ".
+If in a character literal, do nothing. This prevents changing what was
+ in the character literal to a meaningful delimiter unintentionally.")
+ (interactive "P")
+ (cond ((or (paredit-in-string-p)
+ (paredit-in-comment-p))
+ (insert ,open))
+ ((not (paredit-in-char-p))
+ (paredit-insert-pair n ,open ,close 'goto-char))))
+ (defun ,(paredit-conc-name "paredit-close-" name) ()
+ ,(concat "Move past one closing delimiter and reindent.
+\(Agnostic to the specific closing delimiter.)
+If in a string or comment, insert a single closing " name ".
+If in a character literal, do nothing. This prevents changing what was
+ in the character literal to a meaningful delimiter unintentionally.")
+ (interactive)
+ (paredit-move-past-close ,close))
+ (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") ()
+ ,(concat "Move past one closing delimiter, add a newline,"
+ " and reindent.
+If there was a margin comment after the closing delimiter, preserve it
+ on the same line.")
+ (interactive)
+ (paredit-move-past-close-and-newline ,close))
+ (defun ,(paredit-conc-name "paredit-wrap-" name)
+ (&optional argument)
+ ,(concat "Wrap the following S-expression.
+See `paredit-wrap-sexp' for more details.")
+ (interactive "P")
+ (paredit-wrap-sexp argument ,open ,close))
+ (add-to-list 'paredit-wrap-commands
+ ',(paredit-conc-name "paredit-wrap-" name)))))
+
+(defvar paredit-wrap-commands '(paredit-wrap-sexp)
+ "List of paredit commands that wrap S-expressions.
+Used by `paredit-yank-pop'; for internal paredit use only.")
+
+(define-paredit-pair ?\( ?\) "round")
+(define-paredit-pair ?\[ ?\] "square")
+(define-paredit-pair ?\{ ?\} "curly")
+(define-paredit-pair ?\< ?\> "angled")
+
+;;; Aliases for the old names.
+
+(defalias 'paredit-open-parenthesis 'paredit-open-round)
+(defalias 'paredit-close-parenthesis 'paredit-close-round)
+(defalias 'paredit-close-parenthesis-and-newline
+ 'paredit-close-round-and-newline)
+
+(defalias 'paredit-open-bracket 'paredit-open-square)
+(defalias 'paredit-close-bracket 'paredit-close-square)
+(defalias 'paredit-close-bracket-and-newline
+ 'paredit-close-square-and-newline)
+\f
+(defun paredit-move-past-close (close)
+ (cond ((or (paredit-in-string-p)
+ (paredit-in-comment-p))
+ (insert close))
+ ((not (paredit-in-char-p))
+ (paredit-move-past-close-and-reindent close)
+ (paredit-blink-paren-match nil))))
+
+(defun paredit-move-past-close-and-newline (close)
+ (if (or (paredit-in-string-p)
+ (paredit-in-comment-p))
+ (insert close)
+ (if (paredit-in-char-p) (forward-char))
+ (paredit-move-past-close-and-reindent close)
+ (let ((comment.point (paredit-find-comment-on-line)))
+ (newline)
+ (if comment.point
+ (save-excursion
+ (forward-line -1)
+ (end-of-line)
+ (indent-to (cdr comment.point))
+ (insert (car comment.point)))))
+ (lisp-indent-line)
+ (paredit-ignore-sexp-errors (indent-sexp))
+ (paredit-blink-paren-match t)))
+
+(defun paredit-find-comment-on-line ()
+ "Find a margin comment on the current line.
+Return nil if there is no such comment or if there is anything but
+ whitespace until such a comment.
+If such a comment exists, delete the comment (including all leading
+ whitespace) and return a cons whose car is the comment as a string
+ and whose cdr is the point of the comment's initial semicolon,
+ relative to the start of the line."
+ (save-excursion
+ (paredit-skip-whitespace t (point-at-eol))
+ (and (eq ?\; (char-after))
+ (not (eq ?\; (char-after (1+ (point)))))
+ (not (or (paredit-in-string-p)
+ (paredit-in-char-p)))
+ (let* ((start ;Move to before the semicolon.
+ (progn (backward-char) (point)))
+ (comment
+ (buffer-substring start (point-at-eol))))
+ (paredit-skip-whitespace nil (point-at-bol))
+ (delete-region (point) (point-at-eol))
+ (cons comment (- start (point-at-bol)))))))
+\f
+(defun paredit-insert-pair (n open close forward)
+ (let* ((regionp
+ (and (paredit-region-active-p)
+ (paredit-region-safe-for-insert-p)))
+ (end
+ (and regionp
+ (not n)
+ (prog1 (region-end) (goto-char (region-beginning))))))
+ (let ((spacep (paredit-space-for-delimiter-p nil open)))
+ (if spacep (insert " "))
+ (insert open)
+ (save-excursion
+ ;; Move past the desired region.
+ (cond (n (funcall forward
+ (save-excursion
+ (forward-sexp (prefix-numeric-value n))
+ (point))))
+ (regionp (funcall forward (+ end (if spacep 2 1)))))
+ (insert close)
+ (if (paredit-space-for-delimiter-p t close)
+ (insert " "))))))
+
+(defun paredit-region-safe-for-insert-p ()
+ (save-excursion
+ (let ((beginning (region-beginning))
+ (end (region-end)))
+ (goto-char beginning)
+ (let* ((beginning-state (paredit-current-parse-state))
+ (end-state
+ (parse-partial-sexp beginning end nil nil beginning-state)))
+ (and (= (nth 0 beginning-state) ; 0. depth in parens
+ (nth 0 end-state))
+ (eq (nth 3 beginning-state) ; 3. non-nil if inside a
+ (nth 3 end-state)) ; string
+ (eq (nth 4 beginning-state) ; 4. comment status, yada
+ (nth 4 end-state))
+ (eq (nth 5 beginning-state) ; 5. t if following char
+ (nth 5 end-state))))))) ; quote
+
+(defun paredit-space-for-delimiter-p (endp delimiter)
+ ;; If at the buffer limit, don't insert a space. If there is a word,
+ ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a
+ ;; close when want an open the string or an open when we want to
+ ;; close the string), do insert a space.
+ (and (not (if endp (eobp) (bobp)))
+ (memq (char-syntax (if endp (char-after) (char-before)))
+ (list ?w ?_ ?\"
+ (let ((matching (matching-paren delimiter)))
+ (and matching (char-syntax matching)))))))
+\f
+(defun paredit-move-past-close-and-reindent (close)
+ (let ((open (paredit-missing-close)))
+ (if open
+ (if (eq close (matching-paren open))
+ (save-excursion
+ (message "Missing closing delimiter: %c" close)
+ (insert close))
+ (error "Mismatched missing closing delimiter: %c ... %c"
+ open close))))
+ (let ((orig (point)))
+ (up-list)
+ (if (catch 'return ; This CATCH returns T if it
+ (while t ; should delete leading spaces
+ (save-excursion ; and NIL if not.
+ (let ((before-paren (1- (point))))
+ (back-to-indentation)
+ (cond ((not (eq (point) before-paren))
+ ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE
+ ;; here -- we must return from SAVE-EXCURSION
+ ;; first.
+ (throw 'return t))
+ ((save-excursion (forward-line -1)
+ (end-of-line)
+ (paredit-in-comment-p))
+ ;; Moving the closing delimiter any further
+ ;; would put it into a comment, so we just
+ ;; indent the closing delimiter where it is and
+ ;; abort the loop, telling its continuation that
+ ;; no leading whitespace should be deleted.
+ (lisp-indent-line)
+ (throw 'return nil))
+ (t (delete-indentation)))))))
+ (paredit-delete-leading-whitespace))))
+
+(defun paredit-missing-close ()
+ (save-excursion
+ (paredit-handle-sexp-errors (backward-up-list)
+ (error "Not inside a list."))
+ (let ((open (char-after)))
+ (paredit-handle-sexp-errors (progn (forward-sexp) nil)
+ open))))
+
+(defun paredit-delete-leading-whitespace ()
+ ;; This assumes that we're on the closing delimiter already.
+ (save-excursion
+ (backward-char)
+ (while (let ((syn (char-syntax (char-before))))
+ (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax
+ ;; The above line is a perfect example of why the
+ ;; following test is necessary.
+ (not (paredit-in-char-p (1- (point))))))
+ (backward-delete-char 1))))
+
+(defun paredit-blink-paren-match (another-line-p)
+ (if (and blink-matching-paren
+ (or (not show-paren-mode) another-line-p))
+ (paredit-ignore-sexp-errors
+ (save-excursion
+ (backward-sexp)
+ (forward-sexp)
+ ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it
+ ;; locally here.
+ (let ((show-paren-mode nil))
+ (blink-matching-open))))))
+\f
+(defun paredit-doublequote (&optional n)
+ "Insert a pair of double-quotes.
+With a prefix argument N, wrap the following N S-expressions in
+ double-quotes, escaping intermediate characters if necessary.
+If the region is active, `transient-mark-mode' is enabled, and the
+ region's start and end fall in the same parenthesis depth, insert a
+ pair of double-quotes around the region, again escaping intermediate
+ characters if necessary.
+Inside a comment, insert a literal double-quote.
+At the end of a string, move past the closing double-quote.
+In the middle of a string, insert a backslash-escaped double-quote.
+If in a character literal, do nothing. This prevents accidentally
+ changing a what was in the character literal to become a meaningful
+ delimiter unintentionally."
+ (interactive "P")
+ (cond ((paredit-in-string-p)
+ (if (eq (cdr (paredit-string-start+end-points))
+ (point))
+ (forward-char) ; We're on the closing quote.
+ (insert ?\\ ?\" )))
+ ((paredit-in-comment-p)
+ (insert ?\" ))
+ ((not (paredit-in-char-p))
+ (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote))))
+
+(defun paredit-meta-doublequote (&optional n)
+ "Move to the end of the string, insert a newline, and indent.
+If not in a string, act as `paredit-doublequote'; if no prefix argument
+ is specified and the region is not active or `transient-mark-mode' is
+ disabled, the default is to wrap one S-expression, however, not
+ zero."
+ (interactive "P")
+ (if (not (paredit-in-string-p))
+ (paredit-doublequote (or n
+ (and (not (paredit-region-active-p))
+ 1)))
+ (let ((start+end (paredit-string-start+end-points)))
+ (goto-char (1+ (cdr start+end)))
+ (newline)
+ (lisp-indent-line)
+ (paredit-ignore-sexp-errors (indent-sexp)))))
+
+(defun paredit-forward-for-quote (end)
+ (let ((state (paredit-current-parse-state)))
+ (while (< (point) end)
+ (let ((new-state (parse-partial-sexp (point) (1+ (point))
+ nil nil state)))
+ (if (paredit-in-string-p new-state)
+ (if (not (paredit-in-string-escape-p))
+ (setq state new-state)
+ ;; Escape character: turn it into an escaped escape
+ ;; character by appending another backslash.
+ (insert ?\\ )
+ ;; Now the point is after both escapes, and we want to
+ ;; rescan from before the first one to after the second
+ ;; one.
+ (setq state
+ (parse-partial-sexp (- (point) 2) (point)
+ nil nil state))
+ ;; Advance the end point, since we just inserted a new
+ ;; character.
+ (setq end (1+ end)))
+ ;; String: escape by inserting a backslash before the quote.
+ (backward-char)
+ (insert ?\\ )
+ ;; The point is now between the escape and the quote, and we
+ ;; want to rescan from before the escape to after the quote.
+ (setq state
+ (parse-partial-sexp (1- (point)) (1+ (point))
+ nil nil state))
+ ;; Advance the end point for the same reason as above.
+ (setq end (1+ end)))))))
+\f
+;;;; Escape Insertion
+
+(defun paredit-backslash ()
+ "Insert a backslash followed by a character to escape."
+ (interactive)
+ (insert ?\\ )
+ ;; This funny conditional is necessary because PAREDIT-IN-COMMENT-P
+ ;; assumes that PAREDIT-IN-STRING-P already returned false; otherwise
+ ;; it may give erroneous answers.
+ (if (or (paredit-in-string-p)
+ (not (paredit-in-comment-p)))
+ (let ((delp t))
+ (unwind-protect (setq delp
+ (call-interactively 'paredit-escape))
+ ;; We need this in an UNWIND-PROTECT so that the backlash is
+ ;; left in there *only* if PAREDIT-ESCAPE return NIL normally
+ ;; -- in any other case, such as the user hitting C-g or an
+ ;; error occurring, we must delete the backslash to avoid
+ ;; leaving a dangling escape. (This control structure is a
+ ;; crock.)
+ (if delp (backward-delete-char 1))))))
+
+;;; This auxiliary interactive function returns true if the backslash
+;;; should be deleted and false if not.
+
+(defun paredit-escape (char)
+ ;; I'm too lazy to figure out how to do this without a separate
+ ;; interactive function.
+ (interactive "cEscaping character...")
+ (if (eq char 127) ; The backslash was a typo, so
+ t ; the luser wants to delete it.
+ (insert char) ; (Is there a better way to
+ nil)) ; express the rubout char?
+ ; ?\^? works, but ugh...)
+
+;;; The placement of these functions in this file is totally random.
+
+(defun paredit-newline ()
+ "Insert a newline and indent it.
+This is like `newline-and-indent', but it not only indents the line
+ that the point is on but also the S-expression following the point,
+ if there is one.
+Move forward one character first if on an escaped character.
+If in a string, just insert a literal newline."
+ (interactive)
+ (if (paredit-in-string-p)
+ (newline)
+ (if (and (not (paredit-in-comment-p)) (paredit-in-char-p))
+ (forward-char))
+ (newline-and-indent)
+ ;; Indent the following S-expression, but don't signal an error if
+ ;; there's only a closing delimiter after the point.
+ (paredit-ignore-sexp-errors (indent-sexp))))
+
+(defun paredit-reindent-defun (&optional argument)
+ "Reindent the definition that the point is on.
+If the point is in a string or a comment, fill the paragraph instead,
+ and with a prefix argument, justify as well."
+ (interactive "P")
+ (if (or (paredit-in-string-p)
+ (paredit-in-comment-p))
+ (fill-paragraph argument)
+ (save-excursion
+ (beginning-of-defun)
+ (indent-sexp))))
+\f
+;;;; Comment Insertion
+
+(defun paredit-comment-dwim (&optional argument)
+ "Call the Lisp comment command you want (Do What I Mean).
+This is like `comment-dwim', but it is specialized for Lisp editing.
+If transient mark mode is enabled and the mark is active, comment or
+ uncomment the selected region, depending on whether it was entirely
+ commented not not already.
+If there is already a comment on the current line, with no prefix
+ argument, indent to that comment; with a prefix argument, kill that
+ comment.
+Otherwise, insert a comment appropriate for the context and ensure that
+ any code following the comment is moved to the next line.
+At the top level, where indentation is calculated to be at column 0,
+ insert a triple-semicolon comment; within code, where the indentation
+ is calculated to be non-zero, and on the line there is either no code
+ at all or code after the point, insert a double-semicolon comment;
+ and if the point is after all code on the line, insert a single-
+ semicolon margin comment at `comment-column'."
+ (interactive "*P")
+ (paredit-initialize-comment-dwim)
+ (cond ((paredit-region-active-p)
+ (comment-or-uncomment-region (region-beginning)
+ (region-end)
+ argument))
+ ((paredit-comment-on-line-p)
+ (if argument
+ (comment-kill (if (integerp argument) argument nil))
+ (comment-indent)))
+ (t (paredit-insert-comment))))
+
+;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21,
+;;; in which there is no `comment-or-uncomment-region'.
+
+(defun paredit-initialize-comment-dwim ()
+ (require 'newcomment)
+ (if (not (fboundp 'comment-or-uncomment-region))
+ (defalias 'comment-or-uncomment-region
+ (lambda (beginning end &optional argument)
+ (interactive "*r\nP")
+ (funcall (if (save-excursion (goto-char beginning)
+ (comment-forward (point-max))
+ (<= end (point)))
+ 'uncomment-region
+ 'comment-region)
+ beginning end argument))))
+ (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars)
+ (comment-normalize-vars))
+\f
+(defun paredit-comment-on-line-p ()
+ (save-excursion
+ (beginning-of-line)
+ (let ((comment-p nil))
+ ;; Search forward for a comment beginning. If there is one, set
+ ;; COMMENT-P to true; if not, it will be nil.
+ (while (progn (setq comment-p
+ (search-forward ";" (point-at-eol)
+ ;; t -> no error
+ t))
+ (and comment-p
+ (or (paredit-in-string-p)
+ (paredit-in-char-p (1- (point))))))
+ (forward-char))
+ comment-p)))
+
+(defun paredit-insert-comment ()
+ (let ((code-after-p
+ (save-excursion (paredit-skip-whitespace t (point-at-eol))
+ (not (eolp))))
+ (code-before-p
+ (save-excursion (paredit-skip-whitespace nil (point-at-bol))
+ (not (bolp)))))
+ (if (and (bolp)
+ ;; We have to use EQ 0 here and not ZEROP because ZEROP
+ ;; signals an error if its argument is non-numeric, but
+ ;; CALCULATE-LISP-INDENT may return nil.
+ (eq (let ((indent (calculate-lisp-indent)))
+ (if (consp indent)
+ (car indent)
+ indent))
+ 0))
+ ;; Top-level comment
+ (progn (if code-after-p (save-excursion (newline)))
+ (insert ";;; "))
+ (if code-after-p
+ ;; Code comment
+ (progn (if code-before-p
+ ;++ Why NEWLINE-AND-INDENT here and not just
+ ;++ NEWLINE, or PAREDIT-NEWLINE?
+ (newline-and-indent))
+ (lisp-indent-line)
+ (insert ";; ")
+ ;; Move the following code. (NEWLINE-AND-INDENT will
+ ;; delete whitespace after the comment, though, so use
+ ;; NEWLINE & LISP-INDENT-LINE manually here.)
+ (save-excursion (newline)
+ (lisp-indent-line)))
+ ;; Margin comment
+ (progn (indent-to comment-column
+ 1) ; 1 -> force one leading space
+ (insert ?\; ))))))
+\f
+;;;; Character Deletion
+
+(defun paredit-forward-delete (&optional argument)
+ "Delete a character forward or move forward over a delimiter.
+If on an opening S-expression delimiter, move forward into the
+ S-expression.
+If on a closing S-expression delimiter, refuse to delete unless the
+ S-expression is empty, in which case delete the whole S-expression.
+With a numeric prefix argument N, delete N characters forward.
+With a `C-u' prefix argument, simply delete a character forward,
+ without regard for delimiter balancing."
+ (interactive "P")
+ (cond ((or (consp argument) (eobp))
+ (delete-char 1))
+ ((integerp argument)
+ (if (< argument 0)
+ (paredit-backward-delete argument)
+ (while (> argument 0)
+ (paredit-forward-delete)
+ (setq argument (- argument 1)))))
+ ((paredit-in-string-p)
+ (paredit-forward-delete-in-string))
+ ((paredit-in-comment-p)
+ ;++ What to do here? This could move a partial S-expression
+ ;++ into a comment and thereby invalidate the file's form,
+ ;++ or move random text out of a comment.
+ (delete-char 1))
+ ((paredit-in-char-p) ; Escape -- delete both chars.
+ (backward-delete-char 1)
+ (delete-char 1))
+ ((eq (char-after) ?\\ ) ; ditto
+ (delete-char 2))
+ ((let ((syn (char-syntax (char-after))))
+ (or (eq syn ?\( )
+ (eq syn ?\" )))
+ (if (save-excursion
+ (paredit-handle-sexp-errors (progn (forward-sexp) t)
+ nil))
+ (forward-char)
+ (message "Deleting spurious opening delimiter.")
+ (delete-char 1)))
+ ((and (not (paredit-in-char-p (1- (point))))
+ (eq (char-syntax (char-after)) ?\) )
+ (eq (char-before) (matching-paren (char-after))))
+ (backward-delete-char 1) ; Empty list -- delete both
+ (delete-char 1)) ; delimiters.
+ ;; Just delete a single character, if it's not a closing
+ ;; delimiter. (The character literal case is already handled
+ ;; by now.)
+ ((not (eq (char-syntax (char-after)) ?\) ))
+ (delete-char 1))))
+
+(defun paredit-forward-delete-in-string ()
+ (let ((start+end (paredit-string-start+end-points)))
+ (cond ((not (eq (point) (cdr start+end)))
+ ;; If it's not the close-quote, it's safe to delete. But
+ ;; first handle the case that we're in a string escape.
+ (cond ((paredit-in-string-escape-p)
+ ;; We're right after the backslash, so backward
+ ;; delete it before deleting the escaped character.
+ (backward-delete-char 1))
+ ((eq (char-after) ?\\ )
+ ;; If we're not in a string escape, but we are on a
+ ;; backslash, it must start the escape for the next
+ ;; character, so delete the backslash before deleting
+ ;; the next character.
+ (delete-char 1)))
+ (delete-char 1))
+ ((eq (1- (point)) (car start+end))
+ ;; If it is the close-quote, delete only if we're also right
+ ;; past the open-quote (i.e. it's empty), and then delete
+ ;; both quotes. Otherwise we refuse to delete it.
+ (backward-delete-char 1)
+ (delete-char 1)))))
+\f
+(defun paredit-backward-delete (&optional argument)
+ "Delete a character backward or move backward over a delimiter.
+If on a closing S-expression delimiter, move backward into the
+ S-expression.
+If on an opening S-expression delimiter, refuse to delete unless the
+ S-expression is empty, in which case delete the whole S-expression.
+With a numeric prefix argument N, delete N characters backward.
+With a `C-u' prefix argument, simply delete a character backward,
+ without regard for delimiter balancing."
+ (interactive "P")
+ (cond ((or (consp argument) (bobp))
+ ;++ Should this untabify?
+ (backward-delete-char 1))
+ ((integerp argument)
+ (if (< argument 0)
+ (paredit-forward-delete (- 0 argument))
+ (while (> argument 0)
+ (paredit-backward-delete)
+ (setq argument (- argument 1)))))
+ ((paredit-in-string-p)
+ (paredit-backward-delete-in-string))
+ ((paredit-in-comment-p)
+ (backward-delete-char 1))
+ ((paredit-in-char-p) ; Escape -- delete both chars.
+ (backward-delete-char 1)
+ (delete-char 1))
+ ((paredit-in-char-p (1- (point)))
+ (backward-delete-char 2)) ; ditto
+ ((let ((syn (char-syntax (char-before))))
+ (or (eq syn ?\) )
+ (eq syn ?\" )))
+ (if (save-excursion
+ (paredit-handle-sexp-errors (progn (backward-sexp) t)
+ nil))
+ (backward-char)
+ (message "Deleting spurious closing delimiter.")
+ (backward-delete-char 1)))
+ ((and (eq (char-syntax (char-before)) ?\( )
+ (eq (char-after) (matching-paren (char-before))))
+ (backward-delete-char 1) ; Empty list -- delete both
+ (delete-char 1)) ; delimiters.
+ ;; Delete it, unless it's an opening delimiter. The case of
+ ;; character literals is already handled by now.
+ ((not (eq (char-syntax (char-before)) ?\( ))
+ (backward-delete-char-untabify 1))))
+
+(defun paredit-backward-delete-in-string ()
+ (let ((start+end (paredit-string-start+end-points)))
+ (cond ((not (eq (1- (point)) (car start+end)))
+ ;; If it's not the open-quote, it's safe to delete.
+ (if (paredit-in-string-escape-p)
+ ;; If we're on a string escape, since we're about to
+ ;; delete the backslash, we must first delete the
+ ;; escaped char.
+ (delete-char 1))
+ (backward-delete-char 1)
+ (if (paredit-in-string-escape-p)
+ ;; If, after deleting a character, we find ourselves in
+ ;; a string escape, we must have deleted the escaped
+ ;; character, and the backslash is behind the point, so
+ ;; backward delete it.
+ (backward-delete-char 1)))
+ ((eq (point) (cdr start+end))
+ ;; If it is the open-quote, delete only if we're also right
+ ;; past the close-quote (i.e. it's empty), and then delete
+ ;; both quotes. Otherwise we refuse to delete it.
+ (backward-delete-char 1)
+ (delete-char 1)))))
+\f
+;;;; Killing
+
+(defun paredit-kill (&optional argument)
+ "Kill a line as if with `kill-line', but respecting delimiters.
+In a string, act exactly as `kill-line' but do not kill past the
+ closing string delimiter.
+On a line with no S-expressions on it starting after the point or
+ within a comment, act exactly as `kill-line'.
+Otherwise, kill all S-expressions that start after the point.
+With a `C-u' prefix argument, just do the standard `kill-line'.
+With a numeric prefix argument N, do `kill-line' that many times."
+ (interactive "P")
+ (cond (argument
+ (kill-line (if (integerp argument) argument 1)))
+ ((paredit-in-string-p)
+ (paredit-kill-line-in-string))
+ ((or (paredit-in-comment-p)
+ (save-excursion
+ (paredit-skip-whitespace t (point-at-eol))
+ (or (eq (char-after) ?\; )
+ (eolp))))
+ ;** Be careful about trailing backslashes.
+ (kill-line))
+ (t (paredit-kill-sexps-on-line))))
+
+(defun paredit-kill-line-in-string ()
+ (if (save-excursion (paredit-skip-whitespace t (point-at-eol))
+ (eolp))
+ (kill-line)
+ (save-excursion
+ ;; Be careful not to split an escape sequence.
+ (if (paredit-in-string-escape-p)
+ (backward-char))
+ (let ((beginning (point)))
+ (while (not (or (eolp)
+ (eq (char-after) ?\" )))
+ (forward-char)
+ ;; Skip past escaped characters.
+ (if (eq (char-before) ?\\ )
+ (forward-char)))
+ (kill-region beginning (point))))))
+
+(defun paredit-kill-sexps-on-line ()
+ (if (paredit-in-char-p) ; Move past the \ and prefix.
+ (backward-char 2)) ; (# in Scheme/CL, ? in elisp)
+ (let ((beginning (point))
+ (eol (point-at-eol)))
+ (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
+ ;; If we got to the end of the list and it's on the same line,
+ ;; move backward past the closing delimiter before killing. (This
+ ;; allows something like killing the whitespace in ( ).)
+ (if end-of-list-p (progn (up-list) (backward-char)))
+ (if kill-whole-line
+ (paredit-kill-sexps-on-whole-line beginning)
+ (kill-region beginning
+ ;; If all of the S-expressions were on one line,
+ ;; i.e. we're still on that line after moving past
+ ;; the last one, kill the whole line, including
+ ;; any comments; otherwise just kill to the end of
+ ;; the last S-expression we found. Be sure,
+ ;; though, not to kill any closing parentheses.
+ (if (and (not end-of-list-p)
+ (eq (point-at-eol) eol))
+ eol
+ (point)))))))
+\f
+;;; Please do not try to understand this code unless you have a VERY
+;;; good reason to do so. I gave up trying to figure it out well
+;;; enough to explain it, long ago.
+
+(defun paredit-forward-sexps-to-kill (beginning eol)
+ (let ((end-of-list-p nil)
+ (firstp t))
+ ;; Move to the end of the last S-expression that started on this
+ ;; line, or to the closing delimiter if the last S-expression in
+ ;; this list is on the line.
+ (catch 'return
+ (while t
+ ;; This and the `kill-whole-line' business below fix a bug that
+ ;; inhibited any S-expression at the very end of the buffer
+ ;; (with no trailing newline) from being deleted. It's a
+ ;; bizarre fix that I ought to document at some point, but I am
+ ;; too busy at the moment to do so.
+ (if (and kill-whole-line (eobp)) (throw 'return nil))
+ (save-excursion
+ (paredit-handle-sexp-errors (forward-sexp)
+ (up-list)
+ (setq end-of-list-p (eq (point-at-eol) eol))
+ (throw 'return nil))
+ (if (or (and (not firstp)
+ (not kill-whole-line)
+ (eobp))
+ (paredit-handle-sexp-errors
+ (progn (backward-sexp) nil)
+ t)
+ (not (eq (point-at-eol) eol)))
+ (throw 'return nil)))
+ (forward-sexp)
+ (if (and firstp
+ (not kill-whole-line)
+ (eobp))
+ (throw 'return nil))
+ (setq firstp nil)))
+ end-of-list-p))
+
+(defun paredit-kill-sexps-on-whole-line (beginning)
+ (kill-region beginning
+ (or (save-excursion ; Delete trailing indentation...
+ (paredit-skip-whitespace t)
+ (and (not (eq (char-after) ?\; ))
+ (point)))
+ ;; ...or just use the point past the newline, if
+ ;; we encounter a comment.
+ (point-at-eol)))
+ (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol))
+ (bolp))
+ ;; Nothing but indentation before the point, so indent it.
+ (lisp-indent-line))
+ ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL.
+ ;; Insert a space to avoid invalid joining if necessary.
+ ((let ((syn-before (char-syntax (char-before)))
+ (syn-after (char-syntax (char-after))))
+ (or (and (eq syn-before ?\) ) ; Separate opposing
+ (eq syn-after ?\( )) ; parentheses,
+ (and (eq syn-before ?\" ) ; string delimiter
+ (eq syn-after ?\" )) ; pairs,
+ (and (memq syn-before '(?_ ?w)) ; or word or symbol
+ (memq syn-after '(?_ ?w))))) ; constituents.
+ (insert " "))))
+\f
+;;;;; Killing Words
+
+;;; This is tricky and asymmetrical because backward parsing is
+;;; extraordinarily difficult or impossible, so we have to implement
+;;; killing in both directions by parsing forward.
+
+(defun paredit-forward-kill-word ()
+ "Kill a word forward, skipping over intervening delimiters."
+ (interactive)
+ (let ((beginning (point)))
+ (skip-syntax-forward " -")
+ (let* ((parse-state (paredit-current-parse-state))
+ (state (paredit-kill-word-state parse-state 'char-after)))
+ (while (not (or (eobp)
+ (eq ?w (char-syntax (char-after)))))
+ (setq parse-state
+ (progn (forward-char 1) (paredit-current-parse-state))
+;; (parse-partial-sexp (point) (1+ (point))
+;; nil nil parse-state)
+ )
+ (let* ((old-state state)
+ (new-state
+ (paredit-kill-word-state parse-state 'char-after)))
+ (cond ((not (eq old-state new-state))
+ (setq parse-state
+ (paredit-kill-word-hack old-state
+ new-state
+ parse-state))
+ (setq state
+ (paredit-kill-word-state parse-state
+ 'char-after))
+ (setq beginning (point)))))))
+ (goto-char beginning)
+ (kill-word 1)))
+
+(defun paredit-backward-kill-word ()
+ "Kill a word backward, skipping over any intervening delimiters."
+ (interactive)
+ (if (not (or (bobp)
+ (eq (char-syntax (char-before)) ?w)))
+ (let ((end (point)))
+ (backward-word 1)
+ (forward-word 1)
+ (goto-char (min end (point)))
+ (let* ((parse-state (paredit-current-parse-state))
+ (state
+ (paredit-kill-word-state parse-state 'char-before)))
+ (while (and (< (point) end)
+ (progn
+ (setq parse-state
+ (parse-partial-sexp (point) (1+ (point))
+ nil nil parse-state))
+ (or (eq state
+ (paredit-kill-word-state parse-state
+ 'char-before))
+ (progn (backward-char 1) nil)))))
+ (if (and (eq state 'comment)
+ (eq ?\# (char-after (point)))
+ (eq ?\| (char-before (point))))
+ (backward-char 1)))))
+ (backward-kill-word 1))
+\f
+;;;;;; Word-Killing Auxiliaries
+
+(defun paredit-kill-word-state (parse-state adjacent-char-fn)
+ (cond ((paredit-in-comment-p parse-state) 'comment)
+ ((paredit-in-string-p parse-state) 'string)
+ ((memq (char-syntax (funcall adjacent-char-fn))
+ '(?\( ?\) ))
+ 'delimiter)
+ (t 'other)))
+
+;;; This optionally advances the point past any comment delimiters that
+;;; should probably not be touched, based on the last state change and
+;;; the characters around the point. It returns a new parse state,
+;;; starting from the PARSE-STATE parameter.
+
+(defun paredit-kill-word-hack (old-state new-state parse-state)
+ (cond ((and (not (eq old-state 'comment))
+ (not (eq new-state 'comment))
+ (not (paredit-in-string-escape-p))
+ (eq ?\# (char-before))
+ (eq ?\| (char-after)))
+ (forward-char 1)
+ (paredit-current-parse-state)
+;; (parse-partial-sexp (point) (1+ (point))
+;; nil nil parse-state)
+ )
+ ((and (not (eq old-state 'comment))
+ (eq new-state 'comment)
+ (eq ?\; (char-before)))
+ (skip-chars-forward ";")
+ (paredit-current-parse-state)
+;; (parse-partial-sexp (point) (save-excursion
+;; (skip-chars-forward ";"))
+;; nil nil parse-state)
+ )
+ (t parse-state)))
+\f
+;;;; Cursor and Screen Movement
+
+(eval-and-compile
+ (defmacro defun-saving-mark (name bvl doc &rest body)
+ `(defun ,name ,bvl
+ ,doc
+ ,(xcond ((paredit-xemacs-p)
+ '(interactive "_"))
+ ((paredit-gnu-emacs-p)
+ '(interactive)))
+ ,@body)))
+
+(defun-saving-mark paredit-forward ()
+ "Move forward an S-expression, or up an S-expression forward.
+If there are no more S-expressions in this one before the closing
+ delimiter, move past that closing delimiter; otherwise, move forward
+ past the S-expression following the point."
+ (paredit-handle-sexp-errors
+ (forward-sexp)
+ ;++ Is it necessary to use UP-LIST and not just FORWARD-CHAR?
+ (if (paredit-in-string-p) (forward-char) (up-list))))
+
+(defun-saving-mark paredit-backward ()
+ "Move backward an S-expression, or up an S-expression backward.
+If there are no more S-expressions in this one before the opening
+ delimiter, move past that opening delimiter backward; otherwise, move
+ move backward past the S-expression preceding the point."
+ (paredit-handle-sexp-errors
+ (backward-sexp)
+ (if (paredit-in-string-p) (backward-char) (backward-up-list))))
+
+;;; Why is this not in lisp.el?
+
+(defun backward-down-list (&optional arg)
+ "Move backward and descend into one level of parentheses.
+With ARG, do this that many times.
+A negative argument means move forward but still descend a level."
+ (interactive "p")
+ (down-list (- (or arg 1))))
+
+;;; Thanks to Marco Baringer for suggesting & writing this function.
+
+(defun paredit-recentre-on-sexp (&optional n)
+ "Recentre the screen on the S-expression following the point.
+With a prefix argument N, encompass all N S-expressions forward."
+ (interactive "P")
+ (save-excursion
+ (forward-sexp n)
+ (let ((end-point (point)))
+ (backward-sexp n)
+ (let* ((start-point (point))
+ (start-line (count-lines (point-min) (point)))
+ (lines-on-sexps (count-lines start-point end-point)))
+ (goto-line (+ start-line (/ lines-on-sexps 2)))
+ (recenter)))))
+
+(defun paredit-focus-on-defun ()
+ "Moves display to the top of the definition at point."
+ (interactive)
+ (beginning-of-defun)
+ (recenter 0))
+\f
+;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising
+
+(defun paredit-wrap-sexp (&optional argument open close)
+ "Wrap the following S-expression.
+If a `C-u' prefix argument is given, wrap all S-expressions following
+ the point until the end of the buffer or of the enclosing list.
+If a numeric prefix argument N is given, wrap N S-expressions.
+Automatically indent the newly wrapped S-expression.
+As a special case, if the point is at the end of a list, simply insert
+ a parenthesis pair, rather than inserting a lone opening delimiter
+ and then signalling an error, in the interest of preserving
+ structure.
+By default OPEN and CLOSE are round delimiters."
+ (interactive "P")
+ (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp)
+ (let ((open (or open ?\( ))
+ (close (or close ?\) )))
+ (paredit-handle-sexp-errors
+ ((lambda (n) (paredit-insert-pair n open close 'goto-char))
+ (cond ((integerp argument) argument)
+ ((consp argument) (paredit-count-sexps-forward))
+ ((paredit-region-active-p) nil)
+ (t 1)))
+ (insert close)
+ (backward-char)))
+ (save-excursion (backward-up-list) (indent-sexp)))
+
+(defun paredit-count-sexps-forward ()
+ (save-excursion
+ (let ((n 0))
+ (paredit-ignore-sexp-errors
+ (while (not (eobp))
+ (forward-sexp)
+ (setq n (+ n 1))))
+ n)))
+
+(defun paredit-yank-pop (&optional argument)
+ "Replace just-yanked text with the next item in the kill ring.
+If this command follows a `yank', just run `yank-pop'.
+If this command follows a `paredit-wrap-sexp', or any other paredit
+ wrapping command (see `paredit-wrap-commands'), run `yank' and
+ reindent the enclosing S-expression.
+If this command is repeated, run `yank-pop' and reindent the enclosing
+ S-expression.
+
+The argument is passed on to `yank' or `yank-pop'; see their
+ documentation for details."
+ (interactive "*p")
+ (cond ((eq last-command 'yank)
+ (yank-pop argument))
+ ((memq last-command paredit-wrap-commands)
+ (yank argument)
+ ;; `yank' futzes with `this-command'.
+ (setq this-command 'paredit-yank-pop)
+ (save-excursion (backward-up-list) (indent-sexp)))
+ ((eq last-command 'paredit-yank-pop)
+ ;; Pretend we just did a `yank', so that we can use
+ ;; `yank-pop' without duplicating its definition.
+ (setq last-command 'yank)
+ (yank-pop argument)
+ ;; Return to our original state.
+ (setq last-command 'paredit-yank-pop)
+ (setq this-command 'paredit-yank-pop)
+ (save-excursion (backward-up-list) (indent-sexp)))
+ (t (error "Last command was not a yank or a wrap: %s" last-command))))
+\f
+;;; Thanks to Marco Baringer for the suggestion of a prefix argument
+;;; for PAREDIT-SPLICE-SEXP. (I, Taylor R. Campbell, however, still
+;;; implemented it, in case any of you lawyer-folk get confused by the
+;;; remark in the top of the file about explicitly noting code written
+;;; by other people.)
+
+(defun paredit-splice-sexp (&optional argument)
+ "Splice the list that the point is on by removing its delimiters.
+With a prefix argument as in `C-u', kill all S-expressions backward in
+ the current list before splicing all S-expressions forward into the
+ enclosing list.
+With two prefix arguments as in `C-u C-u', kill all S-expressions
+ forward in the current list before splicing all S-expressions
+ backward into the enclosing list.
+With a numerical prefix argument N, kill N S-expressions backward in
+ the current list before splicing the remaining S-expressions into the
+ enclosing list. If N is negative, kill forward.
+Inside a string, unescape all backslashes, or signal an error if doing
+ so would invalidate the buffer's structure."
+ (interactive "P")
+ (if (paredit-in-string-p)
+ (paredit-splice-string argument)
+ (save-excursion
+ (paredit-kill-surrounding-sexps-for-splice argument)
+ (backward-up-list) ; Go up to the beginning...
+ (save-excursion
+ (forward-sexp) ; Go forward an expression, to
+ (backward-delete-char 1)) ; delete the end delimiter.
+ (delete-char 1) ; ...to delete the open char.
+ (paredit-ignore-sexp-errors
+ (backward-up-list) ; Reindent, now that the
+ (indent-sexp))))) ; structure has changed.
+
+(defun paredit-kill-surrounding-sexps-for-splice (argument)
+ (cond ((or (paredit-in-string-p)
+ (paredit-in-comment-p))
+ (error "Invalid context for splicing S-expressions."))
+ ((or (not argument) (eq argument 0)) nil)
+ ((or (numberp argument) (eq argument '-))
+ ;; Kill S-expressions before/after the point by saving the
+ ;; point, moving across them, and killing the region.
+ (let* ((argument (if (eq argument '-) -1 argument))
+ (saved (paredit-point-at-sexp-boundary (- argument))))
+ (goto-char saved)
+ (paredit-ignore-sexp-errors (backward-sexp argument))
+ (paredit-hack-kill-region saved (point))))
+ ((consp argument)
+ (let ((v (car argument)))
+ (if (= v 4) ;One `C-u'.
+ ;; Move backward until we hit the open paren; then
+ ;; kill that selected region.
+ (let ((end (point)))
+ (paredit-ignore-sexp-errors
+ (while (not (bobp))
+ (backward-sexp)))
+ (paredit-hack-kill-region (point) end))
+ ;; Move forward until we hit the close paren; then
+ ;; kill that selected region.
+ (let ((beginning (point)))
+ (paredit-ignore-sexp-errors
+ (while (not (eobp))
+ (forward-sexp)))
+ (paredit-hack-kill-region beginning (point))))))
+ (t (error "Bizarre prefix argument `%s'." argument))))
+\f
+(defun paredit-splice-sexp-killing-backward (&optional n)
+ "Splice the list the point is on by removing its delimiters, and
+ also kill all S-expressions before the point in the current list.
+With a prefix argument N, kill only the preceding N S-expressions."
+ (interactive "P")
+ (paredit-splice-sexp (if n
+ (prefix-numeric-value n)
+ '(4))))
+
+(defun paredit-splice-sexp-killing-forward (&optional n)
+ "Splice the list the point is on by removing its delimiters, and
+ also kill all S-expressions after the point in the current list.
+With a prefix argument N, kill only the following N S-expressions."
+ (interactive "P")
+ (paredit-splice-sexp (if n
+ (- (prefix-numeric-value n))
+ '(16))))
+
+(defun paredit-raise-sexp (&optional n)
+ "Raise the following S-expression in a tree, deleting its siblings.
+With a prefix argument N, raise the following N S-expressions. If N
+ is negative, raise the preceding N S-expressions."
+ (interactive "p")
+ (paredit-lose-if-not-in-sexp 'paredit-raise-sexp)
+ ;; Select the S-expressions we want to raise in a buffer substring.
+ (let* ((bound (save-excursion (forward-sexp n) (point)))
+ (sexps (if (and n (< n 0))
+ (buffer-substring bound
+ (paredit-point-at-sexp-end))
+ (buffer-substring (paredit-point-at-sexp-start)
+ bound))))
+ ;; Move up to the list we're raising those S-expressions out of and
+ ;; delete it.
+ (backward-up-list)
+ (delete-region (point) (save-excursion (forward-sexp) (point)))
+ (save-excursion (insert sexps)) ; Insert & reindent the sexps.
+ (save-excursion (let ((n (abs (or n 1))))
+ (while (> n 0)
+ (paredit-forward-and-indent)
+ (setq n (1- n)))))))
+
+(defun paredit-convolute-sexp (&optional n)
+ "Convolute S-expressions.
+Save the S-expressions preceding point and delete them.
+Splice the S-expressions following point.
+Wrap the enclosing list in a new list prefixed by the saved text.
+With a prefix argument N, move up N lists before wrapping."
+ (interactive "p")
+ (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp)
+ (let (open close) ;++ Is this a good idea?
+ (let ((prefix
+ (let ((end (point)))
+ (paredit-ignore-sexp-errors
+ (while (not (bobp)) (backward-sexp)))
+ (prog1 (buffer-substring (point) end)
+ (backward-up-list)
+ (save-excursion (forward-sexp)
+ (setq close (char-before))
+ (backward-delete-char 1))
+ (setq open (char-after))
+ (delete-region (point) end)))))
+ (backward-up-list n)
+ (paredit-insert-pair 1 open close 'goto-char)
+ (insert prefix)
+ (backward-up-list)
+ (paredit-ignore-sexp-errors (indent-sexp)))))
+\f
+(defun paredit-splice-string (argument)
+ (let ((original-point (point))
+ (start+end (paredit-string-start+end-points)))
+ (let ((start (car start+end))
+ (end (cdr start+end)))
+ ;; START and END both lie before the respective quote
+ ;; characters, which we want to delete; thus we increment START
+ ;; by one to extract the string, and we increment END by one to
+ ;; delete the string.
+ (let* ((escaped-string
+ (cond ((not (consp argument))
+ (buffer-substring (1+ start) end))
+ ((= 4 (car argument))
+ (buffer-substring original-point end))
+ (t
+ (buffer-substring (1+ start) original-point))))
+ (unescaped-string
+ (paredit-unescape-string escaped-string)))
+ (if (not unescaped-string)
+ (error "Unspliceable string.")
+ (save-excursion
+ (goto-char start)
+ (delete-region start (1+ end))
+ (insert unescaped-string))
+ (if (not (and (consp argument)
+ (= 4 (car argument))))
+ (goto-char (- original-point 1))))))))
+
+(defun paredit-unescape-string (string)
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ ;; nil -> no bound; t -> no errors.
+ (search-forward "\\" nil t))
+ (delete-char -1)
+ (forward-char))
+ (condition-case condition
+ (progn (check-parens) (buffer-string))
+ (error nil))))
+\f
+;;;; Slurpage & Barfage
+
+(defun paredit-forward-slurp-sexp ()
+ "Add the S-expression following the current list into that list
+ by moving the closing delimiter.
+Automatically reindent the newly slurped S-expression with respect to
+ its new enclosing form.
+If in a string, move the opening double-quote forward by one
+ S-expression and escape any intervening characters as necessary,
+ without altering any indentation or formatting."
+ (interactive)
+ (save-excursion
+ (cond ((or (paredit-in-comment-p)
+ (paredit-in-char-p))
+ (error "Invalid context for slurping S-expressions."))
+ ((paredit-in-string-p)
+ (paredit-forward-slurp-into-string))
+ (t
+ (paredit-forward-slurp-into-list)))))
+
+(defun paredit-forward-slurp-into-list ()
+ (up-list) ; Up to the end of the list to
+ (let ((close (char-before))) ; save and delete the closing
+ (backward-delete-char 1) ; delimiter.
+ (catch 'return ; Go to the end of the desired
+ (while t ; S-expression, going up a
+ (paredit-handle-sexp-errors ; list if it's not in this,
+ (progn (paredit-forward-and-indent)
+ (throw 'return nil))
+ (up-list)
+ (setq close ; adjusting for mixed
+ (prog1 (char-before) ; delimiters as necessary,
+ (backward-delete-char 1)
+ (insert close))))))
+ (insert close))) ; to insert that delimiter.
+
+(defun paredit-forward-slurp-into-string ()
+ (goto-char (1+ (cdr (paredit-string-start+end-points))))
+ ;; Signal any errors that we might get first, before mucking with the
+ ;; buffer's contents.
+ (save-excursion (forward-sexp))
+ (let ((close (char-before)))
+ (backward-delete-char 1)
+ (paredit-forward-for-quote (save-excursion (forward-sexp) (point)))
+ (insert close)))
+
+(defun paredit-forward-barf-sexp ()
+ "Remove the last S-expression in the current list from that list
+ by moving the closing delimiter.
+Automatically reindent the newly barfed S-expression with respect to
+ its new enclosing form."
+ (interactive)
+ (paredit-lose-if-not-in-sexp 'paredit-forward-slurp-sexp)
+ (save-excursion
+ (up-list) ; Up to the end of the list to
+ (let ((close (char-before))) ; save and delete the closing
+ (backward-delete-char 1) ; delimiter.
+ (paredit-ignore-sexp-errors ; Go back to where we want to
+ (backward-sexp)) ; insert the delimiter.
+ (paredit-skip-whitespace nil) ; Skip leading whitespace.
+ (cond ((bobp)
+ (error "Barfing all subexpressions with no open-paren?"))
+ ((paredit-in-comment-p) ; Don't put the close-paren in
+ (newline-and-indent))) ; a comment.
+ (insert close))
+ ;; Reindent all of the newly barfed S-expressions.
+ (paredit-forward-and-indent)))
+\f
+(defun paredit-backward-slurp-sexp ()
+ "Add the S-expression preceding the current list into that list
+ by moving the closing delimiter.
+Automatically reindent the whole form into which new S-expression was
+ slurped.
+If in a string, move the opening double-quote backward by one
+ S-expression and escape any intervening characters as necessary,
+ without altering any indentation or formatting."
+ (interactive)
+ (save-excursion
+ (cond ((or (paredit-in-comment-p)
+ (paredit-in-char-p))
+ (error "Invalid context for slurping S-expressions."))
+ ((paredit-in-string-p)
+ (paredit-backward-slurp-into-string))
+ (t
+ (paredit-backward-slurp-into-list)))))
+
+(defun paredit-backward-slurp-into-list ()
+ (backward-up-list)
+ (let ((open (char-after)))
+ (delete-char 1)
+ (catch 'return
+ (while t
+ (paredit-handle-sexp-errors
+ (progn (backward-sexp) (throw 'return nil))
+ (backward-up-list)
+ (setq open
+ (prog1 (char-after)
+ (save-excursion (insert open) (delete-char 1)))))))
+ (insert open))
+ ;; Reindent the line at the beginning of wherever we inserted the
+ ;; opening delimiter, and then indent the whole S-expression.
+ (backward-up-list)
+ (lisp-indent-line)
+ (indent-sexp))
+
+(defun paredit-backward-slurp-into-string ()
+ (goto-char (car (paredit-string-start+end-points)))
+ ;; Signal any errors that we might get first, before mucking with the
+ ;; buffer's contents.
+ (save-excursion (backward-sexp))
+ (let ((open (char-after))
+ (target (point)))
+ (message "open = %S" open)
+ (delete-char 1)
+ (backward-sexp)
+ (insert open)
+ (paredit-forward-for-quote target)))
+
+(defun paredit-backward-barf-sexp ()
+ "Remove the first S-expression in the current list from that list
+ by moving the closing delimiter.
+Automatically reindent the barfed S-expression and the form from which
+ it was barfed."
+ (interactive)
+ (paredit-lose-if-not-in-sexp 'paredit-forward-slurp-sexp)
+ (save-excursion
+ (backward-up-list)
+ (let ((open (char-after)))
+ (delete-char 1)
+ (paredit-ignore-sexp-errors
+ (paredit-forward-and-indent))
+ (while (progn (paredit-skip-whitespace t)
+ (eq (char-after) ?\; ))
+ (forward-line 1))
+ (if (eobp)
+ (error "Barfing all subexpressions with no close-paren?"))
+ ;** Don't use `insert' here. Consider, e.g., barfing from
+ ;** (foo|)
+ ;** and how `save-excursion' works.
+ (insert-before-markers open))
+ (backward-up-list)
+ (lisp-indent-line)
+ (indent-sexp)))
+\f
+;;;; Splitting & Joining
+
+(defun paredit-split-sexp ()
+ "Split the list or string the point is on into two."
+ (interactive)
+ (cond ((paredit-in-string-p)
+ (insert "\"")
+ (save-excursion (insert " \"")))
+ ((or (paredit-in-comment-p)
+ (paredit-in-char-p))
+ (error "Invalid context for splitting S-expression."))
+ (t (let ((open (save-excursion (backward-up-list)
+ (char-after)))
+ (close (save-excursion (up-list)
+ (char-before))))
+ (delete-horizontal-space)
+ (insert close)
+ (save-excursion (insert ?\ )
+ (insert open)
+ (backward-char)
+ (indent-sexp))))))
+
+(defun paredit-join-sexps ()
+ "Join the S-expressions adjacent on either side of the point.
+Both must be lists, strings, or atoms; error if there is a mismatch."
+ (interactive)
+ ;++ How ought this to handle comments intervening symbols or strings?
+ (save-excursion
+ (if (or (paredit-in-comment-p)
+ (paredit-in-string-p)
+ (paredit-in-char-p))
+ (error "Invalid context for joining S-expressions.")
+ (let ((left-point (paredit-point-at-sexp-end))
+ (right-point (paredit-point-at-sexp-start)))
+ (let ((left-char (char-before left-point))
+ (right-char (char-after right-point)))
+ (let ((left-syntax (char-syntax left-char))
+ (right-syntax (char-syntax right-char)))
+ (cond ((>= left-point right-point)
+ (error "Can't join a datum with itself."))
+ ((and (eq left-syntax ?\) )
+ (eq right-syntax ?\( )
+ (eq left-char (matching-paren right-char))
+ (eq right-char (matching-paren left-char)))
+ ;; Leave intermediate formatting alone.
+ (goto-char right-point)
+ (delete-char 1)
+ (goto-char left-point)
+ (backward-delete-char 1)
+ (backward-up-list)
+ (indent-sexp))
+ ((and (eq left-syntax ?\" )
+ (eq right-syntax ?\" ))
+ ;; Delete any intermediate formatting.
+ (delete-region (1- left-point)
+ (1+ right-point)))
+ ((and (memq left-syntax '(?w ?_)) ; Word or symbol
+ (memq right-syntax '(?w ?_)))
+ (delete-region left-point right-point))
+ (t
+ (error "Mismatched S-expressions to join.")))))))))
+\f
+;;;; Variations on the Lurid Theme
+
+;;; I haven't the imagination to concoct clever names for these.
+
+(defun paredit-add-to-previous-list ()
+ "Add the S-expression following point to the list preceding point."
+ (interactive)
+ (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list)
+ (save-excursion
+ (backward-down-list)
+ (paredit-forward-slurp-sexp)))
+
+(defun paredit-add-to-next-list ()
+ "Add the S-expression preceding point to the list following point.
+If no S-expression precedes point, move up the tree until one does."
+ (interactive)
+ (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list)
+ (save-excursion
+ (down-list)
+ (paredit-backward-slurp-sexp)))
+
+(defun paredit-join-with-previous-list ()
+ "Join the list the point is on with the previous list in the buffer."
+ (interactive)
+ (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list)
+ (save-excursion
+ (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil)
+ (backward-up-list)
+ t))
+ (paredit-join-sexps)))
+
+(defun paredit-join-with-next-list ()
+ "Join the list the point is on with the next list in the buffer."
+ (interactive)
+ (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list)
+ (save-excursion
+ (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil)
+ (up-list)
+ t))
+ (paredit-join-sexps)))
+\f
+;;;; Utilities
+
+(defun paredit-in-string-escape-p ()
+ "True if the point is on a character escape of a string.
+This is true only if the character is preceded by an odd number of
+ backslashes.
+This assumes that `paredit-in-string-p' has already returned true."
+ (let ((oddp nil))
+ (save-excursion
+ (while (eq (char-before) ?\\ )
+ (setq oddp (not oddp))
+ (backward-char)))
+ oddp))
+
+(defun paredit-in-char-p (&optional argument)
+ "True if the point is immediately after a character literal.
+A preceding escape character, not preceded by another escape character,
+ is considered a character literal prefix. (This works for elisp,
+ Common Lisp, and Scheme.)
+Assumes that `paredit-in-string-p' is false, so that it need not handle
+ long sequences of preceding backslashes in string escapes. (This
+ assumes some other leading character token -- ? in elisp, # in Scheme
+ and Common Lisp.)"
+ (let ((argument (or argument (point))))
+ (and (eq (char-before argument) ?\\ )
+ (not (eq (char-before (1- argument)) ?\\ )))))
+
+(defun paredit-forward-and-indent ()
+ "Move forward an S-expression, indenting it fully.
+Indent with `lisp-indent-line' and then `indent-sexp'."
+ (forward-sexp) ; Go forward, and then find the
+ (save-excursion ; beginning of this next
+ (backward-sexp) ; S-expression.
+ (lisp-indent-line) ; Indent its opening line, and
+ (indent-sexp))) ; the rest of it.
+
+(defun paredit-skip-whitespace (trailing-p &optional limit)
+ "Skip past any whitespace, or until the point LIMIT is reached.
+If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing
+ whitespace."
+ (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward)
+ " \t\n\f" ; This should skip using the syntax table, but LF
+ limit)) ; is a comment end, not newline, in Lisp mode.
+
+(defalias 'paredit-region-active-p
+ (xcond ((paredit-xemacs-p) 'region-active-p)
+ ((paredit-gnu-emacs-p)
+ (lambda ()
+ (and mark-active transient-mark-mode)))))
+
+(defun paredit-hack-kill-region (start end)
+ "Kill the region between START and END.
+Do not append to any current kill, and
+ do not let the next kill append to this one."
+ (interactive "r") ;Eh, why not?
+ ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last
+ ;; command was a kill. It also checks LAST-COMMAND to see whether it
+ ;; should append. If we bind these locally, any modifications to
+ ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to
+ ;; indicate that it should append.
+ (let ((this-command nil)
+ (last-command nil))
+ (kill-region start end)))
+\f
+;;;;; S-expression Parsing Utilities
+
+;++ These routines redundantly traverse S-expressions a great deal.
+;++ If performance issues arise, this whole section will probably have
+;++ to be refactored to preserve the state longer, like paredit.scm
+;++ does, rather than to traverse the definition N times for every key
+;++ stroke as it presently does.
+
+(defun paredit-current-parse-state ()
+ "Return parse state of point from beginning of defun."
+ (let ((point (point)))
+ (beginning-of-defun)
+ ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second
+ ;; argument (unless parsing stops due to an error, but we assume it
+ ;; won't in paredit-mode).
+ (parse-partial-sexp (point) point)))
+
+(defun paredit-in-string-p (&optional state)
+ "True if the parse state is within a double-quote-delimited string.
+If no parse state is supplied, compute one from the beginning of the
+ defun to the point."
+ ;; 3. non-nil if inside a string (the terminator character, really)
+ (and (nth 3 (or state (paredit-current-parse-state)))
+ t))
+
+(defun paredit-string-start+end-points (&optional state)
+ "Return a cons of the points of open and close quotes of the string.
+The string is determined from the parse state STATE, or the parse state
+ from the beginning of the defun to the point.
+This assumes that `paredit-in-string-p' has already returned true, i.e.
+ that the point is already within a string."
+ (save-excursion
+ ;; 8. character address of start of comment or string; nil if not
+ ;; in one
+ (let ((start (nth 8 (or state (paredit-current-parse-state)))))
+ (goto-char start)
+ (forward-sexp 1)
+ (cons start (1- (point))))))
+
+(defun paredit-in-comment-p (&optional state)
+ "True if parse state STATE is within a comment.
+If no parse state is supplied, compute one from the beginning of the
+ defun to the point."
+ ;; 4. nil if outside a comment, t if inside a non-nestable comment,
+ ;; else an integer (the current comment nesting)
+ (and (nth 4 (or state (paredit-current-parse-state)))
+ t))
+
+(defun paredit-point-at-sexp-boundary (n)
+ (cond ((< n 0) (paredit-point-at-sexp-start))
+ ((= n 0) (point))
+ ((> n 0) (paredit-point-at-sexp-end))))
+
+(defun paredit-point-at-sexp-start ()
+ (save-excursion
+ (forward-sexp)
+ (backward-sexp)
+ (point)))
+
+(defun paredit-point-at-sexp-end ()
+ (save-excursion
+ (backward-sexp)
+ (forward-sexp)
+ (point)))
+
+(defun paredit-lose-if-not-in-sexp (command)
+ (if (or (paredit-in-string-p)
+ (paredit-in-comment-p)
+ (paredit-in-char-p))
+ (error "Invalid context for command `%s'." command)))
+\f
+;;;; Initialization
+
+(paredit-define-keys)
+(paredit-annotate-mode-with-examples)
+(paredit-annotate-functions-with-examples)
+
+(provide 'paredit)
--- /dev/null
+;;; pastebin.el --- A simple interface to the www.pastebin.com webservice
+
+;;; Copyright (C) 2008 by Tapsell-Ferrier Limited
+;;; Copyright (C) 2010 by Ivan Korotkov <twee@tweedle-dee.org>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; see the file COPYING. If not, write to the
+;;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;; Boston, MA 02110-1301 USA
+
+;;; Commentary:
+;;;
+;;; Load this file and run:
+;;;
+;;; M-x pastebin-buffer
+;;;
+;;; to send the whole buffer or select a region and run
+;;;
+;;; M-x pastebin
+;;;
+;;; to send just the region.
+;;;
+;;; In either case the url that pastebin generates is left on the kill
+;;; ring and the paste buffer.
+
+
+;;; Code:
+
+;;;###autoload
+(defgroup pastebin nil
+ "Pastebin -- pastebin.com client"
+ :tag "Pastebin"
+ :group 'tools)
+
+(defcustom pastebin-default-subdomain ""
+ "Pastebin subdomain to use by default"
+ :type 'string
+ :group 'pastebin)
+
+(defcustom pastebin-type-assoc
+ '((actionscript-mode . " actionscript")
+ (ada-mode . "ada")
+ (asm-mode . "asm")
+ (autoconf-mode . "bash")
+ (bibtex-mode . "bibtex")
+ (cmake-mode . "cmake")
+ (c-mode . "c")
+ (c++-mode . "cpp")
+ (cobol-mode . "cobol")
+ (conf-colon-mode . "properties")
+ (conf-javaprop-mode . "properties")
+ (conf-mode . "ini")
+ (conf-space-mode . "properties")
+ (conf-unix-mode . "ini")
+ (conf-windows-mode . "ini")
+ (cperl-mode . "perl")
+ (csharp-mode . "csharp")
+ (css-mode . "css")
+ (delphi-mode . "delphi")
+ (diff-mode . "diff")
+ (ebuild-mode . "bash")
+ (eiffel-mode . "eiffel")
+ (emacs-lisp-mode . "lisp")
+ (erlang-mode . "erlang")
+ (erlang-shell-mode . "erlang")
+ (espresso-mode . "javascript")
+ (fortran-mode . "fortran")
+ (glsl-mode . "glsl")
+ (gnuplot-mode . "gnuplot")
+ (graphviz-dot-mode . "dot")
+ (haskell-mode . "haskell")
+ (html-mode . "html4strict")
+ (idl-mode . "idl")
+ (inferior-haskell-mode . "haskell")
+ (inferior-octave-mode . "octave")
+ (inferior-python-mode . "python")
+ (inferior-ruby-mode . "ruby")
+ (java-mode . "java")
+ (js2-mode . "javascript")
+ (jython-mode . "python")
+ (latex-mode . "latex")
+ (lisp-mode . "lisp")
+ (lua-mode . "lua")
+ (makefile-mode . "make")
+ (makefile-automake-mode . "make")
+ (makefile-gmake-mode . "make")
+ (makefile-makepp-mode . "make")
+ (makefile-bsdmake-mode . "make")
+ (makefile-imake-mode . "make")
+ (matlab-mode . "matlab")
+ (nxml-mode . "xml")
+ (oberon-mode . "oberon2")
+ (objc-mode . "objc")
+ (ocaml-mode . "ocaml")
+ (octave-mode . "matlab")
+ (pascal-mode . "pascal")
+ (perl-mode . "perl")
+ (php-mode . "php")
+ (plsql-mode . "plsql")
+ (po-mode . "gettext")
+ (prolog-mode . "prolog")
+ (python-2-mode . "python")
+ (python-3-mode . "python")
+ (python-basic-mode . "python")
+ (python-mode . "python")
+ (ruby-mode . "ruby")
+ (scheme-mode . "lisp")
+ (shell-mode . "bash")
+ (sh-mode . "bash")
+ (smalltalk-mode . "smalltalk")
+ (sql-mode . "sql")
+ (tcl-mode . "tcl")
+ (visual-basic-mode . "vb")
+ (xml-mode . "xml")
+ (yaml-mode . "properties"))
+ "Alist composed of major-mode names and corresponding pastebin highlight formats."
+ :type '(alist :key-type symbol :value-tupe string)
+ :group 'pastebin)
+
+(defvar pastebin-subdomain-history '())
+
+;;;###autoload
+(defun pastebin-buffer (&optional subdomain)
+ "Send the whole buffer to pastebin.com.
+Optional argument subdomain will request the virtual host to use,
+ eg:'emacs' for 'emacs.pastebin.com'."
+ (interactive
+ (let ((pastebin-subdomain
+ (if current-prefix-arg
+ (read-string "pastebin subdomain:" nil 'pastebin-subdomain-history) pastebin-default-subdomain)))
+ (list pastebin-subdomain)))
+ (pastebin (point-min) (point-max) subdomain))
+
+;;;###autoload
+(defun pastebin (start end &optional subdomain)
+ "An interface to the pastebin code snippet www service.
+
+See pastebin.com for more information about pastebin.
+
+Called interactively pastebin uses the current region for
+preference for sending... if the mark is NOT set then the entire
+buffer is sent.
+
+Argument START is the start of region.
+Argument END is the end of region.
+
+If subdomain is used pastebin prompts for a subdomain to be used as the
+virtual host to use. For example use 'emacs' for 'emacs.pastebin.com'."
+ (interactive
+ (let ((pastebin-subdomain
+ (if current-prefix-arg
+ (read-string "pastebin subdomain:" nil 'pastebin-subdomain-history) pastebin-default-subdomain)))
+ (if (mark)
+ (list (region-beginning) (region-end) pastebin-subdomain)
+ (list (point-min) (point-max) pastebin-subdomain))))
+ ;; Main function
+ (let* ((data (buffer-substring-no-properties start end))
+ (pastebin-url "http://pastebin.com/api_public.php")
+ (url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-Type" . "application/x-www-form-urlencoded")))
+ (url-request-data
+
+ (concat (format "submit=submit&paste_private=0&paste_expire_date=N&paste_subdomain=%s&paste_format=%s&paste_name=%s&paste_code=%s"
+ subdomain
+ (or (assoc-default major-mode pastebin-type-assoc) "text")
+ (url-hexify-string (user-full-name))
+ (url-hexify-string data))))
+ (content-buf (url-retrieve pastebin-url
+ (lambda (arg)
+ (cond
+ ((equal :error (car arg))
+ (signal 'pastebin-error (cdr arg)))
+ (t
+ (re-search-forward "\n\n")
+ (clipboard-kill-ring-save (point) (point-max))
+ (message "Pastebin URL: %s" (buffer-substring (point) (point-max)))))))))))
+
+(provide 'pastebin)
+;;; pastebin.el ends here
--- /dev/null
+;;; pbook.el -- Format a program listing for LaTeX.
+;;;
+;;; More mangling by Paul Khuong on 2007-Jan-31 to typeset
+;;; code in a more generic and customisable manner, including
+;;; a rough xref (annotates definition sites).
+;;; Mangled by Paul Khuong (pvk@pvk.ca) on 2007-Jan-20 to
+;;; emit coloured/bold/italic \tt code instead of verbatim
+;;; pbook.el,v 1.4 2007/01/20
+;;; Written by Luke Gorrie <luke@member.fsf.org> in May of 2004.
+;;; $Id: pbook.el,v 1.3 2004/05/17 01:09:01 luke Exp luke $
+;;;
+;;; TODO:
+;;;
+;;; X Remove FIXMEs, etc from index.
+;;;
+;;; X Replace pbook-latex-escape with pbook-escape-code-substring
+;;; Find way to make space work.
+;;;
+;;; o Better xreferencing. Run a first pass to identify all
+;;; the toplevel definitions [as fontified], then annotate
+;;; the source correctly; either change the face, or use the
+;;; escaping mechanism. Changing the face sounds more robust.
+;;; This could run as advice over pbook-process-buffer.
+;;; The face changing could be an advice on pbook-escape-code,
+;;; or, since we ignore face info outside of code, over the
+;;; whole buffer, w/ the definition identification.
+;;; If want to avoid multiple passes (why?), can accumulate
+;;; toplevel defn names while processing them.
+;;;
+;;; X Add a public variable for the current line number (for
+;;; property -> latex, especially)
+;;;
+;;; _ Make all/most of the extras togglable.
+;;;
+;;; X Rewrite the code escaping functions to use regexes instead of
+;;; searching ourselves.
+;;;
+;;; ? Allow escaped `raw' latex strings in comments
+;;;
+;;; o Improve (think) the interface for customising code output
+;;;
+;;; X Find some way to customise font-lock for paper automatically,
+;;; or introduce alists for italic, bold & colour override (per face)?
+;;; Currently: converts to yuv, flips the luminance and back to rgb.
+;;;
+;;;# Introduction
+;;;
+;;; Have you ever printed out a program and read it on paper?
+;;;
+;;; It is an interesting exercise to try with one of your own
+;;; programs, one that you think is well-written. The first few times
+;;; you will probably find that it's torture to try and read in a
+;;; straight line. What seemed so nice in Emacs is riddled with
+;;; glaring problems on paper.
+;;;
+;;; How a program reads on paper may not be very important in itself,
+;;; but there is wonderful upside to this. If you go through the
+;;; program with a red pen and fix all the mind-bendingly obvious
+;;; problems you see, what happens is that the program greatly
+;;; improves -- not just on paper, but also in Emacs!
+;;;
+;;; This is a marvellously effective way to make programs
+;;; better.
+;;;
+;;; Let's explore the idea some more!
+;;;
+;;;# `pbook'
+;;;
+;;; This program, `pbook', is a tool for making readable programs by
+;;; generating LaTeX'ified program listings. Its purpose is to help
+;;; you improve your programs by making them read well on paper. It
+;;; serves this end by generating pretty-looking PDF output for you to
+;;; print out and attack with a red pen, and perhaps use the medium to
+;;; trick your mind into seeking the clarity of a technical paper and
+;;; bringing your prose-editing skills to bear on your source code.
+;;;
+;;; `pbook' is aware of three things: headings, top-level comments,
+;;; and code. Headings become LaTeX sections, and have entries in a
+;;; table of contents. Top-level comments become plain text in a nice
+;;; variable-width font. Other source code is listed as-is in a
+;;; fixed-width font.
+;;;
+;;; These different elements are distinguished in the source using
+;;; maximally unobtrusive markup, which you can see at work in the
+;;; `pbook.el' source code.
+;;;
+;;; Read on to see the program and how it works.
+;;;
+;;;# Prelude
+;;;
+;;; (I have successfully tested this program with GNU Emacs versions
+;;; 20.7 and 21.3, and with XEmacs version 21.5.)
+;;;
+;;; This is actually not true anymore. I have tested this in GNU Emacs
+;;; 22.??? and 21.???. While I don't expect there to be any portability
+;;; problem, it has not been tested in XEmacs at all.
+;;;
+;;; For some tiny luxuries and portability help we use the Common Lisp
+;;; compatibility library:
+(require 'cl)
+
+;;;# Emacs commands
+;;;
+;;; A handful of Emacs commands make up the pbook user-interface. The
+;;; most fundamental is to render a pbook-formatted Emacs buffer as
+;;; LaTeX.
+
+(defun pbook-buffer ()
+ "Generate LaTeX from the current (pbook-formatted) buffer.
+The resulting source is displayed in a buffer called *pbook*."
+ (interactive)
+ (pbook-process-buffer))
+
+;;; A very handy utility is to display a summary of the buffer's
+;;; structure and use it to jump to an appropriate section. I've
+;;; always enjoyed being able to do this in texinfo-mode. Happily,
+;;; pbook gets this for free using the `occur' function, which lists
+;;; all lines in the buffer that match some regular expression.
+
+(defun pbook-show-structure ()
+ "Display the pbook heading structure of the current buffer."
+ (interactive)
+ (occur pbook-heading-regexp))
+
+;;; To avoid a lot of mucking about in the shell there is also a
+;;; command to generate and display a PDF file. This function is a
+;;; quick hack to make experimentation easy.
+;;;
+;;; I should add a function to do the same with dvis, and to output
+;;; to non-temporary files.
+
+(defun pbook-buffer-view-pdf ()
+ "Generate and display PDF from the current buffer.
+The intermediate files are created in the standard temporary
+directory."
+ (interactive)
+ (save-window-excursion
+ (pbook-buffer))
+ (with-current-buffer "*pbook*"
+ (let ((texfile (pbook-tmpfile "pbook" "tex"))
+ (pdffile (pbook-tmpfile "pbook" "pdf"))
+ (idxfile (pbook-tmpfile "pbook" "idx")))
+ (write-region (point-min) (point-max) texfile)
+ ;; Possibly there is a better way to ensure that LaTeX generates
+ ;; the table of contents correctly than to run it more than
+ ;; once, but I don't know one.
+ (shell-command (format "\
+ cd /tmp; latex %s && \
+ makeindex %s && \
+ pdflatex %s && acroread %s &"
+ texfile
+ idxfile
+ texfile pdffile)))))
+
+(defun pbook-buffer-view-dvi ()
+ "Generate and display DVI from the current buffer.
+The intermediate files are created in the standard temporary
+directory."
+ (interactive)
+ (save-window-excursion
+ (pbook-buffer))
+ (with-current-buffer "*pbook*"
+ (let ((texfile (pbook-tmpfile "pbook" "tex"))
+ (dvifile (pbook-tmpfile "pbook" "dvi"))
+ (idxfile (pbook-tmpfile "pbook" "idx")))
+ (write-region (point-min) (point-max) texfile)
+ ;; Possibly there is a better way to ensure that LaTeX generates
+ ;; the table of contents correctly than to run it more than
+ ;; once, but I don't know one.
+ (shell-command (format "\
+ cd /tmp; latex %s && \
+ makeindex %s && \
+ latex %s && xdvi %s &"
+ texfile
+ idxfile
+ texfile dvifile)))))
+
+(defun pbook-buffer-regenerate-dvi ()
+ (interactive)
+ (save-window-excursion
+ (pbook-buffer))
+ (with-current-buffer "*pbook*"
+ (let ((texfile (pbook-tmpfile "pbook" "tex"))
+ (idxfile (pbook-tmpfile "pbook" "idx")))
+ (write-region (point-min) (point-max) texfile)
+ ;; Possibly there is a better way to ensure that LaTeX generates
+ ;; the table of contents correctly than to run it more than
+ ;; once, but I don't know one.
+ (shell-command (format "\
+ cd /tmp; latex %s && \
+ makeindex %s && \
+ latex %s"
+ texfile
+ idxfile
+ texfile)))))
+
+(defun pbook-tmpfile (name extension)
+ "Return the full path to a temporary file called NAME and with EXTENSION.
+An appropriate directory is chosen and the PID of Emacs is inserted
+before the extension."
+ (format "%s%s-%S.%s"
+ (if (boundp 'temporary-file-directory)
+ temporary-file-directory
+ ;; XEmacs does it this way instead:
+ (temp-directory))
+ name (emacs-pid) extension))
+
+;;;# Configurable variables
+;;;
+;;; These are variables that can be customized to affect pbook's
+;;; behaviour. The default regular expressions assume Lisp-style
+;;; comment characters, but they can be overridden with buffer-local
+;;; bindings from hooks for other programming modes. The other
+;;; variables that control formatting are best configured with Emacs's
+;;; magic "file variables" (see down the very bottom for an example).
+
+(defvar pbook-commentary-regexp "^;;;\\($\\|[^#]\\)"
+ "Regular expression matching lines of high-level commentary.")
+
+(defvar pbook-heading-regexp "^;;;\\(#+\\)"
+ "Regular expression matching heading lines of chapters/sections/headings.")
+
+(defvar pbook-heading-level-subexp 1
+ "The subexpression of `pbook-heading-regexp' whose length indicates nesting.")
+
+(defvar pbook-include-toc t
+ "When true include a table of contents.")
+
+(defvar pbook-style 'article
+ "Style of output. Either article (small) or book (large).")
+
+(defvar pbook-author (user-full-name)
+ "The name to use in the \author LaTeX command.")
+
+;;;## Configuration variables for code formatting
+
+(defvar pbook-code-prologue "\
+\\vspace{1pc}
+\\begin{adjustwidth}{0in}{-1.5in}
+\\begin{flushleft}
+"
+ "Tex string to prepend to code listings")
+
+(defvar pbook-code-epilogue "\
+\\end{flushleft}
+\\end{adjustwidth}
+\\vspace{1pc}
+"
+ "Tex string to append to code listings")
+
+(defvar pbook-current-line nil
+ "Holds the line number being processed. Note that this
+is reset for every new section of code. This variable
+is only accessible while processing code lines, obviously.")
+
+(defvar pbook-current-total-lines nil
+ "Holds the total number of lines in the section of
+code that's being processed.")
+
+(defun pbook-around-code-line (line-number total-lines)
+ "returns a list of Tex strings `(prepend append)' to
+surround the line in a code listing. It may also append
+any number of entries to put in `pbook-escaping-regexps'.
+It receives, as its arguments, the line number and the
+total number of lines in the code segment."
+ (labels ((repeat (string num)
+ (if (<= num 0)
+ ""
+ (concat string (repeat string (1- num))))))
+ (if (looking-at "^ *$")
+ (list "~" "\\\\")
+ (let ((str (number-to-string (1+ line-number))))
+ (list (concat "\\hspace{-.4in}{\\small\\texttt{"
+ (repeat "\\ " (max 1 (- 4 (length str))))
+ str
+ "\\ \\ "
+ "}}")
+ (if (= line-number (- total-lines 1))
+ "\\\\"
+ "\\nopagebreak[4]\\\\"))))))
+
+(defvar pbook-dark-colors '("black")
+ "List of dark colours. Used by the coloring property
+to detect when to flip luminances.")
+
+(defvar pbook-face-latex-properties '()
+ "plist of latex properties for current face
+ (only active while calling functions in `pbook-properties')")
+
+(defvar pbook-monochrome t
+ "Force every color to be the specified color (list of rgb components)
+or t for standard black. nil for normal colors.")
+
+(defvar pbook-font-lock-override '(("\\(\\.\\|\\w\\)\\{2,\\}"
+ 0 (string-to-syntax "word") ;; was `pbook-identifier'
+ keep t))
+ "Appended to `font-lock-syntactic-keywords' while fontifying.")
+
+;;;## configuration for the translation of properties to Latex
+;;;
+;;; The code formatting engine is composed of two parts:
+;;; a system of properties that link font-lock faces and syntactic
+;;; markup with latex environments, and a string escaping function.
+;;; These variables let us easily customise both of these systems.
+
+(defvar pbook-current-text-properties nil
+ "text-properties of the current region of text. Maybe be used
+by the property transformation functions to fine-tune their
+output.")
+
+;;; The most common customisation will be to change the way faces
+;;; are shown on paper. By default, they are translated faithfully:
+;;; color, slantedness and boldness are directly translated.
+;;; While a value of `nil' means don't care (and defers to other
+;;; faces properties or default property values), `:no', by default,
+;;; disables the associated property.
+
+(defvar pbook-face-override '((font-lock-keyword-face :bold t :index :no)
+ (font-lock-builtin-face :bold t :index :no)
+ (font-lock-function-name-face
+ :sc t :tt :no
+ :index function)
+ (font-lock-variable-name-face
+ :sc t :tt :no
+ :index variable)
+ (font-lock-warning-face :bold t :index :no)
+ (font-lock-comment-face :italic t :tt :no :index :no)
+ (font-lock-doc-face :italic t :tt :no :index :no)
+ (font-lock-constant-face :italic :no :index :no)
+ (font-lock-string-face :index :no)
+ (paren-face :intensity .5)
+ (default :italic :no))
+ "Alist that associates a face with a set of default properties.")
+
+(defvar pbook-escaping-regexps '(("<" . "\\\\textless{}")
+ (">" . "\\\\textgreater{}")
+ ("\\\\" . "\\\\textbackslash{}")
+ ("~" . "\\\\textasciitilde{}")
+ ("\\^" . "\\\\textasciicircum{}")
+ ("[#%&$_{}]" . "\\\\\\&")) ;;space added as needed in pbook-latex-escape
+ "alist of regexp -> replacement (passed to re-search-forward and replace-match)
+A simple way to index FIXMEs would be to add a regex for that in this list.")
+
+;;; `pbook-properties' defines pbook properties: their name,
+;;; when they are applied (by default), and how they are translated
+;;; into Latex.
+;;; It is a list of triples `([name] [default-value] [translater])'.
+;;; `[name]' is an unique identifier for the property.
+;;; `[default-value]' is an unary function that, given the face,
+;;; returns the value to associate with the property (or `nil'
+;;; to defer).
+;;; `[translater]' is either an unary function that, given
+;;; the property's value, returns a list of a string to prepend
+;;; to the formatted region, a string to append to it, and
+;;; any number of pairs as in `pbook-escaping-regexps'.
+;;; Latex code is spliced outside (for the first property)
+;;; in (for the last property).
+
+(defvar pbook-properties
+ `((:color
+ pbook-face-color
+ (lambda (color)
+ (if (or (null color)
+ (eq pbook-monochrome t)
+ (every (lambda (component)
+ (< component 0.01))
+ color))
+ nil
+ (let ((components (mapcar (lambda (component)
+ (if (< component 0.01)
+ "0"
+ (number-to-string component)))
+ (or pbook-monochrome
+ color))))
+ (list (format "\\textcolor[rgb]{%s, %s, %s}{"
+ (first components)
+ (second components)
+ (third components))
+ "}")))))
+
+ (:intensity
+ (lambda (face)
+ nil)
+ (lambda (intensity)
+ (if (null intensity)
+ nil
+ (let* ((default-color (if (or (null pbook-monochrome)
+ (eq pbook-monochrome t))
+ '(0.0 0.0 0.0)
+ pbook-monochrome))
+ (yuv-default (apply 'pbook-rgb-yuv default-color))
+ (yuv-intensity (list* (- 1 (* intensity (- 1 (car yuv-default))))
+ (cdr yuv-default)))
+ (rgb-intensity (apply 'pbook-yuv-rgb yuv-intensity)))
+ (list (apply 'format
+ "\\textcolor[rgb]{%s, %s, %s}{"
+ rgb-intensity)
+ "}")))))
+
+ (:bold face-bold-p
+ (lambda (prop)
+ (and prop
+ (not (eq prop :no))
+ (looking-at " *[^ ]")
+ '("\\textbf{" "}"))))
+
+ (:italic face-italic-p
+ (lambda (prop)
+ (and prop
+ (not (eq prop :no))
+ (looking-at " *[^ ]")
+ '("\\textit{" "}"))))
+
+ (:tt (lambda (face)
+ t)
+ (lambda (prop)
+ (when (or (not (looking-at " *[^ ]")) ;; always \tt whitespace.
+ (and prop
+ (not (eq prop :no))))
+ '("\\texttt{" "}"))))
+
+ (:sc (lambda (face)
+ nil)
+ ("\\textsc{" "}"))
+
+ (:index (lambda (face)
+ (and (eq face 'default)
+ (equal (plist-get pbook-current-text-properties
+ 'syntax-table)
+ (string-to-syntax "word"))
+ 'use))
+ (lambda (index)
+ (when (and index
+ (not (eq index :no)))
+ (let* ((pbook-escaping-regexps (list* (cons "[!@|]" "\"\\&")
+ pbook-escaping-regexps))
+ (word (pbook-latex-escape-string (buffer-string))))
+ (list (format "\\index{%s%s}{" word (ecase index
+ ((function) "|bb")
+ ((variable) "|ii")
+ ((use) "")))
+ "}")))))
+ )
+ "Complex system. See paragraph above.")
+
+(defun pbook-face-color (face)
+ "Given a face, return a triplet of rgb values. Flips the luminance
+as needed (to adapt dark background colours to a light background)."
+ (let ((dark-bg-p (or (and (boundp 'face-background-mode)
+ (eq face-background-mode 'dark))
+ (member (face-background face)
+ pbook-dark-colors))))
+ (and (face-foreground face)
+ (let ((rgb-specs (mapcar (lambda (n)
+ (/ n 65535.0))
+ (color-values (face-foreground face)))))
+ (and rgb-specs
+ (if dark-bg-p
+ (let ((yuv-specs (apply 'pbook-rgb-yuv rgb-specs)))
+ (pbook-yuv-rgb (* 0.25 (- 1 (first yuv-specs)))
+ (second yuv-specs)
+ (third yuv-specs)))
+ rgb-specs))))))
+
+(defun pbook-rgb-yuv (r g b)
+ "As http://en.wikipedia.org/wiki/YUV -- Matrix fixed by mjp."
+ (let* ((y (+ (* 0.299 r)
+ (* 0.587 g)
+ (* 0.114 b)))
+ (u (+ (* -0.168740 r)
+ (* -0.331260 g)
+ (* 0.500000 b)))
+ (v (+ (* 0.500000 r)
+ (* -0.418690 g)
+ (* -0.081310 b))))
+ (list y u v)))
+
+(defun pbook-yuv-rgb (y u v)
+ "As http://en.wikipedia.org/wiki/YUV -- Matrix fixed by mjp"
+ (let ((r (+ y
+
+ (* 1.40200 v)))
+ (g (+ y
+ (* -0.34413 u)
+ (* -0.71414 v)))
+ (b (+ y
+ (* 1.77200 u))))
+ (mapcar (lambda (x)
+ (cond ((< x 0) 0.0) ;; Need to clamp values for some reason
+ ((> x 1) 1.0)
+ (t x)))
+ (list r g b))))
+;;;# Top-level logic
+;;;
+;;; Here we have the top level of the program. Setting up, calling the
+;;; formatting engine, piecing things together, and putting on the
+;;; finishing touches.
+;;;
+;;; The real work is done in a new buffer called *pbook*. First the
+;;; source is fontified, then copied into this buffer and from there
+;;; it is massaged into shape.
+;;;
+;;; Most of this is mundane, but there is one tricky part: the source
+;;; buffer may have buffer-local values for some pbook settings, and
+;;; we have to be careful or we'd lose them when switching into the
+;;; *pbook* buffer. This is taken care of by moving the correct values
+;;; of all the relevant customizable settings into new dynamic
+;;; bindings.
+
+(defun pbook-process-buffer ()
+ "Generate pbook output for the current buffer
+The output is put in the buffer *pbook* and displayed."
+ (interactive)
+ (let ((font-lock-syntactic-keywords
+ (append font-lock-syntactic-keywords
+ pbook-font-lock-override)))
+ (setq font-lock-fontified nil) ;; pretend buffer isn't fontified
+ (font-lock-default-fontify-buffer) ;; HACK!!! Looks like an internal...
+ )
+ (let ((buffer (current-buffer))
+ (beginning (pbook-tex-beginning))
+ (ending (pbook-tex-ending))
+ (text (buffer-string)))
+ (with-current-buffer (get-buffer-create "*pbook*")
+ ;; Setup,
+ (pbook-inherit-buffer-locals buffer
+ '(pbook-commentary-regexp
+ pbook-heading-regexp
+ pbook-style
+ pbook-heading-level-subexp
+ pbook-include-toc
+ pbook-monochrome
+ pbook-font-lock-override
+ pbook-face-override))
+ (erase-buffer)
+ (insert text)
+ ;; Reformat as LaTeX,
+ (pbook-preprocess)
+ (pbook-format-buffer)
+ ;; Insert header & footer.
+ (goto-char (point-min))
+ (insert beginning)
+ (goto-char (point-max))
+ (insert ending)
+ (display-buffer (current-buffer)))))
+
+(defun pbook-inherit-buffer-locals (buffer variables)
+ "Make buffer-local bindings of VARIABLES using the values in BUFFER."
+ (dolist (v variables)
+ (set (make-local-variable v)
+ (with-current-buffer buffer (symbol-value v)))))
+
+(defun pbook-preprocess ()
+ "Cleanup the buffer to prepare for formatting."
+ (goto-char (point-min))
+ ;; FIXME: Currently we just zap all pagebreak characters.
+ (save-excursion
+ (while (re-search-forward "\C-l" nil t)
+ (replace-match "")))
+ (unless (re-search-forward pbook-heading-regexp nil t)
+ (error "File must have at least one heading."))
+ (beginning-of-line)
+ ;; Delete everything before the first heading.
+ (delete-region (point-min) (point)))
+
+(defun pbook-tex-beginning ()
+ "Return the beginning prelude for the LaTeX output."
+ (format "\
+\\documentclass[notitlepage,a4paper]{%s}
+\\usepackage[nohead,nofoot]{geometry}
+\\usepackage{color}
+\\usepackage{bold-extra}
+\\usepackage{chngpage}
+\\usepackage{index}
+\\newcommand{\\ii}[1]{{\\it #1}}
+\\newcommand{\\bb}[1]{{\\bf #1}}
+\\makeindex
+\\title{%s}
+\\author{%s}
+\\begin{document}
+\\maketitle
+%s\n"
+ (symbol-name pbook-style)
+ (pbook-latex-escape-string (buffer-name))
+ (pbook-latex-escape-string pbook-author)
+ (if pbook-include-toc "\\tableofcontents" "")))
+
+(defun pbook-tex-ending ()
+ "Return the ending of the LaTeX output."
+ "\
+\\printindex
+
+\\end{document}\n")
+
+;;;# Escaping special characters
+;;;
+;;; We have to escape characters that LaTeX treats specially. This is
+;;; done based on `pbook-escaping-regexps', whicn is defined according
+;;; to the rules in the `Special Characters' node of the
+;;; LaTeX2e info manual. (CHECKME)
+
+(defun pbook-latex-escape-string (string &optional space)
+ (with-temp-buffer
+ (insert string)
+ (pbook-latex-escape (point-min) (point-max) space)
+ (buffer-string)))
+
+(defun pbook-latex-escape (start end &optional space)
+ "LaTeX-escape special characters in the region from START to END."
+ (when (or space
+ pbook-escaping-regexps)
+ (let* ((pbook-escaping-regexps (if space
+ (append pbook-escaping-regexps
+ (list (cons " " "\\\\\\&")))
+ pbook-escaping-regexps))
+ (scan-regexp (apply 'concat
+ (car (first pbook-escaping-regexps))
+ (mapcan (lambda (entry)
+ (list "\\|"
+ (car entry)))
+ (rest pbook-escaping-regexps)))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (while (re-search-forward scan-regexp
+ nil t)
+ (goto-char (match-beginning 0))
+ (catch 'out
+ (dolist (entry pbook-escaping-regexps)
+ (let ((test (car entry))
+ (replace (cdr entry)))
+ (when (looking-at test)
+ (replace-match replace)
+ (throw 'out nil)))))))))))
+
+;;;# Processing engine
+;;;
+;;; The main loop scans through the source buffer piece by piece and
+;;; converts each one to LaTeX as it goes. There are three sorts of
+;;; pieces: headings, top-level commentary, and code.
+;;;
+;;; This loop recognises what type of piece is at the point and then
+;;; calls the appropriate subroutine. The subroutines are responsible
+;;; for determining where their piece finishes and for advancing the
+;;; point beyond the region they have formatted.
+
+(defun pbook-format-buffer ()
+ (while (not (eobp))
+ (if (looking-at "^\\s *$")
+ ;; Skip blank lines.
+ (forward-line)
+ (cond ((looking-at pbook-heading-regexp)
+ (pbook-do-heading))
+ ((looking-at pbook-commentary-regexp)
+ (pbook-do-commentary))
+ (t
+ (pbook-do-code))))))
+
+;;;## Heading formatting
+;;;
+;;; Each heading line is converted to a LaTeX sectioning command. The
+;;; heading text is escaped.
+
+(defun pbook-do-heading ()
+ ;; NB: `looking-at' sets the Emacs match data (for match-string, etc)
+ (assert (looking-at pbook-heading-regexp))
+ (let ((depth (length (match-string-no-properties pbook-heading-level-subexp))))
+ ;; Strip off the comment characters and whitespace.
+ (replace-match "")
+ (when (looking-at "\\s +")
+ (replace-match ""))
+ (pbook-latex-escape (line-beginning-position) (line-end-position))
+ (wrap-line (format "\\%s{" (pbook-nth-sectioning-command depth))
+ "}"))
+ (forward-line))
+
+(defun wrap-line (prefix suffix)
+ "Insert PREFIX at the start of the current line and SUFFIX at the end."
+ (save-excursion
+ (goto-char (line-beginning-position))
+ (insert prefix)
+ (goto-char (line-end-position))
+ (insert suffix)))
+
+;;; LaTeX has different sectioning commands for articles and books, so
+;;; we have to choose from the right set. These variables define the
+;;; sets in order of nesting -- the first element is top-level, etc.
+
+(defconst pbook-article-sectioning-commands
+ '("section" "subsection" "subsubsection")
+ "LaTeX commands for sectioning articles.")
+
+(defconst pbook-book-sectioning-commands
+ (cons "chapter" pbook-article-sectioning-commands)
+ "LaTeX commands for sectioning books.")
+
+(defun pbook-nth-sectioning-command (n)
+ "Return the sectioning command for nesting level N (top-level is 1)."
+ (let ((commands (ecase pbook-style
+ (article pbook-article-sectioning-commands)
+ (book pbook-book-sectioning-commands))))
+ (nth (min (1- n) (1- (length commands))) commands)))
+
+;;;## Commentary formatting
+;;;
+;;; Top-level commentary is stripped of its comment characters and we
+;;; escape all characters that LaTeX treats specially.
+
+(defun pbook-do-commentary ()
+ "Format one or more lines of commentary into LaTeX."
+ (assert (looking-at pbook-commentary-regexp))
+ (let ((start (point)))
+ ;; Strip off comment characters line-by-line until end of section.
+ (while (or (looking-at pbook-commentary-regexp)
+ (and (looking-at "^\\s *$")
+ (not (eobp))))
+ (replace-match "")
+ (delete-horizontal-space)
+ (forward-line))
+ (save-excursion
+ (pbook-latex-escape start (point))
+ (pbook-pretty-commentary start (point)))))
+
+;;; These functions define a simple Wiki-like markup language for
+;;; basic formatting.
+
+(defun pbook-pretty-commentary (start end)
+ "Make commentary prettier."
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (save-excursion (pbook-pretty-tt))
+ (save-excursion (pbook-pretty-doublequotes))))
+
+(defun pbook-pretty-tt ()
+ "Format `single quoted' text with a typewriter font."
+ (while (re-search-forward "`\\([^`']*\\)'" nil t)
+ (replace-match "{\\\\tt \\1}" t)))
+
+(defun pbook-pretty-doublequotes ()
+ "Format \"double quoted\" text with ``double single quotes''."
+ (while (re-search-forward "\"\\([^\"]*\\)\"" nil t)
+ (replace-match "``\\1''")))
+
+;;;## Source code formatting
+;;;
+;;; Source text is rendered as defined in pbook-properties.
+
+(defun pbook-do-code ()
+ (assert (and (not (looking-at pbook-commentary-regexp))
+ (not (looking-at pbook-heading-regexp))))
+ (let ((start (point))
+ (end (progn
+ (pbook-goto-end-of-code)
+ (point))))
+ (save-restriction
+ (narrow-to-region start end)
+ (pbook-convert-tabs-to-spaces start end)
+ ;;delete trailing newlines and spaces
+ (goto-char (point-max))
+ (while (or (equal (char-syntax (char-before)) " ")
+ (bolp))
+ (delete-char -1))
+ (pbook-format-code start (point-max)
+ (count-lines start (point-max)))
+ (goto-char (point-min))
+ (insert pbook-code-prologue)
+ (goto-char (point-max))
+ (insert "\n" pbook-code-epilogue "\n"))))
+
+(defun pbook-goto-end-of-code ()
+ "Goto the end of the current section of code."
+ (if (re-search-forward (format "\\(%s\\)\\|\\(%s\\)"
+ pbook-heading-regexp
+ pbook-commentary-regexp)
+ nil t)
+ (beginning-of-line)
+ (goto-char (point-max))))
+
+(defun pbook-convert-tabs-to-spaces (start end)
+ "Replace tab characters with spaces."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (untabify start end))))
+
+
+(defun pbook-format-code (start end num-lines)
+ "Format the section of code. The third argument is
+the total number of line in the section."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (let ((cur-line 0))
+ (while (< cur-line num-lines)
+ (pbook-format-line (line-beginning-position) (line-end-position)
+ cur-line num-lines)
+ (incf cur-line)
+ (beginning-of-line 2))))))
+
+(defun pbook-get-inherits (face)
+ "Flattens a face's inheritance list, in order."
+ (let ((faces (cond ((eq face 'unspecified) nil)
+ ((listp face) face)
+ (t (list face)))))
+ (mapcan (lambda (face)
+ (let ((inherits (face-attribute face :inherit)))
+ (if (and inherits
+ (not (eq inherits 'unspecified)))
+ (cons face (pbook-get-inherits inherits))
+ (list face))))
+ faces)))
+
+(defun pbook-translate-face-properties (face props)
+ "Updates the list of properties `props' with those
+associates with `face'. `pbook-face-override' has priority"
+ (setq props (append props
+ (copy-list (cdr (assoc face pbook-face-override)))))
+ (dolist (defn pbook-properties)
+ (let ((prop-name (first defn))
+ (predicate (second defn)))
+ (unless (plist-get props prop-name)
+ (let ((value (funcall predicate face)))
+ (when value
+ (setq props (plist-put props prop-name value)))))))
+ props)
+
+(defun pbook-face-properties (face)
+ "Finds a face's (and those from which it inherits) pbook
+properties. Earlier faces in the inheritance list (preorder
+depth-first) have priority."
+ (let ((faces (append (pbook-get-inherits face)
+ '(default)))
+ (props nil))
+ (dolist (face faces props)
+ (setq props (pbook-translate-face-properties face props)))))
+
+(defun pbook-properties-latex-strings (plist)
+ "Given a plist of pbook properties, finds the latex
+strings with which to wrap the text that is being formatted,
+and the additional regexps with which to escape it."
+ (let* ((pbook-face-latex-properties plist) ;;special var
+ (prepend nil)
+ (append nil)
+ (regexps nil) ;;escaping-regexp entry
+ )
+ (dolist (property pbook-properties (list (apply 'concat
+ (reverse prepend))
+ (apply 'concat append)
+ regexps))
+ (let* ((name (first property))
+ (transformer (third property))
+ (foundp (plist-member plist name))
+ (prop (plist-get plist name)))
+ (when foundp
+ (let ((wrap (if (and (listp transformer)
+ (not (eq (first transformer)
+ 'lambda)))
+ (and prop
+ (not (eq prop :no))
+ transformer)
+ (funcall transformer prop))))
+ (when wrap
+ (push (first wrap) prepend)
+ (push (second wrap) append)
+ (setq regexps (append (cddr wrap)
+ regexps)))))))))
+
+(defun pbook-format-line (start end line-number total-lines)
+ "Format a complete line of code, by spans of constant text property.
+Also wraps it as per `pbook-around-code-line'. Each span is only escaped
+at the very end to facilitate examination of the buffer."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (let* ((pbook-current-line line-number)
+ (pbook-current-total-lines total-lines)
+ (substr-beg (point-marker))
+ (substr-end (point-marker))
+ (wrap (pbook-around-code-line line-number total-lines))
+ (pbook-escaping-regexps (append (cddr wrap)
+ pbook-escaping-regexps)))
+ (move-marker substr-end
+ (next-char-property-change (marker-position substr-beg)))
+ (set-marker-insertion-type substr-beg t)
+ (set-marker-insertion-type substr-end t)
+ ;; Main loop: find spans of constant text properties
+ ;; then get the latex trings to wrap around it.
+ (while (not (equal substr-beg substr-end))
+ (goto-char (marker-position substr-beg))
+ (let ((wrap (save-excursion ;;DOCUMENT ME
+ (save-restriction
+ (narrow-to-region (marker-position substr-beg)
+ (marker-position substr-end))
+ (let ((pbook-current-text-properties
+ (text-properties-at (marker-position substr-beg))))
+ (pbook-properties-latex-strings
+ (pbook-face-properties
+ (get-char-property (marker-position substr-beg)
+ 'face))))))))
+ (insert (first wrap))
+ (let ((pbook-escaping-regexps (append (third wrap)
+ pbook-escaping-regexps)))
+ (pbook-latex-escape (marker-position substr-beg)
+ (marker-position substr-end)
+ t))
+ (goto-char (marker-position substr-end))
+ (insert (second wrap))
+
+ (move-marker substr-beg (marker-position substr-end))
+ (move-marker substr-end
+ (next-char-property-change
+ (marker-position substr-beg)))))
+ (wrap-line (first wrap)
+ (second wrap))))))
+
+;;;# Prologue and file variables
+
+(provide 'pbook)
+
+;;; We use Emacs's magic `file variables' to make sure pbook is
+;;; formatted how it should be:
+
+;; Local Variables:
+;; pbook-author: "Luke Gorrie, with modifications by Paul Khuong"
+;; pbook-use-toc: t
+;; pbook-style: article
+;; pbook-monochrome: t
+;; End:
--- /dev/null
+;;; quack.el --- enhanced support for editing and running Scheme code
+
+(defconst quack-copyright "Copyright (C) 2002-2012 Neil Van Dyke")
+(defconst quack-copyright-2 "Portions Copyright (C) Free Software Foundation")
+;; Emacs-style font-lock specs adapted from GNU Emacs 21.2 scheme.el.
+;; Scheme Mode menu adapted from GNU Emacs 21.2 cmuscheme.el.
+
+(defconst quack-version "0.44")
+(defconst quack-author-name "Neil Van Dyke")
+(defconst quack-author-email "neil@neilvandyke.org")
+(defconst quack-web-page "http://www.neilvandyke.org/quack/")
+
+(defconst quack-legal-notice
+ "This is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation; either version 2, or (at your option) any later version. This is
+distributed in the hope that it will be useful, but without any warranty;
+without even the implied warranty of merchantability or fitness for a
+particular purpose. See the GNU General Public License for more details. See
+http://www.gnu.org/licenses/ for details. For other licenses and consulting,
+please contact Neil Van Dyke.")
+
+(defconst quack-cvsid "$Id: quack.el,v 1.481 2012-04-11 17:42:25 user Exp $")
+
+;;; Commentary:
+
+;; INTRODUCTION:
+;;
+;; Quack enhances Emacs support for Scheme programming.
+;;
+;; Install Quack rather than following non-Quack-based tutorials on how to
+;; set up Emacs for Scheme.
+;;
+;; The name "Quack" was a play on "DrScheme".
+;;
+;; Quack is dedicated to Yosh, naturally.
+
+;; COMPATIBILITY:
+;;
+;; GNU Emacs 23 and 22 -- Yes. Quack is now developed under GNU Emacs 23
+;; on a GNU/Linux system, which is the preferred platform for Quacksmokers.
+;; Quack should work under GNU Emacs 23 on any Un*x-like OS. Reportedly,
+;; Quack also works with GNU Emacs 22 on Apple Mac OS X and Microsoft
+;; Windows (NT, 2000, XP), but the author has no means of testing on those
+;; platforms.
+;;
+;; GNU Emacs 21 -- Probably, but no longer tested.
+;;
+;; GNU Emacs 20 -- Probably mostly. When last tested. Some of the menus do
+;; not work properly, due to a bug in easymenu.el (which the FSF will not
+;; fix, since they no longer support Emacs 20). Nested block comments are
+;; not fontified correctly. Pretty-lambda does not work. Quack runs less
+;; efficiently in 20 than 21, due to the lack of standard hash tables.
+;;
+;; XEmacs 21 -- Probably mostly, but no longer tested. Block comment
+;; fontification is not yet supported under XEmacs 21, due to what appears
+;; to be a bug in 21.4 font-lock. Pretty-lambda does not work. XEmacs
+;; Quacksmokers who always want the latest and greatest Quack should
+;; consider GNU Emacs 21 -- Quack treats XEmacs like a high-maintenance
+;; redheaded stepchild.
+
+;; INSTALLATION:
+;;
+;; To install, put this file (`quack.el') somewhere in your Emacs load
+;; path, and add the following line to your `.emacs' file:
+;;
+;; (require 'quack)
+;;
+;; If you don't know what your Emacs load path is, try invoking the command
+;; "C-h v load-path RET" or consulting the Emacs manual.
+;;
+;; Note to advanced Emacsers: Byte-compiled `quack.elc' files generally are
+;; *not* portable between Emacs implementations, nor between different
+;; versions of the same implementation.
+;;
+;; You will also need the GNU `wget' program, which Quack uses for
+;; downloading SRFI indexes. This popular program is included in most
+;; GNU/Linux distributions and is available for most other platforms.
+;;
+;; Note to PLT Scheme users: If you do not already have the PLT manuals
+;; installed, they can be downloaded from
+;; `http://download.plt-scheme.org/doc/' and installed in your PLT `doc'
+;; collection. If Quack is not finding installed PLT manuals, then be sure
+;; that the `quack-pltcollect-dirs' variable contains the appropriate
+;; collection directory (if it does not, then either set the `PLTHOME'
+;; and/or `PLTCOLLECTS' environment variables appropriately, or set
+;; `quack-pltcollect-dirs').
+
+;; KEY BINDINGS:
+;;
+;; The key bindings that Quack adds to `scheme-mode' include:
+;;
+;; C-c C-q m View a manual in your Web browser.
+;; C-c C-q k View the manual documentation for a keyword
+;; (currently only works for PLT manuals).
+;; C-c C-q s View an SRFI.
+;; C-c C-q r Run an inferior Scheme process.
+;; C-c C-q f Find a file using context of point for default.
+;; C-c C-q l Toggle `lambda' syntax of `define'-like form.
+;; C-c C-q t Tidy the formatting of the buffer.
+;;
+;; One additional command that does not currently have a standard binding
+;; is `quack-dired-pltcollect', which prompts for a PLT collection name and
+;; creates a Dired buffer on the collection's directory. (A future version
+;; of Quack may integrate this functionality into a more generalized
+;; documentation navigation interface.)
+
+;; RELEASE ANNOUNCEMENTS EMAIL:
+;;
+;; To receive email notification when a new Quack version is released, ask
+;; neil@neilvandyke.org to add you to the moderated `scheme-announce' list.
+
+;; HISTORY:
+;;
+;; Version 0.44 (2012-04-11):
+;; * Added indent and fontify for `struct', `module+', `module*'.
+;; * Changed intent for `module' from `defun' to 2.
+;; * Added fontify for `define-syntax-class',
+;; `define-splicing-syntax-class', `begin-for-syntax'.
+;; * Changed `define-struct' fontify.
+;;
+;; Version 0.43 (2011-08-23):
+;; * Add indent and fontify for "syntax-parse".
+;; * Added another compile error regexp for Racket backtraces.
+;;
+;; Version 0.42 (2011-07-30):
+;; * Added compile error regexp for "raco".
+;;
+;; Version 0.41 (2011-06-04)
+;; * Added `sxml-match' to `scheme-indent-function'.
+;;
+;; Version 0.40 (2010-12-22)
+;; * Added indent rules for Racket `let:', `let*:', and `match'. And
+;; a provisional rule for `define:'.
+;;
+;; Version 0.39 (2010-10-18)
+;; * Renamed "typed/scheme" to "typed/racket".
+;;
+;; Version 0.38 (2010-10-14)
+;; * Replaced old PLT Scheme programs in `quack-programs' with Racket.
+;; * Added Racket ".rkt" and ".rktd" filename extensions.
+;; * Added some Racket keywords for fontifying.
+;;
+;; Version 0.37 (2009-06-29)
+;; * Disabled highlighting of "Compilation started at" lines.
+;;
+;; Version 0.36 (2009-05-27)
+;; * Made `#:' ``colon keywords'' fontify in PLT-ish mode.
+;; * Added PLT `r6rs' and `typed-scheme' languages to `quack-programs'.
+;;
+;; Version 0.35 (2009-02-24)
+;; * Added `interpreter-mode-alist' support, so Scheme scripts with "#!"
+;; start in `scheme-mode'.
+;; * Added PLT `parameterize-break'.
+;; * Improved `compile' mode for PLT 4.x tracebacks when there is only
+;; file, line, and column, but no additional information.
+;;
+;; Version 0.34 (2009-02-19)
+;; * Added fontify and indent support for PLT `define/kw', `lambda/kw',
+;; `parameterize*'.
+;; * Fontify Unix "#!" cookie in PLT-ish font-lock.
+;; * Changed reference to `quack-announce' email list to
+;; `scheme-announce'.
+;; * Added PLT `default-load-handler' to
+;; `quack-compilation-error-regexp-alist-additions'
+;; * Changed some face ":height" attributes.
+;;
+;; Version 0.33 (2008-07-31)
+;; * Added handlers for some PLT 4.0.1 "setup-plt" messages.
+;;
+;; Version 0.32 (2008-06-19)
+;; * Added to `quack-programs'.
+;; * Updated compatibility comments.
+;; * Added indent rule for `for/fold'.
+;;
+;; Version 0.31 (2008-05-03)
+;; * Added `defvar' for `quack-pltish-font-lock-keywords', so that the
+;; GNU Emacs 22.1 compiler doesn't complain about assignment to a free
+;; variable.
+;; * Changed banner regexp for MzScheme for v3.99.x.
+;; * Set `dynamic-wind' `scheme-indent-function to 0, when the default
+;; is 3. It was just taking up too much space. DrScheme's
+;; indentation seems to be equivalent -1, so there is precedent for
+;; something different. We generally respect Emacs indentation
+;; convention.
+;; * Added fontifying and indent for PLT `define-for-syntax',
+;; `define-values-for-syntax', `quasisyntax', `quasisyntax/loc',
+;; `syntax', `syntax/loc', `define-parameters'.
+;; * Advise `scheme-interactively-start-process' for GNU Emacs 22.
+;; * Removed TODO comment that mentioned using `(current-eventspace
+;; (make-eventspace))' under `mred', as Robby Findler has indicated
+;; that is not good advice.
+;;
+;; Version 0.30 (2007-06-27)
+;; * Emacs 22 compatibility change: `string-to-number' instead of
+;; `string-to-int'. Thanks to Charles Comstock.
+;;
+;; Version 0.29 (2006-11-12)
+;; * Fixed `quack-bar-syntax-string', which caused vertical bar
+;; characters to be treated as whitespace. Thanks to Eric Hanchrow
+;; for reporting.
+;;
+;; Version 0.28 (2005-05-14)
+;; * Added `quack-smart-open-paren-p'.
+;; * Changed `scheme-indent-function' for `parameterize' from `defun'
+;; to `1'.
+;; * In `quack-pltish-keywords-to-fontify': added `quasiquote',
+;; `unquote', and `unquote-splicing'.
+;; * Added ".mzschemerc" to `auto-mode-alist'.
+;; * Added a little extra threesemi fontification for Funcelit and
+;; similar Texinfo markup formats.
+;;
+;; Version 0.27 (2004-12-19)
+;; * For Gambit-C, added REPL banner fontifying, `quack-manuals' entry,
+;; and "gsi ~~/syntax-case.scm -" `quack-programs' entry.
+;; * Changed "[PLT]" prefix on PLT manuals to "PLT", to make it easier
+;; to type.
+;; * Minor changes to reflect "MIT Scheme" becoming "MIT/GNU Scheme".
+;;
+;; Version 0.26 (2004-07-14)
+;; * Added fontifying of a bunch of "define-"* syntax from Chicken.
+;;
+;; Version 0.25 (2004-07-09)
+;; * Added `define-record-type' to `quack-pltish-keywords-to-fontify'.
+;; * Added "csi -hygienic" to `quack-programs'.
+;; * In `quack-manuals', replaced PLT-specific `r5rs' and `t-y-scheme'
+;; with generic ones.
+;; * Updated URL in `quack-manuals' for 3rd ed. of `tspl'.
+;; * `quack-view-manual' completions no longer include symbols.
+;; * `quack-view-manual' completion default is now "R5RS".
+;;
+;; Version 0.24 (2004-05-09)
+;; * Made `quack-pltish-keywords-to-fontify' and
+;; `quack-emacs-keywords-to-fontify' custom changes update
+;; immediately. Bug reported by Taylor Campbell.
+;; * Removed some non-syntax names from
+;; `quack-pltish-keywords-to-fontify'.
+;; * Documentation changes.
+;;
+;; Version 0.23 (2003-11-11)
+;; * `quack-local-keywords-for-remote-manuals-p' can now have the value
+;; of the symbol `always', to work around a defect in some versions
+;; of Microsoft Windows. Thanks to Bill Clementson.
+;; * `quack-w3m-browse-url-other-window' no longer splits a `*w3m*'
+;; buffer.
+;; * Added indent and `quack-pltish-keywords-to-fontify' rules for
+;; `c-lambda' and `c-declare'.
+;;
+;; Version 0.22 (2003-07-03)
+;; * `quack-newline-behavior' controls the RET key behavior in Scheme
+;; buffers.
+;; * In `quack-manuals', added Chez Scheme, and updated Chicken.
+;; * Added error message navigation to `compile' for PLT `setup-plt'.
+;; * Partial fix for Quack global menu disappearing from the main menu
+;; bar in XEmacs. Thought it used to work, but it doesn't in XEmacs
+;; 21.4.12.
+;;
+;; Version 0.21 (2003-05-28)
+;; * `quack-find-file' is faster in many cases due to fix to
+;; `quack-backward-sexp'.
+;; * Added auto-mode-alist for `.ccl', `.stk', and `.stklos' files.
+;; * Indent rule additions/changes for `chicken-setup' and `unit/sig'.
+;;
+;; Version 0.20 (2003-05-04)
+;; * Added indent and fontify for SRFI-8 "receive".
+;; * Added indent and fontify for additional PLT syntax.
+;; * Added `quack-fontify-threesemi-p'.
+;; * `quack-tidy-buffer' sets `fill-prefix' to nil when running.
+;; * Added messages to `run-scheme', if only to get rid of annoying
+;; "Mark set" message.
+;; * Added "mzscheme -M errortrace" to `quack-programs'.
+;; * `quack-dired-pltcollect' prompt defaults to `mzlib'.
+;; * "Update SRFI Index" menu item has moved to top of menu, mainly to
+;; avoid usability issue in a particular Emacs menu implementation.
+;; * Several code quality improvements sent by Stefan Monnier will be
+;; in the next release.
+;;
+;; Version 0.19 (2003-03-04)
+;; * Commands such as `scheme-load-file' now start a Scheme process if
+;; none is found.
+;; * Bugfix for using `match-string-no-properties' when we meant
+;; `quack-match-string-no-properties'. (Thanks to Noel Welsh.)
+;;
+;; Version 0.18 (2003-05-02)
+;; * Removed uses of `(regexp-opt LIST t)', since XEmacs21 does not
+;; create match data. (Thanks to Garrett Mitchener for debugging.)
+;; * Added to `quack-programs' and `quack-manuals'.
+;; * Added pretty-case-lambda.
+;; * Changed PLT documentation URL function.
+;;
+;; Version 0.17 (2003-01-03)
+;; * Pretty-lambda is supported well under GNU Emacs 21, when using PLT
+;; Style fontification. Enable via the Options menu. (Based on
+;; approach by Stefan Monnier; suggested by Ray Racine.)
+;; * Various faces now have separate defaults for `light' and `dark'
+;; backgrounds, so may now look better on dark backgrounds.
+;; (Suggested by Eli Barzilay.)
+;; * `quack-find-file' now respects `insert-default-directory' when
+;; there is no default file. (Thanks to Eli Barzilay.)
+;; * Most of the special w3m support has been moved to a separate
+;; package, `w3mnav' (`http://www.neilvandyke.org/w3mnav/').
+;; `quack-w3m-browse-url-other-window' has been added.
+;;
+;; Version 0.16 (2002-12-16)
+;; * `quack-insert-closing' now calls `blink-paren-function'. (Thanks
+;; to Guillaume Marceau and Steve Elkins for reporting this.)
+;; * Now uses PLT 202 manuals. Added "PLT Framework" manual.
+;; * Added `quack-pltish-module-defn-face'.
+;; * Added some PLTish font-lock keywords.
+;;
+;; Version 0.15 (2002-11-21)
+;; * "Keywords" are now fontified in PLT Style fontification mode.
+;; * Definition names are now blue by default in PLT Style.
+;; * Symbol literals with vertical bars are now fontified in PLT Style.
+;; * New `quack-manuals-webjump-sites' function for people who prefer
+;; to use the `webjump' package for invoking manuals.
+;; * New `quack-quiet-warnings-p' option.
+;; * New `quack-pltish-class-defn-face' face.
+;;
+;; Version 0.14 (2002-10-18)
+;; * Fix for `quack-view-manual' interactive prompting (thanks to Marko
+;; Slyz for reporting this).
+;; * `quack-emacsw3m-go-next' and `quack-emacsw3m-go-prev' now work
+;; with GTK reference documentation (not that this has anything to do
+;; with Scheme).
+;; * Added SLIB to `quack-manuals'.
+;; * Added comment about installing PLT manuals (thanks to Marko).
+;; * We now call the canonical version of Emacs "GNU Emacs," instead of
+;; "FSF Emacs".
+;;
+;; Version 0.13 (2002-09-21)
+;; * Bugfix: No longer drop SRFI index entries on the floor.
+;;
+;; Version 0.12 (2002-09-20)
+;; * New "View SRFI" menu. Select "Update SRFI Index" if the submenus
+;; "Draft", "Final", and "Withdrawn" are disabled.
+;; * Most options are now settable via "Options" menu.
+;; * PLT collections are no longer scanned when building "View Manuals"
+;; menu.
+;; * "View Keyword Docs..." back on Scheme Mode menu in addition to
+;; Quack menu.
+;; * Various `defcustom' variables have been made to dynamically update
+;; relevant program state when changed.
+;; * Under GNU Emacs 20, dynamic menus still do not work -- they now
+;; display, but do not perform the selected action. Will do more
+;; debugging after this release.
+;; * '[' and ']' keys work in emacs-w3m of MIT Scheme manuals.
+;;
+;; Version 0.11 (2002-09-17)
+;; * Menus now work under XEmacs. Also now partly broken for Emacs 20.
+;; * New global "Quack" menu. Disable with `quack-global-menu-p'.
+;; * New "View Manual" submenu under GNU Emacs 21 and XEmacs (GNU Emacs
+;; 20 is stuck with the old "View Manual..." menu item).
+;; * Fix for `quack-pltcollects-alist' to include PLT `doc' collection,
+;; which was preventing local manuals from being used.
+;; * `quack-manuals' now includes `t-y-scheme'.
+;; * `quack-view-in-different-browser' command that spawns alternative
+;; Web browser from the special emacs-w3m support, bound to `B'. For
+;; when you normally view manuals in an Emacs window, but
+;; occasionally want to view a particular page in normal Web browser.
+;; * More `scheme-indent-function' properties set.
+;; * `quack-about' command.
+;; * Fix to `quack-keyword-at-point'.
+;;
+;; Version 0.10 (2002-09-11)
+;; * `quack-view-srfi' now prompts with completion, including titles
+;; for all SRFIs. The SRFI titles are fetched from the official SRFI
+;; Web site using the GNU Wget program, and cached locally.
+;; * `quack-view-srfi' also now defaults to the SRFI number at or near
+;; the point.
+;; * `quack-dir' variable specifies a directory where Quack should
+;; store its persistent data files (e.g., cached SRFI indexes), and
+;; defaults to "~/.quack/".
+;; * New `quack-tidy-buffer' command. [C-c C-q t] is now bound to
+;; this; [C-c C-q l] ("l" as in "lambda) is now the official binding
+;; for `quack-toggle-lambda'.
+;; * `quack-find-file' now recognizes PLT `dynamic-require' form.
+;; * Fix to make `quack-looking-at-backward' preserve match data.
+;; * Fix for benign bug in `quack-parent-sexp-search'.
+;;
+;; Version 0.9 (2002-09-04)
+;; * Quack now works under XEmacs 21, except no menus are currently
+;; defined (that will come in a later version) and block comments
+;; aren't fontified.
+;; * `quack-toggle-lambda' command toggles a `define' form between
+;; explicit and implicit `lambda' syntax.
+;; * `quack-dired-pltcollect' feature prompts for a PLT collection name
+;; and creates a Dired on the collection.
+;; * `)' and `]' keys are bound to insert a closing character that
+;; agrees with the opening character of the sexp.
+;; * Nested `#|' comment blocks are now fontified mostly correctly
+;; under GNU Emacs 21.
+;; * Fix to `quack-parent-sexp-search'.
+;; * Fix for PLT manual keywords lookup under Emacs 20.
+;; * `quack-manuals' URLs for assorted implementation manuals now point
+;; to canonical Web copies.
+;; * No longer warns about PLT manual keywords file found without HTML.
+;; * `find-file' key bindings are automatically remapped to
+;; `quack-find-file' in Scheme buffers.
+;; * Both PLT-style and Emacs-style fontification now work with the
+;; `noweb-mode' package. Tested under GNU Emacs 21 with
+;; Debian `nowebm' package version 2.10c-1.
+;; * Added to `quack-emacsish-keywords-to-fontify'.
+;; * Disabled fontification of named `let'.
+;; * Renamed "collect" in PLT identifiers to "pltcollect".
+;; * `auto-mode-alist' set more aggressively.
+;;
+;; Version 0.8 (2002-08-25)
+;; * PLT package file viewing mode. This is mainly used to easily
+;; inspect a ".plt" package before installing it via DrScheme or
+;; "setup-plt".
+;; * No longer warns about `font-lock-keywords' when `noweb-mode'
+;; package is installed.
+;;
+;; Version 0.7 (2002-08-22)
+;; * Now works on GNU Emacs 20 (though people are still encouraged to
+;; upgrade to GNU Emacs 21 if they are able).
+;; * `quack-manuals' now includes MIT Scheme and Chicken manuals
+;; (currently where Debian GNU/Linux puts them).
+;; * `quack-view-srfi' command.
+;; * Named-`let' name is fontified like a PLTish definition name.
+;; * `define-record' and `define-opt' fontified.
+;; * Scheme Mode is forced in `auto-mode-alist' for ".sch" files.
+;; * Fix to `quack-backward-sexp'.
+;; * `quack-warning' messages get your attention.
+;; * `quack-pltrequire-at-point-data-1' search depth limited.
+;;
+;; Version 0.6 (2002-08-20)
+;; * `quack-find-file' now supports multi-line PLT `require' forms.
+;; * When `emacs-w3m' is used, the keys "[", "]", and "t" are bound to
+;; navigate through PLT manuals like in Info mode.
+;; * Names highlighted in PLT-style fontification of `defmacro',
+;; `defmacro-public', `defsyntax'.
+;; * Advised `run-scheme' no longer prompts when there is already a
+;; running Scheme.
+;; * "csi" (Chicken interpreter) added to `quack-programs' default.
+;; * Forces `auto-mode-alist' for ".scm" files to `scheme-mode'
+;; (two can play at that game, `bee-mode'!).
+;; * To-do comments moved from the top of the file to throughout code.
+;;
+;; Version 0.5 (2002-08-15)
+;; * New `quack-find-file' permits quick navigation to files indicated
+;; by a PLT Scheme `require' form under the point. Currently only
+;; works when the "(require" string is on the same line as point.
+;; * Improved PLT-style fontification. Most noticeable difference is
+;; that names in many definition forms are boldfaced. See
+;; `quack-pltish-fontify-definition-names-p' option.
+;; * `quack-collects-alist' added.
+;; * "~/plt/" has been removed from `quack-collect-dirs' default.
+;; * Unnecessary syntax table settings have been removed.
+;; * Reduced memory usage in some cases, via explicit GC calls.
+;;
+;; Version 0.4 (2002-08-07)
+;; * Functionality adapted from author's `giguile.el' package:
+;; - Enhanced `run-scheme' behavior. `quack-run-mzscheme',
+;; `quack-run-mred', and `quack-remove-run-scheme-menu-item-p'
+;; are obsolete.
+;; - Enhanced `switch-to-scheme' behavior.
+;; - Options menu.
+;; - Indent rules for a few Guile-isms.
+;; * Inferior Scheme Mode now uses the preferred fontification method.
+;; * Now uses the PLT-bundled version of R5RS manual, which permits
+;; keyword searching.
+;; * `quack-banner-face' for the MzScheme/MrEd banner in REPL buffer.
+;; * This code includes a start on toolbars and XEmacs21 portability,
+;; but neither feature is yet functional.
+;;
+;; Version 0.3 (2002-08-01)
+;; * PLT-style fontification added, except for quoted lists. Emacs-
+;; style fontification still available; see `quack-fontify-style'.
+;; * `emacs-w3m' package support for lightweight viewing of PLT manuals
+;; in Emacs window. If you install the `emacs-w3m' package, then you
+;; can change the new `quack-browse-url-browser-function' option to
+;; use it.
+;; * Quack menu items added to Scheme Mode menu. "Run Scheme" item
+;; is removed by default; see `quack-remove-run-scheme-menu-item-p'.
+;; * MrEd REPL supported with `quack-run-mred'.
+;; * Better default for `quack-collect-dirs'.
+;; * More `scheme-indent-function' settings.
+;; * Bugfix for `quack-prompt-for-kwmatch-choice'.
+;; * Bugfix for font-lock keywords getting set too early.
+;; * Now byte-compiles without warnings/errors.
+;;
+;; Version 0.2 (2002-07-28)
+;; * Manual keywords lookup.
+;; * Other minor changes.
+;;
+;; Version 0.1 (2002-07-18)
+;; * Initial release.
+
+;; ADMONISHMENT TO IMPRESSIONABLE YOUNG SCHEME STUDENTS:
+;;
+;; Quack should by no means be construed as a model of good programming,
+;; much less of good software engineering. Emacs is by nature a complex
+;; system of interacting kludges. To get Emacs to do useful new things is
+;; to artfully weave one's extensions into a rich tapestry of sticky duct
+;; tape. Also, Quack usually only got hacked on when I was stuck in a busy
+;; lobby for an hour with a laptop and unable to do real work.
+
+;;; Code:
+
+;; Dependencies:
+
+(require 'advice)
+(require 'cmuscheme)
+(require 'compile)
+(require 'custom)
+(require 'easymenu)
+(require 'font-lock)
+(require 'scheme)
+(require 'thingatpt)
+
+(unless (fboundp 'customize-save-variable)
+ (autoload 'customize-save-variable "cus-edit"))
+
+;; Custom Variables:
+
+(defgroup quack nil
+ "Enhanced support for editing and running Scheme code."
+ :group 'scheme
+ :prefix "quack-"
+ :link '(url-link "http://www.neilvandyke.org/quack/"))
+
+(defcustom quack-dir "~/.quack"
+ "*Directory where Quack stores various persistent data in file format."
+ :type 'string
+ :group 'quack)
+
+(defcustom quack-scheme-mode-keymap-prefix "\C-c\C-q"
+ "*Keymap prefix string for `quack-scheme-mode-keymap'.
+
+One of the nice things about having C-q in the prefix is that it is unlikely to
+be already be in use, due to the historical reality of software flow control
+\(and the fact that it is hard to type). If your C-q doesn't seem to be going
+through, then you have several options: disable flow control (if it is safe to
+do so), change the value of this variable, or see the Emacs documentation for
+`enable-flow-control-on'."
+ :type 'string
+ :group 'quack)
+
+(defcustom quack-remap-find-file-bindings-p t
+ "Whether to remap `find-file' key bindings to `quack-find-file'.
+The local map in Scheme Mode and Inferior Scheme Mode buffers is used."
+ :type 'boolean
+ :group 'quack)
+
+(defcustom quack-global-menu-p t
+ "*Whether to have a \"Quack\" menu always on the menu bar."
+ :type 'boolean :group 'quack)
+
+(defcustom quack-tabs-are-evil-p t
+ "*Whether Quack should avoid use of Tab characters in indentation."
+ :type 'boolean
+ :group 'quack)
+
+(defcustom quack-browse-url-browser-function nil
+ "*Optional override for `browse-url-browser-function'.
+
+If non-nil, overrides that variable for URLs viewed by `quack-browse-url'."
+ :type '(choice (const :tag "Do Not Override" nil)
+ (function :tag "Function")
+ (alist :tag "Regexp/Function Association List"
+ :key-type regexp :value-type function))
+ :group 'quack)
+
+(defcustom quack-manuals ; TODO: Options menu.
+
+ ;; TODO: If we make this so users are likely to want to override parts of it,
+ ;; then introduce `quack-manuals-defaults' variable with this in it,
+ ;; and let users edit `quack-manuals-overrides' which are keyed on the
+ ;; ID symbol.
+
+ ;; TODO: Have a way for finding docs on the local filesystem, and/or
+ ;; permitting a user to easily specify location.
+
+ ;; TODO: Provide a way of specifying alternative access means so that, for
+ ;; example, we can look for R5RS first in locally-installed PLT
+ ;; collection, then in one of various non-PLT directories it might be
+ ;; mirrored, then remote PLT copy using local PLT keywords file, then
+ ;; the canonical HTML copy on the Web... Maybe even permit Info
+ ;; format. Let's just reinvent the Web, while we're at it.
+
+ '(
+
+ (r5rs "R5RS"
+ "http://www.schemers.org/Documents/Standards/R5RS/HTML/"
+ nil)
+
+ (bigloo
+ "Bigloo"
+ "http://www-sop.inria.fr/mimosa/fp/Bigloo/doc/bigloo.html"
+ ;;"file:///usr/share/doc/bigloo/manuals/bigloo.html"
+ nil)
+
+ (chez
+ "Chez Scheme User's Guide"
+ "http://www.scheme.com/csug/index.html"
+ nil)
+
+ (chicken
+ "Chicken User's Manual"
+ "http://www.call-with-current-continuation.org/manual/manual.html"
+ ;;"file:///usr/share/doc/chicken/manual.html"
+ nil)
+
+ (gambit
+ "Gambit-C home page"
+ "http://www.iro.umontreal.ca/~gambit/")
+
+ (gauche
+ "Gauche Reference Manual"
+ "http://www.shiro.dreamhost.com/scheme/gauche/man/gauche-refe.html"
+ nil)
+
+ (mitgnu-ref
+ "MIT/GNU Scheme Reference"
+ "http://www.gnu.org/software/mit-scheme/documentation/scheme.html"
+ ;;"http://www.swiss.ai.mit.edu/projects/scheme/documentation/scheme.html"
+
+ ;;"file:///usr/share/doc/mit-scheme/html/scheme.html"
+ nil)
+
+ (mitgnu-user
+ "MIT/GNU Scheme User's Manual"
+ "http://www.gnu.org/software/mit-scheme/documentation/user.html"
+ ;;"http://www.swiss.ai.mit.edu/projects/scheme/documentation/user.html"
+ ;;"file:///usr/share/doc/mit-scheme/html/user.html"
+ nil)
+
+ (mitgnu-sos
+ "MIT/GNU Scheme SOS Reference Manual"
+ "http://www.gnu.org/software/mit-scheme/documentation/sos.html"
+ ;;"http://www.swiss.ai.mit.edu/projects/scheme/documentation/sos.html"
+ ;;"file:///usr/share/doc/mit-scheme/html/sos.html"
+ nil)
+
+ (plt-mzscheme "PLT MzScheme: Language Manual" plt t)
+ (plt-mzlib "PLT MzLib: Libraries Manual" plt t)
+ (plt-mred "PLT MrEd: Graphical Toolbox Manual" plt t)
+ (plt-framework "PLT Framework: GUI Application Framework" plt t)
+ (plt-drscheme "PLT DrScheme: Programming Environment Manual" plt nil)
+ (plt-insidemz "PLT Inside PLT MzScheme" plt nil)
+ (plt-tools "PLT Tools: DrScheme Extension Manual" plt nil)
+ (plt-mzc "PLT mzc: MzScheme Compiler Manual" plt t)
+ (plt-r5rs "PLT R5RS" plt t)
+
+ (scsh
+ "Scsh Reference Manual"
+ "http://www.scsh.net/docu/html/man-Z-H-1.html"
+ ;;"file:///usr/share/doc/scsh-doc/scsh-manual/man-Z-H-1.html"
+ nil)
+
+ (sisc
+ "SISC for Seasoned Schemers"
+ "http://sisc.sourceforge.net/manual/html/"
+ nil)
+
+ (htdp "How to Design Programs"
+ "http://www.htdp.org/"
+ nil)
+ (htus "How to Use Scheme"
+ "http://www.htus.org/"
+ nil)
+ (t-y-scheme "Teach Yourself Scheme in Fixnum Days"
+ "http://www.ccs.neu.edu/home/dorai/t-y-scheme/t-y-scheme.html"
+ nil)
+ (tspl "Scheme Programming Language (Dybvig)"
+ "http://www.scheme.com/tspl/"
+ nil)
+ (sicp "Structure and Interpretation of Computer Programs"
+ "http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-4.html"
+ nil)
+ (slib "SLIB"
+ "http://swissnet.ai.mit.edu/~jaffer/SLIB.html"
+ nil)
+ (faq "Scheme Frequently Asked Questions"
+ "http://www.schemers.org/Documents/FAQ/"
+ nil))
+ "*List of specifications of manuals that can be viewed.
+
+Each manual specification is a list of four elements:
+
+ (SYMBOL TITLE LOCATION USE-KEYWORDS-P)
+
+where SYMBOL is a short symbol that identifies the manual, TITLE is a string,
+LOCATION is either a string with the URL of the manual or the symbol `plt',
+and USE-KEYWORDS-P is `t' or `nil'.
+
+If LOCATION is `plt', then Quack treats it as a PLT bundled manual, looking for
+the HTML and keyword files in `quack-pltcollect-dirs', and optionally providing
+keyword lookup if USE-KEYWORDS-P is `t'. Remote canonical copies of the
+manuals will be used if local copies cannot be found.
+
+If LOCATION is a URL, then USE-KEYWORDS-P must be `nil'."
+ :type '(repeat (list (symbol :tag "Identifying Symbol")
+ (string :tag "Title String")
+ (choice :tag "Location"
+ (string :tag "URL")
+ (const :tag "PLT Bundled Manual" plt))
+ (boolean :tag "Use Keywords?")))
+ :group 'quack)
+
+(defcustom quack-local-keywords-for-remote-manuals-p t
+ "*If non-nil, Quack will use canonical remote Web URLs when there is a local
+keyword file for a PLT manual but no local HTML files. (This feature was
+prompted by the Debian 200.2-3 package for MzScheme, which includes keyword
+files but not HTML files.) If the symbol `always', then Quack will always use
+remote Web manuals for keywords lookup, even if local HTML files exist, as a
+workaround for how some versions of Emacs interact with some versions of
+Microsoft Windows \(inexplicably discarding the fragment identifier from `file'
+scheme URI\)."
+ :type '(choice (const :tag "Permit" t)
+ (const :tag "Forbid" nil)
+ (const :tag "Always" always))
+ :group 'quack
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-srfi-master-base-url "http://srfi.schemers.org/"
+ ;; Note: Intentionally not letting user change this through the options menu.
+ "*The base URL for the master SRFI Web pages.
+The SRFI index files should be immediately beneath this."
+ :type 'string
+ :group 'quack)
+
+(defcustom quack-pltcollect-dirs
+ (let ((good '()))
+ (mapcar (function (lambda (dir)
+ (and dir
+ (not (assoc dir good))
+ (file-directory-p dir)
+ (setq good (nconc good (list dir))))))
+ `(,@(let ((v (getenv "PLTCOLLECTS")))
+ (and v (split-string v ":")))
+ ,(let ((v (getenv "PLTHOME")))
+ (and v (expand-file-name "collects" v)))
+ ,@(mapcar 'expand-file-name
+ '("/usr/lib/plt/collects"
+ "/usr/local/lib/plt/collects"))))
+ good)
+ "*PLT collection directories.
+Listed in order of priority."
+ :type '(repeat directory)
+ :group 'quack
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-fontify-style 'plt
+ "*Which font-lock fontification style to use.
+
+If symbol `plt', an approximation of PLT DrScheme 200 Check Syntax
+fontification will be used. If symbol `emacs', then fontification in the style
+of GNU Emacs' Scheme Mode with extensions will be used. If nil, then Quack
+will not override the default Scheme Mode fontification."
+ :type '(choice (const :tag "PLT Style" plt)
+ (const :tag "Extended GNU Emacs Style" emacs)
+ (const :tag "Emacs Default" nil))
+ :group 'quack
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-pltish-fontify-definition-names-p t
+ "*If non-nil, fontify names in definition forms for PLT-style fontification.
+
+This only has effect when `quack-fontify-style' is `plt'."
+ :type 'boolean
+ :group 'quack
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-pltish-fontify-keywords-p t
+ ;; TODO: Rename this from "keywords" to "syntax-keywords", here, and in for
+ ;; face names.
+ "*If non-nil, fontify keywords in PLT-style fontification.
+
+This only has effect when `quack-fontify-style' is `plt'."
+ :type 'boolean
+ :group 'quack
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-pltish-keywords-to-fontify
+ ;; TODO: These are currently R5RS and some SRFI special syntax plus a bunch
+ ;; of PLT, especially PLT 200 class.ss, and some "define-"* variants from
+ ;; various dialects, plus some Racket 5.0.2... The dumbness of this kind of
+ ;; highlighting without regard to context is not really satisfactory.
+ '(
+
+ "and" "begin" "begin-for-syntax"
+ "begin0" "c-declare" "c-lambda" "case" "case-lambda" "class"
+ "class*" "class*/names" "class100" "class100*" "compound-unit/sig" "cond"
+ "cond-expand" "define" "define-class" "define-compound-unit"
+ "define-const-structure"
+ "define-constant" "define-embedded" "define-entry-point" "define-external"
+ "define-for-syntax" "define-foreign-record" "define-foreign-type"
+ "define-foreign-variable" "define-generic" "define-generic-procedure"
+ "define-inline" "define-location" "define-macro" "define-method"
+ "define-module" "define-opt" "define-public" "define-reader-ctor"
+ "define-record" "define-record-printer" "define-record-type"
+ "define-signature"
+ "define-splicing-syntax-class"
+ "define-struct"
+ "define-structure"
+ "define-syntax"
+ "define-syntax-class"
+ "define-syntax-set" "define-values" "define-values-for-syntax"
+ "define-values/invoke-unit/infer"
+ "define-values/invoke-unit/sig" "define/contract" "define/override"
+ "define/private" "define/public" "define/kw"
+ "delay" "do" "else" "exit-handler" "field"
+ "if" "import" "inherit" "inherit-field" "init" "init-field" "init-rest"
+ "instantiate" "interface" "lambda" "lambda/kw" "let" "let*" "let*-values"
+ "let+"
+ "let-syntax" "let-values" "let/ec" "letrec" "letrec-values" "letrec-syntax"
+ "match-lambda" "match-lambda*" "match-let" "match-let*" "match-letrec"
+ "match-define" "mixin" "module" "module*" "module+" "opt-lambda" "or" "override" "override*"
+ "namespace-variable-bind/invoke-unit/sig" "parameterize" "parameterize*"
+ "parameterize-break" "private"
+ "private*" "protect" "provide" "provide-signature-elements"
+ "provide/contract" "public" "public*" "quasiquote"
+ "quasisyntax" "quasisyntax/loc" "quote" "receive"
+ "rename" "require" "require-for-syntax" "send" "send*" "set!" "set!-values"
+ "signature->symbols" "super-instantiate" "syntax" "syntax/loc"
+ "syntax-case" "syntax-case*" "syntax-error" "syntax-parse" "syntax-rules"
+ "unit/sig"
+ "unless" "unquote" "unquote-splicing" "when" "with-handlers" "with-method"
+ "with-syntax"
+ "define-type-alias"
+ "define-struct:"
+ "define:"
+ "let:"
+ "letrec:"
+ "let*:"
+ "lambda:"
+ "plambda:"
+ "case-lambda:"
+ "pcase-lambda:"
+ "require/typed"
+ "require/opaque-type"
+ "require-typed-struct"
+ "struct"
+ "inst"
+ "ann"
+
+ )
+ "*Scheme keywords to fontify when `quack-fontify-style' is `plt'."
+ :type '(repeat string)
+ :group 'quack
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-emacsish-keywords-to-fontify
+ '("and" "begin" "begin0" "call-with-current-continuation"
+ "call-with-input-file" "call-with-output-file" "call/cc" "case"
+ "case-lambda" "class" "cond" "delay" "do" "else" "exit-handler" "field"
+ "for-each" "if" "import" "inherit" "init-field" "interface" "lambda" "let"
+ "let*" "let*-values" "let-values" "let-syntax" "let/ec" "letrec"
+ "letrec-syntax" "map" "mixin" "opt-lambda" "or" "override" "protect"
+ "provide" "public" "rename" "require" "require-for-syntax" "syntax"
+ "syntax-case" "syntax-error" "syntax-rules" "unit/sig" "unless" "when"
+ "with-syntax")
+ "*Scheme keywords to fontify when `quack-fontify-style' is `emacs'."
+ :type '(repeat string)
+ :group 'quack
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-fontify-threesemi-p t
+ "*Whether three-semicolon comments should be fontified differently."
+ :type 'boolean
+ :group 'quack
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-pretty-lambda-p nil
+ "*Whether Quack should display \"lambda\" as the lambda character.
+
+`quack-fontify-style' must be `plt'. Only supported under GNU Emacs version
+21\; not under XEmacs or older GNU Emacs.
+
+Note: Pretty lambda requires that suitable iso8859-7 fonts be available. Under
+Debian/GNU Linux, for example, these can be downloaded and installed with the
+shell command \"apt-get install 'xfonts-greek-*'\". If iso8859-7 fonts are
+unavailable for your system, please notify the Quack author."
+ :type 'boolean
+ :group 'quack
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-programs
+ '("bigloo" "csi" "csi -hygienic" "gosh" "gracket" "gsi"
+ "gsi ~~/syntax-case.scm -" "guile" "kawa" "mit-scheme" "racket"
+ "racket -il typed/racket" "rs" "scheme" "scheme48" "scsh" "sisc" "stklos"
+ "sxi")
+ "List of Scheme interpreter programs that can be used with `run-scheme'.
+
+These names will be accessible via completion when `run-scheme' prompts for
+which program to run."
+ :group 'quack
+ :type '(repeat string)
+ :set 'quack-custom-set
+ :initialize 'custom-initialize-default)
+
+(defcustom quack-default-program "mzscheme"
+ "Default Scheme interpreter program to use with `run-scheme'."
+ :group 'quack
+ :type 'string)
+
+(defcustom quack-run-scheme-always-prompts-p t
+ "`run-scheme' should always prompt for which program to run.
+
+If nil, `run-scheme' will always use `quack-default-program' when invoked
+interactively without a prefix argument; this is closest to the behavior of the
+`cmuscheme' package."
+ :group 'quack
+ :type 'boolean)
+
+(defcustom quack-run-scheme-prompt-defaults-to-last-p t
+ "If non-nil, `run-scheme' prompt should default to the last program run."
+ :group 'quack
+ :type 'boolean)
+
+(defcustom quack-remember-new-programs-p t
+ "Programs are added to `quack-programs' automatically."
+ :group 'gigule
+ :type 'boolean)
+
+(defcustom quack-switch-to-scheme-method 'other-window
+ "Method to use for choosing a window and frame for the process buffer.
+
+One of three symbols:
+`other-window' will split display in a different window in the current frame,
+splitting the current window if necessary.
+`own-frame' will display the process buffer in its own frame.
+`cmuscheme' will use the normal behavior of the `cmuscheme' package."
+ :group 'quack
+ :type '(choice (const :tag "Other Window" other-window)
+ (const :tag "Own Frame" own-frame)
+ (const :tag "Cmuscheme Behavior" cmuscheme)))
+
+(defcustom quack-warp-pointer-to-frame-p t
+ "Warp mouse pointer to frame with Scheme process buffer.
+
+When `quack-switch-to-scheme-method' is `own-frame', `switch-to-scheme' will
+warp the mouse pointer to the frame displaying the Scheme process buffer."
+ :group 'quack
+ :type 'boolean)
+
+(defcustom quack-newline-behavior 'newline-indent
+ "*Behavior of the RET key in Scheme-Mode buffers. The value is one of three
+symbols: `newline' inserts a normal newline, `newline-indent' \(the default\)
+inserts a newline and leaves the point properly indented on the new line, and
+`indent-newline-indent' indents the current line before inserting a newline and
+indenting the new one."
+ :type '(choice (const 'newline)
+ (const 'newline-indent)
+ (const 'indent-newline-indent))
+ :group 'quack)
+
+(defcustom quack-smart-open-paren-p nil
+ "The `[' can be used to insert `(' characters.
+Actually, this just makes the `(' and '[' keys both insert `(', unless given a
+prefix argument. This makes typing parens easier on typical keyboards for
+which `(' requires a shift modifier but `[' does not. A later version of Quack
+might add actual \"smart\" support for automatic PLT-esque insertion of `['
+instead of `(' in some syntactic contexts."
+ :group 'quack
+ :type 'boolean)
+
+(defcustom quack-options-persist-p t
+ "Option menu settings and programs persist using the `custom' facility.
+
+Note that the value of this option itself cannot be set persistently via the
+option menu -- you must use the `customize' interface or set it manually in an
+Emacs startup file. This is by design, to avoid the risk of users accidentally
+disabling their ability to set persistent options via the option menu."
+ :group 'quack
+ :type 'boolean)
+
+(defcustom quack-quiet-warnings-p t ; TODO: Options menu.
+ "Warning messages are quiet and subtle."
+ :group 'quack
+ :type 'boolean)
+
+(defconst quack-pltish-comment-face 'quack-pltish-comment-face)
+(defface quack-pltish-comment-face
+ '((((class color) (background light)) (:foreground "cyan4"))
+ (((class color) (background dark)) (:foreground "cyan1"))
+ (t (:slant italic)))
+ "Face used for comments when `quack-fontify-style' is `plt'."
+ :group 'quack)
+
+(defconst quack-pltish-selfeval-face 'quack-pltish-selfeval-face)
+(defface quack-pltish-selfeval-face
+ '((((class color) (background light)) (:foreground "green4"))
+ (((class color) (background dark)) (:foreground "green2"))
+ (t ()))
+ "Face used for self-evaluating forms when `quack-fontify-style' is `plt'."
+ :group 'quack)
+
+(defconst quack-pltish-paren-face 'quack-pltish-paren-face)
+(defface quack-pltish-paren-face
+ '((((class color) (background light)) (:foreground "red3"))
+ (((class color) (background dark)) (:foreground "red1"))
+ (((class grayscale)) (:foreground "gray"))
+ (t ()))
+ "Face used for parentheses when `quack-fontify-style' is `plt'."
+ :group 'quack)
+
+(defconst quack-pltish-colon-keyword-face 'quack-pltish-colon-keyword-face)
+(defface quack-pltish-colon-keyword-face
+ '((t (:bold t :foreground "gray50")))
+ "Face used for `#:' keywords when `quack-fontify-style' is `plt'.
+Note that this isn't based on anything in PLT."
+ :group 'quack)
+
+(defconst quack-pltish-paren-face 'quack-pltish-paren-face)
+(defface quack-pltish-paren-face
+ '((((class color) (background light)) (:foreground "red3"))
+ (((class color) (background dark)) (:foreground "red1"))
+ (((class grayscale)) (:foreground "gray"))
+ (t ()))
+ "Face used for parentheses when `quack-fontify-style' is `plt'."
+ :group 'quack)
+
+(defconst quack-banner-face 'quack-banner-face)
+(defface quack-banner-face
+ '((t (:family "Helvetica")))
+ "Face used in the inferior process buffer for the MzScheme banner.
+
+Currently only takes effect when `quack-fontify-style' is `plt'."
+ :group 'quack)
+
+(defconst quack-pltish-defn-face 'quack-pltish-defn-face)
+(defface quack-pltish-defn-face
+ '((((class color) (background light)) (:bold t :foreground "blue3"))
+ (((class color) (background dark)) (:bold t :foreground "blue1"))
+ (t (:bold t :underline t)))
+ "Face used for names in toplevel definitions.
+
+For PLT-style when `quack-pltish-fontify-definition-names-p' is non-nil."
+ :group 'quack)
+
+(defconst quack-pltish-class-defn-face 'quack-pltish-class-defn-face)
+(defface quack-pltish-class-defn-face
+ '((((class color) (background light))
+ (:foreground "purple3" :inherit quack-pltish-defn-face))
+ (((class color) (background dark))
+ (:foreground "purple1" :inherit quack-pltish-defn-face))
+ (t (:inherit quack-pltish-defn-face)))
+ "Face used for class names in toplevel definitions.
+
+For PLT-style when `quack-pltish-fontify-definition-names-p' is non-nil."
+ :group 'quack)
+
+(defconst quack-pltish-module-defn-face 'quack-pltish-module-defn-face)
+(defface quack-pltish-module-defn-face
+ '((((class color) (background light))
+ (:foreground "purple3" :inherit quack-pltish-defn-face))
+ (((class color) (background dark))
+ (:foreground "purple1" :inherit quack-pltish-defn-face))
+ (t (:inherit quack-pltish-defn-face)))
+ "Face used for module names in toplevel definitions.
+
+For PLT-style when `quack-pltish-fontify-definition-names-p' is non-nil."
+ :group 'quack)
+
+(defconst quack-pltish-keyword-face 'quack-pltish-keyword-face)
+(defface quack-pltish-keyword-face
+ '((t (:bold t)))
+ "Face used for keywords in PLT Style fontification.
+
+For PLT-style when `quack-pltish-fontify-keywords-p' is non-nil."
+ :group 'quack)
+
+(defconst quack-threesemi-semi-face 'quack-threesemi-semi-face)
+(defface quack-threesemi-semi-face
+ '((((class color) (background light))
+ (:foreground "#a0ffff":background "#c0ffff"))
+ (((class color) (background dark))
+ (:foreground "cyan2" :background "cyan4"))
+ (t (:slant italic)))
+ "Face used for `;;;' semicolons when `quack-fontify-threesemi-p' is non-nil."
+ :group 'quack)
+
+(defconst quack-threesemi-text-face 'quack-threesemi-text-face)
+(defface quack-threesemi-text-face
+ '((((class color) (background light))
+ (:foreground "cyan4" :background "#c0ffff"))
+ (((class color) (background dark))
+ (:foreground "white" :background "cyan4"))
+ (t (:slant italic)))
+ "Face used for `;;;' text when `quack-fontify-threesemi-p' is non-nil."
+ :group 'quack)
+
+(defconst quack-threesemi-h1-face 'quack-threesemi-h1-face)
+(defface quack-threesemi-h1-face
+ '((t (:bold t :family "Helvetica" :height 1.4 :size "20pt")))
+ "Face used for H1 headings in `;;;' text."
+ :group 'quack)
+
+(defconst quack-threesemi-h2-face 'quack-threesemi-h2-face)
+(defface quack-threesemi-h2-face
+ '((t (:bold t :family "Helvetica" :height 1.2 :size "16pt")))
+ "Face used for H2 headings in `;;;' text."
+ :group 'quack)
+
+(defconst quack-threesemi-h3-face 'quack-threesemi-h3-face)
+(defface quack-threesemi-h3-face
+ '((t (:bold t :family "Helvetica")))
+ "Face used for H3 headings in `;;;' text."
+ :group 'quack)
+
+(defconst quack-pltfile-prologue-face 'quack-pltfile-prologue-face)
+(defface quack-pltfile-prologue-face
+ '((((class color)) (:foreground "black" :background "gray66"))
+ (((class grayscale)) (:foreground "black" :background "gray66"))
+ (t ()))
+ "Face used for the prologue in a decoded PLT package buffer."
+ :group 'quack)
+
+(defconst quack-pltfile-dir-face 'quack-pltfile-dir-face)
+(defface quack-pltfile-dir-face
+ '((((class color)) (:bold t :foreground "white" :background "gray33"
+ :family "Helvetica" :height 1.2 :size "20pt"))
+ (((class grayscale)) (:bold t :foreground "white" :background "gray33"
+ :family "Helvetica" :height 1.2 :size "20pt"))
+ (t (:bold t :inverse-video t)))
+ "Face used for directory headers in a decoded PLT package buffer."
+ :group 'quack)
+
+(defconst quack-pltfile-file-face 'quack-pltfile-file-face)
+(defface quack-pltfile-file-face
+ '((((class color)) (:bold t :foreground "black" :background "gray66"
+ :family "Helvetica" :height 1.2 :size "20pt"))
+ (((class grayscale)) (:bold t :foreground "black" :background "gray66"
+ :family "Helvetica" :height 1.2 :size "20pt"))
+ (t (:bold t :inverse-video t)))
+ "Face used for file headers in a decoded PLT package buffer."
+ :group 'quack)
+
+(defconst quack-about-title-face 'quack-about-title-face)
+(defface quack-about-title-face
+ '((((class color) (background light))
+ (:bold t :family "Helvetica" :foreground "#008000"
+ :height 2.0 :size "24pt"))
+ (((class color) (background dark))
+ (:bold t :family "Helvetica" :foreground "#00f000"
+ :height 2.0 :size "24pt"))
+ (t (:bold t :family "Helvetica"
+ :height 2.0 :size "24pt")))
+ "Face used for Quack name in About Quack."
+ :group 'quack)
+
+(defconst quack-about-face 'quack-about-face)
+(defface quack-about-face
+ '((t (:family "Helvetica")))
+ "Face used for the body text in About Quack."
+ :group 'quack)
+
+(defconst quack-smallprint-face 'quack-smallprint-face)
+(defface quack-smallprint-face
+ '((t (:family "Courier" :height 0.8 :size "8pt")))
+ "Face used for the \"small print\" in About Quack."
+ :group 'quack)
+
+;; Compatibility/Portability Misc. Kludges:
+
+;; Note: Some compatibility gotchas found while porting Quack that aren't
+;; addressed by macros and functions:
+;;
+;; * `defface' in Emacs 21 supports ":weight bold", but this is silently
+;; ignored under older Emacsen, so ":bold t" must be used instead.
+;;
+;; * Third argument of `detect-coding-region' is different in Emacs 21 and
+;; XEmacs 21, so only use the first two args.
+;;
+;; * Under XEmacs 21, characters are `equal' but not `eq' to their integer
+;; ASCII values
+;;
+;; * GNU Emacs 21 faces have `:height' property that is either absolute
+;; decipoints or relative scaling factor. XEmacs 21 faces instead have
+;; `:size' property, which appears to be absolute point or mm size.
+;;
+;; * XEmacs 21 text properties appear to be front-sticky, and there did not
+;; seem to be any documentation references to stickiness.
+;;
+;; * XEmacs 21 `local-variable-p' has second argument mandatory.
+;;
+;; * XEmacs 21 does not display submenu labels at all unless the submenu has
+;; content. For inactive submenus, an empty string suffices for content.
+;;
+;; * XEmacs 21 doesn't support composite characters (which we use for very
+;; nice pretty lambda under GNU Emacs).
+
+(eval-and-compile
+ (defvar quack-xemacs-p (eval '(and (boundp 'running-xemacs) running-xemacs)))
+ (defvar quack-gnuemacs-p (not quack-xemacs-p)))
+
+(defmacro quack-when-xemacs (&rest args)
+ (if quack-xemacs-p (cons 'progn args) 'nil))
+
+(defmacro quack-when-gnuemacs (&rest args)
+ (if quack-gnuemacs-p (cons 'progn args) 'nil))
+
+(defmacro quack-define-key-after (keymap key definition &optional after)
+ (if quack-gnuemacs-p
+ `(define-key-after ,keymap ,key ,definition ,after)
+ `(define-key ,keymap ,key (prog1 ,definition ,after))))
+
+(defmacro quack-delete-horizontal-space (&rest args)
+ (if (and quack-gnuemacs-p (>= emacs-major-version 21))
+ `(delete-horizontal-space ,@args)
+ `(delete-horizontal-space)))
+
+(defmacro quack-match-string-no-properties (&rest args)
+ `(,(if quack-xemacs-p 'match-string 'match-string-no-properties) ,@args))
+
+(defmacro quack-menufilter-return (name form)
+ (if (= emacs-major-version 20)
+ ;; Note: This isn't working in Emacs 20. Menu displays now but actions
+ ;; are not executed. No answer to test case posted to comp.emacs
+ ;; and then to gnu.emacs.help. In response to my subsequent bug
+ ;; report against Emacs, RMS says that, if this is indeed a bug,
+ ;; then nothing will be done, since 20 is no longer supported. I'm
+ ;; going to let this quietly not work unless someone emails me that
+ ;; they're actually using Emacs 20.
+ `(easy-menu-filter-return (easy-menu-create-menu ,name ,form))
+ form))
+
+(defmacro quack-propertize (obj &rest props)
+ (if (and quack-gnuemacs-p (>= emacs-major-version 21))
+ `(propertize ,obj ,@props)
+ (let ((obj-var 'quack-propertize-G-obj))
+ `(let ((,obj-var ,obj))
+ (add-text-properties 0 (length ,obj-var) (list ,@props) ,obj-var)
+ ,obj-var))))
+
+(eval-when-compile
+ (when quack-xemacs-p
+ (defvar inhibit-eol-conversion)
+ (defvar minibuffer-allow-text-properties)))
+
+;; Compatibility/Portability Hash Table:
+
+(eval-and-compile
+ (defmacro quack-make-hash-table (&rest args)
+ `(,(if (>= emacs-major-version 21)
+ 'make-hash-table
+ 'quack-fake-make-hash-table)
+ ,@args)))
+
+(defmacro quack-puthash (key value table)
+ (list (if (>= emacs-major-version 21) 'puthash 'quack-fake-puthash)
+ key value table))
+
+(defmacro quack-gethash (key table &optional dflt)
+ (list (if (>= emacs-major-version 21) 'gethash 'quack-fake-gethash)
+ key table dflt))
+
+(defun quack-fake-make-hash-table (&rest args)
+ ;; TODO: Parse the keyword args and make this do 'assoc or 'assq, as
+ ;; appropriate. Currently, this package only needs 'assoc.
+ (vector 'assoc '()))
+
+(defun quack-fake-puthash (key value table)
+ (let ((pair (funcall (aref table 0) key (aref table 1))))
+ (if pair
+ (setcdr pair value)
+ (aset table 1 (cons (cons key value) (aref table 1))))))
+
+(defun quack-fake-gethash (key table &optional dflt)
+ (let ((pair (funcall (aref table 0) key (aref table 1))))
+ (if pair (cdr pair) dflt)))
+
+;; Compatibility/Portability Overlays/Extents:
+
+;; TODO: Maybe get rid of overlays (and the XEmacs extent kludge), and just use
+;; text properties instead.
+
+(defmacro quack-make-face-ovlext (beg end face)
+ (if quack-xemacs-p
+ `(set-extent-property (make-extent ,beg ,end) 'face ,face)
+ `(overlay-put (make-overlay ,beg ,end) 'face ,face)))
+
+(defmacro quack-make-hiding-ovlext (beg end)
+ (if quack-xemacs-p
+ `(set-extent-property (make-extent ,beg ,end) 'invisible t)
+ `(overlay-put (make-overlay ,beg ,end) 'category 'quack-hiding-ovlcat)))
+
+;; Messages, Errors, Warnings:
+
+(defmacro quack-activity (what &rest body)
+ (let ((var-what (make-symbol "quack-activity-G-what")))
+ `(let ((,var-what ,what))
+ (message (concat ,var-what "..."))
+ (prog1 (progn ,@body)
+ (message (concat ,var-what "...done"))))))
+
+(defun quack-internal-error (&optional format &rest args)
+ (if format
+ (apply 'error (concat "Quack Internal Error: " format) args)
+ (error "Quack Internal Error.")))
+
+(defun quack-warning (format &rest args)
+ (apply 'message (concat "Quack Warning: " format) args)
+ (unless quack-quiet-warnings-p
+ (beep)
+ (sleep-for 1)))
+
+;; Regular Expressions:
+
+(defun quack-re-alt (&rest regexps)
+ (concat "\\(" (mapconcat 'identity regexps "\\|") "\\)"))
+
+(defun quack-re-optional (&rest regexps)
+ (concat "\\("
+ (apply 'concat regexps)
+ "\\)?"))
+
+;; Misc.:
+
+;; (defun quack-abbreviate-file-name (file-name)
+;; (let ((directory-abbrev-alist '()))
+;; (abbreviate-file-name file-name)))
+
+(defun quack-delete-file-if-can (file)
+ (condition-case nil (delete-file file) (error nil)))
+
+(defun quack-expand-file-name (name-or-names &optional directory)
+ ;; Note: This only works for systems with Unix-like filenames.
+ (expand-file-name (if (listp name-or-names)
+ (mapconcat 'identity name-or-names "/")
+ name-or-names)
+ directory))
+
+(defun quack-kill-current-buffer ()
+ (interactive)
+ (kill-buffer (current-buffer)))
+
+(defun quack-line-at-point ()
+ (save-excursion
+ (buffer-substring-no-properties
+ (progn (beginning-of-line) (point))
+ (progn (end-of-line) (point)))))
+
+(defun quack-looking-at-backward (re &optional limit)
+ (save-excursion
+ (save-restriction
+ (let ((start-pt (point)))
+ (narrow-to-region (point-min) (point))
+ (and (re-search-backward re limit t)
+ (= (match-end 0) start-pt)
+ (match-beginning 0))))))
+
+(defun quack-looking-at-close-paren-backward ()
+ (save-match-data
+ (quack-looking-at-backward "[])][ \t\r\n\f]*")))
+
+(defun quack-looking-at-open-paren-backward ()
+ (save-match-data
+ (quack-looking-at-backward "[[(][ \t\r\n\f]*")))
+
+(defun quack-make-directory (dir)
+ (setq dir (file-name-as-directory dir))
+ (unless (file-directory-p dir)
+ (make-directory dir t)))
+
+(defun quack-make-directory-for-file (file)
+ (let ((dir (file-name-directory file)))
+ (when dir (quack-make-directory dir))))
+
+(defun quack-propertize-bold (str)
+ (quack-propertize str 'face 'bold))
+
+(defun quack-propertize-face (str face)
+ (quack-propertize str 'face face))
+
+(defun quack-propertize-italic (str)
+ (quack-propertize str 'face 'italic))
+
+(defun quack-sort-string-list-copy (lst)
+ (sort (copy-sequence lst) 'string<))
+
+(defun quack-uncomment-region (beg end)
+ ;; TODO: Make a quack-toggle-commentout-region.
+ (interactive "r")
+ (comment-region beg end '(4)))
+
+(defun quack-without-side-whitespace (str)
+ ;; Copied from `padr-str-trim-ws' by author.
+ ;;
+ ;; TODO: Don't make an intermediate string. Use regexp match start position.
+ (save-match-data
+ (if (string-match "^[ \t\n\r]+" str)
+ (setq str (substring str (match-end 0))))
+ (if (string-match "[ \t\n\r]+$" str)
+ (setq str (substring str 0 (match-beginning 0))))
+ str))
+
+;; Kludgey Sexp Buffer Operations:
+
+(defconst quack-backward-sexp-re
+ (concat "\\`"
+ (quack-re-alt "[^\";\\\\]"
+ "\\\\\\."
+ (concat "\""
+ (quack-re-alt "[^\"\\\\]"
+ "\\\\\\.")
+ "*\""))
+ "*\\([\"\\\\]\\)?"))
+
+(defun quack-backward-sexp ()
+ ;; Returns non-nil iff point was in a string literal or comment.
+ (interactive)
+ (when (bobp)
+ (error "beginning of buffer"))
+ (save-match-data
+ (let* ((orig (point))
+ (bol (progn (beginning-of-line) (point))))
+ (if (string-match quack-backward-sexp-re
+ (buffer-substring-no-properties bol orig))
+ (if (match-beginning 3)
+ ;; We're in what appears to be a comment or unterminated string
+ ;; literal (though might not be, due to multi-line string
+ ;; literals and block comments), so move point to the beginning.
+ (progn (goto-char (+ bol (match-beginning 3)))
+ t)
+ ;; We don't appear to be in a comment or string literal, so just
+ ;; let `backward-sexp' do its thing.
+ (goto-char orig)
+ (backward-sexp)
+ nil)))))
+
+(defun quack-parent-sexp-search (name-regexp &optional max-depth max-breadth)
+ (save-match-data
+ (save-excursion
+ (let ((max-depth (or max-depth 100))
+ (max-breadth (or max-breadth 100))
+ (orig-point (point))
+ (found 'looking)
+ (depth 0)
+ (child-start nil))
+ (while (and (eq found 'looking) (< depth max-depth))
+ (condition-case nil
+ (let ((breadth 0))
+ ;; Loop until we hit max breadth or error.
+ (while (< breadth max-breadth)
+ (when (and (quack-backward-sexp) (not child-start))
+ (setq child-start (point)))
+ (setq breadth (1+ breadth)))
+ ;; We hit our max breadth without erroring, so set the found
+ ;; flag to indicate failure and then fall out of our loop.
+ (setq found nil))
+ (error ; scan-error
+ ;; We probably hit the beginning of the enclosing sexp, and point
+ ;; should be on the first sexp, which will most often be the form
+ ;; name, so first check that there really is an open paren to our
+ ;; left, and then check if it matches our regexp.
+ (let ((paren-start (quack-looking-at-open-paren-backward)))
+ (if paren-start
+ ;; There is a paren, so check the name of the form.
+ (if (and (looking-at name-regexp)
+ (quack-not-symbol-char-at-point-p (match-end 0)))
+ ;; Found it, so set the result to a list (lexeme, lexeme
+ ;; end point, last nested child sexp start point, parent
+ ;; paren start point) and then fall out of our loop.
+ ;; Note that we return the original point if no child
+ ;; point was found, on the assumption that point was at
+ ;; the beginning of the child sexp (unless it was within
+ ;; the found form name, in which case child sexp start
+ ;; is nil).
+ (setq found (list (quack-match-string-no-properties 0)
+ (match-end 0)
+ (or child-start
+ (if (> orig-point (match-end 0))
+ orig-point))
+ paren-start))
+ ;; This form name didn't match, so try to move up in the
+ ;; paren syntax (which will usually mean moving left one
+ ;; character).
+ (condition-case nil
+ (progn (up-list -1)
+ (setq child-start (point))
+ (setq depth (1+ depth)))
+ (error ; scan-error
+ ;; We can't go up here, so set found flag to indicate
+ ;; failure and then fall out of the loop.
+ (setq found nil))))
+ ;; There wasn't a paren, which means we hit a scan error for
+ ;; some reason other than being at the beginning of the sexp,
+ ;; so consider the search a failure
+ (setq found nil))))))
+ (if (eq found 'looking)
+ nil
+ found)))))
+
+;; TODO: We really need a global definition of what are Scheme symbol
+;; constituent characters (or a whole-symbol regexp)!
+
+(defun quack-not-symbol-char-at-point-p (pt)
+ ;; This is used to check for a symbol boundary point.
+ (save-match-data
+ (or (= pt (point-max))
+ (if (string-match "[^-a-zA-Z0-9!+<=>$%&*./:@^_~]"
+ (buffer-substring-no-properties pt (1+ pt)))
+ t))))
+
+;; String Constant Hashtable:
+
+(eval-and-compile
+ (if (< emacs-major-version 21)
+
+ (defun quack-strconst (str) str)
+
+ (defvar quack-strconst-hashtable
+ (if (>= emacs-major-version 21)
+ (quack-make-hash-table :test 'equal :size 1000)))
+
+ (defun quack-strconst (str)
+ (unless (stringp str)
+ (error "Non-string object passed to quack-strconst: %s" str))
+ (or (quack-gethash str quack-strconst-hashtable nil)
+ (quack-puthash str str quack-strconst-hashtable)
+ str))))
+
+;; Web URLs:
+
+(defun quack-quote-url-substring (str &optional quote-slash-p always-new-p)
+ (save-match-data
+ (let ((regexp (if quote-slash-p "[^-_.A-Za-z0-9]" "[^-_.A-Za-z0-9/]"))
+ (subs '())
+ (len (length str))
+ (start 0))
+ (while (and (> len start)
+ (string-match regexp str start))
+ (let ((beg (match-beginning 0))
+ (end (match-end 0)))
+ (when (> beg start)
+ (setq subs (cons (substring str start beg) subs)))
+ (setq subs (cons (format "%%%X" (aref str beg)) subs))
+ (setq start end)))
+ (if subs
+ (apply 'concat (reverse (if (> len start)
+ (cons (substring str start len) subs)
+ subs)))
+ (if always-new-p (copy-sequence str) str)))))
+
+(defun quack-file-url (dir file)
+ ;; TODO: This is Unix-centric and a little fragile. Rewrite eventually.
+ (concat "file:"
+ (quack-quote-url-substring dir)
+ "/"
+ (or (quack-quote-url-substring file) "")))
+
+(defun quack-build-url (base path)
+ (let ((base-slash-p (= (aref base (1- (length base))) ?\/)))
+ (if path
+ (mapconcat 'identity
+ (cons (if base-slash-p
+ (substring base 0 -1)
+ base)
+ path)
+ "/")
+ (if base-slash-p
+ base
+ (concat base "/")))))
+
+;; Web Browsing:
+
+(defun quack-browse-url (url)
+ (require 'browse-url)
+ (message "Quack viewing URL: %s" url)
+ (let ((browse-url-browser-function (or quack-browse-url-browser-function
+ browse-url-browser-function)))
+ (browse-url url)))
+
+(defun quack-browse-quack-web-page ()
+ (interactive)
+ (quack-browse-url quack-web-page))
+
+(defun quack-w3m-browse-url-other-window (url &optional new-window)
+ (interactive (eval '(browse-url-interactive-arg "URL: ")))
+ (unless (string= (buffer-name) "*w3m*")
+ (switch-to-buffer-other-window (current-buffer)))
+ ;; TODO: If `*w3m*' buffer is visible in current frame or other frame,
+ ;; switch to that, for Emacsen that don't do that by default.
+ (eval '(w3m-browse-url url nil)))
+
+;; Web Getting:
+
+(defconst quack-web-get-log-buffer-name "*quack-web-get*")
+
+(defun quack-web-get-to-file (url out-file)
+ ;; TODO: Support other getting tools, such as "lynx -source", "links
+ ;; -source", "w3m -dump_source", and the Emacs w3 package. Most of
+ ;; these send the Web content to stdout, so, unlike for wget, it will
+ ;; be easier to insert directly to a buffer and send stderr to a temp
+ ;; file. We should have *-to-file-* and *-insert-via-* functions for
+ ;; each external downloader program anyway.
+ (quack-make-directory-for-file out-file)
+ (quack-web-get-to-file-via-wget url out-file))
+
+;;(defun quack-web-get-to-temp-file (url)
+;; (let ((temp-file (quack-make-temp-file "web-get")))
+;; (quack-web-get-to-file url temp-file)
+;; temp-file))
+
+(defun quack-web-get-to-file-via-wget (url out-file)
+ ;; TODO: Make this initially download to a temp file; replace any
+ ;; pre-existing out-file after successful download. Do this for any
+ ;; external downloader programs that write to the specified output file
+ ;; before the download is complete.
+ (let ((window (selected-window))
+ (saved-buf (current-buffer))
+ (log-buf (get-buffer-create quack-web-get-log-buffer-name)))
+ (unwind-protect
+ (progn
+ ;; Prepare the log buffer.
+ (set-buffer log-buf)
+ (widen)
+ (buffer-disable-undo)
+ (goto-char (point-min))
+ (delete-region (point-min) (point-max))
+ (set-window-buffer window log-buf)
+ ;; Do the wget.
+ (quack-activity
+ (format "Getting %S via wget" url)
+ (let ((status (call-process "wget" nil t t
+ "-O" out-file "-t" "1" "--" url)))
+ (unless (= status 0)
+ (quack-delete-file-if-can out-file)
+ (error "Could not get %S via wget." url))
+ (kill-buffer log-buf)
+ out-file)))
+ ;; unwind-protect cleanup
+ (set-window-buffer window saved-buf)
+ (set-buffer saved-buf))))
+
+;; HTML Kludges:
+
+(defun quack-strip-limited-html-tags (str)
+ (save-match-data
+ (let ((case-fold-search t)
+ (str-len (length str))
+ (frags '())
+ (start 0))
+ (while (string-match "</?[a-z]+[ \r\n]*>" str start)
+ (when (> (match-beginning 0) start)
+ (setq frags (cons (substring str start (match-beginning 0)) frags)))
+ (setq start (match-end 0)))
+ (if frags
+ (progn (when (< start str-len)
+ (setq frags (cons (substring str start) frags)))
+ (apply 'concat (reverse frags)))
+ str))))
+
+;; Temp Files:
+
+(defun quack-temp-dir ()
+ (file-name-as-directory (expand-file-name "tmp" quack-dir)))
+
+;; TODO: Make sure this gets executed in load phase even if byte-compiled.
+
+(random t)
+
+(defun quack-make-temp-file (purpose-str)
+ ;; Note: There is an obvious race condition here. But we're trying to do
+ ;; this in portable Elisp, and if user's `quack-dir' is writable by
+ ;; someone other than user, then user has bigger problems.
+ (save-excursion
+ (let* ((buf (generate-new-buffer "*quack-make-temp-file*"))
+ (dir (quack-temp-dir))
+ file)
+ (set-buffer buf)
+ (quack-make-directory dir)
+ (while (progn (setq file (expand-file-name (format "%d-%s-%d"
+ (emacs-pid)
+ purpose-str
+ (random 10000))
+ dir))
+ (file-exists-p file)))
+ (set-visited-file-name file)
+ (save-buffer 0)
+ (kill-buffer buf)
+ file)))
+
+;; About:
+
+(defun quack-about ()
+ (interactive)
+ (let* ((buf-name "*About Quack*")
+ (buf (get-buffer buf-name)))
+ (when buf (kill-buffer buf))
+ (setq buf (get-buffer-create buf-name))
+ (switch-to-buffer buf)
+ (setq buffer-read-only nil)
+ (widen)
+ (fundamental-mode)
+ (when font-lock-mode
+ ;;(quack-warning "Font-lock mode mysteriously on in fundamental-mode.")
+ (font-lock-mode -1))
+ (buffer-disable-undo)
+ ;;(delete-region (point-min) (point-max))
+ (erase-buffer)
+ (insert
+ "\n"
+ (quack-propertize-face (copy-sequence "Quack") 'quack-about-title-face)
+ " Version "
+ (quack-propertize-bold (copy-sequence quack-version))
+ "\n"
+ (quack-propertize-italic
+ (copy-sequence "Enhanced Emacs support for Scheme programming"))
+ "\n\n"
+ "You can email bug reports and feature requests to the author,\n"
+ quack-author-name
+ " <"
+ quack-author-email
+ ">. Mention that\n"
+ "you are using "
+ (quack-propertize-bold
+ (copy-sequence
+ (cond (quack-gnuemacs-p "GNU Emacs")
+ (quack-xemacs-p "XEmacs")
+ (t "*an unrecognized Emacs kind*"))))
+ " "
+ (quack-propertize-bold
+ (format "%d.%d" emacs-major-version emacs-minor-version))
+ " on "
+ (quack-propertize-bold (copy-sequence system-configuration))
+ ".\n\n"
+ "To be notified via email when new Quack versions are released,\n"
+ "ask Neil to add you to the moderated "
+ (quack-propertize-bold "scheme-announce")
+ " list.\n\n"
+ "Visit the Web page: "
+ quack-web-page
+ "\n")
+ (insert "\n\n"
+ (quack-propertize-face (copy-sequence quack-copyright)
+ 'quack-smallprint-face)
+ "\n"
+ (quack-propertize-face (copy-sequence quack-copyright-2)
+ 'quack-smallprint-face)
+ "\n\n"
+ (quack-propertize-face (concat quack-legal-notice "\n")
+ 'quack-smallprint-face))
+ (goto-char (point-min))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (local-set-key "q" 'quack-kill-current-buffer)
+ (local-set-key "w" 'quack-browse-quack-web-page)
+ (message
+ "Press `q' to quit *About Quack*, `w' to visit the Quack Web page.")))
+
+;; PLT Collections:
+
+(defvar quack-pltcollects-alist-cache nil)
+
+(defun quack-invalidate-pltcollects-caches ()
+ (setq quack-pltcollects-alist-cache nil)
+ (quack-invalidate-manuals-caches))
+
+(defun quack-pltcollects-alist ()
+ (or quack-pltcollects-alist-cache
+ (quack-activity
+ "Scanning PLT collection directories"
+ (let ((result '()))
+ (mapcar (function
+ (lambda (dir)
+ (mapcar (function
+ (lambda (subdir)
+ (unless (member subdir '("." ".." "CVS" "RCS"))
+ (let ((subdir-path (expand-file-name subdir
+ dir)))
+ (when (file-directory-p subdir-path)
+ (setq result
+ (cons (cons subdir subdir-path)
+ result)))))))
+ (condition-case nil
+ (directory-files dir)
+ (file-error nil)))))
+ quack-pltcollect-dirs)
+ (setq quack-pltcollects-alist-cache (reverse result))))))
+
+(defun quack-dir-for-pltcollect (name)
+ (cdr (assoc name (quack-pltcollects-alist))))
+
+(defun quack-dired-pltcollect ()
+ (interactive)
+ (let* ((alist (quack-pltcollects-alist))
+ (default (if (assoc "mzlib" alist) "mzlib" nil))
+ (dir (cdr (assoc
+ (completing-read
+ (if default
+ (format "Dired for PLT collection (default %S): "
+ default)
+ "Dired for PLT collection: ")
+ alist nil t nil nil default)
+ alist))))
+ (and dir (dired dir))))
+
+;; Find File:
+
+(defun quack-shorter-file-relative-name (filename &optional directory)
+ (let ((absolute (expand-file-name filename directory))
+ (relative (file-relative-name filename directory)))
+ (if (< (length relative) (length absolute))
+ relative
+ absolute)))
+
+;; TODO: Also write `quack-find-file-other-window' and
+;; `quack-find-file-other-frame' and steal appropriate key bindings.
+
+(defun quack-find-file ()
+ ;; TODO: Hangup/delay problems in mega-huge files.
+ ;;
+ ;; TODO: Handle `(load <filename>)'
+ (interactive)
+ (let* ((default (quack-find-file-default))
+ (entry (let ((insert-default-directory (if default
+ nil
+ insert-default-directory)))
+ (read-file-name
+ (if default
+ (format "Quack find file (default %S): "
+ (quack-shorter-file-relative-name
+ default
+ default-directory))
+ "Quack find file: ")
+ default-directory
+ default))))
+ (find-file (if (string= entry "")
+ (or default "")
+ entry))))
+
+(defun quack-find-file-default ()
+ (or (quack-pltrequire-at-point-filename)
+ ;; TODO: Add support for syntax from Guile, SLIB, Chicken, etc.
+ ))
+
+;; TODO: Guile `:use-module' support. Forget about 1.4, and do 1.6.
+;;
+;; (defun quack-guilecolonusemodule-at-point-data ()
+;; (save-match-data
+;; (when (thing-at-point-looking-at
+;; ":use-module[ \t]+\\(([^][()\"#'`,]+)\\)")
+;; (condition-case nil
+;; (car (read-from-string (buffer-substring-no-properties
+;; (match-beginning 1) (match-end 1))))
+;; (error nil)))))
+;;
+;; ;; (define-module (ice-9 expect) :use-module (ice-9 regex))
+
+;; TODO: Guile 1.6 `use-modules' and `use-syntax' support.
+;;
+;; (use-modules (ice-9 regex))
+;;
+;; (use-modules ((ice-9 popen)
+;; :select ((open-pipe . pipe-open) close-pipe)
+;; :renamer (symbol-prefix-proc 'unixy:)))
+;;
+;; (use-modules { SPEC }+ )
+;;
+;; SPEC ::= MODULE-NAME | (MODULE-NAME [:select SELECTION] [:renamer RENAMER])
+;;
+;; (use-syntax MODULE-NAME)
+
+;; TODO: Support SLIB-style `require' forms:
+;;
+;; (require 'foo)
+
+;; TODO: Bigloo `import' and maybe `extern' support.
+;;
+;; ;; /usr/share/doc/bigloo-examples/examples/Foreign/
+;; (module example
+;; (import (bis foreign2 "foreign2.scm"))
+;; ...)
+;;
+;; ;; /usr/share/doc/bigloo-examples/examples/Fork/
+;; (module sys-example
+;; (extern (include "sys/types.h")
+;; (include "wait.h")
+;; (include "unistd.h")
+;; ...))
+
+;; TODO: PLT module language syntax: (module info (lib "infotab.ss" "setup")
+
+(defconst quack-pltrequire-at-point-data-re
+ (quack-re-alt "dynamic-require"
+ (concat "require"
+ (quack-re-alt "-for-syntax"
+ ""))))
+
+(defconst quack-pltrequire-at-point-data-1-re
+ (concat quack-pltrequire-at-point-data-re
+ "\\>"))
+
+(defconst quack-pltrequire-at-point-data-2-re
+ (concat "[^\r\n]*[[(]"
+ quack-pltrequire-at-point-data-re
+ "[ \t]+\\([^\r\n]+\\)"))
+
+(defun quack-pltrequire-at-point-data-1 ()
+ (save-match-data
+ (let ((qpss (quack-parent-sexp-search quack-pltrequire-at-point-data-1-re
+ 4)))
+ (when qpss
+ (let ((child-start (nth 2 qpss)))
+ (when child-start
+ (save-excursion
+ (goto-char child-start)
+ (condition-case nil
+ ;; Note: It is normally OK to use the Elisp reader here.
+ (read (current-buffer))
+ (error nil)))))))))
+
+(defun quack-pltrequire-at-point-data-2 ()
+ (save-match-data
+ (when (thing-at-point-looking-at quack-pltrequire-at-point-data-2-re)
+ (let* ((read-start (match-beginning 2))
+ (parts-pt (- (point) read-start))
+ (parts (buffer-substring-no-properties read-start
+ (match-end 2)))
+ (parts-len (length parts))
+ (start 0)
+ (result '()))
+ (condition-case nil
+ (while (< start parts-len)
+ ;; Note: It is normally OK to use the Elisp reader here.
+ (let ((r (read-from-string parts start)))
+ (when (or (not result) (> parts-pt start))
+ (setq result (car r)))
+ (setq start (cdr r))))
+ (error nil))
+ result))))
+
+(defun quack-pltrequire-at-point-filename (&optional silent)
+ (let* ((d (or (quack-pltrequire-at-point-data-1)
+ (quack-pltrequire-at-point-data-2)))
+ (m (cond
+ ((not d) nil)
+ ((stringp d) d)
+ ((listp d)
+ (let ((f (car d)))
+ (when (symbolp f)
+ (cond ((memq f '(file lib)) d)
+ ((memq f '(all-except rename)) (nth 1 d))
+ ((memq f '(prefix prefix-all-except)) (nth 2 d)))))))))
+ (cond
+ ((stringp m) m)
+ ((listp m)
+ (let ((f (car m)))
+ (when (symbolp f)
+ (cond ((eq f 'file) (nth 1 f))
+ ((eq f 'lib)
+ (let* ((file (nth 1 m))
+ (collect (or (nth 2 m) "mzlib"))
+ (collect-dir (quack-dir-for-pltcollect collect))
+ (subs (nthcdr 3 m)))
+ (when file
+ (if collect-dir
+ (quack-expand-file-name (nconc subs (list file))
+ collect-dir)
+ (unless silent
+ (quack-warning "Cannot find collection %S" collect))
+ nil)))))))))))
+
+;; Indenting Newline:
+
+(defun quack-newline (&optional arg)
+ (interactive "*P")
+ (if (eq quack-newline-behavior 'newline)
+ (newline arg)
+ (if (eq quack-newline-behavior 'indent-newline-indent)
+ (lisp-indent-line)
+ (unless (eq quack-newline-behavior 'newline-indent)
+ (error "invalid quack-newline-behavior value: %s"
+ quack-newline-behavior)))
+ (let ((n (prefix-numeric-value arg)))
+ (when (> n 0)
+ (while (> n 0)
+ (setq n (1- n))
+ (quack-delete-horizontal-space t)
+ (newline))
+ (lisp-indent-line)))))
+
+;; Agreeing-Paren Insert:
+
+;; TODO: Make paren-matching within comments limit seaching to within comments,
+;; not skip back and try to match code. One workaround is to prefix
+;; parents/brackets in comments with backslash.
+
+(defun quack-insert-closing (prefix default-close other-open other-close)
+ (insert default-close)
+ (unless prefix
+ (let ((open-pt (condition-case nil
+ (scan-sexps (point) -1)
+ (error (beep) nil))))
+ (when open-pt
+ (let ((open-char (aref (buffer-substring-no-properties
+ open-pt (1+ open-pt))
+ 0)))
+ (when (= open-char other-open)
+ (delete-backward-char 1)
+ (insert other-close))))))
+ (when blink-paren-function (funcall blink-paren-function)))
+
+(defun quack-insert-closing-paren (&optional prefix)
+ (interactive "P")
+ (quack-insert-closing prefix ?\) ?\[ ?\]))
+
+(defun quack-insert-closing-bracket (&optional prefix)
+ (interactive "P")
+ (quack-insert-closing prefix ?\] ?\( ?\)))
+
+;; Opening-Paren Insert:
+
+(defun quack-insert-opening (prefix char)
+ (insert (if (or prefix (not quack-smart-open-paren-p)) char ?\())
+ (when blink-paren-function (funcall blink-paren-function)))
+
+(defun quack-insert-opening-paren (&optional prefix)
+ (interactive "P")
+ (quack-insert-opening prefix ?\())
+
+(defun quack-insert-opening-bracket (&optional prefix)
+ (interactive "P")
+ (quack-insert-opening prefix ?\[))
+
+;; Definition Lambda Syntax Toggling:
+
+(defconst quack-toggle-lambda-re-1
+ (concat "define\\*?"
+ (quack-re-alt "-for-syntax"
+ "-public"
+ "/override"
+ "/private"
+ "/public"
+ "")))
+
+(defconst quack-toggle-lambda-re-2
+ (let ((ws-opt "[ \t\r\n\f]*")
+ (symbol "[^][() \t\r\n\f]+")
+ (open-paren "[[(]")
+ (close-paren "[])]"))
+ (concat ws-opt
+ (quack-re-alt ; #=1
+ (concat "\\(" ; #<2 `NAME (lambda ('
+ "\\(" ; #<3 name
+ symbol
+ "\\)" ; #>3
+ ws-opt
+ open-paren
+ ws-opt
+ "lambda"
+ ws-opt
+ open-paren
+ ws-opt
+ "\\)")
+ (concat "\\(" ; #<4 `(NAME'
+ open-paren
+ ws-opt
+ "\\(" ; #<5 name
+ symbol
+ "\\)" ; #>5
+ ws-opt
+ "\\)"))
+ "\\(" ; #<6 optional close paren
+ close-paren
+ "\\)?" ; #>6
+ )))
+
+(defun quack-toggle-lambda ()
+ (interactive)
+ (save-match-data
+ (let ((found (quack-parent-sexp-search quack-toggle-lambda-re-1))
+ last-paren-marker
+ leave-point-marker)
+ (unless found
+ (error "Sorry, this does not appear to be a definition form."))
+ (unwind-protect
+ (let ((lexeme-end (nth 1 found))
+ (define-beg (nth 3 found)))
+
+ ;; Make the markers.
+ (setq last-paren-marker (make-marker))
+ (setq leave-point-marker (point-marker))
+
+ ;; Move to right after the define form keyword, and match the
+ ;; pattern of the two possible syntaxes. Error if no match.
+ (goto-char lexeme-end)
+ (unless (looking-at quack-toggle-lambda-re-2)
+ (error "Sorry, we can't grok this definition syntax."))
+
+ ;; Pattern matched, so find the closing paren of the define form.
+ (let ((pt (condition-case nil
+ (scan-sexps define-beg 1)
+ (error ; scan-error
+ nil))))
+ (if pt
+ (set-marker last-paren-marker (1- pt))
+ (quack-warning
+ "This definition form sexp is unclosed. Consider undo.")))
+
+ ;; Now act based on which syntax we saw.
+ (cond
+
+ ((match-beginning 2)
+ ;; We saw the syntax `NAME (lambda ('.
+ (let ((name (quack-match-string-no-properties 3)))
+ (when (marker-position last-paren-marker)
+ (goto-char last-paren-marker)
+ (let ((victim-beg (quack-looking-at-close-paren-backward)))
+ (unless victim-beg
+ (error "This definition form should end with `))'."))
+ (delete-region victim-beg (point))))
+ (goto-char lexeme-end)
+ (delete-region lexeme-end (match-end 2))
+ (insert " (" name (if (match-beginning 6) "" " "))))
+
+ ((match-beginning 4)
+ ;; We saw the syntax `(NAME'.
+ (let ((name (quack-match-string-no-properties 5)))
+ (when (marker-position last-paren-marker)
+ (goto-char last-paren-marker)
+ (insert ")"))
+ (goto-char lexeme-end)
+ (delete-region lexeme-end (match-end 4))
+ (insert " " name "\n")
+ (set-marker leave-point-marker (point))
+ (insert "(lambda (")
+ (set-marker-insertion-type leave-point-marker t)))
+
+ (t (quack-internal-error)))
+
+ ;; Reindent, which also takes care of font-lock updating of deleted
+ ;; and inserted text.
+ (indent-region define-beg
+ (or (marker-position last-paren-marker)
+ (max (marker-position leave-point-marker)
+ (point)))
+ nil))
+
+ ;; unwind-protect cleanup
+ (goto-char (marker-position leave-point-marker))
+ (set-marker leave-point-marker nil)))))
+
+;; Buffer Tidying:
+
+;; TODO: Maybe have an option to automatically tidy the buffer on save. Make
+;; default off. This can be slow for larger buffers on older computers,
+;; especially if font-lock is activated. It can also annoy people who
+;; have a CM system full of improperly formatted files, or who like
+;; things like formfeed characters in their files.
+
+(defun quack-delete-all-in-buffer (regexp &optional subexp)
+ (unless subexp (setq subexp 0))
+ ;; Note: This moves the point and changes the match data.
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (goto-char (match-end subexp))
+ (delete-region (match-beginning subexp) (point))))
+
+(defun quack-tidy-buffer ()
+
+ ;; TODO: Make sure this works with odd eol conventions and the various
+ ;; codeset representations in various versions of Emacs.
+
+ ;; TODO: Maybe detect DrScheme ASCII-art "big letters" and protect them from
+ ;; reindenting.
+
+ "Tidy the formatting of the current Scheme buffer.
+
+This reindents, converts tabs to spaces, removes trailing whitespace on lines,
+removes formfeed characters, removes extraneous blank lines, and makes sure
+the buffer ends with a newline.
+
+This can conceivably corrupt multi-line string literals, but not in any way
+they wouldn't be corrupted by Usenet, various mailers, typesetting for print,
+etc.
+
+This may also result in large diffs when the tidied file is commited back to a
+version control or configuration management system. Consider making a VC or CM
+delta that consists only of changes made by `quack-tidy-buffer'."
+ (interactive)
+ (if (= (point-min) (point-max))
+ (message "Buffer is empty; no tidying necessary.")
+ (let ((marker (point-marker))
+ (fill-prefix nil))
+ (unwind-protect
+ (save-excursion
+ (save-match-data
+ (quack-activity
+ "Tidying buffer"
+
+ ;; Make sure last character is a newline.
+ (unless (string= "\n" (buffer-substring-no-properties
+ (1- (point-max))
+ (point-max)))
+ (goto-char (point-max))
+ (insert "\n"))
+
+ ;; Remove form-feed characters.
+ (quack-delete-all-in-buffer "\f")
+
+ ;; Reindent buffer (without inserting any new tabs).
+ ;; Note: This is the time-consuming pass.
+ (let ((saved-indent-tabs-mode indent-tabs-mode))
+ (unwind-protect
+ (progn (setq indent-tabs-mode nil)
+ (indent-region (point-min) (point-max) nil))
+ ;; unwind-protect cleanup
+ (setq indent-tabs-mode saved-indent-tabs-mode)))
+
+ ;; Expand any remaining tabs.
+ (untabify (point-min) (point-max))
+
+ ;; Remove trailing whitespace on each line.
+ (quack-delete-all-in-buffer "\\([ \t\r]+\\)\n" 1)
+
+ ;; Remove blank lines from top.
+ (goto-char (point-min))
+ (when (looking-at "[ \t\r\n]+")
+ (delete-region (match-beginning 0) (match-end 0)))
+
+ ;; Remove excess adjacent blank lines.
+ (quack-delete-all-in-buffer "\n\n\\(\n+\\)" 1)
+
+ ;; Remove blank lines from bottom.
+ (goto-char (point-max))
+ (when (quack-looking-at-backward
+ "\n\\(\n\\)"
+ (max (point-min) (- (point-max) 3)))
+ (delete-region (match-beginning 1) (match-end 1))))))
+
+ ;; unwind-protect cleanup
+ (goto-char (marker-position marker))
+ (set-marker marker nil)))))
+
+;; SRFIs:
+
+;; TODO: Archive local copies of SRFIs? Have to update them when modified, but
+;; without unnecessarily downloading from the master site. This is
+;; doable with wget mirroring, but not with things like "lynx -source".
+
+(defconst quack-srfi-subindex-kinds '(draft final withdrawn)
+ "List of symbols representing the three possible states of an SRFI (`draft',
+`final', and `withdrawn'), in order of increasing precedence (e.g., final
+follows draft,since a final version supercedes a draft version).")
+
+(defvar quack-srfi-completes-cache 'invalid)
+(defvar quack-srfi-menu-cache 'invalid)
+
+(defun quack-srfi-completes ()
+ (when (eq quack-srfi-completes-cache 'invalid)
+ (quack-process-srfi-subindex-files))
+ quack-srfi-completes-cache)
+
+(defun quack-srfi-menu (&optional noninteractive)
+ (when (eq quack-srfi-menu-cache 'invalid)
+ (quack-process-srfi-subindex-files noninteractive))
+ quack-srfi-menu-cache)
+
+(defun quack-srfi-master-url (path)
+ (quack-build-url quack-srfi-master-base-url path))
+
+(defun quack-srfi-subindex-master-url (kind)
+ (quack-srfi-master-url (list (quack-srfi-subindex-basename kind))))
+
+(defun quack-srfi-dir ()
+ (file-name-as-directory (expand-file-name "srfi" quack-dir)))
+
+(defun quack-srfi-subindex-file (kind)
+ (expand-file-name (quack-srfi-subindex-basename kind) (quack-srfi-dir)))
+
+(defun quack-srfi-subindex-basename (kind)
+ (format "%S-srfis.html" kind))
+
+(defun quack-invalidate-srfi-index-caches ()
+ (setq quack-srfi-completes-cache 'invalid)
+ (setq quack-srfi-menu-cache 'invalid))
+
+(defun quack-update-srfi-index ()
+ (interactive)
+ (quack-activity
+ "Updating SRFI index"
+ (quack-download-srfi-subindex-files)))
+
+(defun quack-download-srfi-subindex-files ()
+ (quack-invalidate-srfi-index-caches)
+ (mapcar (function
+ (lambda (kind)
+ (quack-activity
+ (format "Downloading %s SRFI subindex" kind)
+ (quack-web-get-to-file (quack-srfi-subindex-master-url kind)
+ (quack-srfi-subindex-file kind)))))
+ quack-srfi-subindex-kinds))
+
+(defun quack-download-srfi-subindex-files-if-missing ()
+ (let ((missing '()))
+ (mapcar (function
+ (lambda (kind)
+ (unless (file-exists-p (quack-srfi-subindex-file kind))
+ (setq missing (nconc missing (list kind))))))
+ quack-srfi-subindex-kinds)
+ (when (and missing
+ (y-or-n-p "Some cached SRFI subindexes are missing. Update? "))
+ (quack-update-srfi-index))))
+
+(defun quack-process-srfi-subindex-files (&optional noninteractive)
+ (let ((index '())
+ (completes '())
+ (menu (mapcar (function (lambda (kind) (cons kind nil)))
+ quack-srfi-subindex-kinds)))
+
+ ;; Invalidate dependent caches.
+ (quack-invalidate-srfi-index-caches)
+
+ ;; Give user a chance to download any missing cache files all at once,
+ ;; instead of prompting individually later.
+ (unless noninteractive
+ (quack-download-srfi-subindex-files-if-missing))
+
+ ;; Parse the index files, letting entries for successive states supercede.
+ (mapcar (function
+ (lambda (kind)
+ (mapcar (function
+ (lambda (new)
+ (let (old)
+ (if (setq old (assq (car new) index))
+ (setcdr old (cdr new))
+ (setq index (cons new index))))))
+ (quack-parse-srfi-subindex-file kind noninteractive))))
+ quack-srfi-subindex-kinds)
+
+ ;; Sort the parse form in reverse order, since the cache-building functions
+ ;; will reverse this.
+ (setq index (sort index (function (lambda (a b) (>= (car a) (car b))))))
+
+ ;; Build the completions and menu caches.
+ (let ((fmt (concat "%"
+ (if index
+ (number-to-string
+ (length (number-to-string (car (car index)))))
+ "")
+ "d %s")))
+ (mapcar (function
+ (lambda (n)
+ (let ((num (nth 0 n))
+ (kind (nth 1 n))
+ (title (nth 2 n)))
+ (unless kind (quack-internal-error))
+ (setq completes
+ (cons (cons (if (eq kind 'final)
+ (format "%d %s" num title)
+ (format "%d [%s] %s" num kind title))
+ num)
+ completes))
+ (let ((pair (or (assq kind menu)
+ (quack-internal-error))))
+ (setcdr pair (cons `[,(format fmt num title)
+ (quack-view-srfi ,num)]
+ (cdr pair)))))))
+ index))
+
+ ;; Finish the menu.
+ (mapcar (function (lambda (n)
+ (setcar n (cdr (assoc (car n)
+ '((draft . "Draft")
+ (final . "Final")
+ (withdrawn . "Withdrawn")))))
+ ;; Add dummy content so that XEmacs 21 will display
+ ;; the submenu label.
+ (unless (cdr n)
+ (setcdr n (cons "(None)" nil)))))
+ menu)
+ (setq menu `(["Update SRFI Index" quack-update-srfi-index]
+ "---"
+ ,@menu
+ ["Other SRFI..." quack-view-srfi]))
+
+ ;; Store the results.
+ (setq quack-srfi-menu-cache menu)
+ (setq quack-srfi-completes-cache completes)))
+
+(defun quack-parse-srfi-subindex-file (kind &optional noninteractive)
+ (save-excursion
+ (let ((file (quack-srfi-subindex-file kind)))
+ (unless (file-exists-p file)
+ (error "No SRFI index file %S" file))
+ (let* ((buf (get-file-buffer file))
+ (already-visiting-p buf))
+ (unless buf
+ (setq buf (find-file-noselect file t t)))
+ (unwind-protect
+ (progn (set-buffer buf)
+ (quack-parse-srfi-subindex-buffer kind))
+ ;; unwind-protect-cleanup
+ (unless already-visiting-p
+ (kill-buffer buf)))))))
+
+(defconst quack-parse-srfi-index-buffer-re-1
+ (concat
+ "<LI><A HREF=\"?srfi-[0-9]+/?\"?>SRFI[ \t]+"
+ "\\([0-9]+\\)" ; #=1 srfi number
+ "</A>:?[ \t]*"
+ "\\(" ; #<2 srfi title
+ ; #=3
+ (quack-re-alt "[^\r\n<>]" "</?[a-z]+>")
+ "+"
+ "\\)"))
+
+(defun quack-parse-srfi-subindex-buffer (kind)
+ (save-excursion
+ (let ((case-fold-search t)
+ (alist '()))
+ (goto-char (point-min))
+ (while (re-search-forward quack-parse-srfi-index-buffer-re-1 nil t)
+ (let ((number (string-to-number (quack-match-string-no-properties 1)))
+ (title (quack-without-side-whitespace
+ (quack-strip-limited-html-tags
+ (quack-match-string-no-properties 2)))))
+ (setq alist (cons
+
+ ;;(cons number
+ ;; (if (and kind (not (eq kind 'final)))
+ ;; (format "[%s] %s" kind title)
+ ;; title))
+ (list number kind title)
+
+ alist))))
+ (setq alist (reverse alist)))))
+
+(defun quack-srfi-num-url (num)
+ (quack-srfi-master-url (list (format "srfi-%d" num)
+ (format "srfi-%d.html" num))))
+
+(defconst quack-srfi-num-at-point-re-1
+ "srfi[-: \t]*\\([0-9]+\\)")
+
+(defconst quack-srfi-num-at-point-re-2
+ ;; Note: We can't have "[^\r\n]*" as a prefix, since it's too slow.
+ (concat quack-srfi-num-at-point-re-1 "[^\r\n]*"))
+
+(defun quack-srfi-num-at-point ()
+ ;; TODO: Make this get the nearest SRFI number in all cases.
+ (save-match-data
+ (let ((case-fold-search t))
+ (cond ((thing-at-point-looking-at quack-srfi-num-at-point-re-1)
+ (string-to-number (quack-match-string-no-properties 1)))
+ ((thing-at-point-looking-at "[0-9]+")
+ (string-to-number (quack-match-string-no-properties 0)))
+ ((thing-at-point-looking-at quack-srfi-num-at-point-re-2)
+ (string-to-number (quack-match-string-no-properties 1)))
+ ((let ((str (quack-line-at-point)))
+ (when (string-match quack-srfi-num-at-point-re-1 str)
+ (string-to-number
+ (quack-match-string-no-properties 1 str)))))))))
+
+(defun quack-view-srfi (num)
+ (interactive (list (quack-srfi-num-prompt "View SRFI number")))
+ (when num
+ (unless (and (integerp num) (>= num 0))
+ (error "Not a valid SRFI number: %S" num))
+ (quack-browse-url (quack-srfi-num-url num))))
+
+(defun quack-srfi-num-prompt (prompt)
+ (let* ((completes (quack-srfi-completes))
+ (default (quack-srfi-num-at-point))
+ (input (quack-without-side-whitespace
+ (completing-read
+ (if default
+ (format "%s (default %d): " prompt default)
+ (concat prompt ": "))
+ completes)))
+ v)
+ (cond ((or (not input) (string= "" input)) default)
+ ((setq v (assoc input completes)) (cdr v))
+ ((and (setq v (condition-case nil
+ (string-to-number input)
+ (error nil)))
+ (integerp v)
+ (>= v 0))
+ v)
+ (t (error "Invalid SRFI number: %s" input)))))
+
+;; Doc Keyword Value Object:
+
+(defmacro quack-kw-get-syntax (o) `(aref ,o 0))
+(defmacro quack-kw-get-file (o) `(aref ,o 1))
+(defmacro quack-kw-get-fragment (o) `(aref ,o 2))
+
+(defmacro quack-kw-set-syntax (o v) `(aset ,o 0 ,v))
+(defmacro quack-kw-set-file (o v) `(aset ,o 1 ,v))
+(defmacro quack-kw-set-fragment (o v) `(aset ,o 2 ,v))
+
+;; Documentation Object:
+
+;; TODO: Rework these document representations once we know the different kinds
+;; of documents with which we'll be dealing.
+
+(defmacro quack-doc-get-type (o) `(aref ,o 0))
+(defmacro quack-doc-get-sym (o) `(aref ,o 1))
+(defmacro quack-doc-get-title (o) `(aref ,o 2))
+(defmacro quack-doc-get-loc (o) `(aref ,o 3))
+(defmacro quack-doc-get-kw-p (o) `(aref ,o 4))
+(defmacro quack-doc-get-start-url (o) `(aref ,o 5))
+(defmacro quack-doc-get-kw-base-url (o) `(aref ,o 6))
+(defmacro quack-doc-get-kw-file (o) `(aref ,o 7))
+(defmacro quack-doc-get-kw-hashtable (o) `(aref ,o 8))
+
+(defmacro quack-doc-set-type (o v) `(aset ,o 0 ,v))
+(defmacro quack-doc-set-sym (o v) `(aset ,o 1 ,v))
+(defmacro quack-doc-set-title (o v) `(aset ,o 2 ,v))
+(defmacro quack-doc-set-loc (o v) `(aset ,o 3 ,v))
+(defmacro quack-doc-set-kw-p (o v) `(aset ,o 4 ,v))
+(defmacro quack-doc-set-start-url (o v) `(aset ,o 5 ,v))
+(defmacro quack-doc-set-kw-base-url (o v) `(aset ,o 6 ,v))
+(defmacro quack-doc-set-kw-file (o v) `(aset ,o 7 ,v))
+(defmacro quack-doc-set-kw-hashtable (o v) `(aset ,o 8 ,v))
+
+(defun quack-manual-to-doc (manual)
+ ;; Accepts a user's manual preference object of the list form:
+ ;;
+ ;; (SYM TITLE LOC KW-P)
+ ;;
+ ;; and creates a manual doc object of the vector form:
+ ;;
+ ;; [manual SYM TITLE LOC KW-P START-URL KW-BASE-URL KW-FILE KW-P
+ ;; KEYWORDS]
+ ;;
+ ;; KEYWORDS is not populated here -- keywords importing for a manual happens
+ ;; the first time keyword searching is done for the manual."
+ (let ((sym (nth 0 manual))
+ (title (nth 1 manual))
+ (loc (nth 2 manual))
+ (kw-p (nth 3 manual))
+ (start-url nil)
+ (kw-file nil)
+ (kw-base nil))
+ (cond
+ ;; If the location is a string, then handle manual as simple URL.
+ ((stringp loc)
+ (setq start-url loc)
+ (when kw-p
+ (quack-warning "Quack can only use keywords for PLT manuals.")
+ (setq kw-p nil)))
+ ;; If the location is a symbol, handle manual as special.
+ ((symbolp loc)
+ (cond
+ ;; If the location is symbol `plt', handle manual as PLT bundled.
+ ((eq loc 'plt)
+ (let* ((plt-name (let ((s (symbol-name sym)))
+ (if (string-match "\\`plt-\\(.+\\)\\'" s)
+ (match-string 1 s)
+ s)))
+ (web-base (concat
+ "http://download.plt-scheme.org/doc/"
+ plt-name
+ "/"))
+ (index-name "index.htm")
+ (col-dirs quack-pltcollect-dirs))
+ ;; Search from the collection directories for keywords and index
+ ;; files. Note that we currently look for keywords files even if
+ ;; `kw-p' is false since we want to allow the user to dynamically
+ ;; enable and disable keywords searching for a particular manual
+ ;; without us having to change `quack-docs'.
+ (while (and col-dirs (not (and kw-file kw-base start-url)))
+ (let ((dir (expand-file-name plt-name
+ (expand-file-name "doc"
+ (car col-dirs)))))
+ (setq col-dirs (cdr col-dirs))
+ (when (file-directory-p dir)
+ (let* ((k-f (expand-file-name "keywords" dir))
+ (i-f (expand-file-name index-name dir))
+ (i-r (file-readable-p i-f)))
+ (if (file-readable-p k-f)
+ ;; Keywords file.
+ (if i-r
+ ;; Keywords file and index file. So, unless we
+ ;; already found a keywords base URL, set everything
+ ;; based on this directory. Note that we override
+ ;; any existing start URL because we prefer to use
+ ;; the same manual version for both keywords and
+ ;; non-keywords access.
+ (unless kw-base
+ (setq kw-file k-f)
+ (setq kw-base (quack-file-url dir nil))
+ (setq start-url (quack-file-url dir index-name)))
+ ;; Keywords file, but no index file. So, unless we
+ ;; already have a keywords file, set it to this one.
+ (unless kw-file
+ (setq kw-file k-f)))
+ ;; No keywords file. So, if there is an index file, and we
+ ;; don't already have one, then use this one.
+ (when (and i-r (not start-url))
+ (setq start-url (quack-file-url dir index-name))))))))
+ ;; If we didn't find a start URL, use the Web one.
+ (unless start-url
+ (setq start-url (concat web-base index-name)))
+ ;; Do we have a keywords file?
+ (if kw-file
+ ;; We have a keywords file, so set the keywords base to the Web
+ ;; if needed and desired. Note that we never use the keywords
+ ;; file from one directory with the HTML files from a different
+ ;; directory, on the assumption that a local copy of HTML missing
+ ;; a keywords file is suspect, and that the Web version is
+ ;; therefore preferable.
+ (when (or (eq quack-local-keywords-for-remote-manuals-p 'always)
+ (and (not kw-base)
+ quack-local-keywords-for-remote-manuals-p))
+ (setq kw-base web-base))
+ ;; We don't have a keywords file, so warn if the user wanted
+ ;; keywords for this manual.
+ (when kw-p
+ (quack-warning "Could not find keywords file for manual %S."
+ plt-name)))))
+ ;; The location is an unrecognized symbol, so just barf.
+ (t (quack-internal-error))))
+ ;; The location is something other than a string or symbol, so just barf.
+ (t (quack-internal-error)))
+ ;; We've populated all the variables for the location type, so return the
+ ;; representation.
+ (vector 'manual sym title loc kw-p start-url kw-base kw-file nil)))
+
+(defun quack-doc-keyword-lookup (doc keyword)
+ (let ((ht (or (quack-doc-get-kw-hashtable doc)
+ (progn (quack-doc-import-keywords doc)
+ (quack-doc-get-kw-hashtable doc)))))
+ (if ht
+ (quack-gethash keyword ht nil)
+ (quack-warning "No keywords for document \"%S\"."
+ (quack-doc-get-sym doc))
+ nil)))
+
+(defun quack-doc-import-keywords (doc)
+ (if (eq (quack-doc-get-loc doc) 'plt)
+ (quack-doc-import-plt-manual-keywords doc)
+ (quack-internal-error)))
+
+(defun quack-doc-import-plt-manual-keywords (doc)
+ ;; Reads in the predetermined keywords file for PLT manual `doc' object,
+ ;; populating the `kw-hashtable' field of the `doc' object. The format of
+ ;; each entry in the PLT keywords file is a list of 5 strings:
+ ;;
+ ;; (KEYWORD SYNTAX FILE FRAGMENT SECTION)
+ ;;
+ ;; The hashtable is keyed on the KEYWORD string, for which the value is
+ ;; usually a vector:
+ ;;
+ ;; [SYNTAX FILE-CONST FRAGMENT]
+ ;;
+ ;; where FILE-CONST is the FILE string registered with the `quack-strconst'
+ ;; to save memory on redundant strings.
+ ;;
+ ;; When more there is more than one entry for a given keyword, then the value
+ ;; of the hashtable entry for that keyword is a list of vectors, in the order
+ ;; in which they were derived from the original keywords file.
+ ;;
+ ;; These duplicate values may be duplicated or conflicting, as in:
+ ;;
+ ;; (["(regexp-match pattern input-port [start-k end-k output-port])"
+ ;; "mzscheme-Z-H-10.html" "%_kw_definitionregexp-match"]
+ ;; ["(regexp-match pattern string [start-k end-k output-port])"
+ ;; "mzscheme-Z-H-10.html" "%_kw_definitionregexp-match"])
+ ;;
+ ;; No attempt is made here to weed out any duplicate/conflicting entries --
+ ;; that behavior left up to the code that accesses the hashtable. For the
+ ;; example above, a command to display the syntax for the keyword would need
+ ;; to display both values. However, a command to view the documentation for
+ ;; the keyword would need only to display one Web page without querying the
+ ;; user, since both entries above point to the same page and fragment.
+ (quack-activity
+ (format "Importing keywords for manual %S" (quack-doc-get-sym doc))
+ (let (sexp)
+ (garbage-collect)
+ (condition-case err
+ (setq sexp (quack-read-sexp-file
+ (or (quack-doc-get-kw-file doc)
+ (quack-warning "Manual %S has no keywords file."
+ (quack-doc-get-sym doc)))))
+ (error (quack-warning "Problem importing keywords for manual %S: %s"
+ (quack-doc-get-sym doc) err)))
+ (when sexp
+ (garbage-collect)
+ (let ((ht (quack-make-hash-table :test 'equal
+ :size (length sexp)
+ :rehash-threshold 1.0)))
+ ;; Note: We make the hashtable equal to the length of the read list of
+ ;; keyword forms so that it will be at least large enough for all the
+ ;; keywords without being excessively overlarge, and without having to
+ ;; do resizes or a counting pass or intermediate representation. The
+ ;; hashtable will be a little larger than necessary when there are
+ ;; multiple keyword forms for the same keyword. In a test with
+ ;; MzScheme 200.2, the hashtable used/size for "mzscheme" manual was
+ ;; 489/502; for "mzlib", 245/257.
+ (quack-doc-set-kw-hashtable doc ht)
+ (mapcar (function
+ (lambda (raw-entry)
+ (let* ((kw (nth 0 raw-entry))
+ (new (vector (nth 1 raw-entry)
+ (quack-strconst (nth 2 raw-entry))
+ (nth 3 raw-entry)))
+ (old (quack-gethash kw ht nil)))
+ (quack-puthash
+ kw
+ (cond ((not old) new)
+ ((vectorp old) (list old new))
+ ((listp old) (nconc old (list new))))
+ ht))))
+ sexp))))))
+
+(defun quack-read-sexp-file (filename)
+ (save-excursion
+ (let* ((buf (generate-new-buffer "*quack-read-sexp-file*")))
+ (set-buffer buf)
+ (unwind-protect
+ (progn (insert-file-contents-literally filename)
+ (goto-char (point-min))
+ (read buf))
+ ;; unwind-protect cleanup
+ (kill-buffer buf)))))
+
+;; Documentation Database:
+
+(defvar quack-docs 'invalid)
+
+(defun quack-docs ()
+ (when (eq quack-docs 'invalid)
+ (quack-docs-build))
+ quack-docs)
+
+(defun quack-docs-build ()
+ (quack-activity
+ "Building Quack docs database"
+ (quack-invalidate-manuals-caches)
+ (setq quack-docs (mapcar 'quack-manual-to-doc quack-manuals))))
+
+(defun quack-docs-manual-lookup (sym)
+ (let ((docs (quack-docs))
+ (found nil))
+ (while (and docs (not found))
+ (let ((doc (car docs)))
+ (setq docs (cdr docs))
+ (when (eq (quack-doc-get-sym doc) sym)
+ (setq found doc))))
+ found))
+
+(defun quack-docs-manual-keyword-lookup (keyword)
+ (let ((results '()))
+ (mapcar (function
+ (lambda (doc)
+ (cond
+ ((not (quack-doc-get-kw-p doc)) nil)
+ ((not (quack-doc-get-kw-base-url doc))
+ (quack-warning "Manual %S has no HTML."
+ (quack-doc-get-sym doc)))
+ (t (let ((match (quack-doc-keyword-lookup doc keyword)))
+ (cond
+ ((not match) nil)
+ ((vectorp match)
+ (setq results (cons (cons doc match) results)))
+ ((listp match)
+ (mapcar (function
+ (lambda (m)
+ (setq results (cons (cons doc m) results))))
+ match))
+ (t (quack-internal-error))))))))
+ (quack-docs))
+ (reverse results)))
+
+;; Keyword Lookup Match Object:
+
+(defmacro quack-kwmatch-get-doc (o) `(car ,o))
+(defmacro quack-kwmatch-get-kw (o) `(cdr ,o))
+
+(defun quack-kwmatch-url (kwmatch)
+ (let ((doc (car kwmatch))
+ (kw (cdr kwmatch)))
+ (concat (quack-doc-get-kw-base-url doc)
+ (quack-quote-url-substring (quack-kw-get-file kw))
+ "#"
+ (quack-quote-url-substring (quack-kw-get-fragment kw) t))))
+
+;; Manual Viewing:
+
+(defun quack-view-manual (&optional sym)
+ "View a manual."
+ (interactive
+ (list
+ (let* ((completes (or (quack-manuals-completes)
+ (error
+ "Sorry, variable \"quack-manuals\" is empty.")))
+ (default "R5RS")
+ (input (let ((completion-ignore-case t))
+ (completing-read
+ (format "Quack Manual (default %S): " default)
+ completes nil t nil nil default))))
+ (cdr (or (assoc input completes)
+ (error "No manual %S." input))))))
+ (quack-activity
+ (format "Viewing manual \"%S\"" sym)
+ (quack-browse-url (or (quack-doc-get-start-url
+ (or (quack-docs-manual-lookup sym)
+ (error "Manual \"%S\" not found." sym)))
+ (error "Don't know a URL for manual \"%S\"." sym)))))
+
+(defvar quack-manuals-menu-cache 'invalid)
+(defvar quack-manuals-completes-cache 'invalid)
+
+(defun quack-invalidate-manuals-caches ()
+ (setq quack-docs 'invalid)
+ (setq quack-manuals-completes-cache 'invalid)
+ (setq quack-manuals-menu-cache 'invalid))
+
+;;(quack-invalidate-manuals-caches)
+
+;; This version maps completion strings to URLs.
+;; (defun quack-manuals-completes ()
+;; (when (eq quack-manuals-completes-cache 'invalid)
+;; (let ((completes '()))
+;; (mapcar (function
+;; (lambda (doc)
+;; (let ((sym (quack-doc-get-sym doc))
+;; (url (quack-doc-get-start-url doc)))
+;; (setq completes
+;; (cons (cons (quack-doc-get-title doc) url)
+;; (cons (cons (symbol-name sym) url)
+;; completes))))))
+;; (quack-docs))
+;; (setq quack-manuals-completes-cache (reverse completes))))
+;; quack-manuals-completes-cache)
+
+(defun quack-manuals-completes ()
+ (when (eq quack-manuals-completes-cache 'invalid)
+ (let ((completes '()))
+ (mapcar (function
+ (lambda (doc)
+ (let ((sym (quack-doc-get-sym doc))
+ ;;(url (quack-doc-get-start-url doc))
+ )
+ (setq completes
+ (cons (cons (quack-doc-get-title doc) sym)
+ ;;(cons (cons (symbol-name sym) sym)
+ completes
+ ;;)
+ )))))
+ (quack-docs))
+ (setq quack-manuals-completes-cache (reverse completes))))
+ quack-manuals-completes-cache)
+
+(defun quack-manuals-menu ()
+ (when (eq quack-manuals-menu-cache 'invalid)
+ (setq quack-manuals-menu-cache
+ (mapcar (function
+ (lambda (manual)
+ (let ((sym (nth 0 manual))
+ (title (nth 1 manual)))
+ `[,title (quack-view-manual (quote ,sym))])))
+ quack-manuals)))
+ quack-manuals-menu-cache)
+
+(defun quack-manuals-webjump-sites ()
+ "Returns `webjump' entries for manuals in `quack-manuals'.
+
+Can be used in your `~/.emacs' file something like this:
+
+ (require 'quack)
+ (require 'webjump)
+ (require 'webjump-plus)
+ (setq webjump-sites
+ (append my-own-manually-maintained-webjump-sites
+ (quack-manuals-webjump-sites)
+ webjump-plus-sites
+ webjump-sample-sites))"
+ ;; TODO: Note what they should do if they are adding to plt collectsion dirs
+ ;; via custom settings but quack-manuals-webjump-sites is getting
+ ;; called before then.
+ (let ((result '())
+ (quack-quiet-warnings-p t))
+ (mapcar (function
+ (lambda (doc)
+ (let ((url (quack-doc-get-start-url doc)))
+ (when url
+ (setq result (cons (cons (quack-doc-get-title doc) url)
+ result))))))
+ (quack-docs))
+ result))
+
+;; Keyword Docs Viewing:
+
+;; TODO: Add doc lookup in PLT "doc.txt" files. A little tricky. Maybe make
+;; sure doc.txt is a long-term format first.
+
+(defun quack-view-keyword-docs (keyword)
+ ;; TODO: Don't prompt if all choices would result in the same URL.
+ (interactive (list (quack-prompt-for-keyword "View docs for keyword")))
+ (when (and keyword (stringp keyword) (not (string= keyword "")))
+ (let ((matches (quack-docs-manual-keyword-lookup keyword)))
+ (if (not matches)
+ (message "Sorry, no documentation found for keyword %S." keyword)
+ (quack-browse-url
+ (quack-kwmatch-url
+ (if (cdr matches)
+ (quack-prompt-for-kwmatch-choice "Which" matches)
+ (car matches))))))))
+
+(defun quack-keyword-at-point ()
+ ;; TODO: Make sure this reads all Scheme symbols -- it may currently only
+ ;; read valid Elisp symbols.
+ (let ((bounds (bounds-of-thing-at-point 'symbol)))
+ ;; In some cases (point at beginning of empty buffer?), `bounds' will be
+ ;; the bounds of an empty string, so check this.
+ (when bounds
+ (let ((beg (car bounds))
+ (end (cdr bounds)))
+ (when (/= beg end)
+ (buffer-substring-no-properties beg end))))))
+
+(defun quack-prompt-for-keyword (prompt)
+ (let* ((default (quack-keyword-at-point))
+ (history (list default)))
+ (read-string (if default
+ (format "%s (default %S): " prompt default)
+ (concat prompt ": "))
+ nil
+ ;; Note: Gratuitous reference to `history' eliminates warning
+ ;; from XEmacs 21 byte-compiler.
+ (if (and default history) 'history nil)
+ default)))
+
+(defun quack-prompt-for-kwmatch-choice (prompt kwmatch-list)
+ (let ((completes '()))
+ ;; Build the completion alist, ensure each key is unique.
+ (mapcar
+ (function
+ (lambda (kwmatch)
+ (let* ((kw (quack-kwmatch-get-kw kwmatch))
+ (orig-name (or (quack-kw-get-syntax kw)
+ (progn (quack-warning "No keyword syntax: %s"
+ kw)
+ "???")))
+ (name orig-name)
+ (name-tries 1))
+ ;; Ensure the name is unique within the completion list thus far.
+ (while (assoc name completes)
+ (setq name-tries (1+ name-tries))
+ (setq name (format "%s #%d" orig-name name-tries)))
+ ;; Prepend to the completion list (we'll reverse the list later).
+ (setq completes (cons (cons name kwmatch) completes)))))
+ kwmatch-list)
+ (setq completes (reverse completes))
+ ;; Prompt user and return selection.
+ (let* ((default (car (car completes)))
+ (read (let ((completion-ignore-case t))
+ (completing-read
+ (format "%s (default %S): " prompt default)
+ completes nil t nil nil default))))
+ (cdr (assoc read completes)))))
+
+;; Inferior Process:
+
+(defvar quack-run-scheme-prompt-history '())
+
+(defun quack-remember-program-maybe (program)
+ (when (and quack-remember-new-programs-p
+ (not (member program quack-programs)))
+ (quack-option-set 'quack-programs (cons program quack-programs) t)
+ (message "Remembering program %S." program)))
+
+(defun quack-run-scheme-prompt ()
+ (let* ((last (car quack-run-scheme-prompt-history))
+ (default (or (and quack-run-scheme-prompt-defaults-to-last-p
+ last)
+ quack-default-program
+ scheme-program-name
+ last
+ "mzscheme"))
+ (program (let ((minibuffer-allow-text-properties nil))
+ (completing-read
+ (concat "Run Scheme"
+ (if default
+ (format " (default %S)" default)
+ "")
+ ": ")
+ (quack-run-scheme-prompt-completion-collection)
+ nil nil nil
+ 'quack-run-scheme-prompt-history
+ default))))
+ (quack-remember-program-maybe program)
+ program))
+
+(defun quack-run-scheme-prompt-completion-collection ()
+ (let ((program-list quack-programs))
+ (mapcar (function (lambda (program)
+ (and program
+ (not (member program program-list))
+ (setq program-list (cons program program-list)))))
+ (list quack-default-program
+ scheme-program-name))
+ (mapcar (function (lambda (program) (cons program nil)))
+ program-list)))
+
+(defadvice run-scheme (around quack-ad-run first nil activate)
+ "Adds prompting for which Scheme interpreter program to run."
+ ;; We don't want to prompt if there's already a Scheme running, but it's
+ ;; possible for process to die between the comint check in `interactive' form
+ ;; of this advice and the comint check in the `run-scheme' function. We
+ ;; should override `run-scheme' altogether, but for now let's only call the
+ ;; original in the case that we do not detect a running Scheme.
+ (interactive (list (cond ((comint-check-proc "*scheme*") nil)
+ ((or current-prefix-arg
+ quack-run-scheme-always-prompts-p)
+ (quack-run-scheme-prompt))
+ (t quack-default-program))))
+ (if cmd
+ ;; We will assume there is no running Scheme, so... Since `run-scheme'
+ ;; calls `pop-to-buffer' rather than `switch-to-scheme', our options for
+ ;; Scheme process window management, such as putting the process buffer
+ ;; window in its own frame, do not take effect when the process buffer is
+ ;; displayed by `run-scheme'. So, unless we are using the `cmuscheme'
+ ;; window management behavior, we attempt to undo whatever window changes
+ ;; and buffer changes `run-scheme' makes, then just call
+ ;; `switch-to-scheme'. (This code will be revisited once we decide how
+ ;; to handle multiple Schemes, if not before then.)
+ (let ((buf (current-buffer))
+ (wg (current-window-configuration)))
+ ad-do-it
+ (unless (or (not quack-switch-to-scheme-method)
+ (eq quack-switch-to-scheme-method 'cmuscheme))
+ (set-window-configuration wg)
+ (set-buffer buf)
+ (switch-to-scheme t))
+ (message "Started Scheme: %s" scheme-program-name))
+ ;; There is a running Scheme, so don't call the `run-scheme' function at
+ ;; all -- just call `switch-to-scheme' or duplicate the `cmuscheme'
+ ;; package's `pop-to-buffer' behavior.
+ (if (or (not quack-switch-to-scheme-method)
+ (eq quack-switch-to-scheme-method 'cmuscheme))
+ (pop-to-buffer "*scheme*")
+ (switch-to-scheme t))
+ (message "Switched to running Scheme: %s" scheme-program-name)))
+
+(defadvice scheme-interactively-start-process (around
+ quack-ad-sisp
+ first
+ (&optional cmd)
+ activate)
+ ;; (save-window-excursion
+ (call-interactively 'run-scheme)
+ ;; )
+ )
+
+(defadvice scheme-proc (around quack-ad-scheme-proc first nil activate)
+ (condition-case nil
+ ad-do-it
+ (error (message "Oops, we must start a Scheme process!")
+ (call-interactively 'run-scheme)
+ (setq ad-return-value (scheme-proc)))))
+
+;; Switch-to-Scheme:
+
+(defun quack-force-frame-switch-to-window (win)
+ (let ((frame (window-frame win)))
+ (unless (eq frame (selected-frame))
+ (and window-system
+ quack-warp-pointer-to-frame-p
+ (set-mouse-position frame 0 0))
+ (select-frame frame))
+ (select-window win)))
+
+(defadvice switch-to-scheme (before quack-ad-switch last nil activate)
+ "Adds support for the `quack-switch-to-scheme-method' option."
+ ;; This can be done as before-advice since the `pop-to-buffer' that
+ ;; `switch-to-scheme' is using appears to always be a no-op when the target
+ ;; buffer is already the current buffer.
+ (require 'cmuscheme)
+ ;; The `eval' below is to avoid problems with the byte-compiler and advising.
+ ;; It doesn't seem to like: (and (boundp 'SYM) SYM)
+ (let ((repl-buf (eval '(and (boundp 'scheme-buffer)
+ scheme-buffer
+ (get-buffer scheme-buffer)))))
+ (cond ((not repl-buf)
+ (error (concat "No process current buffer."
+ " Set `scheme-buffer' or execute `run-scheme'")))
+
+ ((or (not quack-switch-to-scheme-method)
+ (eq quack-switch-to-scheme-method 'cmuscheme))
+ nil)
+
+ ((eq (current-buffer) repl-buf) nil)
+
+ ((eq quack-switch-to-scheme-method 'other-window)
+ (switch-to-buffer-other-window repl-buf))
+
+ ;; The following code may be revived if anyone reports problems with
+ ;; the use of `special-display-popup-frame'.
+ ;;
+ ;; ((eq quack-switch-to-scheme-method 'own-frame)
+ ;; (let ((pop-up-frames t)
+ ;; (same-window-buffer-names nil)
+ ;; (same-window-regexps nil)
+ ;; (special-display-buffer-names nil)
+ ;; (special-display-regexps nil))
+ ;; (switch-to-buffer (pop-to-buffer repl-buf))))
+
+ ((eq quack-switch-to-scheme-method 'own-frame)
+ (quack-force-frame-switch-to-window
+ (special-display-popup-frame repl-buf)))
+
+ (t (error "Invalid quack-switch-to-scheme-method: %S"
+ quack-switch-to-scheme-method)))))
+
+;; Customize:
+
+(defun quack-customize ()
+ "Customize the Quack package."
+ (interactive)
+ (customize-group 'quack))
+
+;; Auto Modes:
+
+(defun quack-add-auto-mode-alist (alist)
+ (setq auto-mode-alist
+ (append alist
+ (let ((retained '()))
+ (mapcar (function (lambda (pair)
+ (unless (assoc (car pair) alist)
+ (setq retained (cons pair retained)))))
+ auto-mode-alist)
+ (reverse retained)))))
+
+(quack-add-auto-mode-alist '(("\\.ccl\\'" . scheme-mode)
+ ("\\.rkt\\'" . scheme-mode)
+ ("\\.rktd\\'" . scheme-mode)
+ ("\\.sch\\'" . scheme-mode)
+ ("\\.scm\\'" . scheme-mode)
+ ("\\.ss\\'" . scheme-mode)
+ ("\\.stk\\'" . scheme-mode)
+ ("\\.stklos\\'" . scheme-mode)
+ ;;
+ ("/\\.mzschemerc\\'" . scheme-mode)
+ ;; Non-Scheme:
+ ("\\.plt\\'" . quack-pltfile-mode)))
+
+;; Syntax Table:
+
+(defmacro quack-str-syntax (str)
+ `(,(if (and quack-gnuemacs-p (>= emacs-major-version 21))
+ 'string-to-syntax
+ 'quack-kludged-string-to-syntax)
+ ,str))
+
+(defun quack-kludged-string-to-syntax (str)
+ (let* ((str-len (length str))
+ (code (aref str 0))
+ (matches (if (> str-len 1) (aref str 1)))
+ (result (cond ((= code 32) 0)
+ ((= code ?_) 3)
+ (t (quack-internal-error))))
+ (i 2))
+ (while (< i str-len)
+ (let ((c (aref str i)))
+ (setq i (1+ i))
+ (setq result (logior result
+ (lsh 1 (cond ((= c ?1) 16)
+ ((= c ?2) 17)
+ ((= c ?3) 18)
+ ((= c ?4) 19)
+ ((= c ?p) 20)
+ ((= c ?b) 21)
+ ((= c ?n) 21)
+ (t (quack-internal-error))))))))
+ (cons result (if (= matches 32) nil matches))))
+
+;; Note: We are assuming that it is better to endeavor to fontify all "#|"
+;; block comments as nestable rather than as unnestable, regardless of
+;; whether or not a user's target Scheme dialect supports nested.
+
+(defconst quack-pound-syntax-string (if quack-gnuemacs-p "_ p14bn" "_ p14b"))
+;; (defconst quack-bar-syntax-string (if quack-gnuemacs-p " 23bn" " 23b"))
+(defconst quack-bar-syntax-string (if quack-gnuemacs-p "_ 23bn" "_ 23b"))
+
+(defconst quack-pound-syntax (quack-str-syntax quack-pound-syntax-string))
+(defconst quack-bar-syntax (quack-str-syntax quack-bar-syntax-string))
+
+(modify-syntax-entry ?# quack-pound-syntax-string scheme-mode-syntax-table)
+(modify-syntax-entry ?| quack-bar-syntax-string scheme-mode-syntax-table)
+
+;; Note: Unclear why, but `scheme.el' in GNU Emacs 21.2 is doing
+;; `(set-syntax-table scheme-mode-syntax-table)' in whatever buffer is
+;; active at the time the Elisp package is loaded.
+
+;; Indent Properties:
+
+(put 'begin0 'scheme-indent-function 1)
+(put 'c-declare 'scheme-indent-function 0)
+(put 'c-lambda 'scheme-indent-function 2)
+(put 'case-lambda 'scheme-indent-function 0)
+(put 'catch 'scheme-indent-function 1)
+(put 'chicken-setup 'scheme-indent-function 1)
+(put 'class 'scheme-indent-function 'defun)
+(put 'class* 'scheme-indent-function 'defun)
+(put 'compound-unit/sig 'scheme-indent-function 0)
+(put 'define: 'scheme-indent-function 3)
+(put 'dynamic-wind 'scheme-indent-function 0)
+(put 'for/fold 'scheme-indent-function 2)
+(put 'instantiate 'scheme-indent-function 2)
+(put 'interface 'scheme-indent-function 1)
+(put 'lambda/kw 'scheme-indent-function 1)
+(put 'let*-values 'scheme-indent-function 1)
+(put 'let*: 'scheme-indent-function 'quack-let-colon-indent)
+(put 'let+ 'scheme-indent-function 1)
+(put 'let-values 'scheme-indent-function 1)
+(put 'let/ec 'scheme-indent-function 1)
+(put 'let: 'scheme-indent-function 'quack-let-colon-indent)
+(put 'match 'scheme-indent-function 1)
+(put 'mixin 'scheme-indent-function 2)
+(put 'module 'scheme-indent-function 'defun)
+(put 'module 'scheme-indent-function 2)
+(put 'module* 'scheme-indent-function 2)
+(put 'module+ 'scheme-indent-function 1)
+(put 'opt-lambda 'scheme-indent-function 1)
+(put 'parameterize 'scheme-indent-function 1)
+(put 'parameterize* 'scheme-indent-function 1)
+(put 'parameterize-break 'scheme-indent-function 1)
+(put 'quasisyntax/loc 'scheme-indent-function 1)
+(put 'receive 'scheme-indent-function 2)
+(put 'send* 'scheme-indent-function 1)
+(put 'sigaction 'scheme-indent-function 1)
+(put 'struct 'scheme-indent-function 1)
+(put 'sxml-match 'scheme-indent-function 1)
+(put 'syntax-case 'scheme-indent-function 2)
+(put 'syntax-parse 'scheme-indent-function 1)
+(put 'syntax/loc 'scheme-indent-function 1)
+(put 'unit 'scheme-indent-function 'defun)
+(put 'unit/sig 'scheme-indent-function 2)
+(put 'unless 'scheme-indent-function 1)
+(put 'when 'scheme-indent-function 1)
+(put 'while 'scheme-indent-function 1)
+(put 'with-handlers 'scheme-indent-function 1)
+(put 'with-method 'scheme-indent-function 1)
+(put 'with-syntax 'scheme-indent-function 1)
+
+(defun quack-let-colon-indent (state indent-point normal-indent)
+ ;; Note: This was adapted from "scheme.el" "scheme-let-indent".
+ (skip-chars-forward " \t")
+ (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
+ (lisp-indent-specform 4 state indent-point normal-indent)
+ (lisp-indent-specform 1 state indent-point normal-indent)))
+
+;; Keymaps:
+
+(defvar quack-scheme-mode-keymap nil)
+
+(setq quack-scheme-mode-keymap (make-sparse-keymap))
+
+;; TODO: Maybe have an option to also map the Ctrl variants of each of these
+;; keys to their respective bindings. As Eli pointed out, `C-c C-q C-x'
+;; is arguably easier to type than `C-c C-q x'. Actually, though, I
+;; don't like the `C-c C-q' prefix at all -- it signifies everything that
+;; is wrong with traditional modifier-happy Emacs keybindings. Maybe we
+;; should encourage users to set the prefix to some other key, like an
+;; unmodified function key.
+
+(define-key quack-scheme-mode-keymap "f" 'quack-find-file)
+(define-key quack-scheme-mode-keymap "k" 'quack-view-keyword-docs)
+(define-key quack-scheme-mode-keymap "m" 'quack-view-manual)
+(define-key quack-scheme-mode-keymap "r" 'run-scheme)
+(define-key quack-scheme-mode-keymap "s" 'quack-view-srfi)
+(define-key quack-scheme-mode-keymap "l" 'quack-toggle-lambda)
+(define-key quack-scheme-mode-keymap "t" 'quack-tidy-buffer)
+
+;; Menus:
+
+(defmacro quack-bool-menuitem (title var &rest rest)
+ (unless (stringp title) (quack-internal-error))
+ (unless (symbolp var) (quack-internal-error))
+ `[,title (quack-option-toggle (quote ,var)) :style toggle :selected ,var
+ ,@rest])
+
+(defmacro quack-radio-menuitems (var alist)
+ (unless (symbolp var) (quack-internal-error))
+ (unless (listp alist) (quack-internal-error))
+ `(quote ,(mapcar
+ (function (lambda (pair)
+ (let ((title (car pair))
+ (value (cdr pair)))
+ (unless (stringp title) (quack-internal-error))
+ (unless (symbolp value) (quack-internal-error))
+ `[,title
+ (quack-option-set (quote ,var) (quote ,value))
+ :style radio
+ :selected (eq ,var (quote ,value))])))
+ alist)))
+
+(defconst quack-browser-radio-alist
+ '((nil . "(Browse-URL Default)")
+ (browse-url-galeon . "Galeon")
+ (browse-url-mozilla . "Mozilla")
+ (browse-url-kde . "KDE Konqueror")
+ (browse-url-netscape . "Netscape Navigator")
+ (browse-url-w3 . "Emacs W3")
+ (w3m-browse-url . "W3M")
+ (quack-w3m-browse-url-other-window . "W3M (in other window)")
+ (browse-url-lynx-xterm . "Lynx in Xterm")
+ (browse-url-lynx-emacs . "Lynx in Emacs")
+ (browse-url-default-windows-browser . "MS Windows Default")))
+
+(defconst quack-global-menuspec
+ `("Quack"
+ ["About Quack..." quack-about]
+ ("Options"
+ ("Startup Options"
+ "These settings take full effect"
+ "once Emacs is restarted."
+ "---"
+ ,(quack-bool-menuitem "Put Quack on Global Menu Bar" quack-global-menu-p)
+ ,(quack-bool-menuitem "Remap Find-File Bindings"
+ quack-remap-find-file-bindings-p)
+ "---"
+ ["Quack Directory..." (customize-option 'quack-dir)]
+ ["Quack Scheme Mode Keymap Prefix..."
+ (customize-option 'quack-scheme-mode-keymap-prefix)])
+ "---"
+ ("Default Program" :filter quack-defaultprogram-menufilter)
+ ,(quack-bool-menuitem "Always Prompt for Program"
+ quack-run-scheme-always-prompts-p)
+ ,(quack-bool-menuitem "Program Prompt Defaults to Last"
+ quack-run-scheme-prompt-defaults-to-last-p)
+ ,(quack-bool-menuitem "Remember New Programs"
+ quack-remember-new-programs-p)
+ "---"
+ ("Newline Behavior"
+ ,@(quack-radio-menuitems
+ quack-newline-behavior
+ (("Newline" . newline)
+ ("Newline-Indent" . newline-indent)
+ ("Indent-Newline-Indent" . indent-newline-indent))))
+ ,(quack-bool-menuitem "Smart Open-Paren"
+ quack-smart-open-paren-p)
+ ("Switch-to-Scheme Method"
+ ,@(quack-radio-menuitems quack-switch-to-scheme-method
+ (("Other Window" . other-window)
+ ("Own Frame" . own-frame)
+ ("Cmuscheme Behavior" . cmuscheme)))
+ "---"
+ ,(quack-bool-menuitem
+ "Warp Pointer to Frame"
+ quack-warp-pointer-to-frame-p
+ :active (eq quack-switch-to-scheme-method 'own-frame)))
+ ("Fontification"
+ ,@(quack-radio-menuitems quack-fontify-style
+ (("PLT Style" . plt)
+ ("Extended GNU Emacs Style" . emacs)
+ ("Emacs Default" . nil)))
+ "---"
+ ,(quack-bool-menuitem "Pretty Lambda \(in PLT Style\)"
+ quack-pretty-lambda-p
+ :active (and quack-pretty-lambda-supported-p
+ (memq quack-fontify-style '(plt))))
+ ,(quack-bool-menuitem "Fontify Definition Names \(in PLT Style\)"
+ quack-pltish-fontify-definition-names-p
+ :active (eq quack-fontify-style 'plt))
+ ,(quack-bool-menuitem "Fontify Syntax Keywords \(in PLT Style\)"
+ quack-pltish-fontify-keywords-p
+ :active (eq quack-fontify-style 'plt))
+ ;; TODO: Add menuitem here for "Fontify #: Keywords \(in PLT Style\)"
+ ,(quack-bool-menuitem "Fontify 3-Semicolon Comments \(in PLT Style\)"
+ quack-fontify-threesemi-p
+ :active (memq quack-fontify-style '(plt)))
+ )
+ ("Web Browser"
+ ,@(mapcar (function
+ (lambda (n)
+ (let ((func (car n))
+ (title (cdr n)))
+ `[,title
+ (quack-option-set 'quack-browse-url-browser-function
+ (quote ,func))
+ :style radio
+ :selected ,(if (not func)
+ '(not quack-browse-url-browser-function)
+ `(eq quack-browse-url-browser-function
+ (quote ,func)))])))
+ quack-browser-radio-alist)
+ ["(Other)..."
+ (customize-option 'quack-browse-url-browser-function)
+ :style radio
+ :selected (not (assq quack-browse-url-browser-function
+ quack-browser-radio-alist))])
+ ,(quack-bool-menuitem "Tab Characters are Evil" quack-tabs-are-evil-p)
+ ("Local Keywords for Remote Manuals"
+ ,@(quack-radio-menuitems
+ quack-local-keywords-for-remote-manuals-p
+ (("Permit" . t)
+ ("Forbid" . nil)
+ ("Always" . always))))
+ ["PLT Collection Directories..."
+ (customize-option 'quack-pltcollect-dirs)]
+ "---"
+ ["Customize..." quack-customize])
+ "---"
+ ["Run Scheme" run-scheme]
+ ["Switch to Scheme Buffer" switch-to-scheme]
+ "---"
+ ("View Manual" :filter quack-view-manual-menufilter)
+ ("View SRFI" :filter quack-view-srfi-menufilter)
+ ["View Keyword Docs..." quack-view-keyword-docs]
+ ["Dired on PLT Collection..." quack-dired-pltcollect]))
+
+(defun quack-install-global-menu ()
+ (when quack-global-menu-p
+ (quack-when-gnuemacs
+ (unless (assq 'Quack menu-bar-final-items)
+ (setq menu-bar-final-items (cons 'Quack menu-bar-final-items)))
+ (easy-menu-define quack-global-menu global-map ""
+ quack-global-menuspec))
+ (quack-when-xemacs
+ ;; Die! Die! Die!
+ ;;(mapcar (function (lambda (n)
+ ;;(delete-menu-item '("Quack") n)
+ ;;(add-submenu nil quack-global-menuspec "Help" n)))
+ ;;(list
+ ;;;;current-menubar
+ ;;default-menubar
+ ;;))
+ (delete-menu-item '("Quack") current-menubar)
+ (add-submenu nil quack-global-menuspec "Help" current-menubar)
+ (set-menubar-dirty-flag))))
+
+;; TODO: We should make sure the user's custom settings have been loaded
+;; before we do this.
+(quack-install-global-menu)
+
+;; And die some more!
+;;(quack-when-xemacs (add-hook 'after-init-hook 'quack-install-global-menu))
+
+(defconst quack-scheme-mode-menuspec
+ `("Scheme"
+ ("Quack Global" ,@(cdr quack-global-menuspec))
+ "---"
+ ["Toggle Lambda Syntax" quack-toggle-lambda]
+ ["Tidy Buffer Formatting" quack-tidy-buffer]
+ ["Comment-Out Region" comment-region]
+ ["Un-Comment-Out Region" quack-uncomment-region]
+ "---"
+ ["Evaluate Last S-expression" scheme-send-last-sexp]
+ ["Evaluate Region" scheme-send-region]
+ ["Evaluate Region & Go" scheme-send-region-and-go]
+ ["Evaluate Last Definition" scheme-send-definition]
+ ["Evaluate Last Definition & Go" scheme-send-definition-and-go]
+ ["Compile Definition" scheme-compile-definition]
+ ["Compile Definition & Go" scheme-compile-definition-and-go]
+ ["Load Scheme File" scheme-load-file]
+ ["Compile Scheme File" scheme-compile-file]
+ "---"
+ ["View Keyword Docs..." quack-view-keyword-docs]
+ ["Quack Find File" quack-find-file]))
+
+(defvar quack-scheme-mode-menu)
+(quack-when-gnuemacs
+ (let ((map (make-sparse-keymap)))
+ (setq quack-scheme-mode-menu nil)
+ (easy-menu-define quack-scheme-mode-menu map ""
+ quack-scheme-mode-menuspec)
+ (define-key scheme-mode-map [menu-bar scheme]
+ (cons "Scheme"
+ (or (lookup-key map [menu-bar Scheme])
+ (lookup-key map [menu-bar scheme]))))))
+
+(defun quack-view-manual-menufilter (arg)
+ (quack-menufilter-return "quack-view-manual-menufilter-menu"
+ (quack-manuals-menu)))
+
+(defun quack-view-srfi-menufilter (arg)
+ (quack-menufilter-return
+ "quack-view-srfi-menufilter-menu"
+ (condition-case nil
+ (quack-srfi-menu t)
+ ;; TODO: Move the generation of this fallback menu down to
+ ;; quack-srfi-menu.
+ (error '(["Update SRFI Index" quack-update-srfi-index]
+ "---"
+ ("Draft" :active nil "")
+ ("Final" :active nil "")
+ ("Withdrawn" :active nil "")
+ ["Other SRFI..." quack-view-srfi])))))
+
+(defun quack-defaultprogram-menufilter (arg)
+ (quack-menufilter-return
+ "quack-defaultprogram-menufilter-menu"
+ `(,@(quack-optionmenu-items-setdefaultprogram)
+ "---"
+ ["Other Program..." quack-set-other-default-program]
+ "---"
+ ("Forget Program"
+ ,@(mapcar
+ (function
+ (lambda (program)
+ `[,(format "Forget %s" program)
+ (quack-forget-program ,program)]))
+ quack-programs)))))
+
+(defun quack-optionmenu-items-setdefaultprogram ()
+ (let* ((programs (quack-sort-string-list-copy quack-programs))
+ (add-default-p (and quack-default-program
+ (not (member quack-default-program programs)))))
+ (and add-default-p
+ (setq programs (cons quack-default-program programs)))
+ (mapcar
+ (function
+ (lambda (program)
+ (let* ((selected-p (and quack-default-program
+ (equal program quack-default-program))))
+ `[,(format "%s%s"
+ program
+ (if (and add-default-p
+ (equal program quack-default-program))
+ " (temporary)"
+ ""))
+ (quack-option-set 'quack-default-program ,program)
+ :style radio :selected ,selected-p])))
+ programs)))
+
+(mapcar (function (lambda (sym) (put sym 'menu-enable 'mark-active)))
+ '(comment-region
+ indent-region
+ quack-uncomment-region
+ scheme-send-region
+ scheme-send-region-and-go))
+
+;; Option Menu Callbacks:
+
+(defun quack-set-other-default-program ()
+ (interactive)
+ (let* ((minibuffer-allow-text-properties nil)
+ (program (quack-without-side-whitespace
+ (read-string "Other Default Program: "))))
+ (if (string= program "")
+ (message "Default program unchanged.")
+ (quack-remember-program-maybe program)
+ (quack-option-set 'quack-default-program
+ program))))
+
+(defun quack-forget-program (program)
+ (setq quack-programs (delete program quack-programs))
+ (quack-option-set 'quack-programs quack-programs t)
+ (message "Forgot program %S." program))
+
+(defun quack-custom-set (sym value)
+ ;; Clean up the value based on the variable symbol.
+ (cond ((eq sym 'quack-programs)
+ (setq value (quack-sort-string-list-copy value))))
+
+ ;; Set default binding. Set local binding just for the halibut, although if
+ ;; there are local bindings, then other things will likely break. \(We used
+ ;; to have a check here, but removed it while porting to XEmacs.\)
+ (set sym value)
+ (set-default sym value)
+
+ ;; TODO: Probably don't do this during Emacs initialization time, to avoid
+ ;; unnecessary behavior like:
+ ;;
+ ;; Loading ~/emacs/my-custom.el (source)...
+ ;; Updating Scheme Mode buffers...done
+ ;; Updating Scheme Mode buffers...done
+ ;; Updating Scheme Mode buffers...done
+ ;; Updating Scheme Mode buffers...done
+ ;; Updating Scheme Mode buffers...done
+ ;; Loading ~/emacs/my-custom.el (source)...done
+
+ ;; Update dependent program state.
+ (cond ((memq sym '(quack-emacsish-keywords-to-fontify
+ quack-fontify-style
+ quack-fontify-threesemi-p
+ quack-pltish-fontify-definition-names-p
+ quack-pltish-fontify-keywords-p
+ quack-pltish-keywords-to-fontify
+ quack-pretty-lambda-p))
+ (quack-update-scheme-mode-buffers))
+
+ ((eq sym 'quack-local-keywords-for-remote-manuals-p)
+ (quack-invalidate-manuals-caches))
+
+ ((eq sym 'quack-pltcollect-dirs)
+ (quack-invalidate-pltcollects-caches))))
+
+(defun quack-option-set (sym value &optional silently)
+ (if quack-options-persist-p
+ (customize-save-variable sym value)
+ (quack-custom-set sym value))
+ (or silently
+ (message "Set %s%s to: %S"
+ sym
+ (if quack-options-persist-p "" " (non-persistently)")
+ value)))
+
+(defun quack-option-toggle (sym &optional silently)
+ (quack-option-set sym (not (symbol-value sym)) t)
+ (or silently
+ (message "Set %s%s %s."
+ sym
+ (if quack-options-persist-p "" " (non-persistently)")
+ (if (symbol-value sym) "ON" "OFF"))))
+
+(defun quack-update-scheme-mode-buffers ()
+ (save-excursion
+ (quack-activity
+ "Updating Scheme Mode buffers"
+ (mapcar (function
+ (lambda (buf)
+ (set-buffer buf)
+ (when (eq major-mode 'scheme-mode)
+ (quack-activity (format "Updating buffer %S" (buffer-name))
+ (scheme-mode)))))
+ (buffer-list)))))
+
+;; Pretty Lambda:
+
+(defconst quack-lambda-char (make-char 'greek-iso8859-7 107))
+
+(defconst quack-pretty-lambda-supported-p
+ (and quack-gnuemacs-p (>= emacs-major-version 21)))
+
+;; Font Lock:
+
+(defconst quack-emacsish1-font-lock-keywords
+ `((,(concat "[[(]"
+ "\\(" ; #<1
+ "define\\*?"
+ ; #=2 #=3
+ (quack-re-alt (quack-re-alt ""
+ "-generic"
+ "-generic-procedure"
+ "-method"
+ "-public"
+ "/kw"
+ "/override"
+ "/private"
+ "/public")
+ ; #=4
+ (quack-re-alt "-macro"
+ "-syntax")
+ "-class"
+ "-module"
+ "-signature"
+ "-struct")
+ "\\)" ; #>1
+ "\\>"
+ "[ \t]*[[(]?"
+ ; #=5
+ "\\(\\sw+\\)?")
+ (1 font-lock-keyword-face)
+ (5 (cond ((match-beginning 3) font-lock-function-name-face)
+ ((match-beginning 4) font-lock-variable-name-face)
+ (t font-lock-type-face))
+ nil t))
+
+ ;; PLT module definitions.
+ ("[[(]\\(module\\)\\>[ \t]+\\(\\sw+\\)?"
+ (1 font-lock-keyword-face)
+ (2 font-lock-type-face nil t))))
+
+(defconst quack-emacsish2-font-lock-keywords
+ (append quack-emacsish1-font-lock-keywords
+ `(
+ ;; Misc. keywords.
+ (,(concat
+ "[[(]\\("
+ (regexp-opt quack-emacsish-keywords-to-fontify)
+ "\\)\\>")
+ . 1)
+ ;; Class specifiers in SOS, Stklos, Goops.
+ ("\\<<\\sw+>\\>" . font-lock-type-face)
+ ;; Colon keywords.
+ ("\\<:\\sw+\\>" . font-lock-builtin-face))))
+
+(defvar quack-pltish-font-lock-keywords nil)
+
+(defun quack-pltish-num-re (radix digit base16-p)
+ ;; These regexps started as a transliteration of the R5RS BNF to regular
+ ;; expressions, adapted for PLTisms, and with a few optimizations.
+ ;;
+ ;; PLTisms are that 'e' is not permitted as an exponent marker in base-16
+ ;; literals, and that "decimal-point" forms are permitted in any radix.
+ ;;
+ ;; There's obvious opportunity for further optimization, especially if we
+ ;; relax the accepted syntax a little. These regexps have not been tested
+ ;; much, but, since this is only Emacs syntax fontification, false-positives
+ ;; and false-negatives will be obvious yet benign.
+ (let* ((uint (concat digit "+#*"))
+ (sign "[-+]?")
+ (suffix (quack-re-optional (if base16-p "[sSfFdDlL]" "[eEsSfFdDlL]")
+ sign
+ "[0-9]+"))
+ (decimal (quack-re-alt
+ (concat uint suffix)
+ (concat "\\." digit "+#*" suffix)
+ (concat digit
+ "+"
+ (quack-re-alt (concat "\\." digit "*")
+ "#+\\.")
+ "#*")))
+ (ureal (quack-re-alt uint
+ (concat uint "/" uint)
+ decimal))
+ (real (concat sign ureal))
+ (complex (quack-re-alt
+ (concat real
+ (quack-re-alt (concat "@" real)
+ (quack-re-optional
+ "[-+]"
+ (quack-re-optional ureal)
+ "i")
+ ""))
+ (concat "[-+]" (quack-re-optional ureal) "i")))
+ (exact (quack-re-optional "#[eEiI]"))
+ (prefix (quack-re-alt (concat radix exact)
+ (concat exact radix))))
+ (concat "\\<" prefix complex "\\>")))
+
+(defconst quack-pltish-fls-base
+ `(
+ ("\\`\\(MrEd\\|Welcome to MzScheme\\) v[^\n]+" . quack-banner-face)
+ ("\\`Gambit Version 4\\.0[^\n]*" . quack-banner-face)
+ ("\\`Welcome to scsh [0-9][^\n]+\nType ,\\? for help[^\n]+"
+ . quack-banner-face)
+ ("\\`MIT/GNU Scheme running under [^\n]+" . quack-banner-face)
+ ;;("\\`; This is the CHICKEN interpreter - Version [^\n]+\n; (c)[^\n]+"
+ ;; . quack-banner-face)
+ ;;("\\`Scheme Microcode Version[^\n]+\nMIT Scheme[^\n]+\n\\([^\n]+\n\\)+" .
+ ;;quack-banner-face)
+ ;; Unix cookie line.
+ ("\\`#![^\r\n]*" . quack-pltish-comment-face)
+ ;; Colon keywords:
+ ("\\<#:\\sw+\\>" . quack-pltish-colon-keyword-face)
+ ;; Self-evals:
+ ("'\\sw+\\>" . quack-pltish-selfeval-face)
+ ("'|\\(\\sw\\| \\)+|" . quack-pltish-selfeval-face)
+ ;; Note: The first alternative in the following rule will misleadingly
+ ;; fontify some invalid syntax, such as "#\(x".
+ ("\\<#\\\\\\([][-`~!@#$%&*()_+=^{}\;:'\"<>,.?/|\\\\]\\|\\sw+\\>\\)"
+ . quack-pltish-selfeval-face)
+ ("[][()]" . quack-pltish-paren-face)
+ ("\\<#\\(t\\|f\\)\\>" . quack-pltish-selfeval-face)
+ ("\\<+\\(inf.0\\|nan\\)\\>" . quack-pltish-selfeval-face)
+ ("\\<-inf.0\\>" . quack-pltish-selfeval-face)
+ ,@(mapcar (function (lambda (args)
+ (cons (apply 'quack-pltish-num-re args)
+ 'quack-pltish-selfeval-face)))
+ '(("#b" "[01]" nil)
+ ("#o" "[0-7]" nil)
+ ("\\(#d\\)?" "[0-9]" nil)
+ ("#x" "[0-9a-fA-F]" t)))))
+
+(defconst quack-pltish-fls-defnames
+ ;; TODO: Optimize these once they're fairly complete and correct.
+
+ ;; TODO: Would be nice to fontify binding names everywhere they are
+ ;; introduced, such as in `let' and `lambda' forms. That may require
+ ;; real parsing to do reasonably well -- the kludges get too bad and
+ ;; slow, and font-lock gets in the way more than it helps.
+
+ `(
+ ;,@quack-pltish-font-lock-keywords
+
+ ;; Lots of definition forms that start with "define".
+ (,(concat "[[(]"
+ "define\\*?"
+ ;; TODO: make this into regexp-opt
+ (quack-re-alt ""
+ ":"
+ "-class"
+ "-class"
+ "-const-structure"
+ "-constant"
+ "-embedded"
+ "-entry-point"
+ "-external"
+ "-for-syntax"
+ "-foreign-record"
+ "-foreign-type"
+ "-foreign-variable"
+ "-generic"
+ "-generic-procedure"
+ "-inline"
+ "-location"
+ "-macro"
+ "-method"
+ "-opt"
+ "-parameters"
+ "-public"
+ "-reader-ctor"
+ "-record"
+ "-record-printer"
+ "-record-type"
+ "-signature"
+ "-structure"
+ "-syntax"
+ "-values"
+ "-values-for-syntax"
+ "/contract"
+ "/override"
+ "/private"
+ "/public")
+ "\\>"
+ "[ \t]*[[(]?"
+ "\\(\\sw+\\)")
+ (2 (let ((name (quack-match-string-no-properties 2)))
+ (if (= (aref name (1- (length name))) ?%)
+ quack-pltish-class-defn-face
+ quack-pltish-defn-face))
+ nil t))
+
+ ;; Racket "struct" and "define-struct" forms:
+ (,(concat "[[(]"
+ "\\(?:define-\\)?"
+ "struct"
+ "\\>"
+ "[ \t]*[[(]?"
+ "\\(\\sw+\\)")
+ ;; TODO: Use a struct face rather than the class face.
+ (1 quack-pltish-class-defn-face nil t))
+
+ ;; `defmacro' and related SCM forms.
+ (,(concat "[[(]def"
+ (quack-re-alt (concat "macro"
+ (quack-re-alt "" "-public"))
+ "syntax")
+ "\\>[ \t]+\\(\\sw+\\)")
+ 3 quack-pltish-defn-face nil t)
+
+ ;; `defmac' from SIOD.
+ ("[[(]defmac[ \t]+[[(][ \t]*\\(\\sw+\\)"
+ 1 quack-pltish-defn-face nil t)
+
+ ;; `defvar' and `defun' from SIOD.
+ (,(concat "[[(]def"
+ (quack-re-alt "un"
+ "var")
+ "[ \t]+\\(\\sw+\\)")
+ 2 quack-pltish-defn-face nil t)
+
+ ;; Guile and Chicken `define-module'.
+ ("[[(]define-module\\>[ \t]+[[(][ \t]*\\(\\sw+\\([ \t]+\\sw+\\)*\\)"
+ 1 quack-pltish-module-defn-face nil t)
+
+ ;; PLT `define-values', `define-syntaxes', and `define-syntax-set'.
+ (,(concat "[[(]define-"
+ (quack-re-alt "values" "syntax-set" "syntaxes")
+ "\\>[ \t]+[[(][ \t]*\\(\\sw+\\([ \t]+\\sw+\\)*\\)")
+ 2 quack-pltish-defn-face nil t)
+
+ ;; PLT `module'.
+ ("[[(]module\\>[ \t]+\\(\\sw+\\)"
+ 1 quack-pltish-module-defn-face nil t)
+
+ ;; Named `let'. (Note: This is disabled because it's too incongruous.)
+ ;;("[[(]let\\>[ \t]+\\(\\sw+\\)"
+ ;; 1 quack-pltish-defn-face nil t)
+ ))
+
+;; TODO: Adding PLT-style (quasi)quoted list fontifying is obviously not doable
+;; with just regexps. Probably requires either cloning
+;; `font-lock-default-fontify-region' just to get it to call our
+;; replacement syntactic pass fontification function, *or*
+;; before-advising `font-lock-fontify-keywords-region' to perform our
+;; syntactic pass when in scheme-mode, and around-advising
+;; `font-lock-fontify-syntactically-region' to not do anything for
+;; scheme-mode (or maybe setting `font-lock-keywords-only' to non-nil,
+;; unless that breaks something else). Or just ditch font-lock. See
+;; `font-lock-fontify-region-function' variable in font-lock specs.
+
+;; (defconst quack-pltish-fls-keywords
+;; `((,(concat
+;; "[[(]\\("
+;; (regexp-opt quack-pltish-keywords-to-fontify)
+;; "\\)\\>")
+;; (1 quack-pltish-keyword-face))))
+
+(defun quack-install-fontification ()
+
+ (when (eq quack-fontify-style 'plt)
+ (set (make-local-variable 'font-lock-comment-face)
+ 'quack-pltish-comment-face)
+ (set (make-local-variable 'font-lock-string-face)
+ 'quack-pltish-selfeval-face))
+
+ (let* ((sk `(("\\(#\\)\\(|\\)"
+ (1 ,quack-pound-syntax)
+ (2 ,quack-bar-syntax))
+ ("\\(|\\)\\(#\\)"
+ (1 ,quack-bar-syntax)
+ (2 ,quack-pound-syntax))))
+ (pl (if (and quack-pretty-lambda-supported-p quack-pretty-lambda-p)
+ '(("[[(]\\(case-\\|match-\\|opt-\\)?\\(lambda\\)\\>"
+ 2
+ (progn (compose-region (match-beginning 2)
+ (match-end 2)
+ quack-lambda-char)
+ nil)))
+ '()))
+ (threesemi
+ (if quack-fontify-threesemi-p
+ `(
+ (,(concat "^\\(\;\;\;\\)"
+ ;; TODO: Make this enforce space or newline after the
+ ;; three semicolons.
+ "\\("
+ "[ \t]*"
+ "\\("
+ "[^\r\n]*"
+ "\\)"
+ "\r?\n?\\)")
+ (1 quack-threesemi-semi-face prepend)
+ (2 quack-threesemi-text-face prepend)
+ ;;(4 quack-threesemi-h1-face prepend)
+ ;;(5 quack-threesemi-h2-face prepend)
+ )
+
+ ;; Funcelit:
+ ("^\;\;\; @\\(Package\\|section\\|unnumberedsec\\)[ \t]+\\([^\r\n]*\\)"
+ (2 quack-threesemi-h1-face prepend))
+ ("^\;\;\; @subsection[ \t]+\\([^\r\n]*\\)"
+ (1 quack-threesemi-h2-face prepend))
+
+ ;; semiscribble:
+ ("^\;\;\; package +\"\\([^\r\n\"]*\\)\" *"
+ (1 quack-threesemi-h1-face prepend))
+ ("^\;\;\; @section\\(?:\\[[^]]*\\]\\)?{\\([^\r\n]*\\)}"
+ (1 quack-threesemi-h1-face prepend))
+ ("^\;\;\; @subsection\\(?:\\[[^]]*\\]\\)?{\\([^\r\n]*\\)}"
+ (1 quack-threesemi-h2-face prepend))
+
+
+ )
+ '()))
+ (fld `(,(cond
+ ((eq quack-fontify-style 'plt)
+ (set (make-local-variable
+ 'quack-pltish-font-lock-keywords)
+ `(,@quack-pltish-fls-base
+ ,@(if quack-pltish-fontify-definition-names-p
+ quack-pltish-fls-defnames
+ '())
+ ,@pl
+ ,@(if quack-pltish-fontify-keywords-p
+ ;; quack-pltish-fls-keywords
+ `((,(concat
+ "[[(]\\("
+ (regexp-opt
+ quack-pltish-keywords-to-fontify)
+ "\\)\\>")
+ (1 quack-pltish-keyword-face)))
+ '())
+ ,@threesemi
+ ))
+ 'quack-pltish-font-lock-keywords)
+ ((eq quack-fontify-style 'emacs)
+ ;; TODO: Do pretty-lambda here too. But first get rid of
+ ;; this font-lock style "degrees of general gaudiness"
+ ;; and switch to separate options for each property of
+ ;; fontification.
+ '(quack-emacsish1-font-lock-keywords
+ quack-emacsish1-font-lock-keywords
+ quack-emacsish2-font-lock-keywords))
+ (t (quack-internal-error)))
+ nil
+ t
+ ((?! . "w") (?$ . "w") (?% . "w") (?& . "w") (?* . "w")
+ (?+ . "w") (?- . "w") (?. . "w") (?/ . "w") (?: . "w")
+ (?< . "w") (?= . "w") (?> . "w") (?? . "w") (?@ . "w")
+ (?^ . "w") (?_ . "w") (?~ . "w")
+ ,@(if (eq quack-fontify-style 'plt)
+ '((?# . "w"))
+ '()))
+ ;; TODO: Using `beginning-of-defun' here could be very slow,
+ ;; say, when you have a large buffer that is wrapped in a
+ ;; `module' form. Look into whether this is a problem.
+ beginning-of-defun
+ ,@(if t ; quack-gnuemacs-p
+ `((font-lock-mark-block-function . mark-defun)
+ (font-lock-syntactic-keywords . ,sk))
+ '()))))
+
+ ;; TODO: Figure out why `font-lock-syntactic-keywords' just doesn't work in
+ ;; XEmacs 21, even though the syntax text properties seem to get set.
+ ;; We have already beaten it like an egg-sucking dog.
+
+ ;;(if quack-xemacs-p
+ ;;(put 'scheme-mode 'font-lock-defaults fld)
+ (set (make-local-variable 'font-lock-defaults) fld)
+ ;;)
+
+ ;;(when quack-xemacs-p
+ ;; (set (make-local-variable 'font-lock-syntactic-keywords)
+ ;; syntactic-keywords))
+ ))
+
+;; Scheme Mode Startup Hook:
+
+(defun quack-locally-steal-key-bindings (old-func new-func)
+ (mapcar (function (lambda (key)
+ (unless (and (vectorp key)
+ (eq (aref key 0) 'menu-bar))
+ (local-set-key key new-func))))
+ (where-is-internal old-func)))
+
+(defun quack-shared-mode-hookfunc-stuff ()
+
+ ;; Install the Quack keymap and menu items.
+ (local-set-key quack-scheme-mode-keymap-prefix quack-scheme-mode-keymap)
+ (quack-when-xemacs
+ (when (featurep 'menubar)
+ ;;(set-buffer-menubar current-menubar)
+ ;; TODO: For XEmacs, we could have two versions of this menu -- the popup
+ ;; one would have the Global submenu, but the menubar one would have
+ ;; the Global submenu only if quack-global-menu-p were nil.
+ (add-submenu nil quack-scheme-mode-menuspec)
+ (set-menubar-dirty-flag)
+ (setq mode-popup-menu quack-scheme-mode-menuspec)))
+
+ ;; Bind the paren-matching keys.
+ (local-set-key ")" 'quack-insert-closing-paren)
+ (local-set-key "]" 'quack-insert-closing-bracket)
+
+ (local-set-key "(" 'quack-insert-opening-paren)
+ (local-set-key "[" 'quack-insert-opening-bracket)
+
+ ;; Steal any find-file bindings.
+ (when quack-remap-find-file-bindings-p
+ (quack-locally-steal-key-bindings 'find-file 'quack-find-file)
+ (quack-locally-steal-key-bindings 'ido-find-file 'quack-find-file))
+
+ ;; Fight against tabs.
+ (when quack-tabs-are-evil-p
+ (setq indent-tabs-mode nil))
+
+ ;; Remove character compositions, to get rid of any pretty-lambda. (Note:
+ ;; This is bad, if it turns out compositions are used for other purposes in
+ ;; buffers that are edited with Scheme Mode.)
+ (when quack-pretty-lambda-supported-p
+ (eval '(decompose-region (point-min) (point-max))))
+
+ ;; Install fontification
+ (when quack-fontify-style
+ (when (and (boundp 'font-lock-keywords)
+ (symbol-value 'font-lock-keywords)
+ (not (featurep 'noweb-mode)))
+ ;; This warning is not given if the `noweb-mode' package is installed.
+ (quack-warning "`font-lock-keywords' already set when hook ran."))
+ (quack-install-fontification))
+
+ ;; Die! Die! Die!
+ (quack-when-xemacs
+ (quack-install-global-menu)))
+
+(defun quack-inferior-scheme-mode-hookfunc ()
+ (quack-shared-mode-hookfunc-stuff))
+
+(defun quack-scheme-mode-hookfunc ()
+ (quack-shared-mode-hookfunc-stuff)
+
+ ;; Bind Return/Enter key.
+ (local-set-key "\r" 'quack-newline)
+
+ ;; Install toolbar.
+ ;;(unless quack-xemacs-p
+ ;;(when (display-graphic-p)
+ ;;(quack-install-tool-bar)))
+ )
+
+(add-hook 'scheme-mode-hook 'quack-scheme-mode-hookfunc)
+(add-hook 'inferior-scheme-mode-hook 'quack-inferior-scheme-mode-hookfunc)
+
+;; Compilation Mode:
+
+;; TODO: Add compilation-directory-matcher support for "setup-plt: in".
+
+(defvar quack-saved-compilation-error-regexp-alist nil)
+
+(defconst quack-compilation-error-regexp-alist-additions
+ (let ((no-line (if quack-xemacs-p
+ (let ((m (make-marker))) (set-marker m 0) m)
+ 'quack-compile-no-line-number)))
+ `(
+
+ ;; Racket 5.1.1 "raco" compile error (which can have multiple spaces):
+ ("^raco\\(?:cgc\\)?: +\\([^: ][^:]*\\):\\([0-9]+\\):\\([0-9]+\\):"
+ 1 2 3)
+
+ ;; Racket 5.1.1 entries without line number info in "=== context ===":
+ ("^\\(/[^:]+\\): \\[running body\\]$" 1 nil nil 0)
+
+ ;; PLT MzScheme 4.1.4 "=== context ===" traceback when there is only file,
+ ;; line, and column info, but potentially no following ":" and additional
+ ;; info like procedure name.
+ ("^\\([^:\n\" ]+\\):\\([0-9]+\\):\\([0-9]+\\)" 1 2 3)
+
+ ;; PLT MzScheme 205 "setup-plt"
+ ;; load-handler: expected a `module' declaration for `bar-unit' in
+ ;; "/u/collects/bar/bar-unit.ss", but found something else
+ (,(concat "load-handler: expected a `module' declaration for `[^']+' in "
+ "\"\\([^:\n\"]+\\)\", but found something else")
+ 1 ,no-line)
+
+ ;; PLT MzScheme 205 "setup-plt".
+ ;; setup-plt: Error during Compiling .zos for Foo Bar (/u/collects/fb)
+ ("setup-plt: Error during Compiling .zos for [^\n]+ \(\\([^\n\)]+\\)\)"
+ 1 ,no-line)
+
+ ;; PLT MzScheme 4.0.1 "setup-plt".
+ ("setup-plt: +\\(?:WARNING: +\\)\\([^:\n]+\\)::"
+ 1 ,no-line)
+
+ ;; PLT MzScheme 4.0.1 "setup-plt".
+ ("setup-plt: +\\(?:WARNING: +\\)\\([^:\n ][^:\n]*\\):\\([0-9]+\\):\\([0-9]+\\)"
+ 1 2 3)
+
+ ;; PLT MzScheme 4.0.1 "setup-plt":
+ ("load-handler: expected a `module' declaration for `[^'\n]+' in #<path:\\([^>\n]+\\)>[^\n]+"
+ 1 ,no-line)
+
+ ;; PLT Scheme 4.1.2 "default-load-handler" error without useful filename:
+ ("default-load-handler: cannot open input-file: "
+ nil ,no-line)
+
+ )))
+
+(defun quack-compile-no-line-number (filename column)
+ (list (point-marker) filename 1 (and column (string-to-number column))))
+
+(defun quack-install-compilation-mode-stuff ()
+ (unless quack-saved-compilation-error-regexp-alist
+ (setq quack-saved-compilation-error-regexp-alist
+ compilation-error-regexp-alist))
+ (setq compilation-error-regexp-alist
+ (append quack-compilation-error-regexp-alist-additions
+ quack-saved-compilation-error-regexp-alist)))
+
+(quack-install-compilation-mode-stuff)
+
+;; Interpreter-mode-alist:
+
+(defvar quack-saved-interpreter-mode-alist nil)
+
+(defvar quack-interpreter-mode-alist-additions
+ (mapcar (function (lambda (x)
+ (cons x 'scheme-mode)))
+ '("bigloo"
+ "csi"
+ "gosh"
+ "gsi"
+ "guile"
+ "kawa"
+ "mit-scheme"
+ "mred"
+ "mred3m"
+ "mredcgc"
+ "mzscheme"
+ "mzscheme3m"
+ "mzschemecgc"
+ "r5rs"
+ "r6rs"
+ "rs"
+ "rs"
+ "scheme"
+ "scheme48"
+ "scsh"
+ "sisc"
+ "stklos"
+ "sxi")))
+
+(defun quack-install-interpreter-mode-alist ()
+ (unless quack-saved-interpreter-mode-alist
+ (setq quack-saved-interpreter-mode-alist
+ interpreter-mode-alist))
+ (setq interpreter-mode-alist
+ (append quack-interpreter-mode-alist-additions
+ quack-saved-interpreter-mode-alist)))
+
+(quack-install-interpreter-mode-alist)
+
+;; PLT Package Mode:
+
+;; TODO: Do some simple checking and summarize what directories and files are
+;; getting modified by this package.
+
+;; TODO: Maybe don't worry about preserving the decompressed text verbatim in
+;; the buffer -- set markers and generate headings, and be able to
+;; construct valid package.
+
+;; TODO: Command to install package from original file using "setup-plt".
+
+;; TODO: Fontify Scheme code file contents.
+
+(defvar quack-pltfile-mode-hook nil)
+
+(defvar quack-hiding-ovlcat)
+(put 'quack-hiding-ovlcat 'face 'default)
+(put 'quack-hiding-ovlcat 'intangible t)
+(put 'quack-hiding-ovlcat 'invisible t)
+
+(defvar quack-pltfile-mode-map (make-sparse-keymap))
+(define-key quack-pltfile-mode-map "q" 'quack-pltfile-quit)
+(define-key quack-pltfile-mode-map "r" 'quack-pltfile-raw)
+(define-key quack-pltfile-mode-map " " 'scroll-up)
+
+;; TODO: Make a menu map for pltfile-mode.
+
+(defun quack-pltfile-mode ()
+ (interactive)
+ "Major mode for viewing PLT Scheme `.plt' package files.
+
+\\{quack-pltfile-mode-map}
+
+Provided by Quack: http://www.neilvandyke.org/quack/"
+ (kill-all-local-variables)
+ (put 'quack-pltfile-mode 'mode-class 'special)
+ (setq major-mode 'quack-pltfile-mode)
+ (setq mode-name "PLT Package")
+ (use-local-map quack-pltfile-mode-map)
+ ;; Note: Currently, the `font-lock' feature is always defined, since we
+ ;; require it.
+ (when (featurep 'font-lock)
+ (setq font-lock-defaults nil))
+ (buffer-disable-undo)
+ (let ((saved-bmp (buffer-modified-p)))
+ (quack-activity "Decoding PLT package" (quack-pltfile-decode-buffer))
+ (setq buffer-read-only t)
+ (set-buffer-modified-p saved-bmp))
+ (quack-when-xemacs
+ (make-variable-buffer-local 'write-contents-hooks))
+ (add-hook 'write-contents-hooks 'quack-prevent-pltfile-write)
+ (run-hooks 'quack-pltfile-mode-hook)
+ (message "Decoded PLT package. %s"
+ (substitute-command-keys
+ (concat "`\\[quack-pltfile-quit]' to quit"
+ ", `\\[quack-pltfile-raw]' for raw format."))))
+
+(defun quack-prevent-pltfile-write ()
+ (unless (yes-or-no-p
+ "Write a decoded PLT package buffer?! Are you *sure*?!")
+ (error "Aborted write of decoded PLT package buffer.")))
+
+(defun quack-pltfile-raw ()
+ (interactive)
+ (let ((auto-mode-alist '()))
+ (setq buffer-read-only nil)
+ (widen)
+ (delete-region (point-min) (point-max))
+ (fundamental-mode)
+ (revert-buffer t t)))
+
+(defun quack-pltfile-quit ()
+ (interactive)
+ (kill-buffer (current-buffer)))
+
+(defun quack-skip-whitespace-to-nonblank-line-beginning ()
+ (save-match-data
+ (while (looking-at "[ \t\r\f]*\n")
+ (goto-char (match-end 0)))))
+
+(defun quack-pltfile-decode-buffer ()
+
+ ;; MIME Base-64 decode. (Note: an error is signaled if this fails.)
+ (base64-decode-region (point-min) (point-max))
+
+ ;; Gzip decompress.
+ (let ((coding-system-for-write (if quack-xemacs-p 'binary 'raw-text-unix))
+ (coding-system-for-read (if quack-xemacs-p 'binary 'raw-text-unix))
+ (inhibit-eol-conversion t)
+ status)
+ (unless (= (setq status (call-process-region (point-min) (point-max)
+ "gzip" t t nil "-d")) 0)
+ (error "Could not decompress PLT package: gzip process status %s"
+ status)))
+
+ ;; Move past the "PLT" cookie, and the two sexp forms.
+ (goto-char (point-min))
+ (unless (looking-at "PLT")
+ (error "This does not appear to be a PLT package file."))
+ (goto-char (match-end 0))
+ (forward-list 2)
+ (quack-skip-whitespace-to-nonblank-line-beginning)
+ (quack-make-face-ovlext (point-min) (point) 'quack-pltfile-prologue-face)
+
+ ;; Process the buffer contents.
+ (let ((standard-input (current-buffer)))
+
+ (while (not (eobp))
+ (let ((step-beg (point)))
+ ;; TODO: This read will fail if we just had whitespace at the end of
+ ;; the file, which it shouldn't, but maybe we should check, just
+ ;; in case.
+ (let ((sym (read)))
+ (unless (symbolp sym)
+ (error "Expected a symbol, but saw: %S" sym))
+ (cond
+
+ ((eq sym 'dir)
+ (forward-list)
+ (quack-skip-whitespace-to-nonblank-line-beginning)
+ (quack-make-face-ovlext step-beg
+ (point)
+ 'quack-pltfile-dir-face))
+
+ ((memq sym '(file file-replace))
+ (forward-list)
+ (let ((size (read)))
+ (unless (and (integerp size) (>= size 0))
+ (error "Expected a file size, but saw: %S" size))
+ (unless (looking-at "[ \t\r\n\f]*\\*")
+ (error "Expected a `*' after file size."))
+ (goto-char (match-end 0))
+
+ ;; Fontify the file header.
+ (quack-make-face-ovlext step-beg
+ (1- (point))
+ 'quack-pltfile-file-face)
+
+ ;; Hide the file contents asterisk.
+ (quack-make-hiding-ovlext (1- (point)) (point))
+
+ ;; Set the coding region for the content.
+ (let* ((content-beg (point))
+ (content-end (+ content-beg size))
+ (cs (detect-coding-region content-beg
+ content-end)))
+ (goto-char content-end)
+ (when (listp cs)
+ (setq cs (car cs)))
+ (unless (eq cs 'undecided)
+ (cond ((eq cs 'undecided-dos) (setq cs 'raw-text-dos))
+ ((eq cs 'undecided-mac) (setq cs 'raw-text-mac))
+ ((eq cs 'undecided-unix) (setq cs 'raw-text-unix)))
+ (decode-coding-region content-beg content-end cs))
+ ;; TODO: XEmacs 21 `decode-coding-region' seems to lose the
+ ;; point position. This is disconcerting, since the
+ ;; point semantics under coding system changes do not
+ ;; currently seem to be well-specified, so resetting the
+ ;; point here *might* not always be the right thing to
+ ;; do. Verify.
+ (quack-when-xemacs
+ (goto-char content-end)))))
+
+ (t (error "Expected `dir', `file', or `file-replace', but saw: %S"
+ sym)))))))
+
+ ;; Return point to top of buffer.
+ (goto-char (point-min)))
+
+;; The rest of this file except for the `provide' form is TODO comments.
+
+;; TODO: Add tool bar support later.
+;;
+;; (defvar quack-toolbarimage-width 24)
+;; (defvar quack-toolbarimage-height 24)
+;;
+;; (defun quack-create-image (&rest args)
+;; (if (and quack-gnuemacs-p (>= emacs-major-version 21))
+;; (apply 'create-image args)
+;; nil))
+;;
+;; (defun quack-make-toolbarimage (&rest lines)
+;; ;; TODO: We really should make an efficient function to print N spaces
+;; ;; or to return a string of N spaces. Or at least keep 1-2
+;; ;; strings for the left and right padding here, which will
+;; ;; usually be the same for the duration of this function.
+;; (quack-create-image
+;; (let* ((lines-count (length lines))
+;; (blank-line (make-string quack-toolbarimage-width 32)))
+;; (and (> lines-count quack-toolbarimage-height) (quack-internal-error))
+;; (with-output-to-string
+;; (princ "/* XPM */\nstatic char *magick[] = {\n")
+;; ;;(princ "/* columns rows colors chars-per-pixel */\n")
+;; (princ (format "\"%d %d 5 1\",\n"
+;; quack-toolbarimage-width quack-toolbarimage-height))
+;; (princ "\". c #f0f0f0\",\n")
+;; (princ "\"@ c #0f0f0f\",\n")
+;; (princ "\"g c #00b000\",\n")
+;; (princ "\"r c #d00000\",\n")
+;; (princ "\" c None\",\n")
+;; ;;(princ "/* pixels */\n")
+;; (let ((line-num 0))
+;; (mapcar (function
+;; (lambda (line)
+;; (princ "\"")
+;; (if line
+;; (let* ((c (length line))
+;; (l (/ (- quack-toolbarimage-width c) 2)))
+;; (and (> c quack-toolbarimage-width)
+;; (quack-internal-error))
+;; (princ (make-string l 32))
+;; (princ line)
+;; (princ (make-string (- quack-toolbarimage-width
+;; c l)
+;; 32)))
+;; (princ blank-line))
+;; (if (< (setq line-num (1+ line-num))
+;; quack-toolbarimage-height)
+;; (princ "\",\n")
+;; (princ "\"\n"))))
+;; (let ((rows-before (/ (- quack-toolbarimage-width
+;; lines-count)
+;; 2)))
+;; `(,@(make-list rows-before nil)
+;; ,@lines
+;; ,@(make-list (- quack-toolbarimage-height
+;; lines-count rows-before)
+;; nil)))))
+;; (princ "};\n")))
+;; 'xpm t))
+;;
+;; (defvar quack-tbi-evalbuf
+;; (quack-make-toolbarimage
+;; "@@@@@@@@@@ "
+;; "@........@@ "
+;; "@........@.@ ggg "
+;; "@........@..@ ggg "
+;; "@........@@@@@ ggg "
+;; "@............@ ggg "
+;; "@..@@........@ ggg "
+;; "@...@@.......@ ggg "
+;; "@....@@......@ ggg "
+;; "@.....@@.....@ ggg "
+;; "@....@@@@....@ ggg "
+;; "@...@@..@@...@ ggg "
+;; "@..@@....@@..@ ggg "
+;; "@............@ ggg "
+;; "@@@@@@@@@@@@@@ ggg "
+;; " ggg "
+;; " ggggggg"
+;; " ggggg "
+;; " ggg "
+;; " g "))
+;;
+;; (defvar quack-tbi-adoc
+;; (quack-make-toolbarimage
+;; "@@@@@@@@@@ "
+;; "@........@@ "
+;; "@........@.@ "
+;; "@........@..@ "
+;; "@........@@@@@"
+;; "@...@@@......@"
+;; "@..@@@@@@....@"
+;; "@..@....@@...@"
+;; "@...@@@.@@...@"
+;; "@..@@@@@@@...@"
+;; "@..@@...@@...@"
+;; "@..@@..@@@...@"
+;; "@...@@@@.@@..@"
+;; "@............@"
+;; "@@@@@@@@@@@@@@"))
+;;
+;; (defvar quack-tbi-manual
+;; (quack-make-toolbarimage
+;; "@@@@@@@@@@ "
+;; "@........@@ "
+;; "@........@.@ "
+;; "@........@..@ "
+;; "@........@@@@@"
+;; "@............@"
+;; "@..@@.@.@@...@"
+;; "@..@@@@@@@@..@"
+;; "@..@@.@@.@@..@"
+;; "@..@@.@@.@@..@"
+;; "@..@@.@@.@@..@"
+;; "@..@@.@@.@@..@"
+;; "@..@@.@@.@@..@"
+;; "@............@"
+;; "@@@@@@@@@@@@@@"))
+;;
+;; (defvar quack-tbi-manuallookup
+;; (quack-make-toolbarimage
+;; "@@@@@@@@@@ "
+;; "@........@@ "
+;; "@........@.@ "
+;; "@........@..@ "
+;; "@........@@@@@ "
+;; "@............@ "
+;; "@..@@.@@@@@@@@@@ "
+;; "@...@@@........@@ "
+;; "@....@@........@.@ "
+;; "@.....@........@..@ "
+;; "@....@@........@@@@@"
+;; "@...@@@............@"
+;; "@..@@.@..@@.@.@@...@"
+;; "@.....@..@@@@@@@@..@"
+;; "@@@@@@@..@@.@@.@@..@"
+;; " @..@@.@@.@@..@"
+;; " @..@@.@@.@@..@"
+;; " @..@@.@@.@@..@"
+;; " @..@@.@@.@@..@"
+;; " @............@"
+;; " @@@@@@@@@@@@@@"))
+;;
+;; (defvar quack-tbi-stop
+;; (quack-make-toolbarimage
+;; " @@@@@ "
+;; " @@rrrrr@@ "
+;; " @rrrrrrrrr@ "
+;; " @rrrrrrrrr@ "
+;; "@rr@@rrr@@rr@"
+;; "@rrr@@r@@rrr@"
+;; "@rrrr@@@rrrr@"
+;; "@rrr@@r@@rrr@"
+;; "@rr@@rrr@@rr@"
+;; " @rrrrrrrrr@ "
+;; " @rrrrrrrrr@ "
+;; " @@rrrrr@@ "
+;; " @@@@@ "))
+;;
+;; (defun quack-install-tool-bar ()
+;; (require 'tool-bar)
+;; (let ((map (make-sparse-keymap)))
+;;
+;; (quack-define-key-after map [quack-load-file]
+;; `(menu-item "quack-evalbuffer" scheme-load-file
+;; :image ,quack-tbi-evalbuf
+;; :help "Load File"))
+;;
+;; (quack-define-key-after map [quack-alpha]
+;; `(menu-item "quack-alpha" quack-alpha
+;; :image ,quack-tbi-adoc
+;; :help "alpha"))
+;;
+;; (quack-define-key-after map [quack-manual]
+;; `(menu-item "quack-manual" quack-manual
+;; :image ,quack-tbi-manual
+;; :help "View Manual"))
+;;
+;; (quack-define-key-after map [quack-view-keyword-docs]
+;; `(menu-item "quack-view-keyword-docs"
+;; quack-view-keyword-docs
+;; :image ,quack-tbi-manuallookup
+;; :help "View Keyword Docs"))
+;;
+;; (quack-define-key-after map [quack-stop]
+;; `(menu-item "quack-stop" quack-stop
+;; :image ,quack-tbi-stop
+;; :help "Stop"))
+;;
+;; (set (make-local-variable 'tool-bar-map) map)))
+
+;; TODO: Extend `scheme-imenu-generic-expression' for PLT-specific definition
+;; forms and for definitions within modules.
+
+;; TODO: Clickable URLs
+;;
+;; (defvar quack-url-keymap)
+;;
+;; (setq quack-url-keymap (make-sparse-keymap))
+;; (define-key quack-url-keymap "\r" 'quack-browse-overlaid-url)
+;; (define-key quack-url-keymap "q" 'quack-browse-overlaid-url)
+;;
+;; (defun quack-make-url-overlay (beg end &optional url)
+;; (let ((ovl (make-overlay beg end nil t)))
+;; (overlay-put ovl 'face 'underline)
+;; (overlay-put ovl 'local-map 'quack-url-keymap)
+;; (overlay-put ovl 'help-echo "Press RET to browse this URL.")
+;; (overlay-put ovl 'quack-url
+;; (or url (buffer-substring-no-properties beg end)))
+;; ovl))
+;;
+;; (defun quack-insert-url (url)
+;; (let* ((beg (point)))
+;; (insert url)
+;; (quack-make-url-overlay beg (point))))
+;;
+;; (defun quack-overlaid-url-at-point (&optional pt)
+;; (let ((overlays (overlays-at (or pt (point))))
+;; (url nil))
+;; (while overlays
+;; (setq overlays (if (setq url (overlay-get (car overlays) 'quack-url))
+;; (cdr overlays)
+;; '())))
+;; url))
+;;
+;; (defun quack-browse-overlaid-url (pt)
+;; ;; Dehydration.
+;; (interactive "d")
+;; (quack-browse-url (quack-overlaid-url-at-point pt)))
+
+;; TODO: Possible Future Inferior Process I/O Stuff. Make encoding with
+;; inferior process disambiguate REPL values, port output, error info,
+;; etc. Start of code commented out below. This may require rewriting
+;; chunks of `cmuscheme' and `comint'.
+;;
+;; Try to use ELI protocol first. http://www.cliki.net/ELI
+;;
+;; (defface quack-output-face
+;; '((((class color)) (:foreground "purple4" :background "lavender"))
+;; (t (:inverse-video t)))
+;; "Face used for..."
+;; :group 'quack)
+;;
+;; (defface quack-value-face
+;; '((((class color)) (:foreground "blue4" :background "light sky blue"))
+;; (t (:inverse-video t)))
+;; "Face used for..."
+;; :group 'quack)
+;;
+;; Escape Codes:
+;; REPL State:
+;; R repl read begin
+;; r repl read end
+;; E repl eval begin
+;; e repl eval end
+;; P repl print begin
+;; p repl print end
+;; Stream Change:
+;; O output stream
+;; E error stream
+;; Error Info?
+;;
+;; (defconst quack-mzscheme-init-string
+;; (let ((print-length nil)
+;; (print-level nil))
+;; (prin1-to-string
+;; '(let ((o (current-output-port))
+;; (i (current-input-port))
+;; (e (current-eval)))
+;; ;; TODO: Define custom escaping output and error ports here.
+;; (current-prompt-read
+;; (lambda ()
+;; (display "\eR" o)
+;; (begin0 (read-syntax "quack-repl" i)
+;; (display "\er" o))))
+;; (current-eval
+;; (lambda (n)
+;; (display "\eE" o)
+;; (begin0 (e n)
+;; (display "\ee" o))))
+;; (current-print
+;; (lambda (n)
+;; (display "\eP" o)
+;; (begin0 (print n o)
+;; (display "\ep" o))))))))
+;;
+;; In `quack' function, after call to `run-scheme':
+;;
+;; (add-hook 'comint-preoutput-filter-functions
+;; 'quack-comint-preoutput-filter-func)
+;; (comint-send-string (scheme-proc) quack-mzscheme-init-string)
+;; (comint-send-string (scheme-proc) "\n")
+
+;; TODO: If we do that, then add pretty-printing of REPL results.
+
+;; TODO: Maybe provide utilities for converting to/from PLT-style
+;; square-bracket paren conventions.
+
+;; TODO: Populate abbrevs table from keywords extracted from manuals, and from
+;; definitions in current buffer. Or maybe query running MzScheme
+;; process for bound symbols.
+
+;; TODO: Maybe use `compile-zos' to do error-checking for PLT (look up person
+;; to credit with idea of using that to get more warnings). Need to know
+;; more about a particular Scheme implementation than just the command
+;; line to start its REPL, though.
+
+;; TODO: Perhaps put some initialization code that depends on user's custom
+;; settings into after-init-hook. See if this works in XEmacs.
+
+;; TODO: Set `interpreter-mode-alist' based on interpreter list.
+
+;; TODO: "I think it would be good if the quack menu showed up only when emacs
+;; was in Scheme mode."
+
+;; TODO: Support this:
+;;
+;; * Added 'addon-dir for `find-system-path':
+;; Unix: "~/.plt-scheme"
+;; Windows: "PLT Scheme" in the user's Application Data folder.
+;; Mac OS X: "~/Library/PLT Scheme"
+;; Mac OS Classic: "PLT Scheme" in the preferences folder.
+;;
+;; The version string for "~/.plt-scheme/<version>/collects/" might be:
+;; mzscheme -mqe '(begin (display (version)) (exit))'
+;; Double-check PLT source first.
+
+;; TODO: Add autoindenting to inferior Scheme buffer when pressing RET on an
+;; incomplete sexp -- iff we can do this reliably enough.
+
+;; TODO: When tidying and point is within a series of multiple blank lines that
+;; are reduced to a single blank line, leave point at the beginning of
+;; the single blank line.
+
+;; TODO: Riastradh says: Do you suppose you could add a feature to Quack that
+;; indents lists beginning with symbols of the form WITH-... &
+;; CALL-WITH-... as if their SCHEME-INDENT-FUNCTION property were DEFUN?
+
+;; TODO: Matt Dickerson asks " Also, the command history appears to be based on
+;; newlines -- I work with blocks of code in the REPL and would like C-p
+;; to give me the last block, not the last line of the previous block."
+
+;; TODO: Maybe get appropriate PLT collection path from the default for
+;; whatever "mzscheme" executable is picked up.
+;;
+;; mzscheme -emq '(begin (write (current-library-collection-paths)) (exit 0))'
+;; ("/home/neil/collects" "/home/neil/.plt-scheme/208/collects"
+;; "/usr/lib/plt/collects")
+
+;; TODO: Bind M-[ to quack-insert-parentheses
+
+;; TODO: Peter Barabas reports that `quack-global-menu-p' set to nil doesn't
+;; disable the menu.
+
+;; TODO: Way to get default collects directories. From Matthew Flatt,
+;; 2006-04-22:
+;;
+;; env PLTCOLLECTS="" mzscheme -mvqe '(printf "~s\n" (map path->string
+;; (current-library-collection-paths)))'
+
+;; TODO: Have key binding to insert "lambda" (for use with pretty-lambda).
+;; Suggested by Olwe Bottorff on 2006-04-20.
+
+;; TODO: Jerry van Dijk writes: "I would like to try out quack, but I do not
+;; like its menu constantly on the main menu bar (as I use emacs for a lot of
+;; things). Unfortunately sofar quack has bravely defied all my attempts to
+;; remove it. From desecting the customize option to adding (define-key
+;; global-map [menu-bar quack] nil)"
+
+;; TODO: We could do this:
+;;
+;; mzscheme -m -e "(begin (display #\') (write (map path->string (current-library-collection-paths))) (newline) (exit))"
+;; '("/home/neil/collects"
+;; "/home/neil/.plt-scheme/360/collects"
+;; "/usr/lib/plt/collects")
+
+;; emacs22 -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
+;; emacs21 -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
+;; emacs20 -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
+;; xemacs21 -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
+
+;; End:
+
+(provide 'quack)
+
+;; quack.el ends here
--- /dev/null
+;;; rainbow-mode.el --- prints color strings with colored background
+
+;; Copyright (C) 2010 Julien Danjou
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: strings, faces
+
+;; This file is NOT part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This minor mode will add background to strings that matches color names.
+;; i.e.
+;; #0000ff
+;; Will be printed in white with a blue background.
+;;
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'regexp-opt)
+(require 'faces)
+
+(defgroup rainbow nil
+ "Show color strings with a background color."
+ :tag "Rainbow"
+ :group 'help)
+
+;; Hexadecimal colors
+(defvar rainbow-hexadecimal-colors-font-lock-keywords
+ '("#[0-9a-fA-F]\\{3\\}[0-9a-fA-F]\\{3\\}?"
+ (0 (rainbow-colorize-itself)))
+ "Font-lock keywords to add for hexadecimal colors.")
+
+;; rgb() colors
+(defvar rainbow-html-rgb-colors-font-lock-keywords
+ '(("rgb(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*)"
+ (0 (rainbow-colorize-rgb)))
+ ("rgba(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*[0-9]\\{1,3\\}\s*%?\s*)"
+ (0 (rainbow-colorize-rgb))))
+ "Font-lock keywords to add for RGB colors.")
+
+;; HTML colors name
+(defvar rainbow-html-colors-font-lock-keywords nil
+ "Font-lock keywords to add for HTML colors.")
+(make-variable-buffer-local 'rainbow-html-colors-font-lock-keywords)
+
+(defcustom rainbow-html-colors-alist
+ '(("black" . "#000000")
+ ("silver" . "#C0C0C0")
+ ("gray" . "#808080")
+ ("white" . "#FFFFFF")
+ ("maroon" . "#800000")
+ ("red" . "#FF0000")
+ ("purple" . "#800080")
+ ("fuchsia" . "#FF00FF")
+ ("green" . "#008000")
+ ("lime" . "#00FF00")
+ ("olive" . "#808000")
+ ("yellow" . "#FFFF00")
+ ("navy" . "#000080")
+ ("blue" . "#0000FF")
+ ("teal" . "#008080")
+ ("aqua" . "#00FFFF"))
+ "Alist of HTML colors.
+Each entry should have the form (COLOR-NAME . HEXADECIMAL-COLOR)."
+ :group 'rainbow)
+
+(defcustom rainbow-html-colors-major-mode-list
+ '(html-mode css-mode php-mode nxml-mode xml-mode)
+ "List of major mode where HTML colors are enabled when
+`rainbow-html-colors' is set to auto."
+ :group 'rainbow)
+
+(defcustom rainbow-html-colors 'auto
+ "When to enable HTML colors.
+If set to t, the HTML colors will be enabled. If set to nil, the
+HTML colors will not be enabled. If set to auto, the HTML colors
+will be enabled if a major mode has been detected from the
+`rainbow-html-colors-major-mode-list'."
+ :group 'rainbow)
+
+;; X colors
+(defvar rainbow-x-colors-font-lock-keywords
+ `(,(regexp-opt (x-defined-colors) 'words)
+ (0 (rainbow-colorize-itself)))
+ "Font-lock keywords to add for X colors.")
+
+(defcustom rainbow-x-colors-major-mode-list
+ '(emacs-lisp-mode lisp-interaction-mode c-mode c++-mode java-mode)
+ "List of major mode where X colors are enabled when
+`rainbow-x-colors' is set to auto."
+ :group 'rainbow)
+
+(defcustom rainbow-x-colors 'auto
+ "When to enable X colors.
+If set to t, the X colors will be enabled. If set to nil, the
+X colors will not be enabled. If set to auto, the X colors
+will be enabled if a major mode has been detected from the
+`rainbow-x-colors-major-mode-list'."
+ :group 'rainbow)
+
+;; Functions
+(defun rainbow-colorize-match (color)
+ "Return a matched string propertized with a face whose
+background is COLOR. The foreground is computed using
+`rainbow-color-luminance', and is either white or black."
+ (put-text-property
+ (match-beginning 0) (match-end 0)
+ 'face `((:foreground ,(if (> 128.0 (rainbow-x-color-luminance color))
+ "white" "black"))
+ (:background ,color))))
+
+(defun rainbow-colorize-itself ()
+ "Colorize a match with itself."
+ (rainbow-colorize-match (match-string-no-properties 0)))
+
+(defun rainbow-colorize-by-assoc (assoc-list)
+ "Colorize a match with its association from ASSOC-LIST."
+ (rainbow-colorize-match (cdr (assoc (match-string-no-properties 0) assoc-list))))
+
+(defun rainbow-rgb-relative-to-absolute (number)
+ "Convert a relative NUMBER to absolute. If NUMBER is absolute, return NUMBER.
+This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\""
+ (let ((string-length (- (length number) 1)))
+ ;; Is this a number with %?
+ (if (eq (elt number string-length) ?%)
+ (/ (* (string-to-number (substring number 0 string-length)) 255) 100)
+ (string-to-number number))))
+
+(defun rainbow-colorize-rgb ()
+ "Colorize a match with itself."
+ (let ((r (rainbow-rgb-relative-to-absolute (match-string-no-properties 1)))
+ (g (rainbow-rgb-relative-to-absolute (match-string-no-properties 2)))
+ (b (rainbow-rgb-relative-to-absolute (match-string-no-properties 3))))
+ (rainbow-colorize-match (format "#%02X%02X%02X" r g b))))
+
+(defun rainbow-color-luminance (red green blue)
+ "Calculate the luminance of color composed of RED, BLUE and GREEN."
+ (floor (+ (* .2126 red) (* .7152 green) (* .0722 blue)) 256))
+
+(defun rainbow-x-color-luminance (color)
+ "Calculate the luminance of a color string (e.g. \"#ffaa00\", \"blue\")."
+ (let* ((values (x-color-values color))
+ (r (car values))
+ (g (cadr values))
+ (b (caddr values)))
+ (rainbow-color-luminance r g b)))
+
+(defun rainbow-turn-on ()
+ "Turn on raibow-mode."
+ (font-lock-add-keywords nil
+ (list rainbow-hexadecimal-colors-font-lock-keywords))
+ ;; Activate X colors?
+ (when (or (eq rainbow-x-colors t)
+ (and (eq rainbow-x-colors 'auto)
+ (memq major-mode rainbow-x-colors-major-mode-list)))
+ (font-lock-add-keywords nil
+ (list rainbow-x-colors-font-lock-keywords)))
+ ;; Activate HTML colors?
+ (when (or (eq rainbow-html-colors t)
+ (and (eq rainbow-html-colors 'auto)
+ (memq major-mode rainbow-html-colors-major-mode-list)))
+ (setq rainbow-html-colors-font-lock-keywords
+ `(,(regexp-opt (mapcar 'car rainbow-html-colors-alist) 'words)
+ (0 (rainbow-colorize-by-assoc rainbow-html-colors-alist))))
+ (font-lock-add-keywords nil
+ `(,rainbow-html-colors-font-lock-keywords
+ ,@rainbow-html-rgb-colors-font-lock-keywords))))
+
+(defun rainbow-turn-off ()
+ "Turn off rainbow-mode."
+ (font-lock-remove-keywords
+ nil
+ (list
+ rainbow-hexadecimal-colors-font-lock-keywords
+ rainbow-html-colors-font-lock-keywords
+ rainbow-x-colors-font-lock-keywords
+ rainbow-html-rgb-colors-font-lock-keywords)))
+
+;;;###autoload
+(define-minor-mode rainbow-mode
+ "Colorize strings that represent colors.
+This will fontify with colors the string like \"#aabbcc\" or \"blue\""
+ :lighter " Rbow"
+ (progn
+ (if rainbow-mode
+ (rainbow-turn-on)
+ (rainbow-turn-off))
+ ;; Turn on font lock
+ (font-lock-mode 1)))
+
+(provide 'rainbow-mode)
--- /dev/null
+;;; redo.el -- Redo/undo system for XEmacs
+
+;; Copyright (C) 1985, 1986, 1987, 1993-1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+;; Copyright (C) 1997 Kyle E. Jones
+
+;; Author: Kyle E. Jones, February 1997
+;; Keywords: lisp, extensions
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; Derived partly from lisp/prim/simple.el in XEmacs.
+
+;; Emacs' normal undo system allows you to undo an arbitrary
+;; number of buffer changes. These undos are recorded as ordinary
+;; buffer changes themselves. So when you break the chain of
+;; undos by issuing some other command, you can then undo all
+;; the undos. The chain of recorded buffer modifications
+;; therefore grows without bound, truncated only at garbage
+;; collection time.
+;;
+;; The redo/undo system is different in two ways:
+;; 1. The undo/redo command chain is only broken by a buffer
+;; modification. You can move around the buffer or switch
+;; buffers and still come back and do more undos or redos.
+;; 2. The `redo' command rescinds the most recent undo without
+;; recording the change as a _new_ buffer change. It
+;; completely reverses the effect of the undo, which
+;; includes making the chain of buffer modification records
+;; shorter by one, to counteract the effect of the undo
+;; command making the record list longer by one.
+;;
+;; Installation:
+;;
+;; Save this file as redo.el, byte compile it and put the
+;; resulting redo.elc file in a directory that is listed in
+;; load-path.
+;;
+;; In your .emacs file, add
+;; (require 'redo)
+;; and the system will be enabled.
+
+;;; Code:
+
+(provide 'redo)
+
+(defvar redo-version "1.02"
+ "Version number for the Redo package.")
+
+(defvar last-buffer-undo-list nil
+ "The head of buffer-undo-list at the last time an undo or redo was done.")
+(make-variable-buffer-local 'last-buffer-undo-list)
+
+(make-variable-buffer-local 'pending-undo-list)
+
+;; Emacs 20 variable
+(defvar undo-in-progress)
+
+(defun redo (&optional count)
+ "Redo the the most recent undo.
+Prefix arg COUNT means redo the COUNT most recent undos.
+If you have modified the buffer since the last redo or undo,
+then you cannot redo any undos before then."
+ (interactive "*p")
+ (if (eq buffer-undo-list t)
+ (error "No undo information in this buffer"))
+ (if (eq last-buffer-undo-list nil)
+ (error "No undos to redo"))
+ (or (eq last-buffer-undo-list buffer-undo-list)
+ ;; skip one undo boundary and all point setting commands up
+ ;; until the next undo boundary and try again.
+ (let ((p buffer-undo-list))
+ (and (null (car-safe p)) (setq p (cdr-safe p)))
+ (while (and p (integerp (car-safe p)))
+ (setq p (cdr-safe p)))
+ (eq last-buffer-undo-list p))
+ (error "Buffer modified since last undo/redo, cannot redo"))
+ (and (or (eq buffer-undo-list pending-undo-list)
+ (eq (cdr buffer-undo-list) pending-undo-list))
+ (error "No further undos to redo in this buffer"))
+ (or (eq (selected-window) (minibuffer-window))
+ (message "Redo..."))
+ (let ((modified (buffer-modified-p))
+ (undo-in-progress t)
+ (recent-save (recent-auto-save-p))
+ (old-undo-list buffer-undo-list)
+ (p (cdr buffer-undo-list))
+ (records-between 0))
+ ;; count the number of undo records between the head of the
+ ;; undo chain and the pointer to the next change. Note that
+ ;; by `record' we mean clumps of change records, not the
+ ;; boundary records. The number of records will always be a
+ ;; multiple of 2, because an undo moves the pending pointer
+ ;; forward one record and prepend a record to the head of the
+ ;; chain. Thus the separation always increases by two. When
+ ;; we decrease it we will decrease it by a multiple of 2
+ ;; also.
+ (while p
+ (cond ((eq p pending-undo-list)
+ (setq p nil))
+ ((null (car p))
+ (setq records-between (1+ records-between))
+ (setq p (cdr p)))
+ (t
+ (setq p (cdr p)))))
+ ;; we're off by one if pending pointer is nil, because there
+ ;; was no boundary record in front of it to count.
+ (and (null pending-undo-list)
+ (setq records-between (1+ records-between)))
+ ;; don't allow the user to redo more undos than exist.
+ ;; only half the records between the list head and the pending
+ ;; pointer are undos that are a part of this command chain.
+ (setq count (min (/ records-between 2) count)
+ p (primitive-undo (1+ count) buffer-undo-list))
+ (if (eq p old-undo-list)
+ nil ;; nothing happened
+ ;; set buffer-undo-list to the new undo list. if has been
+ ;; shortened by `count' records.
+ (setq buffer-undo-list p)
+ ;; primitive-undo returns a list without a leading undo
+ ;; boundary. add one.
+ (undo-boundary)
+ ;; now move the pending pointer backward in the undo list
+ ;; to reflect the redo. sure would be nice if this list
+ ;; were doubly linked, but no... so we have to run down the
+ ;; list from the head and stop at the right place.
+ (let ((n (- records-between count)))
+ (setq p (cdr old-undo-list))
+ (while (and p (> n 0))
+ (if (null (car p))
+ (setq n (1- n)))
+ (setq p (cdr p)))
+ (setq pending-undo-list p)))
+ (and modified (not (buffer-modified-p))
+ (delete-auto-save-file-if-necessary recent-save))
+ (or (eq (selected-window) (minibuffer-window))
+ (message "Redo!"))
+ (setq last-buffer-undo-list buffer-undo-list)))
+
+(defun undo (&optional arg)
+ "Undo some previous changes.
+Repeat this command to undo more changes.
+A numeric argument serves as a repeat count."
+ (interactive "*p")
+ (let ((modified (buffer-modified-p))
+ (recent-save (recent-auto-save-p)))
+ (or (eq (selected-window) (minibuffer-window))
+ (message "Undo..."))
+ (or (eq last-buffer-undo-list buffer-undo-list)
+ ;; skip one undo boundary and all point setting commands up
+ ;; until the next undo boundary and try again.
+ (let ((p buffer-undo-list))
+ (and (null (car-safe p)) (setq p (cdr-safe p)))
+ (while (and p (integerp (car-safe p)))
+ (setq p (cdr-safe p)))
+ (eq last-buffer-undo-list p))
+ (progn (undo-start)
+ (undo-more 1)))
+ (undo-more (or arg 1))
+ ;; Don't specify a position in the undo record for the undo command.
+ ;; Instead, undoing this should move point to where the change is.
+ ;;
+ ;;;; The old code for this was mad! It deleted all set-point
+ ;;;; references to the position from the whole undo list,
+ ;;;; instead of just the cells from the beginning to the next
+ ;;;; undo boundary. This does what I think the other code
+ ;;;; meant to do.
+ (let ((list buffer-undo-list)
+ (prev nil))
+ (while (and list (not (null (car list))))
+ (if (integerp (car list))
+ (if prev
+ (setcdr prev (cdr list))
+ ;; impossible now, but maybe not in the future
+ (setq buffer-undo-list (cdr list))))
+ (setq prev list
+ list (cdr list))))
+ (and modified (not (buffer-modified-p))
+ (delete-auto-save-file-if-necessary recent-save)))
+ (or (eq (selected-window) (minibuffer-window))
+ (message "Undo!"))
+ (setq last-buffer-undo-list buffer-undo-list))
+
+;;; redo.el ends here
--- /dev/null
+;;; scheme-complete.el --- Smart tab completion for Emacs
+
+;;; This code is written by Alex Shinn and placed in the Public
+;;; Domain. All warranties are disclaimed.
+
+;;; Commentary:
+
+;; This file provides a single function, `scheme-smart-complete',
+;; which you can use for intelligent, context-sensitive completion
+;; for any Scheme implementation. To use it just load this file and
+;; bind that function to a key in your preferred mode:
+;;
+;; (autoload 'scheme-smart-complete "scheme-complete" nil t)
+;; (eval-after-load 'scheme
+;; '(progn (define-key scheme-mode-map "\e\t" 'scheme-smart-complete)))
+;;
+;; Alternately, you may want to just bind TAB to the
+;; `scheme-complete-or-indent' function, which indents at the start
+;; of a line and otherwise performs the smart completion:
+;;
+;; (eval-after-load 'scheme
+;; '(progn (define-key scheme-mode-map "\t" 'scheme-complete-or-indent)))
+;;
+;; If you use eldoc-mode (included in Emacs), you can also get live
+;; scheme documentation with:
+;;
+;; (autoload 'scheme-get-current-symbol-info "scheme-complete" nil t)
+;; (add-hook 'scheme-mode-hook
+;; (lambda ()
+;; (make-local-variable 'eldoc-documentation-function)
+;; (setq eldoc-documentation-function 'scheme-get-current-symbol-info)
+;; (eldoc-mode)))
+;;
+;; There's a single custom variable, `scheme-default-implementation',
+;; which you can use to specify your preferred implementation when we
+;; can't infer it from the source code.
+;;
+;; That's all there is to it.
+
+;;; History:
+
+;; 0.8.2: 2008/07/04 - both TAB and M-TAB scroll results (thanks Peter Bex),
+;; better MATCH handling, fixed SRFI-55, other bugfixes
+;; 0.8.1: 2008/04/17 - great renaming, everthing starts with `scheme-'
+;; also, don't scan imported modules multiple times
+;; 0.8: 2008/02/08 - several parsing bugfixes on unclosed parenthesis
+;; (thanks to Kazushi NODA)
+;; filename completion works properly on absolute paths
+;; eldoc works properly on dotted lambdas
+;; 0.7: 2008/01/18 - handles higher-order types (for apply, map, etc.)
+;; smarter string completion (hostname, username, etc.)
+;; smarter type inference, various bugfixes
+;; 0.6: 2008/01/06 - more bugfixes (merry christmas)
+;; 0.5: 2008/01/03 - handling internal defines, records, smarter
+;; parsing
+;; 0.4: 2007/11/14 - silly bugfix plus better repo env support
+;; for searching chicken and gauche modules
+;; 0.3: 2007/11/13 - bugfixes, better inference, smart strings
+;; 0.2: 2007/10/15 - basic type inference
+;; 0.1: 2007/09/11 - initial release
+;;
+;; What is this talk of 'release'? Klingons do not make software
+;; 'releases'. Our software 'escapes' leaving a bloody trail of
+;; designers and quality assurance people in its wake.
+
+;;; Code:
+
+(require 'cl)
+
+;; this is just to eliminate some warnings when compiling - this file
+;; should be loaded after 'scheme
+(eval-when (compile)
+ (require 'scheme))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; info
+;;
+;; identifier type [doc-string no-type-display?]
+;;
+;; types:
+;;
+;; pair, number, symbol, etc.
+;; (lambda (param-types) [return-type])
+;; (syntax (param-types) [return-type])
+;; (set name values ...)
+;; (flags name values ...)
+;; (list type)
+;; (string expander)
+;; (special type function [outer-function])
+
+(defvar *scheme-r5rs-info*
+ '((define (syntax (identifier value) undefined) "define a new variable")
+ (set! (syntax (identifier value) undefined) "set the value of a variable")
+ (let (syntax (vars body \.\.\.)) "bind new local variables in parallel")
+ (let* (syntax (vars body \.\.\.)) "bind new local variables sequentially")
+ (letrec (syntax (vars body \.\.\.)) "bind new local variables recursively")
+ (lambda (syntax (params body \.\.\.)) "procedure syntax")
+ (if (syntax (cond then else)) "conditional evaluation")
+ (cond (syntax (clause \.\.\.)) "try each clause until one succeeds")
+ (case (syntax (expr clause \.\.\.)) "look for EXPR among literal lists")
+ (delay (syntax (expr)) "create a promise to evaluate EXPR")
+ (and (syntax (expr \.\.\.)) "evaluate EXPRs while true, return last")
+ (or (syntax (expr \.\.\.)) "return the first true EXPR")
+ (begin (syntax (expr \.\.\.)) "evaluate each EXPR in turn and return the last")
+ (do (syntax (vars finish body \.\.\.)) "simple iterator")
+ (quote (syntax (expr)) "represent EXPR literally without evaluating it")
+ (quasiquote (syntax (expr)) "quote literals allowing escapes")
+ (unquote (syntax (expr)) "escape an expression inside quasiquote")
+ (unquote-splicing (syntax (expr)) "escape and splice a list expression inside quasiquote")
+ (define-syntax (syntax (identifier body \.\.\.) undefined) "create a macro")
+ (let-syntax (syntax (syntaxes body \.\.\.)) "a local macro")
+ (letrec-syntax (syntax (syntaxes body \.\.\.)) "a local macro")
+ (syntax-rules (syntax (literals clauses \.\.\.) undefined) "simple macro language")
+ (eqv? (lambda (obj1 obj2) bool) "returns #t if OBJ1 and OBJ2 are the same object")
+ (eq? (lambda (obj1 obj2) bool) "finer grained version of EQV?")
+ (equal? (lambda (obj1 obj2) bool) "recursive equivalence")
+ (not (lambda (obj) bool) "returns #t iff OBJ is false")
+ (boolean? (lambda (obj) bool) "returns #t iff OBJ is #t or #f")
+ (number? (lambda (obj) bool) "returns #t iff OBJ is a number")
+ (complex? (lambda (obj) bool) "returns #t iff OBJ is a complex number")
+ (real? (lambda (obj) bool) "returns #t iff OBJ is a real number")
+ (rational? (lambda (obj) bool) "returns #t iff OBJ is a rational number")
+ (integer? (lambda (obj) bool) "returns #t iff OBJ is an integer")
+ (exact? (lambda (z) bool) "returns #t iff Z is exact")
+ (inexact? (lambda (z) bool) "returns #t iff Z is inexact")
+ (= (lambda (z1 z2 \.\.\.) bool) "returns #t iff the arguments are all equal")
+ (< (lambda (x1 x2 \.\.\.) bool) "returns #t iff the arguments are monotonically increasing")
+ (> (lambda (x1 x2 \.\.\.) bool) "returns #t iff the arguments are monotonically decreasing")
+ (<= (lambda (x1 x2 \.\.\.) bool) "returns #t iff the arguments are monotonically nondecreasing")
+ (>= (lambda (x1 x2 \.\.\.) bool) "returns #t iff the arguments are monotonically nonincreasing")
+ (zero? (lambda (z) bool))
+ (positive? (lambda (x1) bool))
+ (negative? (lambda (x1) bool))
+ (odd? (lambda (n) bool))
+ (even? (lambda (n) bool))
+ (max (lambda (x1 x2 \.\.\.) x3) "returns the maximum of the arguments")
+ (min (lambda (x1 x2 \.\.\.) x3) "returns the minimum of the arguments")
+ (+ (lambda (z1 \.\.\.) z))
+ (* (lambda (z1 \.\.\.) z))
+ (- (lambda (z1 \.\.\.) z))
+ (/ (lambda (z1 \.\.\.) z))
+ (abs (lambda (x1) x2) "returns the absolute value of X")
+ (quotient (lambda (n1 n2) n) "integer division")
+ (remainder (lambda (n1 n2) n) "same sign as N1")
+ (modulo (lambda (n1 n2) n) "same sign as N2")
+ (gcd (lambda (n1 \.\.\.) n) "greatest common divisor")
+ (lcm (lambda (n2 \.\.\.) n) "least common multiple")
+ (numerator (lambda (rational) n))
+ (denominator (lambda (rational) n))
+ (floor (lambda (x1) n) "largest integer not larger than X")
+ (ceiling (lambda (x1) n) "smallest integer not smaller than X")
+ (truncate (lambda (x1) n) "drop fractional part")
+ (round (lambda (x1) n) "round to even (banker's rounding)")
+ (rationalize (lambda (x1 y) n) "rational number differing from X by at most Y")
+ (exp (lambda (z) z) "e^Z")
+ (log (lambda (z) z) "natural logarithm of Z")
+ (sin (lambda (z) z) "sine function")
+ (cos (lambda (z) z) "cosine function")
+ (tan (lambda (z) z) "tangent function")
+ (asin (lambda (z) z) "arcsine function")
+ (acos (lambda (z) z) "arccosine function")
+ (atan (lambda (z) z) "arctangent function")
+ (sqrt (lambda (z) z) "principal square root of Z")
+ (expt (lambda (z1 z2) z) "returns Z1 raised to the Z2 power")
+ (make-rectangular (lambda (x1 x2) z) "create a complex number")
+ (make-polar (lambda (x1 x2) z) "create a complex number")
+ (real-part (lambda (z) x1))
+ (imag-part (lambda (z) x1))
+ (magnitude (lambda (z) x1))
+ (angle (lambda (z) x1))
+ (exact->inexact (lambda (z) z))
+ (inexact->exact (lambda (z) z))
+ (number->string (lambda (z :optional radix) str))
+ (string->number (lambda (str :optional radix) z))
+ (pair? (lambda (obj) bool) "returns #t iff OBJ is a pair")
+ (cons (lambda (obj1 obj2) pair) "create a newly allocated pair")
+ (car (lambda (pair) obj))
+ (cdr (lambda (pair) obj))
+ (set-car! (lambda (pair obj) undefined))
+ (set-cdr! (lambda (pair obj) undefined))
+ (caar (lambda (pair) obj))
+ (cadr (lambda (pair) obj))
+ (cdar (lambda (pair) obj))
+ (cddr (lambda (pair) obj))
+ (caaar (lambda (pair) obj))
+ (caadr (lambda (pair) obj))
+ (cadar (lambda (pair) obj))
+ (caddr (lambda (pair) obj))
+ (cdaar (lambda (pair) obj))
+ (cdadr (lambda (pair) obj))
+ (cddar (lambda (pair) obj))
+ (cdddr (lambda (pair) obj))
+ (caaaar (lambda (pair) obj))
+ (caaadr (lambda (pair) obj))
+ (caadar (lambda (pair) obj))
+ (caaddr (lambda (pair) obj))
+ (cadaar (lambda (pair) obj))
+ (cadadr (lambda (pair) obj))
+ (caddar (lambda (pair) obj))
+ (cadddr (lambda (pair) obj))
+ (cdaaar (lambda (pair) obj))
+ (cdaadr (lambda (pair) obj))
+ (cdadar (lambda (pair) obj))
+ (cdaddr (lambda (pair) obj))
+ (cddaar (lambda (pair) obj))
+ (cddadr (lambda (pair) obj))
+ (cdddar (lambda (pair) obj))
+ (cddddr (lambda (pair) obj))
+ (null? (lambda (obj) bool) "returns #t iff OBJ is the empty list")
+ (list? (lambda (obj) bool) "returns #t iff OBJ is a proper list")
+ (list (lambda (obj \.\.\.) list) "returns a newly allocated list")
+ (length (lambda (list) n))
+ (append (lambda (list \.\.\.) list) "concatenates the list arguments")
+ (reverse (lambda (list) list))
+ (list-tail (lambda (list k) list) "returns the Kth cdr of LIST")
+ (list-ref (lambda (list k) obj) "returns the Kth element of LIST")
+ (memq (lambda (obj list)) "the sublist of LIST whose car is eq? to OBJ")
+ (memv (lambda (obj list)) "the sublist of LIST whose car is eqv? to OBJ")
+ (member (lambda (obj list)) "the sublist of LIST whose car is equal? to OBJ")
+ (assq (lambda (obj list)) "the element of LIST whose car is eq? to OBJ")
+ (assv (lambda (obj list)) "the element of LIST whose car is eqv? to OBJ")
+ (assoc (lambda (obj list)) "the element of LIST whose car is equal? to OBJ")
+ (symbol? (lambda (obj) bool) "returns #t iff OBJ is a symbol")
+ (symbol->string (lambda (symbol) str))
+ (string->symbol (lambda (str) symbol))
+ (char? (lambda (obj) bool) "returns #t iff OBJ is a character")
+ (char=? (lambda (ch1 ch2) bool))
+ (char<? (lambda (ch1 ch2) bool))
+ (char>? (lambda (ch1 ch2) bool))
+ (char<=? (lambda (ch1 ch2) bool))
+ (char>=? (lambda (ch1 ch2) bool))
+ (char-ci=? (lambda (ch1 ch2) bool))
+ (char-ci<? (lambda (ch1 ch2) bool))
+ (char-ci>? (lambda (ch1 ch2) bool))
+ (char-ci<=? (lambda (ch1 ch2) bool))
+ (char-ci>=? (lambda (ch1 ch2) bool))
+ (char-alphabetic? (lambda (ch) bool))
+ (char-numeric? (lambda (ch) bool))
+ (char-whitespace? (lambda (ch) bool))
+ (char-upper-case? (lambda (ch) bool))
+ (char-lower-case? (lambda (ch) bool))
+ (char->integer (lambda (ch) int))
+ (integer->char (lambda (int) ch))
+ (char-upcase (lambda (ch) ch))
+ (char-downcase (lambda (ch) ch))
+ (string? (lambda (obj) bool) "returns #t iff OBJ is a string")
+ (make-string (lambda (k :optional ch) str) "a new string of length k")
+ (string (lambda (ch \.\.\.) str) "a new string made of the char arguments")
+ (string-length (lambda (str) n) "the number of characters in STR")
+ (string-ref (lambda (str i) ch) "the Ith character of STR")
+ (string-set! (lambda (str i ch) undefined) "set the Ith character of STR to CH")
+ (string=? (lambda (str1 str2) bool))
+ (string-ci=? (lambda (str1 str2) bool))
+ (string<? (lambda (str1 str2) bool))
+ (string>? (lambda (str1 str2) bool))
+ (string<=? (lambda (str1 str2) bool))
+ (string>=? (lambda (str1 str2) bool))
+ (string-ci<? (lambda (str1 str2) bool))
+ (string-ci>? (lambda (str1 str2) bool))
+ (string-ci<=? (lambda (str1 str2) bool))
+ (string-ci>=? (lambda (str1 str2) bool))
+ (substring (lambda (str start end) str))
+ (string-append (lambda (str \.\.\.) str) "concatenate the string arguments")
+ (string->list (lambda (str) list))
+ (list->string (lambda (list) str))
+ (string-copy (lambda (str) str))
+ (string-fill! (lambda (str ch) undefined) "set every char in STR to CH")
+ (vector? (lambda (obj) bool) "returns #t iff OBJ is a vector")
+ (make-vector (lambda (len :optional fill) vec) "a new vector of K elements")
+ (vector (lambda (obj \.\.\.) vec))
+ (vector-length (lambda (vec) n) "the number of elements in VEC")
+ (vector-ref (lambda (vec i) obj) "the Ith element of VEC")
+ (vector-set! (lambda (vec i obj) undefined) "set the Ith element of VEC to OBJ")
+ (vector->list (lambda (vec) list))
+ (list->vector (lambda (list) vec))
+ (vector-fill! (lambda (vec obj) undefined) "set every element in VEC to OBJ")
+ (procedure? (lambda (obj) bool) "returns #t iff OBJ is a procedure")
+ (apply (lambda ((lambda obj a) obj \.\.\.) a) "procedure application")
+ (map (lambda ((lambda obj a) obj \.\.\.) (list a)) "a new list of PROC applied to every element of LIST")
+ (for-each (lambda ((lambda obj a) obj \.\.\.) undefined) "apply PROC to each element of LIST in order")
+ (force (lambda (promise) obj) "force the delayed value of PROMISE")
+ (call-with-current-continuation (lambda (proc) obj) "goto on steroids")
+ (values (lambda (obj \.\.\.)) "send multiple values to the calling continuation")
+ (call-with-values (lambda (producer consumer) obj))
+ (dynamic-wind (lambda (before-thunk thunk after-thunk) obj))
+ (scheme-report-environment (lambda (int) env) "INT should be 5")
+ (null-environment (lambda (int) env) "INT should be 5")
+ (call-with-input-file (lambda (path proc) input-port))
+ (call-with-output-file (lambda (path proc) output-port))
+ (input-port? (lambda (obj) bool) "returns #t iff OBJ is an input port")
+ (output-port? (lambda (obj) bool) "returns #t iff OBJ is an output port")
+ (current-input-port (lambda () input-port) "the default input for read procedures")
+ (current-output-port (lambda () output-port) "the default output for write procedures")
+ (with-input-from-file (lambda (path thunk) obj))
+ (with-output-to-file (lambda (path thunk) obj))
+ (open-input-file (lambda (path) input-port))
+ (open-output-file (lambda (path) output-port))
+ (close-input-port (lambda (input-port)))
+ (close-output-port (lambda (output-port)))
+ (read (lambda (:optional input-port) obj) "read a datum")
+ (read-char (lambda (:optional input-port) ch) "read a single character")
+ (peek-char (lambda (:optional input-port) ch))
+ (eof-object? (lambda (obj) bool) "returns #t iff OBJ is the end-of-file object")
+ (char-ready? (lambda (:optional input-port) bool))
+ (write (lambda (object :optional output-port) undefined) "write a datum")
+ (display (lambda (object :optional output-port) undefined) "display")
+ (newline (lambda (:optional output-port) undefined) "send a linefeed")
+ (write-char (lambda (char :optional output-port) undefined) "write a single character")
+ (load (lambda (filename) undefined) "evaluate expressions from a file")
+ (eval (lambda (expr env)))
+ ))
+
+(defvar *scheme-srfi-info*
+ [
+ ;; SRFI 0
+ ("Feature-based conditional expansion construct"
+ (cond-expand (syntax (clause \.\.\.))))
+
+ ;; SRFI 1
+ ("List Library"
+ (xcons (lambda (object object) pair))
+ (cons* (lambda (object \.\.\.) pair))
+ (make-list (lambda (integer :optional object) list))
+ (list-tabulate (lambda (integer procedure) list))
+ (list-copy (lambda (list) list))
+ (circular-list (lambda (object \.\.\.) list))
+ (iota (lambda (integer :optional integer integer) list))
+ (proper-list? (lambda (object) bool))
+ (circular-list? (lambda (object) bool))
+ (dotted-list? (lambda (object) bool))
+ (not-pair? (lambda (object) bool))
+ (null-list? (lambda (object) bool))
+ (list= (lambda (procedure list \.\.\.) bool))
+ (first (lambda (pair)))
+ (second (lambda (pair)))
+ (third (lambda (pair)))
+ (fourth (lambda (pair)))
+ (fifth (lambda (pair)))
+ (sixth (lambda (pair)))
+ (seventh (lambda (pair)))
+ (eighth (lambda (pair)))
+ (ninth (lambda (pair)))
+ (tenth (lambda (pair)))
+ (car+cdr (lambda (pair)))
+ (take (lambda (pair integer) list))
+ (drop (lambda (pair integer) list))
+ (take-right (lambda (pair integer) list))
+ (drop-right (lambda (pair integer) list))
+ (take! (lambda (pair integer) list))
+ (drop-right! (lambda (pair integer) list))
+ (split-at (lambda (pair integer) list))
+ (split-at! (lambda (pair integer) list))
+ (last (lambda (pair) obj))
+ (last-pair (lambda (pair) pair))
+ (length+ (lambda (object) n))
+ (concatenate (lambda (list) list))
+ (append! (lambda (list \.\.\.) list))
+ (concatenate! (lambda (list) list))
+ (reverse! (lambda (list) list))
+ (append-reverse (lambda (list list) list))
+ (append-reverse! (lambda (list list) list))
+ (zip (lambda (list \.\.\.) list))
+ (unzip1 (lambda (list) list))
+ (unzip2 (lambda (list) list))
+ (unzip3 (lambda (list) list))
+ (unzip4 (lambda (list) list))
+ (unzip5 (lambda (list) list))
+ (count (lambda (procedure list \.\.\.) n))
+ (fold (lambda ((lambda obj a) object list \.\.\.) a))
+ (unfold (lambda (procedure procedure procedure object :optional procedure) obj))
+ (pair-fold (lambda ((lambda obj a) object list \.\.\.) a))
+ (reduce (lambda ((lambda obj a) object list \.\.\.) a))
+ (fold-right (lambda ((lambda obj a) object list \.\.\.) a))
+ (unfold-right (lambda (procedure procedure procedure object :optional object) obj))
+ (pair-fold-right (lambda ((lambda obj a) object list \.\.\.) a))
+ (reduce-right (lambda ((lambda obj a) object list \.\.\.) a))
+ (append-map (lambda (procedure list \.\.\.) list))
+ (append-map! (lambda (procedure list \.\.\.) list))
+ (map! (lambda (procedure list \.\.\.) list))
+ (pair-for-each (lambda (procedure list \.\.\.) undefined))
+ (filter-map (lambda (procedure list \.\.\.) list))
+ (map-in-order (lambda (procedure list \.\.\.) list))
+ (filter (lambda (procedure list) list))
+ (partition (lambda (procedure list) list))
+ (remove (lambda (procedure list) list))
+ (filter! (lambda (procedure list) list))
+ (partition! (lambda (procedure list) list))
+ (remove! (lambda (procedure list) list))
+ (find (lambda (procedure list) obj))
+ (find-tail (lambda (procedure list) obj))
+ (any (lambda ((lambda obj a) list \.\.\.) a))
+ (every (lambda ((lambda obj a) list \.\.\.) a))
+ (list-index (lambda (procedure list \.\.\.) (or bool integer)))
+ (take-while (lambda (procedure list) list))
+ (drop-while (lambda (procedure list) list))
+ (take-while! (lambda (procedure list) list))
+ (span (lambda (procedure list) list))
+ (break (lambda (procedure list) list))
+ (span! (lambda (procedure list) list))
+ (break! (lambda (procedure list) list))
+ (delete (lambda (object list :optional procedure) list))
+ (delete-duplicates (lambda (list :optional procedure) list))
+ (delete! (lambda (obj list :optional procedure) list))
+ (delete-duplicates! (lambda (list :optional procedure) list))
+ (alist-cons (lambda (obj1 obj2 alist) alist))
+ (alist-copy (lambda (alist) alist))
+ (alist-delete (lambda (obj alist) alist))
+ (alist-delete! (lambda (obj alist) alist))
+ (lset<= (lambda (procedure list \.\.\.) bool))
+ (lset= (lambda (procedure list \.\.\.) bool))
+ (lset-adjoin (lambda (procedure list object \.\.\.) list))
+ (lset-union (lambda (procedure list \.\.\.) list))
+ (lset-union! (lambda (procedure list \.\.\.) list))
+ (lset-intersection (lambda (procedure list \.\.\.) list))
+ (lset-intersection! (lambda (procedure list \.\.\.) list))
+ (lset-difference (lambda (procedure list \.\.\.) list))
+ (lset-difference! (lambda (procedure list \.\.\.) list))
+ (lset-xor (lambda (procedure list \.\.\.) list))
+ (lset-xor! (lambda (procedure list \.\.\.) list))
+ (lset-diff+intersection (lambda (procedure list \.\.\.) list))
+ (lset-diff+intersection! (lambda (procedure list \.\.\.) list))
+
+ )
+
+ ;; SRFI 2
+ ("AND-LET*: an AND with local bindings, a guarded LET* special form"
+ (and-let* (syntax (bindings body \.\.\.))))
+
+ ()
+
+ ;; SRFI 4
+ ("Homogeneous numeric vector datatypes"
+
+ (u8vector? (lambda (obj) bool))
+ (make-u8vector (lambda (size integer) u8vector))
+ (u8vector (lambda (integer \.\.\.) u8vector))
+ (u8vector-length (lambda (u8vector) n))
+ (u8vector-ref (lambda (u8vector i) int))
+ (u8vector-set! (lambda (u8vector i u8value) undefined))
+ (u8vector->list (lambda (u8vector) list))
+ (list->u8vector (lambda (list) u8vector))
+
+ (s8vector? (lambda (obj) bool))
+ (make-s8vector (lambda (size integer) s8vector))
+ (s8vector (lambda (integer \.\.\.) s8vector))
+ (s8vector-length (lambda (s8vector) n))
+ (s8vector-ref (lambda (s8vector i) int))
+ (s8vector-set! (lambda (s8vector i s8value) undefined))
+ (s8vector->list (lambda (s8vector) list))
+ (list->s8vector (lambda (list) s8vector))
+
+ (u16vector? (lambda (obj) bool))
+ (make-u16vector (lambda (size integer) u16vector))
+ (u16vector (lambda (integer \.\.\.)))
+ (u16vector-length (lambda (u16vector) n))
+ (u16vector-ref (lambda (u16vector i) int))
+ (u16vector-set! (lambda (u16vector i u16value) undefined))
+ (u16vector->list (lambda (u16vector) list))
+ (list->u16vector (lambda (list) u16vector))
+
+ (s16vector? (lambda (obj) bool))
+ (make-s16vector (lambda (size integer) s16vector))
+ (s16vector (lambda (integer \.\.\.) s16vector))
+ (s16vector-length (lambda (s16vector) n))
+ (s16vector-ref (lambda (s16vector i) int))
+ (s16vector-set! (lambda (s16vector i s16value) undefined))
+ (s16vector->list (lambda (s16vector) list))
+ (list->s16vector (lambda (list) s16vector))
+
+ (u32vector? (lambda (obj) bool))
+ (make-u32vector (lambda (size integer) u32vector))
+ (u32vector (lambda (integer \.\.\.) u32vector))
+ (u32vector-length (lambda (u32vector) n))
+ (u32vector-ref (lambda (u32vector i) int))
+ (u32vector-set! (lambda (u32vector i u32value) undefined))
+ (u32vector->list (lambda (u32vector) list))
+ (list->u32vector (lambda (list) u32vector))
+
+ (s32vector? (lambda (obj) bool))
+ (make-s32vector (lambda (size integer) s32vector))
+ (s32vector (lambda (integer \.\.\.) s32vector))
+ (s32vector-length (lambda (s32vector) n))
+ (s32vector-ref (lambda (s32vector i) int))
+ (s32vector-set! (lambda (s32vector i s32value) undefined))
+ (s32vector->list (lambda (s32vector) list))
+ (list->s32vector (lambda (list) s32vector))
+
+ (u64vector? (lambda (obj) bool))
+ (make-u64vector (lambda (size integer) u64vector))
+ (u64vector (lambda (integer \.\.\.) u64vector))
+ (u64vector-length (lambda (u64vector) n))
+ (u64vector-ref (lambda (u64vector i) int))
+ (u64vector-set! (lambda (u64vector i u64value) undefined))
+ (u64vector->list (lambda (u64vector) list))
+ (list->u64vector (lambda (list) u64vector))
+
+ (s64vector? (lambda (obj) bool))
+ (make-s64vector (lambda (size integer) s64vector))
+ (s64vector (lambda (integer \.\.\.) s64vector))
+ (s64vector-length (lambda (s64vector) n))
+ (s64vector-ref (lambda (s64vector i) int))
+ (s64vector-set! (lambda (s64vector i s64value) undefined))
+ (s64vector->list (lambda (s64vector) list))
+ (list->s64vector (lambda (list) s64vector))
+
+ (f32vector? (lambda (obj) bool))
+ (make-f32vector (lambda (size integer) f32vector))
+ (f32vector (lambda (number \.\.\.) f32vector))
+ (f32vector-length (lambda (f32vector) n))
+ (f32vector-ref (lambda (f32vector i) int))
+ (f32vector-set! (lambda (f32vector i f32value) undefined))
+ (f32vector->list (lambda (f32vector) list))
+ (list->f32vector (lambda (list) f32vector))
+
+ (f64vector? (lambda (obj) bool))
+ (make-f64vector (lambda (size integer) f64vector))
+ (f64vector (lambda (number \.\.\.) f64vector))
+ (f64vector-length (lambda (f64vector) n))
+ (f64vector-ref (lambda (f64vector i) int))
+ (f64vector-set! (lambda (f64vector i f64value) undefined))
+ (f64vector->list (lambda (f64vector) list))
+ (list->f64vector (lambda (list) f64vector))
+ )
+
+ ;; SRFI 5
+ ("A compatible let form with signatures and rest arguments"
+ (let (syntax (bindings body \.\.\.))))
+
+ ;; SRFI 6
+ ("Basic String Ports"
+ (open-input-string (lambda (str) input-port))
+ (open-output-string (lambda () output-port))
+ (get-output-string (lambda (output-port) str)))
+
+ ;; SRFI 7
+ ("Feature-based program configuration language"
+ (program (syntax (clause \.\.\.)))
+ (feature-cond (syntax (clause))))
+
+ ;; SRFI 8
+ ("receive: Binding to multiple values"
+ (receive (syntax (identifiers producer body \.\.\.))))
+
+ ;; SRFI 9
+ ("Defining Record Types"
+ (define-record-type (syntax (name constructor-name pred-name fields \.\.\.))))
+
+ ;; SRFI 10
+ ("Sharp-Comma External Form"
+ (define-reader-ctor (syntax (name proc) undefined)))
+
+ ;; SRFI 11
+ ("Syntax for receiving multiple values"
+ (let-values (syntax (bindings body \.\.\.)))
+ (let-values* (syntax (bindings body \.\.\.))))
+
+ ()
+
+ ;; SRFI 13
+ ("String Library"
+ (string-map (lambda (proc str :optional start end) str))
+ (string-map! (lambda (proc str :optional start end) undefined))
+ (string-fold (lambda (kons knil str :optional start end) obj))
+ (string-fold-right (lambda (kons knil str :optional start end) obj))
+ (string-unfold (lambda (p f g seed :optional base make-final) str))
+ (string-unfold-right (lambda (p f g seed :optional base make-final) str))
+ (string-tabulate (lambda (proc len) str))
+ (string-for-each (lambda (proc str :optional start end) undefined))
+ (string-for-each-index (lambda (proc str :optional start end) undefined))
+ (string-every (lambda (pred str :optional start end) obj))
+ (string-any (lambda (pred str :optional start end) obj))
+ (string-hash (lambda (str :optional bound start end) int))
+ (string-hash-ci (lambda (str :optional bound start end) int))
+ (string-compare (lambda (string1 string2 lt-proc eq-proc gt-proc :optional start end) obj))
+ (string-compare-ci (lambda (string1 string2 lt-proc eq-proc gt-proc :optional start end) obj))
+ (string= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string<> (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string< (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string> (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string<= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string>= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-ci= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-ci<> (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-ci< (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-ci> (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-ci<= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-ci>= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-titlecase (lambda (string :optional start end) str))
+ (string-upcase (lambda (string :optional start end) str))
+ (string-downcase (lambda (string :optional start end) str))
+ (string-titlecase! (lambda (string :optional start end) undefined))
+ (string-upcase! (lambda (string :optional start end) undefined))
+ (string-downcase! (lambda (string :optional start end) undefined))
+ (string-take (lambda (string nchars) str))
+ (string-drop (lambda (string nchars) str))
+ (string-take-right (lambda (string nchars) str))
+ (string-drop-right (lambda (string nchars) str))
+ (string-pad (lambda (string k :optional char start end) str))
+ (string-pad-right (lambda (string k :optional char start end) str))
+ (string-trim (lambda (string :optional char/char-set/pred start end) str))
+ (string-trim-right (lambda (string :optional char/char-set/pred start end) str))
+ (string-trim-both (lambda (string :optional char/char-set/pred start end) str))
+ (string-filter (lambda (char/char-set/pred string :optional start end) str))
+ (string-delete (lambda (char/char-set/pred string :optional start end) str))
+ (string-index (lambda (string char/char-set/pred :optional start end) (or integer bool)))
+ (string-index-right (lambda (string char/char-set/pred :optional end start) (or integer bool)))
+ (string-skip (lambda (string char/char-set/pred :optional start end) (or integer bool)))
+ (string-skip-right (lambda (string char/char-set/pred :optional end start) (or integer bool)))
+ (string-count (lambda (string char/char-set/pred :optional start end) n))
+ (string-prefix-length (lambda (string1 string2 :optional start1 end1 start2 end2) n))
+ (string-suffix-length (lambda (string1 string2 :optional start1 end1 start2 end2) n))
+ (string-prefix-length-ci (lambda (string1 string2 :optional start1 end1 start2 end2) n))
+ (string-suffix-length-ci (lambda (string1 string2 :optional start1 end1 start2 end2) n))
+ (string-prefix? (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-suffix? (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-prefix-ci? (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-suffix-ci? (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
+ (string-contains (lambda (string pattern :optional s-start s-end p-start p-end) obj))
+ (string-contains-ci (lambda (string pattern :optional s-start s-end p-start p-end) obj))
+ (string-fill! (lambda (string char :optional start end) undefined))
+ (string-copy! (lambda (to tstart from :optional fstart fend) undefined))
+ (string-copy (lambda (str :optional start end) str))
+ (substring/shared (lambda (str start :optional end) str))
+ (string-reverse (lambda (str :optional start end) str))
+ (string-reverse! (lambda (str :optional start end) undefined))
+ (reverse-list->string (lambda (char-list) str))
+ (string->list (lambda (str :optional start end) list))
+ (string-concatenate (lambda (string-list) str))
+ (string-concatenate/shared (lambda (string-list) str))
+ (string-append/shared (lambda (str \.\.\.) str))
+ (string-concatenate-reverse (lambda (string-list :optional final-string end) str))
+ (string-concatenate-reverse/shared (lambda (string-list :optional final-string end) str))
+ (xsubstring (lambda (str from :optional to start end) str))
+ (string-xcopy! (lambda (target tstart str from :optional to start end) undefined))
+ (string-null? (lambda (str) bool))
+ (string-join (lambda (string-list :optional delim grammar) str))
+ (string-tokenize (lambda (string :optional token-chars start end) str))
+ (string-replace (lambda (str1 str2 start1 end1 :optional start2 end2) str))
+ (string-kmp-partial-search (lambda (pat rv str i :optional c= p-start s-start s-end) n))
+ (make-kmp-restart-vector (lambda (str :optional c= start end) vec))
+ (kmp-step (lambda (pat rv c i c= p-start) n))
+ )
+
+ ;; SRFI 14
+ ("Character-Set Library"
+ (char-set? (lambda (cset) bool))
+ (char-set= (lambda (cset \.\.\.) bool))
+ (char-set<= (lambda (cset \.\.\.) bool))
+ (char-set-hash (lambda (cset :optional int) int))
+ (char-set-cursor (lambda (cset) cursor))
+ (char-set-ref (lambda (cset cursor) ch))
+ (char-set-cursor-next (lambda (cset cursor) int))
+ (end-of-char-set? (lambda (cursor) bool))
+ (char-set-fold (lambda (proc obj cset) obj))
+ (char-set-unfold (lambda (proc proc proc obj :optional obj) cset))
+ (char-set-unfold! (lambda (proc proc proc obj obj) cset))
+ (char-set-for-each (lambda (proc cset) undefined))
+ (char-set-map (lambda (proc cset) cset))
+ (char-set-copy (lambda (cset) cset))
+ (char-set (lambda (ch \.\.\.) cset))
+ (list->char-set (lambda (list :optional obj) cset))
+ (list->char-set! (lambda (list cset) cset))
+ (string->char-set (lambda (str :optional cset) cset))
+ (string->char-set! (lambda (str cset) cset))
+ (ucs-range->char-set (lambda (int int :optional bool cset) cset))
+ (ucs-range->char-set! (lambda (int int bool cset) cset))
+ (char-set-filter (lambda (proc cset :optional base-cset) cset))
+ (char-set-filter! (lambda (proc cset base-cset) cset))
+ (->char-set (lambda (obj) cset))
+ (char-set-size (lambda (cset) n))
+ (char-set-count (lambda (proc cset) n))
+ (char-set-contains? (lambda (cset ch) bool))
+ (char-set-every (lambda (proc cset) obj))
+ (char-set-any (lambda (proc cset) obj))
+ (char-set-adjoin (lambda (cset ch \.\.\.) cset))
+ (char-set-delete (lambda (cset ch \.\.\.) cset))
+ (char-set-adjoin! (lambda (cset ch \.\.\.) cset))
+ (char-set-delete! (lambda (cset ch \.\.\.) cset))
+ (char-set->list (lambda (cset) list))
+ (char-set->string (lambda (cset) str))
+ (char-set-complement (lambda (cset) cset))
+ (char-set-union (lambda (cset \.\.\.) cset))
+ (char-set-intersection (lambda (cset \.\.\.) cset))
+ (char-set-xor (lambda (cset \.\.\.) cset))
+ (char-set-difference (lambda (cset \.\.\.) cset))
+ (char-set-diff+intersection (lambda (cset \.\.\.) cset))
+ (char-set-complement! (lambda (cset) cset))
+ (char-set-union! (lambda (cset \.\.\.) cset))
+ (char-set-intersection! (lambda (cset \.\.\.) cset))
+ (char-set-xor! (lambda (cset \.\.\.) cset))
+ (char-set-difference! (lambda (cset \.\.\.) cset))
+ (char-set-diff+intersection! (lambda (cset \.\.\.) cset))
+ (char-set:lower-case char-set)
+ (char-set:upper-case char-set)
+ (char-set:letter char-set)
+ (char-set:digit char-set)
+ (char-set:letter+digit char-set)
+ (char-set:graphic char-set)
+ (char-set:printing char-set)
+ (char-set:whitespace char-set)
+ (char-set:blank char-set)
+ (char-set:iso-control char-set)
+ (char-set:punctuation char-set)
+ (char-set:symbol char-set)
+ (char-set:hex-digit char-set)
+ (char-set:ascii char-set)
+ (char-set:empty char-set)
+ (char-set:full char-set)
+ )
+
+ ()
+
+ ;; SRFI 16
+ ("Syntax for procedures of variable arity"
+ (case-lambda (syntax (clauses \.\.\.) procedure)))
+
+ ;; SRFI 17
+ ("Generalized set!"
+ (set! (syntax (what value) undefined)))
+
+ ;; SRFI 18
+ ("Multithreading support"
+ (current-thread (lambda () thread))
+ (thread? (lambda (obj) bool))
+ (make-thread (lambda (thunk :optional name) thread))
+ (thread-name (lambda (thread) name))
+ (thread-specific (lambda (thread)))
+ (thread-specific-set! (lambda (thread obj)))
+ (thread-base-priority (lambda (thread)))
+ (thread-base-priority-set! (lambda (thread number)))
+ (thread-priority-boost (lambda (thread)))
+ (thread-priority-boost-set! (lambda (thread number)))
+ (thread-quantum (lambda (thread)))
+ (thread-quantum-set! (lambda (thread number)))
+ (thread-start! (lambda (thread)))
+ (thread-yield! (lambda ()))
+ (thread-sleep! (lambda (number)))
+ (thread-terminate! (lambda (thread)))
+ (thread-join! (lambda (thread :optional timeout timeout-val)))
+ (mutex? (lambda (obj) bool))
+ (make-mutex (lambda (:optional name) mutex))
+ (mutex-name (lambda (mutex) name))
+ (mutex-specific (lambda (mutex)))
+ (mutex-specific-set! (lambda (mutex obj)))
+ (mutex-state (lambda (mutex)))
+ (mutex-lock! (lambda (mutex :optional timeout thread)))
+ (mutex-unlock! (lambda (mutex :optional condition-variable timeout)))
+ (condition-variable? (lambda (obj) bool))
+ (make-condition-variable (lambda (:optional name) condition-variable))
+ (condition-variable-name (lambda (condition-variable) name))
+ (condition-variable-specific (lambda (condition-variable)))
+ (condition-variable-specific-set! (lambda (condition-variable obj)))
+ (condition-variable-signal! (lambda (condition-variable)))
+ (condition-variable-broadcast! (lambda (condition-variable)))
+ (current-time (lambda () time))
+ (time? (lambda (obj) bool))
+ (time->seconds (lambda (time) x1))
+ (seconds->time (lambda (x1) time))
+ (current-exception-handler (lambda () handler))
+ (with-exception-handler (lambda (handler thunk)))
+ (raise (lambda (obj)))
+ (join-timeout-exception? (lambda (obj) bool))
+ (abandoned-mutex-exception? (lambda (obj) bool))
+ (terminated-thread-exception? (lambda (obj) bool))
+ (uncaught-exception? (lambda (obj) bool))
+ (uncaught-exception-reason (lambda (exc) obj))
+ )
+
+ ;; SRFI 19
+ ("Time Data Types and Procedures"
+ (current-date (lambda (:optional tz-offset)) date)
+ (current-julian-day (lambda ()) jdn)
+ (current-modified-julian-day (lambda ()) mjdn)
+ (current-time (lambda (:optional time-type)) time)
+ (time-resolution (lambda (:optional time-type)) nanoseconds)
+ (make-time (lambda (type nanosecond second)))
+ (time? (lambda (obj)))
+ (time-type (lambda (time)))
+ (time-nanosecond (lambda (time)))
+ (time-second (lambda (time)))
+ (set-time-type! (lambda (time)))
+ (set-time-nanosecond! (lambda (time)))
+ (set-time-second! (lambda (time)))
+ (copy-time (lambda (time)))
+ (time<=? (lambda (time1 time2)))
+ (time<? (lambda (time1 time2)))
+ (time=? (lambda (time1 time2)))
+ (time>=? (lambda (time1 time2)))
+ (time>? (lambda (time1 time2)))
+ (time-difference (lambda (time1 time2)))
+ (time-difference! (lambda (time1 time2)))
+ (add-duration (lambda (time duration)))
+ (add-duration! (lambda (time duration)))
+ (subtract-duration (lambda (time duration)))
+ (subtract-duration! (lambda (time duration)))
+ (make-date (lambda (nanosecond second minute hour day month year zone-offset)))
+ (date? (lambda (obj)))
+ (date-nanosecond (lambda (date)))
+ (date-second (lambda (date)))
+ (date-minute (lambda (date)))
+ (date-hour (lambda (date)))
+ (date-day (lambda (date)))
+ (date-month (lambda (date)))
+ (date-year (lambda (date)))
+ (date-zone-offset (lambda (date)))
+ (date-year-day (lambda (date)))
+ (date-week-day (lambda (date)))
+ (date-week-number (lambda (date)))
+ (date->julian-day (lambda (date)))
+ (date->modified-julian-day (lambda (date)))
+ (date->time-monotonic (lambda (date)))
+ (date->time-tai (lambda (date)))
+ (date->time-utc (lambda (date)))
+ (julian-day->date (lambda (date)))
+ (julian-day->time-monotonic (lambda (date)))
+ (julian-day->time-tai (lambda (date)))
+ (julian-day->time-utc (lambda (date)))
+ (modified-julian-day->date (lambda (date)))
+ (modified-julian-day->time-monotonic (lambda (date)))
+ (modified-julian-day->time-tai (lambda (date)))
+ (modified-julian-day->time-utc (lambda (date)))
+ (time-monotonic->date (lambda (date)))
+ (time-monotonic->julian-day (lambda (date)))
+ (time-monotonic->modified-julian-day (lambda (date)))
+ (time-monotonic->time-monotonic (lambda (date)))
+ (time-monotonic->time-tai (lambda (date)))
+ (time-monotonic->time-tai! (lambda (date)))
+ (time-monotonic->time-utc (lambda (date)))
+ (time-monotonic->time-utc! (lambda (date)))
+ (time-tai->date (lambda (date)))
+ (time-tai->julian-day (lambda (date)))
+ (time-tai->modified-julian-day (lambda (date)))
+ (time-tai->time-monotonic (lambda (date)))
+ (time-tai->time-monotonic! (lambda (date)))
+ (time-tai->time-utc (lambda (date)))
+ (time-tai->time-utc! (lambda (date)))
+ (time-utc->date (lambda (date)))
+ (time-utc->julian-day (lambda (date)))
+ (time-utc->modified-julian-day (lambda (date)))
+ (time-utc->time-monotonic (lambda (date)))
+ (time-utc->time-monotonic! (lambda (date)))
+ (time-utc->time-tai (lambda (date)))
+ (time-utc->time-tai! (lambda (date)))
+ (date->string (lambda (date :optional format-string)))
+ (string->date (lambda (input-string template-string)))
+ )
+
+ ()
+
+ ;; SRFI 21
+ ("Real-time multithreading support"
+ srfi-18) ; same as srfi-18
+
+ ;; SRFI 22
+ ("Running Scheme Scripts on Unix"
+ )
+
+ ;; SRFI 23
+ ("Error reporting mechanism"
+ (error (lambda (reason-string arg \.\.\.))))
+
+ ()
+
+ ;; SRFI 25
+ ("Multi-dimensional Array Primitives"
+ (array? (lambda (obj)))
+ (make-array (lambda (shape :optional init)))
+ (shape (lambda (bound \.\.\.)))
+ (array (lambda (shape obj \.\.\.)))
+ (array-rank (lambda (array)))
+ (array-start (lambda (array)))
+ (array-end (lambda (array)))
+ (array-shape (lambda (array)))
+ (array-ref (lambda (array i \.\.\.)))
+ (array-set! (lambda (array obj \.\.\.) undefined))
+ (share-array (lambda (array shape proc)))
+ )
+
+ ;; SRFI 26
+ ("Notation for Specializing Parameters without Currying"
+ (cut (syntax (obj \.\.\.)))
+ (cute (lambda (obj \.\.\.))))
+
+ ;; SRFI 27
+ ("Sources of Random Bits"
+ (random-integer (lambda (n)))
+ (random-real (lambda ()))
+ (default-random-source (lambda ()))
+ (make-random-source (lambda ()))
+ (random-source? (lambda (obj)))
+ (random-source-state-ref (lambda (random-source)))
+ (random-source-state-set! (lambda (random-source state)))
+ (random-source-randomize! (lambda (random-source)))
+ (random-source-pseudo-randomize! (lambda (random-source i j)))
+ (random-source-make-integers (lambda (random-source)))
+ (random-source-make-reals (lambda (random-source)))
+ )
+
+ ;; SRFI 28
+ ("Basic Format Strings"
+ (format (lambda (port-or-boolean format-string arg \.\.\.))))
+
+ ;; SRFI 29
+ ("Localization"
+ (current-language (lambda (:optional symbol)))
+ (current-country (lambda (:optional symbol)))
+ (current-locale-details (lambda (:optional list)))
+ (declare-bundle! (lambda (bundle-name association-list)))
+ (store-bundle (lambda (bundle-name)))
+ (load-bundle! (lambda (bundle-name)))
+ (localized-template (lambda (package-name message-template-name)))
+ )
+
+ ;; SRFI 30
+ ("Nested Multi-line Comments"
+ )
+
+ ;; SRFI 31
+ ("A special form for recursive evaluation"
+ (rec (syntax (name body \.\.\.) procedure)))
+
+ ()
+
+ ()
+
+ ;; SRFI 34
+ ("Exception Handling for Programs"
+ (guard (syntax (clauses \.\.\.)))
+ (raise (lambda (obj)))
+ )
+
+ ;; SRFI 35
+ ("Conditions"
+ (make-condition-type (lambda (id parent field-name-list)))
+ (condition-type? (lambda (obj)))
+ (make-condition (lambda (condition-type)))
+ (condition? (lambda (obj)))
+ (condition-has-type? (lambda (condition condition-type)))
+ (condition-ref (lambda (condition field-name)))
+ (make-compound-condition (lambda (condition \.\.\.)))
+ (extract-condition (lambda (condition condition-type)))
+ (define-condition-type (syntax (name parent pred-name fields \.\.\.)))
+ (condition (syntax (type-field-binding \.\.\.)))
+ )
+
+ ;; SRFI 36
+ ("I/O Conditions"
+ (&error condition)
+ (&i/o-error condition)
+ (&i/o-port-error condition)
+ (&i/o-read-error condition)
+ (&i/o-write-error condition)
+ (&i/o-closed-error condition)
+ (&i/o-filename-error condition)
+ (&i/o-malformed-filename-error condition)
+ (&i/o-file-protection-error condition)
+ (&i/o-file-is-read-only-error condition)
+ (&i/o-file-already-exists-error condition)
+ (&i/o-no-such-file-error condition)
+ )
+
+ ;; SRFI 37
+ ("args-fold: a program argument processor"
+ (args-fold
+ (arg-list option-list unrecognized-option-proc operand-proc seed \.\.\.))
+ (option-processor (lambda (option name arg seeds \.\.\.)))
+ (operand-processor (lambda (operand seeds \.\.\.)))
+ (option (lambda (name-list required-arg? optional-arg? option-proc)))
+ (option-names (lambda (option)))
+ (option-required-arg? (lambda (option)))
+ (option-optional-arg? (lambda (option)))
+ (option-processor (lambda (option)))
+ )
+
+ ;; SRFI 38
+ ("External Representation for Data With Shared Structure"
+ (write-with-shared-structure (lambda (obj :optional port optarg)))
+ (read-with-shared-structure (lambda (:optional port)))
+ )
+
+ ;; SRFI 39
+ ("Parameter objects"
+ (make-parameter (lambda (init-value :optional converter)))
+ (parameterize (syntax (bindings body \.\.\.))))
+
+ ;; SRFI 40
+ ("A Library of Streams"
+ (stream-null stream)
+ (stream-cons (syntax (obj stream)))
+ (stream? (lambda (obj)))
+ (stream-null? (lambda (obj)))
+ (stream-pair? (lambda (obj)))
+ (stream-car (lambda (stream)))
+ (stream-cdr (lambda (stream)))
+ (stream-delay (syntax (expr)))
+ (stream (lambda (obj \.\.\.)))
+ (stream-unfoldn (lambda (generator-proc seed n)))
+ (stream-map (lambda (proc stream \.\.\.)))
+ (stream-for-each (lambda (proc stream \.\.\.) undefined))
+ (stream-filter (lambda (pred stream)))
+ )
+
+ ()
+
+ ;; SRFI 42
+ ("Eager Comprehensions"
+ (list-ec (syntax))
+ (append-ec (syntax))
+ (sum-ec (syntax))
+ (min-ec (syntax))
+ (max-ec (syntax))
+ (any?-ec (syntax))
+ (every?-ec (syntax))
+ (first-ec (syntax))
+ (do-ec (syntax))
+ (fold-ec (syntax))
+ (fold3-ec (syntax))
+ (:list (syntax () undefined))
+ (:string (syntax () undefined))
+ (:vector (syntax () undefined))
+ (:integers (syntax () undefined))
+ (:range (syntax () undefined))
+ (:real-range (syntax () undefined))
+ (:char-range (syntax () undefined))
+ (:port (syntax () undefined))
+ (:do (syntax () undefined))
+ (:let (syntax () undefined))
+ (:parallel (syntax () undefined))
+ (:while (syntax () undefined))
+ (:until (syntax () undefined))
+ )
+
+ ;; SRFI 43
+ ("Vector Library"
+ (vector-unfold (f length initial-seed \.\.\.))
+ (vector-unfold-right (lambda (f length initial-seed \.\.\.)))
+ (vector-tabulate (lambda (f size)))
+ (vector-copy (lambda (vec :optional start end fill)))
+ (vector-reverse-copy (lambda (vec :optional start end)))
+ (vector-append (lambda (vec \.\.\.)))
+ (vector-concatenate (lambda (vector-list)))
+ (vector-empty? (lambda (obj)))
+ (vector= (lambda (eq-proc vec \.\.\.)))
+ (vector-fold (lambda (kons knil vec \.\.\.)))
+ (vector-fold-right (lambda (kons knil vec \.\.\.)))
+ (vector-map (lambda (f vec \.\.\.)))
+ (vector-map! (lambda (f vec \.\.\.)))
+ (vector-for-each (lambda (f vec \.\.\.) undefined))
+ (vector-count (lambda (pred vec \.\.\.)))
+ (vector-index (lambda (pred vec \.\.\.)))
+ (vector-index-right (lambda (pred vec \.\.\.)))
+ (vector-skip (lambda (pred vec \.\.\.)))
+ (vector-skip-right (lambda (pred vec \.\.\.)))
+ (vector-binary-search (lambda (vec value cmp-proc)))
+ (vector-any (lambda (pred vec \.\.\.)))
+ (vector-every (lambda (pred vec \.\.\.)))
+ (vector-swap! (lambda (vec i j) undefined))
+ (vector-reverse! (lambda (vec :optional start end) undefined))
+ (vector-copy! (lambda (target-vec t-start source-vec :optional start end) undefined))
+ (vector-reverse-copy! (lambda (target-vec t-start source-vec :optional start end) undefined))
+ (reverse-vector-to-list (lambda (vec :optional start end)))
+ (reverse-list-to-vector (lambda (list)))
+ )
+
+ ;; SRFI 44
+ ("Collections"
+ )
+
+ ;; SRFI 45
+ ("Primitives for expressing iterative lazy algorithms"
+ (delay (syntax (expr)))
+ (lazy (syntax (expr)))
+ (force (lambda (promise)))
+ (eager (lambda (promise)))
+ )
+
+ ;; SRFI 46
+ ("Basic Syntax-rules Extensions"
+ (syntax-rules (syntax () undefined)))
+
+ ;; SRFI 47
+ ("Array"
+ (make-array (lambda (prototype k \.\.\.)))
+ (ac64 (lambda (:optional z)))
+ (ac32 (lambda (:optional z)))
+ (ar64 (lambda (:optional x1)))
+ (ar32 (lambda (:optional x1)))
+ (as64 (lambda (:optional n)))
+ (as32 (lambda (:optional n)))
+ (as16 (lambda (:optional n)))
+ (as8 (lambda (:optional n)))
+ (au64 (lambda (:optional n)))
+ (au32 (lambda (:optional n)))
+ (au16 (lambda (:optional n)))
+ (au8 (lambda (:optional n)))
+ (at1 (lambda (:optional bool)))
+ (make-shared-array (lambda (array mapper k \.\.\.)))
+ (array-rank (lambda (obj)))
+ (array-dimensions (lambda (array)))
+ (array-in-bounds? (lambda (array k \.\.\.)))
+ (array-ref (lambda (array k \.\.\.)))
+ (array-set! (lambda (array obj k \.\.\.)))
+ )
+
+ ;; SRFI 48
+ ("Intermediate Format Strings"
+ (format (lambda (port-or-boolean format-string arg \.\.\.))))
+
+ ;; SRFI 49
+ ("Indentation-sensitive syntax"
+ )
+
+ ()
+
+ ;; SRFI 51
+ ("Handling rest list"
+ (rest-values (lambda (caller rest-list :optional args-number-limit default)))
+ (arg-and (syntax))
+ (arg-ands (syntax))
+ (err-and (syntax))
+ (err-ands (syntax))
+ (arg-or (syntax))
+ (arg-ors (syntax))
+ (err-or (syntax))
+ (err-ors (syntax))
+ )
+
+ ()
+
+ ()
+
+ ;; SRFI 54
+ ("Formatting"
+ (cat (lambda (obj \.\.\.))))
+
+ ;; SRFI 55
+ ("require-extension"
+ (require-extension (syntax)))
+
+ ()
+
+ ;; SRFI 57
+ ("Records"
+ (define-record-type (syntax))
+ (define-record-scheme (syntax))
+ (record-update (syntax))
+ (record-update! (syntax))
+ (record-compose (syntax)))
+
+ ;; SRFI 58
+ ("Array Notation"
+ )
+
+ ;; SRFI 59
+ ("Vicinity"
+ (program-vicinity (lambda ()))
+ (library-vicinity (lambda ()))
+ (implementation-vicinity (lambda ()))
+ (user-vicinity (lambda ()))
+ (home-vicinity (lambda ()))
+ (in-vicinity (lambda (vicinity filename)))
+ (sub-vicinity (lambda (vicinity name)))
+ (make-vicinity (lambda (dirname)))
+ (path-vicinity (lambda (path)))
+ (vicinity:suffix? (lambda (ch)))
+ )
+
+ ;; SRFI 60
+ ("Integers as Bits"
+ (bitwise-and (lambda (n \.\.\.) int))
+ (bitwise-ior (lambda (n \.\.\.) int))
+ (bitwise-xor (lambda (n \.\.\.) int))
+ (bitwise-not (lambda (n) int))
+ (bitwise-if (lambda (mask n m) int))
+ (any-bits-set? (lambda (n m) bool))
+ (bit-count (lambda (n) int))
+ (integer-length (lambda (n) int))
+ (first-bit-set (lambda (n) int))
+ (bit-set? (lambda (i n) bool))
+ (copy-bit (lambda (index n bool) int))
+ (bit-field (lambda (n start end) int))
+ (copy-bit-field (lambda (to-int from-int start end) int))
+ (arithmetic-shift (lambda (n count) int))
+ (rotate-bit-field (lambda (n count start end) int))
+ (reverse-bit-field (lambda (n start end) int))
+ (integer->list (lambda (k :optional len) list))
+ (list->integer (lambda (list) int))
+ )
+
+ ;; SRFI 61
+ ("A more general cond clause"
+ (cond (syntax)))
+
+ ;; SRFI 62
+ ("S-expression comments"
+ )
+
+ ;; SRFI 63
+ ("Homogeneous and Heterogeneous Arrays"
+ )
+
+ ;; SRFI 64
+ ("A Scheme API for test suites"
+ (test-assert (syntax))
+ (test-eqv (syntax))
+ (test-equal (syntax))
+ (test-eq (syntax))
+ (test-approximate (syntax))
+ (test-error (syntax))
+ (test-read-eval-string (lambda (string)))
+ (test-begin (syntax (suite-name :optional count)))
+ (test-end (syntax (suite-name)))
+ (test-group (syntax (suite-name decl-or-expr \.\.\.)))
+ (test-group-with-cleanup (syntax (suite-name decl-or-expr \.\.\.)))
+ (test-match-name (lambda (name)))
+ (test-match-nth (lambda (n :optional count)))
+ (test-match-any (lambda (specifier \.\.\.)))
+ (test-match-all (lambda (specifier \.\.\.)))
+ (test-skip (syntax (specifier)))
+ (test-expect-fail (syntax (specifier)))
+ (test-runner? (lambda (obj)))
+ (test-runner-current (lambda (:optional runner)))
+ (test-runner-get (lambda ()))
+ (test-runner-simple (lambda ()))
+ (test-runner-null (lambda ()))
+ (test-runner-create (lambda ()))
+ (test-runner-factory (lambda (:optional factory)))
+ (test-apply (syntax (runner specifier \.\.\.)))
+ (test-with-runner (syntax (runner decl-or-expr \.\.\.)))
+ (test-result-kind (lambda (:optional runner)))
+ (test-passed? (lambda (:optional runner)))
+ (test-result-ref (lambda (runner prop-name (:optional default))))
+ (test-result-set! (lambda (runner prop-name value)))
+ (test-result-remove (lambda (runner prop-name)))
+ (test-result-clear (lambda (runner)))
+ (test-result-alist (lambda (runner)))
+ (test-runner-on-test-begin (lambda (runner :optional proc)))
+ (test-runner-on-test-begin! (lambda (runner :optional proc)))
+ (test-runner-on-test-end (lambda (runner :optional proc)))
+ (test-runner-on-test-end! (lambda (runner :optional proc)))
+ (test-runner-on-group-begin (lambda (runner :optional proc)))
+ (test-runner-on-group-begin! (lambda (runner :optional proc)))
+ (test-runner-on-group-end (lambda (runner :optional proc)))
+ (test-runner-on-group-end! (lambda (runner :optional proc)))
+ (test-runner-on-bad-count (lambda (runner :optional proc)))
+ (test-runner-on-bad-count! (lambda (runner :optional proc)))
+ (test-runner-on-bad-end-name (lambda (runner :optional proc)))
+ (test-runner-on-bad-end-name! (lambda (runner :optional proc)))
+ (test-runner-on-final (lambda (runner :optional proc)))
+ (test-runner-on-final! (lambda (runner :optional proc)))
+ (test-runner-pass-count (lambda (runner)))
+ (test-runner-fail-count (lambda (runner)))
+ (test-runner-xpass-count (lambda (runner)))
+ (test-runner-skip-count (lambda (runner)))
+ (test-runner-test-name (lambda (runner)))
+ (test-runner-group-path (lambda (runner)))
+ (test-runner-group-stack (lambda (runner)))
+ (test-runner-aux-value (lambda (runner)))
+ (test-runner-aux-value! (lambda (runner)))
+ (test-runner-reset (lambda (runner)))
+ )
+
+ ()
+
+ ;; SRFI 66
+ ("Octet Vectors"
+ (make-u8vector (lambda (len n)))
+ (u8vector (lambda (n \.\.\.)))
+ (u8vector->list (lambda (u8vector)))
+ (list->u8vector (lambda (octet-list)))
+ (u8vector-length u8vector)
+ (u8vector-ref (lambda (u8vector k)))
+ (u8vector-set! (lambda (u8vector k n)))
+ (u8vector=? (lambda (u8vector-1 u8vector-2)))
+ (u8vector-compare (lambda (u8vector-1 u8vector-2)))
+ (u8vector-copy! (lambda (source source-start target target-start n)))
+ (u8vector-copy (lambda (u8vector)))
+ )
+
+ ;; SRFI 67
+ ("Compare Procedures"
+ )
+
+ ()
+
+ ;; SRFI 69
+ ("Basic hash tables"
+ )
+
+ ;; SRFI 70
+ ("Numbers"
+ )
+
+ ;; SRFI 71
+ ("LET-syntax for multiple values"
+ )
+
+ ;; SRFI 72
+ ("Simple hygienic macros"
+ )
+
+ ()
+
+ ;; SRFI 74
+ ("Octet-Addressed Binary Blocks"
+ )
+
+ ])
+
+(defvar *scheme-chicken-modules*
+ '((extras
+ (->string (lambda (obj) str))
+ (alist->hash-table (lambda (alist) hash-table))
+ (alist-ref (lambda (alist key :optional eq-fn default)))
+ (alist-update! (lambda (key value alist :optional eq-fn) undefined))
+ (atom? (lambda (obj) bool))
+ (binary-search (lambda (vec proc)))
+ (butlast (lambda (list) list) "drops the last element of list")
+ (call-with-input-string (lambda (string proc)))
+ (call-with-output-string (lambda (proc) str))
+ (chop (lambda (list k) list))
+ (complement (lambda (f) f2))
+ (compose (lambda (f1 f2 \.\.\.) f))
+ (compress (lambda (boolean-list list)))
+ (conc (lambda (obj \.\.\.)))
+ (conjoin (lambda (pred \.\.\.) pred))
+ (constantly (lambda (obj \.\.\.) f))
+ (disjoin (lambda (pred \.\.\.) pred))
+ (each (lambda (proc \.\.\.) proc))
+ (flatten (lambda (list1 \.\.\.) list))
+ (flip (lambda (proc) proc))
+ (format (lambda (format-string arg \.\.\.)))
+ (fprintf (lambda (port format-string arg \.\.\.)))
+ (hash (lambda (obj :optional n) int))
+ (hash-by-identity (lambda (obj :optional n) int))
+ (hash-table->alist (lambda (hash-table) alist))
+ (hash-table-copy (lambda (hash-table) hash-table))
+ (hash-table-delete! (lambda (hash-table key) undefined))
+ (hash-table-equivalence-function (lambda (hash-table) pred))
+ (hash-table-exists? (lambda (hash-table key) bool))
+ (hash-table-fold (lambda (hash-table f init-value)))
+ (hash-table-hash-function (lambda (hash-table) f))
+ (hash-table-keys (lambda (hash-table) list))
+ (hash-table-merge! (lambda (hash-table1 hash-table2) undefined))
+ (hash-table-ref (lambda (hash-table key :optional thunk)))
+ (hash-table-ref/default (lambda (hash-table key default)))
+ (hash-table-remove! (lambda (hash-table proc) undefined))
+ (hash-table-set! (lambda (hash-table key value) undefined))
+ (hash-table-size (lambda (hash-table) n))
+ (hash-table-update! (lambda (hash-table key proc :optional thunk) undefined))
+ (hash-table-update!/default (lambda (hash-table key proc default) undefined))
+ (hash-table-values (lambda (hash-table) list))
+ (hash-table-walk (lambda (hash-table proc) undefined))
+ (hash-table? (lambda (obj) bool))
+ (identity (lambda (obj)))
+ (intersperse (lambda (list obj) list))
+ (join (lambda (list-of-lists :optional list) list))
+ (list->queue (lambda (list) queue))
+ (list-of (lambda (pred)))
+ (make-hash-table (lambda (:optional eq-fn hash-fn size) hash-table))
+ (make-input-port (lambda (read-proc ready?-pred close-proc :optional peek-proc) input-port))
+ (make-output-port (lambda (write-proc close-proc :optional flush-proc) output-port))
+ (make-queue (lambda () queue))
+ (merge (lambda (list1 list2 less-fn) list))
+ (merge! (lambda (list1 list2 less-fn) list))
+ (noop (lambda (obj \.\.\.) undefined))
+ (pp (lambda (obj :optional output-port) undefined))
+ (pretty-print (lambda (obj :optional output-port) undefined))
+ (pretty-print-width (lambda (:optional new-width) n))
+ (printf (lambda (format-string arg \.\.\.) undefined))
+ (project (lambda (n) proc))
+ (queue->list (lambda (queue) list))
+ (queue-add! (lambda (queue obj) undefined))
+ (queue-empty? (lambda (queue) bool))
+ (queue-first (lambda (queue)))
+ (queue-last (lambda (queue)))
+ (queue-push-back! (lambda (queue obj) undefined))
+ (queue-push-back-list! (lambda (queue list) undefined))
+ (queue-remove! (lambda (queue) undefined))
+ (queue? (lambda (obj) bool))
+ (random (lambda (n) n))
+ (randomize (lambda (:optional x1) undefined))
+ (rassoc (lambda (key list :optional eq-fn)))
+ (read-file (lambda (:optional file-or-port reader-fn max-count) str))
+ (read-line (lambda (:optional port limit) str))
+ (read-lines (lambda (:optional port max) list))
+ (read-string (lambda (:optional n port) str))
+ (read-string! (lambda (n dest :optional port start) undefined))
+ (read-token (lambda (predicate :optional port) str))
+ (shuffle (lambda (list) list))
+ (sort (lambda (sequence less-fn) sequence))
+ (sort! (lambda (sequence less-fn) sequence))
+ (sorted? (lambda (sequence less-fn) bool))
+ (sprintf (lambda (format-string arg \.\.\.) str))
+ (string-chomp (lambda (str :optional suffix-str) str))
+ (string-chop (lambda (str length) list))
+ (string-ci-hash (lambda (str :optional n) n))
+ (string-compare3 (lambda (str1 str2) n))
+ (string-compare3-ci (lambda (str1 str2) n))
+ (string-hash (lambda (str1 :optional n) n))
+ (string-intersperse (lambda (list :optional seperator-string) str))
+ (string-split (lambda (str :optional delimiter-str keep-empty?) list))
+ (string-translate (lambda (str from-str :optional to-str) str))
+ (string-translate* (lambda (str list) str))
+ (substring-ci=? (lambda (str1 str2 :optional start1 start2 length) str))
+ (substring-index (lambda (which-str where-str :optional start) i))
+ (substring-index-ci (lambda (which-str where-str :optional start) i))
+ (substring=? (lambda (str1 str2 :optional start1 start2 length) bool))
+ (tail? (lambda (obj list) bool))
+ (with-error-output-to-port (lambda (output-port thunk)))
+ (with-input-from-port (lambda (port thunk)))
+ (with-input-from-string (lambda (str thunk)))
+ (with-output-to-port (lambda (port thunk)))
+ (with-output-to-string (lambda (thunk) str))
+ (write-line (lambda (str :optional port) undefined))
+ (write-string (lambda (str :optional num port) undefined))
+ )
+ (lolevel
+ (address->pointer (lambda (n) ptr))
+ (align-to-word (lambda (ptr-or-int) ptr))
+ (allocate (lambda (size) block))
+ (block-ref (lambda (block index) int))
+ (block-set! (lambda (block index obj) undefined))
+ (byte-vector (lambda (n \.\.\.) byte-vector))
+ (byte-vector->list (lambda (byte-vector) list))
+ (byte-vector->string (lambda (byte-vector) string))
+ (byte-vector-fill! (lambda (byte-vector n) undefined))
+ (byte-vector-length (lambda (byte-vector) n))
+ (byte-vector-ref (lambda (byte-vector i) int))
+ (byte-vector-set! (lambda (byte-vector i n) undefined))
+ (byte-vector? (lambda (obj) bool))
+ (extend-procedure (lambda (proc x1) proc))
+ (extended-procedure? (lambda (proc) bool))
+ (free (lambda (pointer) undefined))
+ (global-bound? (lambda (sym) bool))
+ (global-make-unbound! (lambda (sym) undefined))
+ (global-ref (lambda (sym)))
+ (global-set! (lambda (sym val) undefined))
+ (list->byte-vector (lambda (list) byte-vector))
+ (locative->object (lambda (locative) obj))
+ (locative-ref (lambda (locative)))
+ (locative-set! (lambda (locative val) undefined))
+ (locative? (lambda (obj) bool))
+ (make-byte-vector (lambda (size :optional init-n) byte-vector))
+ (make-locative (lambda (obj :optional index) locative))
+ (make-record-instance (lambda (sym arg \.\.\.)))
+ (make-static-byte-vector (lambda (size :optional init-n)))
+ (make-weak-locative (lambda (obj :optional index) locative))
+ (move-memory! (lambda (from to :optional bytes from-offset to-offset) undefined))
+ (mutate-procedure (lambda (proc proc) proc))
+ (null-pointer (lambda () pointer))
+ (null-pointer? (lambda (pointer) bool))
+ (number-of-bytes (lambda (block) int))
+ (number-of-slots (lambda (block) int))
+ (object->pointer (lambda (obj) ptr))
+ (object-become! (lambda (alist) undefined))
+ (object-copy (lambda (obj)))
+ (object-evict (lambda (obj :optional allocator-proc)))
+ (object-evict-to-location (lambda (obj ptr :optional limit)))
+ (object-evicted? (lambda (obj) bool))
+ (object-release (lambda (obj :optional releaser-proc)))
+ (object-size (lambda (obj) int))
+ (object-unevict (lambda (obj :optional full)))
+ (pointer->address (lambda (ptr) n))
+ (pointer->object (lambda (ptr)))
+ (pointer-f32-ref (lambda (ptr) real))
+ (pointer-f32-set! (lambda (ptr x1) undefined))
+ (pointer-f64-ref (lambda (ptr) real))
+ (pointer-f64-set! (lambda (ptr x1) undefined))
+ (pointer-offset (lambda (ptr n) n))
+ (pointer-s16-ref (lambda (ptr) int))
+ (pointer-s16-set! (lambda (ptr n) undefined))
+ (pointer-s32-ref (lambda (ptr) int))
+ (pointer-s32-set! (lambda (ptr n) undefined))
+ (pointer-s8-ref (lambda (ptr) int))
+ (pointer-s8-set! (lambda (ptr n) undefined))
+ (pointer-tag (lambda (ptr) tag))
+ (pointer-u16-ref (lambda (ptr) int))
+ (pointer-u16-set! (lambda (ptr n) undefined))
+ (pointer-u32-ref (lambda (ptr) int))
+ (pointer-u32-set! (lambda (ptr n) undefined))
+ (pointer-u8-ref (lambda (ptr) int))
+ (pointer-u8-set! (lambda (ptr n) undefined))
+ (pointer=? (lambda (ptr1 ptr2) bool))
+ (pointer? (lambda (obj) bool))
+ (procedure-data (lambda (proc)))
+ (record->vector (lambda (block) vector))
+ (record-instance? (lambda (obj) bool))
+ (set-invalid-procedure-call-handler! (lambda (proc) undefined))
+ (set-procedure-data! (lambda (proc obj) undefined))
+ (static-byte-vector->pointer (lambda (byte-vector) pointer))
+ (string->byte-vector (lambda (str) byte-vector))
+ (tag-pointer (lambda (ptr tag)))
+ (tagged-pointer? (lambda (obj tag) bool))
+ (unbound-variable-value (lambda (:optional value)))
+ )
+ (posix
+ (_exit (lambda (:optional n) undefined))
+ (call-with-input-pipe (lambda (cmdline-string proc :optional mode)))
+ (call-with-output-pipe (lambda (cmdline-string proc :optional mode)))
+ (change-directory (lambda (dir)))
+ (change-file-mode (lambda (filename mode)))
+ (change-file-owner (lambda (filename user-n group-n)))
+ (close-input-pipe (lambda (input-port)))
+ (close-output-pipe (lambda (output-port)))
+ (create-directory (lambda (filename)))
+ (create-fifo (lambda (filename :optional mode)))
+ (create-pipe (lambda ()))
+ (create-session (lambda ()))
+ (create-symbolic-link (lambda (old-filename new-filename)))
+ (current-directory (lambda (:optional new-dir)))
+ (current-effective-group-id (lambda () int))
+ (current-effective-user-id (lambda () int))
+ (current-environment (lambda ()))
+ (current-group-id (lambda ()))
+ (current-process-id (lambda ()))
+ (current-user-id (lambda ()))
+ (delete-directory (lambda (dir)))
+ (directory (lambda (:optional dir show-dotfiles?) list))
+ (directory? (lambda (filename) bool))
+ (duplicate-fileno (lambda (old-n :optional new-n)))
+;; (errno/acces integer)
+;; (errno/again integer)
+;; (errno/badf integer)
+;; (errno/busy integer)
+;; (errno/child integer)
+;; (errno/exist integer)
+;; (errno/fault integer)
+;; (errno/intr integer)
+;; (errno/inval integer)
+;; (errno/io integer)
+;; (errno/isdir integer)
+;; (errno/mfile integer)
+;; (errno/noent integer)
+;; (errno/noexec integer)
+;; (errno/nomem integer)
+;; (errno/nospc integer)
+;; (errno/notdir integer)
+;; (errno/perm integer)
+;; (errno/pipe integer)
+;; (errno/rofs integer)
+;; (errno/spipe integer)
+;; (errno/srch integer)
+;; (errno/wouldblock integer)
+ (fifo? (lambda (filename) bool))
+ (file-access-time (lambda (filename) real))
+ (file-change-time (lambda (filename) real))
+ (file-close (lambda (fileno)))
+ (file-execute-access? (lambda (filename) bool))
+ (file-link (lambda (old-filename new-filename)))
+ (file-lock (lambda (port :optional start len)))
+ (file-lock/blocking (lambda (port :optional start len)))
+ (file-mkstemp (lambda (template-filename)))
+ (file-modification-time (lambda (filename) real))
+ (file-open (lambda (filename (flags open-mode open/binary open/excl open/fsync open/noctty open/nonblock open/rdonly open/rdwr open/read open/sync open/text) :optional mode) fileno))
+ (file-owner (lambda (filename)))
+ (file-permissions (lambda (filename) int))
+ (file-position (lambda (port-or-fileno) int))
+ (file-read (lambda (fileno size :optional buffer-string)))
+ (file-read-access? (lambda (filename) bool))
+ (file-select (lambda (read-fd-list write-fd-list :optional timeout)))
+ (file-size (lambda (filename) int))
+ (file-stat (lambda (filename :optional follow-link?)))
+ (file-test-lock (lambda (port :optional start len)))
+ (file-truncate (lambda (filename-or-fileno offset)))
+ (file-unlock (lambda (lock)))
+ (file-write (lambda (fileno buffer-string :optional size)))
+ (file-write-access? (lambda (filename)))
+ (fileno/stderr integer)
+ (fileno/stdin integer)
+ (fileno/stdout integer)
+ (find-files (lambda (dir pred :optional action-proc identity limit)))
+ (get-groups (lambda ()))
+ (get-host-name (lambda ()))
+ (glob (lambda (pattern1 \.\.\.)))
+ (group-information (lambda (group-name-or-n)))
+ (initialize-groups (lambda (user-name base-group-n)))
+ (local-time->seconds (lambda (vector)))
+ (local-timezone-abbreviation (lambda ()))
+ (map-file-to-memory (lambda (address len protection flag fileno :optional offset)))
+ (memory-mapped-file-pointer (lambda (mmap)))
+ (memory-mapped-file? (lambda (obj)))
+ (open-input-file* (lambda (fileno :optional (flags open-mode open/binary open/excl open/fsync open/noctty open/nonblock open/rdonly open/rdwr open/read open/sync open/text))))
+ (open-input-pipe (lambda (cmdline-string :optional mode)))
+ (open-output-file* (lambda (fileno :optional (flags open-mode open/append open/binary open/creat open/excl open/fsync open/noctty open/nonblock open/rdwr open/sync open/text open/trunc open/write open/wronly))))
+ (open-output-pipe (lambda (cmdline-string :optional mode)))
+;; (open/append integer)
+;; (open/binary integer)
+;; (open/creat integer)
+;; (open/excl integer)
+;; (open/fsync integer)
+;; (open/noctty integer)
+;; (open/nonblock integer)
+;; (open/rdonly integer)
+;; (open/rdwr integer)
+;; (open/read integer)
+;; (open/sync integer)
+;; (open/text integer)
+;; (open/trunc integer)
+;; (open/write integer)
+;; (open/wronly integer)
+ (parent-process-id (lambda ()))
+;; (perm/irgrp integer)
+;; (perm/iroth integer)
+;; (perm/irusr integer)
+;; (perm/irwxg integer)
+;; (perm/irwxo integer)
+;; (perm/irwxu integer)
+;; (perm/isgid integer)
+;; (perm/isuid integer)
+;; (perm/isvtx integer)
+;; (perm/iwgrp integer)
+;; (perm/iwoth integer)
+;; (perm/iwusr integer)
+;; (perm/ixgrp integer)
+;; (perm/ixoth integer)
+;; (perm/ixusr integer)
+;; (pipe/buf integer)
+ (port->fileno (lambda (port)))
+ (process (lambda (cmdline-string :optional arg-list env-list)))
+ (process-execute (lambda (filename :optional arg-list env-list)))
+ (process-fork (lambda (:optional thunk)))
+ (process-group-id (lambda ()))
+ (process-run (lambda (filename :optional list)))
+ (process-signal (lambda (pid :optional signal)))
+ (process-wait (lambda (:optional pid nohang?)))
+ (read-symbolic-link (lambda (filename) filename))
+ (regular-file? (lambda (filename)))
+ (seconds->local-time (lambda (seconds)))
+ (seconds->string (lambda (seconds)))
+ (seconds->utc-time (lambda (seconds)))
+ (set-alarm! (lambda (seconds)))
+ (set-buffering-mode! (lambda (port mode :optional buf-size)))
+ (set-file-position! (lambda (port-or-fileno pos :optional whence)))
+ (set-group-id! (lambda (n)))
+ (set-groups! (lambda (group-n-list)))
+ (set-process-group-id! (lambda (process-n n)))
+ (set-root-directory! (lambda (dir)) "chroot")
+ (set-signal-handler! (lambda (sig-n proc)))
+ (set-signal-mask! (lambda (sig-n-list)))
+ (set-user-id! (lambda (n)))
+ (setenv (lambda (name value-string)))
+;; (signal/abrt integer)
+;; (signal/alrm integer)
+;; (signal/chld integer)
+;; (signal/cont integer)
+;; (signal/fpe integer)
+;; (signal/hup integer)
+;; (signal/ill integer)
+;; (signal/int integer)
+;; (signal/io integer)
+;; (signal/kill integer)
+;; (signal/pipe integer)
+;; (signal/prof integer)
+;; (signal/quit integer)
+;; (signal/segv integer)
+;; (signal/stop integer)
+;; (signal/term integer)
+;; (signal/trap integer)
+;; (signal/tstp integer)
+;; (signal/urg integer)
+;; (signal/usr1 integer)
+;; (signal/usr2 integer)
+;; (signal/vtalrm integer)
+;; (signal/winch integer)
+;; (signal/xcpu integer)
+;; (signal/xfsz integer)
+ (sleep (lambda (seconds)))
+ (symbolic-link? (lambda (filename)))
+ (system-information (lambda ()))
+ (terminal-name (lambda (port)))
+ (terminal-port? (lambda (port)))
+ (time->string (lambda (vector)))
+ (unmap-file-from-memory (lambda (mmap :optional len)))
+ (unsetenv (lambda (name) undefined))
+ (user-information (lambda ((or integer (string scheme-complete-user-name))) list))
+ (utc-time->seconds (lambda (vector)))
+ (with-input-from-pipe (lambda (cmdline-string thunk :optional mode)))
+ (with-output-to-pipe (lambda (cmdline-string thunk :optional mode)))
+ )
+ (regex
+ (glob->regexp (lambda (pattern)))
+ (glob? (lambda (obj)))
+ (grep (lambda (pattern list) list))
+ (regexp (lambda (pattern ignore-case? ignore-space? utf-8?)))
+ (regexp-escape (lambda (str) str))
+ (regexp? (lambda (obj) bool))
+ (string-match (lambda (pattern str :optional start)))
+ (string-match-positions (lambda (pattern str :optional start)))
+ (string-search (lambda (pattern str :optional start)))
+ (string-search-positions (lambda (pattern str :optional start)))
+ (string-split-fields (lambda (pattern str :optional mode start)))
+ (string-substitute (lambda (pattern subst str :optional mode)))
+ (string-substitute* (lambda (str subst-list :optional mode)))
+ )
+ (tcp
+ (tcp-abandon-port (lambda (port)))
+ (tcp-accept (lambda (listener)))
+ (tcp-accept-ready? (lambda (listener)))
+ (tcp-addresses (lambda (port)))
+ (tcp-buffer-size (lambda (:optional new-size)))
+ (tcp-close (lambda (listener)))
+ (tcp-connect (lambda ((string scheme-complete-host-name) :optional (string scheme-complete-port-name))))
+ (tcp-listen (lambda (tcp-port-n :optional backlog-n host-string)))
+ (tcp-listener-fileno (lambda (listener)))
+ (tcp-listener-port (lambda (listener)))
+ (tcp-listener? (lambda (obj)))
+ (tcp-port-numbers (lambda (port)))
+ )
+ (utils
+ (absolute-pathname? (lambda (pathname)))
+ (create-temporary-file (lambda (:optional ext-str)))
+ (decompose-pathname (lambda (pathname)))
+ (delete-file* (lambda (filename)))
+ (for-each-argv-line (lambda (proc) undefined))
+ (for-each-line (lambda (proc :optional input-port) undefined))
+ (make-absolute-pathname (lambda (dir filename :optional ext-str)))
+ (make-pathname (lambda (dir filename :optional ext-str)))
+ (pathname-directory (lambda (pathname)))
+ (pathname-extension (lambda (pathname)))
+ (pathname-file (lambda (pathname)))
+ (pathname-replace-directory (lambda (pathname dir)))
+ (pathname-replace-extension (lambda (pathname ext-str)))
+ (pathname-replace-file (lambda (pathname filename)))
+ (pathname-strip-directory (lambda (pathname)))
+ (pathname-strip-extension (lambda (pathname)))
+ (port-for-each (lambda (read-fn thunk) undefined))
+ (port-map (lambda (read-fn thunk)))
+ (read-all (lambda (:optional file-or-port)))
+ (shift! (lambda (list :optional default)))
+ (system* (lambda (format-string arg1 \.\.\.)))
+ (unshift! (lambda (obj pair)))
+ )
+ ))
+
+;; another big table - consider moving to a separate file
+(defvar *scheme-implementation-exports*
+ '((chicken
+ (abort (lambda (obj) undefined))
+ (add1 (lambda (z) z))
+ (andmap (lambda (pred list) bool))
+ (any? (lambda (obj) bool))
+ (argc+argv (lambda () (values n ptr)))
+ (argv (lambda () list))
+ (bit-set? (lambda (n index) bool))
+ (bitwise-and (lambda (n \.\.\.) n))
+ (bitwise-ior (lambda (n \.\.\.) n))
+ (bitwise-not (lambda (n \.\.\.) n))
+ (bitwise-xor (lambda (n \.\.\.) n))
+ (blob->string (lambda (blob) string))
+ (blob-size (lambda (blob) n))
+ (blob? (lambda (obj) bool))
+ (breakpoint (lambda (:optional name)))
+ (build-platform (lambda () symbol))
+ (c-runtime (lambda () symbol))
+ (call/cc (lambda (proc)))
+ (case-sensitive (lambda (:optional on?)))
+ (chicken-home (lambda () string))
+ (chicken-version (lambda () string))
+ (command-line-arguments (lambda () list))
+ (condition-predicate (lambda (kind) pred))
+ (condition-property-accessor (lambda (kind prop :optional err?) proc))
+ (condition? (lambda (obj) bool))
+ (continuation-capture (lambda (proc)))
+ (continuation-graft (lambda (continuation thunk)))
+ (continuation-return (lambda (continuation vals\.\.\.)))
+ (continuation? (lambda (obj) bool))
+ (copy-read-table (lambda (read-table) read-table))
+ (cpu-time (lambda () (values n n)))
+ (current-error-port (lambda () output-port))
+ (current-exception-handler (lambda () proc))
+ (current-gc-milliseconds (lambda () n))
+ (current-milliseconds (lambda () n))
+ (current-read-table (lambda () read-table))
+ (current-seconds (lambda () x1))
+ (define-reader-ctor (lambda (sym proc) undefined))
+ (delete-file (lambda (filename) undefined))
+ (disable-interrupts (lambda () undefined))
+ (dynamic-load-libraries (lambda () list))
+ (dynamic-wind (lambda (before-thunk thunk after-thunk)))
+ (enable-interrupts (lambda () undefined))
+ (enable-warnings (lambda () undefined))
+ (errno (lambda () n))
+ (error (lambda (error-string args \.\.\.) undefined))
+ (eval-handler (lambda () proc))
+ (exit (lambda (:optional n) undefined))
+ (exit-handler (lambda () proc))
+ (extension-info (lambda (proc)))
+ (extension-information (lambda (proc)))
+ (feature? (lambda (sym) bool))
+ (features (lambda () list))
+ (file-exists? (lambda (filename) bool))
+ (finite? (lambda (z) bool))
+ (fixnum? (lambda (obj) bool))
+ (flonum? (lambda (obj) bool))
+ (flush-output (lambda (:optional port) undefined))
+ (force (lambda (promise)))
+ (force-finalizers (lambda (f args \.\.\.)))
+ (fp* (lambda (x1 x2) x3))
+ (fp+ (lambda (x1 x2) x3))
+ (fp- (lambda (x1 x2) x3))
+ (fp/ (lambda (x1 x2) x3))
+ (fp< (lambda (x1 x2) x3))
+ (fp<= (lambda (x1 x2) x3))
+ (fp= (lambda (x1 x2) x3))
+ (fp> (lambda (x1 x2) x3))
+ (fp>= (lambda (x1 x2) x3))
+ (fpmax (lambda (x1 x2) x3))
+ (fpmin (lambda (x1 x2) x3))
+ (fpneg (lambda (x1 x2) x3))
+ (fx* (lambda (n1 n2) n))
+ (fx+ (lambda (n1 n2) n))
+ (fx- (lambda (n1 n2) n))
+ (fx/ (lambda (n1 n2) n))
+ (fx< (lambda (n1 n2) n))
+ (fx<= (lambda (n1 n2) n))
+ (fx= (lambda (n1 n2) n))
+ (fx> (lambda (n1 n2) n))
+ (fx>= (lambda (n1 n2) n))
+ (fxand (lambda (n1 n2) n))
+ (fxior (lambda (n1 n2) n))
+ (fxmax (lambda (n1 n2) n))
+ (fxmin (lambda (n1 n2) n))
+ (fxmod (lambda (n1 n2) n))
+ (fxneg (lambda (n1 n2) n))
+ (fxnot (lambda (n1 n2) n))
+ (fxshl (lambda (n1 n2) n))
+ (fxshr (lambda (n1 n2) n))
+ (fxxor (lambda (n1 n2) n))
+ (gc (lambda () n))
+ (gensym (lambda (:optional name) sym))
+ (get-call-chain (lambda (:optional n) list))
+ (get-keyword (lambda (sym list :optional default)))
+ (get-line-number (lambda (sexp) n))
+ (get-output-string (lambda (string-output-port) string))
+ (getenv (lambda (name) string))
+ (getter-with-setter (lambda (get-proc set-proc) proc))
+ (implicit-exit-handler (lambda (:optional proc) proc))
+ (invalid-procedure-call-handler (lambda (:optional proc) proc))
+ (keyword->string (lambda (sym) string))
+ (keyword-style (lambda (:optional sym) sym))
+ (keyword? (lambda (obj) bool))
+ (load-library (lambda (sym) undefined))
+ (load-noisily (lambda (string) undefined))
+ (load-relative (lambda (string) undefined))
+ (load-verbose (lambda (:optional bool) bool))
+ (machine-byte-order (lambda () sym))
+ (machine-type (lambda () sym))
+ (macro? (lambda (obj) bool))
+ (macroexpand (lambda (sexp) sexp))
+ (macroexpand-1 (lambda (sexp) sexp))
+ (make-blob (lambda (size) blob))
+ (make-composite-condition (lambda (condition \.\.\.) condition))
+ (make-parameter (lambda (val) proc))
+ (make-property-condition (lambda (kind \.\.\.) condition))
+ (match-error-control (lambda (:optional proc) proc))
+ (match-error-procedure (lambda (:optional proc) proc))
+ (memory-statistics (lambda () vector))
+ (on-exit (lambda (thunk) undefined))
+ (open-input-string (lambda (string) string-input-port))
+ (open-output-string (lambda () string-output-port))
+ (ormap (lambda (pred list \.\.\.) bool))
+ (port-name (lambda (port) name))
+ (port-position (lambda (port) n))
+ (port? (lambda (obj) bool))
+ (print (lambda (obj \.\.\.) undefined))
+ (print* (lambda (obj \.\.\.) undefined))
+ (print-backtrace (lambda (:optional n) undefined))
+ (print-call-chain (lambda (:optional n) undefined))
+ (print-error-message (lambda (err args \.\.\.) undefined))
+ (procedure-information (lambda (proc)))
+ (program-name (lambda (:optional name) name))
+ (provide (lambda (name)))
+ (provided? (lambda (name) bool))
+ (rational? (lambda (obj) bool))
+ (read-byte (lambda (:optional input-port) n))
+ (register-feature! (lambda (name) undefined))
+ (rename-file (lambda (old-name new-name) undefined))
+ (repl (lambda () undefined))
+ (repository-path (lambda (:optional dirname) dirname))
+ (require (lambda (sym \.\.\.) undefined))
+ (reset (lambda () undefined))
+ (reset-handler (lambda (:optional proc) proc))
+ (return-to-host (lambda () undefined))
+ (reverse-list->string (lambda (list) string))
+ (set-dynamic-load-mode! (lambda (obj) undefined))
+ (set-extension-specifier! (lambda (name proc) undefined))
+ (set-finalizer! (lambda (obj proc) undefined))
+ (set-gc-report! (lambda (bool) undefined))
+ (set-parameterized-read-syntax! (lambda (ch proc) undefined))
+ (set-port-name! (lambda (port name) undefined))
+ (set-read-syntax! (lambda (ch proc) undefined))
+ (set-sharp-read-syntax! (lambda (ch proc) undefined))
+ (setter (lambda (proc) proc))
+ (signal (lambda (n) undefined))
+ (signum (lambda (x1) x2))
+ (singlestep (lambda (thunk)))
+ (software-type (lambda () sym))
+ (software-version (lambda () sym))
+ (string->blob (lambda (string) blob))
+ (string->keyword (lambda (string) sym))
+ (string->uninterned-symbol (lambda (string) sym))
+ (string-copy (lambda (string) string))
+ (sub1 (lambda (z1) z2))
+ (syntax-error (lambda (args \.\.\.) undefined))
+ (system (lambda (str) n))
+ (test-feature? (lambda (obj) bool))
+ (undefine-macro! (lambda (sym) undefined))
+ (unregister-feature! (lambda (sym) undefined))
+ (use (special symbol scheme-chicken-available-modules)
+ "import extensions into top-level namespace")
+ (vector-copy! (lambda (from-vector to-vector :optional start) undefined))
+ (vector-resize (lambda (vec n :optional init)))
+ (void (lambda () undefined))
+ (warning (lambda (msg-str args \.\.\.) undefined))
+ (with-exception-handler (lambda (handler thunk)))
+ (write-byte (lambda (n :optional output-port) undefined))
+ )
+ (gauche
+ (E2BIG integer)
+ (EACCES integer)
+ (EADDRINUSE integer)
+ (EADDRNOTAVAIL integer)
+ (EADV integer)
+ (EAFNOSUPPORT integer)
+ (EAGAIN integer)
+ (EALREADY integer)
+ (EBADE integer)
+ (EBADF integer)
+ (EBADFD integer)
+ (EBADMSG integer)
+ (EBADR integer)
+ (EBADRQC integer)
+ (EBADSLT integer)
+ (EBFONT integer)
+ (EBUSY integer)
+ (ECANCELED integer)
+ (ECHILD integer)
+ (ECHRNG integer)
+ (ECOMM integer)
+ (ECONNABORTED integer)
+ (ECONNREFUSED integer)
+ (ECONNRESET integer)
+ (EDEADLK integer)
+ (EDEADLOCK integer)
+ (EDESTADDRREQ integer)
+ (EDOM integer)
+ (EDOTDOT integer)
+ (EDQUOT integer)
+ (EEXIST integer)
+ (EFAULT integer)
+ (EFBIG integer)
+ (EHOSTDOWN integer)
+ (EHOSTUNREACH integer)
+ (EIDRM integer)
+ (EILSEQ integer)
+ (EINPROGRESS integer)
+ (EINTR integer)
+ (EINVAL integer)
+ (EIO integer)
+ (EISCONN integer)
+ (EISDIR integer)
+ (EISNAM integer)
+ (EKEYEXPIRED integer)
+ (EKEYREJECTED integer)
+ (EKEYREVOKED integer)
+ (EL2HLT integer)
+ (EL2NSYNC integer)
+ (EL3HLT integer)
+ (EL3RST integer)
+ (ELIBACC integer)
+ (ELIBBAD integer)
+ (ELIBEXEC integer)
+ (ELIBMAX integer)
+ (ELIBSCN integer)
+ (ELNRNG integer)
+ (ELOOP integer)
+ (EMEDIUMTYPE integer)
+ (EMFILE integer)
+ (EMLINK integer)
+ (EMSGSIZE integer)
+ (EMULTIHOP integer)
+ (ENAMETOOLONG integer)
+ (ENAVAIL integer)
+ (ENETDOWN integer)
+ (ENETRESET integer)
+ (ENETUNREACH integer)
+ (ENFILE integer)
+ (ENOANO integer)
+ (ENOBUFS integer)
+ (ENOCSI integer)
+ (ENODATA integer)
+ (ENODEV integer)
+ (ENOENT integer)
+ (ENOEXEC integer)
+ (ENOKEY integer)
+ (ENOLCK integer)
+ (ENOLINK integer)
+ (ENOMEDIUM integer)
+ (ENOMEM integer)
+ (ENOMSG integer)
+ (ENONET integer)
+ (ENOPKG integer)
+ (ENOPROTOOPT integer)
+ (ENOSPC integer)
+ (ENOSR integer)
+ (ENOSTR integer)
+ (ENOSYS integer)
+ (ENOTBLK integer)
+ (ENOTCONN integer)
+ (ENOTDIR integer)
+ (ENOTEMPTY integer)
+ (ENOTNAM integer)
+ (ENOTSOCK integer)
+ (ENOTTY integer)
+ (ENOTUNIQ integer)
+ (ENXIO integer)
+ (EOPNOTSUPP integer)
+ (EOVERFLOW integer)
+ (EPERM integer)
+ (EPFNOSUPPORT integer)
+ (EPIPE integer)
+ (EPROTO integer)
+ (EPROTONOSUPPORT integer)
+ (EPROTOTYPE integer)
+ (ERANGE integer)
+ (EREMCHG integer)
+ (EREMOTE integer)
+ (EREMOTEIO integer)
+ (ERESTART integer)
+ (EROFS integer)
+ (ESHUTDOWN integer)
+ (ESOCKTNOSUPPORT integer)
+ (ESPIPE integer)
+ (ESRCH integer)
+ (ESRMNT integer)
+ (ESTALE integer)
+ (ESTRPIPE integer)
+ (ETIME integer)
+ (ETIMEDOUT integer)
+ (ETOOMANYREFS integer)
+ (ETXTBSY integer)
+ (EUCLEAN integer)
+ (EUNATCH integer)
+ (EUSERS integer)
+ (EWOULDBLOCK integer)
+ (EXDEV integer)
+ (EXFULL integer)
+ (F_OK integer)
+ (LC_ALL integer)
+ (LC_COLLATE integer)
+ (LC_CTYPE integer)
+ (LC_MONETARY integer)
+ (LC_NUMERIC integer)
+ (LC_TIME integer)
+ (RAND_MAX integer)
+ (R_OK integer)
+ (SEEK_CUR integer)
+ (SEEK_END integer)
+ (SEEK_SET integer)
+ (SIGABRT integer)
+ (SIGALRM integer)
+ (SIGBUS integer)
+ (SIGCHLD integer)
+ (SIGCONT integer)
+ (SIGFPE integer)
+ (SIGHUP integer)
+ (SIGILL integer)
+ (SIGINT integer)
+ (SIGIO integer)
+ (SIGIOT integer)
+ (SIGKILL integer)
+ (SIGPIPE integer)
+ (SIGPOLL integer)
+ (SIGPROF integer)
+ (SIGPWR integer)
+ (SIGQUIT integer)
+ (SIGSEGV integer)
+ (SIGSTKFLT integer)
+ (SIGSTOP integer)
+ (SIGTERM integer)
+ (SIGTRAP integer)
+ (SIGTSTP integer)
+ (SIGTTIN integer)
+ (SIGTTOU integer)
+ (SIGURG integer)
+ (SIGUSR1 integer)
+ (SIGUSR2 integer)
+ (SIGVTALRM integer)
+ (SIGWINCH integer)
+ (SIGXCPU integer)
+ (SIGXFSZ integer)
+ (SIG_BLOCK integer)
+ (SIG_SETMASK integer)
+ (SIG_UNBLOCK integer)
+ (W_OK integer)
+ (X_OK integer)
+ (acons (lambda (key value alist) alist))
+ (acosh (lambda (z) z))
+ (add-load-path (lambda (path) undefined))
+ (add-method! (lambda (generic method) undefined))
+ (all-modules (lambda () list))
+ (allocate-instance (lambda (class list)))
+ (and-let* (syntax))
+ (any (lambda (pred list)))
+ (any$ (lambda (pred) proc))
+ (any-pred (lambda (pred \.\.\.) pred))
+ (append! (lambda (list \.\.\.) list))
+ (apply$ (lambda (proc) proc))
+ (apply-generic (lambda (generic list)))
+ (apply-method (lambda (method list)))
+ (apply-methods (lambda (generic list list)))
+ (arity (lambda (proc) n))
+ (arity-at-least-value (lambda (n)))
+ (arity-at-least? (lambda (proc) bool))
+ (ash (lambda (n i) n))
+ (asinh (lambda (z) z))
+ (assoc$ (lambda (obj) proc))
+ (atanh (lambda (z) z))
+ (autoload (syntax))
+ (begin0 (syntax))
+ (bignum? (lambda (obj) bool))
+ (bit-field (lambda (n start end) n))
+ (byte-ready? (lambda (:optional input-port) bool))
+ (call-with-input-string (lambda (str proc)))
+ (call-with-output-string (lambda (proc) str))
+ (call-with-string-io (lambda (str proc) str))
+ (case-lambda (syntax))
+ (change-class (lambda (obj new-class)))
+ (change-object-class (lambda (obj orig-class new-class)))
+ (char->ucs (lambda (ch) int))
+ (char-set (lambda (ch \.\.\.) char-set))
+ (char-set-contains? (lambda (char-set ch) bool))
+ (char-set-copy (lambda (char-set) char-set))
+ (char-set? (lambda (obj) bool))
+ (check-arg (syntax))
+ (circular-list? (lambda (obj) bool))
+ (clamp (lambda (x1 :optional min-x max-x) x2))
+ (class-direct-methods (lambda (class) list))
+ (class-direct-slots (lambda (class) list))
+ (class-direct-subclasses (lambda (class) list))
+ (class-direct-supers (lambda (class) list))
+ (class-name (lambda (class) sym))
+ (class-of (lambda (obj) class))
+ (class-precedence-list (lambda (class) list))
+ (class-slot-accessor (lambda (class id) proc))
+ (class-slot-bound? (lambda (class id) bool))
+ (class-slot-definition (lambda (class id)))
+ (class-slot-ref (lambda (class slot)))
+ (class-slot-set! (lambda (class slot val) undefined))
+ (class-slots (lambda (class) list))
+ (closure-code (lambda (proc)))
+ (closure? (lambda (obj) bool))
+ (compare (lambda (obj1 obj2) n))
+ (complement (lambda (proc) proc))
+ (compose (lambda (proc \.\.\.) proc))
+ (compute-applicable-methods (lambda (generic list)))
+ (compute-cpl (lambda (generic list)))
+ (compute-get-n-set (lambda (class slot)))
+ (compute-slot-accessor (lambda (class slot)))
+ (compute-slots (lambda (class)))
+ (cond-expand (syntax))
+ (condition (syntax))
+ (condition-has-type? (lambda (condition obj)))
+ (condition-ref (lambda (condition id)))
+ (condition-type? (lambda (obj) bool))
+ (condition? (lambda (obj) bool))
+ (copy-bit (lambda (index n i) n))
+ (copy-bit-field (lambda (n start end from) n))
+ (copy-port (lambda (from-port to-port :optional unit-sym) undefined))
+ (cosh (lambda (z) z))
+ (count$ (lambda (pred) proc))
+ (current-class-of (lambda (obj) class))
+ (current-error-port (lambda () output-port))
+ (current-exception-handler (lambda () handler))
+ (current-load-history (lambda () list))
+ (current-load-next (lambda () list))
+ (current-load-port (lambda () port))
+ (current-module (lambda () env))
+ (current-thread (lambda () thread))
+ (current-time (lambda () time))
+ (cut (syntax))
+ (cute (lambda (args \.\.\.) proc))
+ (debug-print (lambda (obj)))
+ (debug-print-width (lambda () int))
+ (debug-source-info (lambda (obj)))
+ (dec! (syntax))
+ (decode-float (lambda (x1) vector))
+ (define-class (syntax))
+ (define-condition-type (syntax))
+ (define-constant (syntax))
+ (define-generic (syntax))
+ (define-in-module (syntax))
+ (define-inline (syntax))
+ (define-macro (syntax))
+ (define-method (syntax))
+ (define-module (syntax))
+ (define-reader-ctor (lambda (sym proc) undefined))
+ (define-values (syntax))
+ (delete$ (lambda (obj) proc))
+ (delete-keyword (lambda (id list) list))
+ (delete-keyword! (lambda (id list) list))
+ (delete-method! (lambda (generic method) undefined))
+ (digit->integer (lambda (ch) n))
+ (disasm (lambda (proc) undefined))
+ (dolist (syntax))
+ (dotimes (syntax))
+ (dotted-list? (lambda (obj) bool))
+ (dynamic-load (lambda (file)))
+ (eager (lambda (obj)))
+ (eq-hash (lambda (obj)))
+ (eqv-hash (lambda (obj)))
+ (error (lambda (msg-string args \.\.\.)))
+ (errorf (lambda (fmt-string args \.\.\.)))
+ (eval-when (syntax))
+ (every$ (lambda (pred) pred))
+ (every-pred (lambda (pred \.\.\.) pred))
+ (exit (lambda (:optional n) undefined))
+ (export (syntax))
+ (export-all (syntax))
+ (export-if-defined (syntax))
+ (extend (syntax))
+ (extract-condition (lambda (condition type)))
+ (file-exists? (lambda (filename) bool))
+ (file-is-directory? (lambda (filename) bool))
+ (file-is-regular? (lambda (filename) bool))
+ (filter$ (lambda (pred) proc))
+ (find (lambda (pred list)))
+ (find$ (lambda (pred) proc))
+ (find-module (lambda (id) env))
+ (find-tail$ (lambda (pred) proc))
+ (fixnum? (lambda (obj) bool))
+ (flonum? (lambda (obj) bool))
+ (fluid-let (syntax))
+ (flush (lambda (:optional output-port) undefined))
+ (flush-all-ports (lambda () undefined))
+ (fmod (lambda (x1 x2) x3))
+ (fold (lambda (proc init list)))
+ (fold$ (lambda (proc :optional init) proc))
+ (fold-right (lambda (proc init list)))
+ (fold-right$ (lambda (proc :optional init)))
+ (for-each$ (lambda (proc) (lambda (ls) undefined)))
+ (foreign-pointer-attribute-get (lambda (ptr attr)))
+ (foreign-pointer-attribute-set (lambda (ptr attr val)))
+ (foreign-pointer-attributes (lambda (ptr) list))
+ (format (lambda (fmt-string arg \.\.\.)))
+ (format/ss (lambda (fmt-string arg \.\.\.)))
+ (frexp (lambda (x1) x2))
+ (gauche-architecture (lambda () string))
+ (gauche-architecture-directory (lambda () string))
+ (gauche-character-encoding (lambda () symbol))
+ (gauche-dso-suffix (lambda () string))
+ (gauche-library-directory (lambda () string))
+ (gauche-site-architecture-directory (lambda () string))
+ (gauche-site-library-directory (lambda () string))
+ (gauche-version (lambda () string))
+ (gc (lambda () undefined))
+ (gc-stat (lambda () list))
+ (gensym (lambda (:optional name) symbol))
+ (get-keyword (lambda (id list :optional default)))
+ (get-keyword* (syntax))
+ (get-optional (syntax))
+ (get-output-string (lambda (string-output-port) string))
+ (get-remaining-input-string (lambda (port) string))
+ (get-signal-handler (lambda (n) proc))
+ (get-signal-handler-mask (lambda (n) n))
+ (get-signal-handlers (lambda () list))
+ (get-signal-pending-limit (lambda () n))
+ (getter-with-setter (lambda (get-proc set-proc) proc))
+ (global-variable-bound? (lambda (sym) bool))
+ (global-variable-ref (lambda (sym)))
+ (guard (syntax))
+ (has-setter? (lambda (proc) bool))
+ (hash (lambda (obj)))
+ (hash-table (lambda (id pair \.\.\.) hash-table))
+ (hash-table-delete! (lambda (hash-table key) undefined))
+ (hash-table-exists? (lambda (hash-table key) bool))
+ (hash-table-fold (lambda (hash-table proc init)))
+ (hash-table-for-each (lambda (hash-table proc) undefined))
+ (hash-table-get (lambda (hash-table key :optional default)))
+ (hash-table-keys (lambda (hash-table) list))
+ (hash-table-map (lambda (hash-table proc) list))
+ (hash-table-num-entries (lambda (hash-table) n))
+ (hash-table-pop! (lambda (hash-table key :optional default)))
+ (hash-table-push! (lambda (hash-table key value) undefined))
+ (hash-table-put! (lambda (hash-table key value) undefined))
+ (hash-table-stat (lambda (hash-table) list))
+ (hash-table-type (lambda (hash-table) id))
+ (hash-table-update! (lambda (hash-table key proc :optional default) undefined))
+ (hash-table-values (lambda (hash-table) list))
+ (hash-table? (lambda (obj) bool))
+ (identifier->symbol (lambda (obj) sym))
+ (identifier? (lambda (obj) bool))
+ (identity (lambda (obj)))
+ (import (syntax))
+ (inc! (syntax))
+ (inexact-/ (lambda (x1 x2) x3))
+ (initialize (lambda (obj)))
+ (instance-slot-ref (lambda (obj id)))
+ (instance-slot-set (lambda (obj id value)))
+ (integer->digit (lambda (n) ch))
+ (integer-length (lambda (n) n))
+ (is-a? (lambda (obj class) bool))
+ (keyword->string (lambda (id) string))
+ (keyword? (lambda (obj) bool))
+ (last-pair (lambda (pair) pair))
+ (lazy (syntax))
+ (ldexp (lambda (x1 n) x2))
+ (let-keywords* (syntax))
+ (let-optionals* (syntax))
+ (let/cc (syntax))
+ (let1 (syntax))
+ (library-exists? (lambda (filename) bool))
+ (library-fold (lambda (string proc init)))
+ (library-for-each (lambda (string proc) undefined))
+ (library-has-module? (lambda (filename id) bool))
+ (library-map (lambda (string proc) list))
+ (list* (lambda (obj \.\.\.) list))
+ (list-copy (lambda (list) list))
+ (logand (lambda (n \.\.\.) n))
+ (logbit? (lambda (index n) bool))
+ (logcount (lambda (n) n))
+ (logior (lambda (n \.\.\.) n))
+ (lognot (lambda (n) n))
+ (logtest (lambda (n \.\.\.) bool))
+ (logxor (lambda (n \.\.\.) n))
+ (macroexpand (lambda (obj)))
+ (macroexpand-1 (lambda (obj)))
+ (make (lambda (class args \.\.\.)))
+ (make-byte-string (lambda (n :optional int) byte-string))
+ (make-compound-condition (lambda (condition \.\.\.) condition))
+ (make-condition (lambda (condition-type field+value \.\.\.) condition))
+ (make-condition-type (lambda (id condition-type list) condition-type))
+ (make-hash-table (lambda (:optional id) hash-table))
+ (make-keyword (lambda (string) sym))
+ (make-list (lambda (n :optional init) list))
+ (make-module (lambda (id :optional if-exists-proc) env))
+ (make-weak-vector (lambda (n) vector))
+ (map$ (lambda (proc) proc))
+ (member$ (lambda (obj) proc))
+ (merge (lambda (list1 list2 proc) list))
+ (merge! (lambda (list1 list2 proc) list))
+ (method-more-specific? (lambda (method1 method2 list) bool))
+ (min&max (lambda (x1 \.\.\.) (values x2 x3)))
+ (modf (lambda (x1) x2))
+ (module-exports (lambda (env) list))
+ (module-imports (lambda (env) list))
+ (module-name (lambda (env) sym))
+ (module-name->path (lambda (sym) string))
+ (module-parents (lambda (env) list))
+ (module-precedence-list (lambda (env) list))
+ (module-table (lambda (env) hash-table))
+ (module? (lambda (obj) bool))
+ (null-list? (lambda (obj) bool))
+ (object-* (lambda (z \.\.\.) z))
+ (object-+ (lambda (z \.\.\.) z))
+ (object-- (lambda (z \.\.\.) z))
+ (object-/ (lambda (z \.\.\.) z))
+ (object-apply (lambda (proc arg \.\.\.)))
+ (object-compare (lambda (obj1 obj2) n))
+ (object-equal? (lambda (obj1 obj2) bool))
+ (object-hash (lambda (obj) n))
+ (open-coding-aware-port (lambda (input-port) input-port))
+ (open-input-buffered-port (lambda ()))
+ (open-input-fd-port (lambda (fileno) input-port))
+ (open-input-string (lambda (str) input-port))
+ (open-output-buffered-port (lambda ()))
+ (open-output-fd-port (lambda (fileno) output-port))
+ (open-output-string (lambda () string-output-port))
+ (pa$ (lambda (proc arg \.\.\.) proc))
+ (partition$ (lambda (pred) proc))
+ (path->module-name (lambda (str) sym))
+ (peek-byte (lambda (:optional input-port) n))
+ (pop! (syntax (list)))
+ (port->byte-string (lambda (input-port) byte-string))
+ (port->list (lambda (proc input-port) list))
+ (port->sexp-list (lambda (port) list))
+ (port->string (lambda (port) string))
+ (port->string-list (lambda (port) list))
+ (port-buffering (lambda (port) sym))
+ (port-closed? (lambda (port) bool))
+ (port-current-line (lambda (port) n))
+ (port-file-number (lambda (port) n))
+ (port-fold (lambda (proc init port)))
+ (port-fold-right (lambda (proc init port)))
+ (port-for-each (lambda (proc read-proc) undefined))
+ (port-map (lambda (proc read-proc)))
+ (port-name (lambda (port) name))
+ (port-position-prefix (lambda ()))
+ (port-seek (lambda (port offset (set int SEEK_SET SEEK_CUR SEEK_END))))
+ (port-tell (lambda (port) n))
+ (port-type (lambda (port) sym))
+ (print (lambda (obj \.\.\.)))
+ (procedure-arity-includes? (lambda (proc n) bool))
+ (procedure-info (lambda (proc)))
+ (profiler-reset (lambda () undefined))
+ (profiler-show (lambda () undefined))
+ (profiler-show-load-stats (lambda () undefined))
+ (profiler-start (lambda () undefined))
+ (profiler-stop (lambda () undefined))
+ (program (syntax))
+ (promise-kind (lambda ()))
+ (promise? (lambda (obj) bool))
+ (proper-list? (lambda (obj) bool))
+ (provide (lambda (str) undefined))
+ (provided? (lambda (str) bool))
+ (push! (syntax))
+ (quotient&remainder (lambda (n1 n2) (values n1 n2)))
+ (raise (lambda (exn) undefined))
+ (read-block (lambda (n :optional input-port) string))
+ (read-byte (lambda (:optional input-port) n))
+ (read-eval-print-loop (lambda () undefined))
+ (read-from-string (lambda (str)))
+ (read-line (lambda (:optional input-port) str))
+ (read-list (lambda (ch :optional input-port)))
+ (read-reference-has-value? (lambda ()))
+ (read-reference-value (lambda ()))
+ (read-reference? (lambda ()))
+ (read-with-shared-structure (lambda (:optional input-port)))
+ (read/ss (lambda (:optional input-port)))
+ (rec (syntax))
+ (receive (syntax))
+ (redefine-class! (lambda ()))
+ (reduce$ (lambda (proc :optional default) proc))
+ (reduce-right$ (lambda (proc :optional default) proc))
+ (ref (lambda (obj key \.\.\.)))
+ (ref* (lambda (obj key \.\.\.)))
+ (regexp->string (lambda (regexp) string))
+ (regexp-case-fold? (lambda (regexp) bool))
+ (regexp-compile (lambda (str) regexp))
+ (regexp-optimize (lambda (str) str))
+ (regexp-parse (lambda (str) list))
+ (regexp-quote (lambda (str) str))
+ (regexp-replace (lambda (regexp string subst) string))
+ (regexp-replace* (lambda (string regexp subst \.\.\.) string))
+ (regexp-replace-all (lambda (regexp string subst) string))
+ (regexp-replace-all* (lambda (string regexp subst \.\.\.)))
+ (regexp? (lambda (obj) bool))
+ (regmatch? (lambda (obj) bool))
+ (remove$ (lambda (pred) proc))
+ (report-error (lambda ()))
+ (require (syntax))
+ (require-extension (syntax))
+ (reverse! (lambda (list) list))
+ (rxmatch (lambda (regexp string) regmatch))
+ (rxmatch-after (lambda (regmatch :optional i) str))
+ (rxmatch-before (lambda (regmatch :optional i) str))
+ (rxmatch-case (syntax))
+ (rxmatch-cond (syntax))
+ (rxmatch-end (lambda (regmatch :optional i) n))
+ (rxmatch-if (syntax))
+ (rxmatch-let (syntax))
+ (rxmatch-num-matches (lambda (regmatch) i))
+ (rxmatch-start (lambda (regmatch :optional i) n))
+ (rxmatch-substring (lambda (regmatch :optional i) str))
+ (seconds->time (lambda (x1) time))
+ (select-module (syntax))
+ (set!-values (syntax))
+ (set-signal-handler! (lambda (signals handler) undefined))
+ (set-signal-pending-limit (lambda (n) undefined))
+ (setter (lambda (proc) proc))
+ (sinh (lambda (z) z))
+ (slot-bound-using-accessor? (lambda (proc obj id) bool))
+ (slot-bound-using-class? (lambda (class obj id) bool))
+ (slot-bound? (lambda (obj id) bool))
+ (slot-definition-accessor (lambda ()))
+ (slot-definition-allocation (lambda ()))
+ (slot-definition-getter (lambda ()))
+ (slot-definition-name (lambda ()))
+ (slot-definition-option (lambda ()))
+ (slot-definition-options (lambda ()))
+ (slot-definition-setter (lambda ()))
+ (slot-exists-using-class? (lambda (class obj id) bool))
+ (slot-exists? (lambda (obj id) bool))
+ (slot-initialize-using-accessor! (lambda ()))
+ (slot-missing (lambda (class obj id)))
+ (slot-push! (lambda (obj id value) undefined))
+ (slot-ref (lambda (obj id)))
+ (slot-ref-using-accessor (lambda (proc obj id)))
+ (slot-ref-using-class (lambda (class obj id)))
+ (slot-set! (lambda (obj id value) undefined))
+ (slot-set-using-accessor! (lambda (proc obj id value) undefined))
+ (slot-set-using-class! (lambda (class obj id value) undefined))
+ (slot-unbound (lambda (class obj id)))
+ (sort (lambda (seq :optional proc)))
+ (sort! (lambda (seq :optional proc)))
+ (sort-applicable-methods (lambda ()))
+ (sorted? (lambda (seq :optional proc)))
+ (split-at (lambda (list i) (values list list)))
+ (stable-sort (lambda (seq :optional proc)))
+ (stable-sort! (lambda (seq :optional proc)))
+ (standard-error-port (lambda () output-port))
+ (standard-input-port (lambda () input-port))
+ (standard-output-port (lambda () output-port))
+ (string->regexp (lambda (str) regexp))
+ (string-byte-ref (lambda (str i) n))
+ (string-byte-set! (lambda (str i n) undefined))
+ (string-complete->incomplete (lambda (str) str))
+ (string-immutable? (lambda (str) bool))
+ (string-incomplete->complete (lambda (str) str))
+ (string-incomplete->complete! (lambda (str) str))
+ (string-incomplete? (lambda (str) bool))
+ (string-interpolate (lambda (str) list))
+ (string-join (lambda (list :optional delim-str (set grammar infix strict-infix prefix suffix))))
+;; deprecated
+;; (string-pointer-byte-index (lambda ()))
+;; (string-pointer-copy (lambda ()))
+;; (string-pointer-index (lambda ()))
+;; (string-pointer-next! (lambda ()))
+;; (string-pointer-prev! (lambda ()))
+;; (string-pointer-ref (lambda ()))
+;; (string-pointer-set! (lambda ()))
+;; (string-pointer-substring (lambda ()))
+;; (string-pointer? (lambda ()))
+ (string-scan (lambda (string item :optional (set return index before after before* after* both))))
+ (string-size (lambda (str) n))
+ (string-split (lambda (str splitter) list))
+ (string-substitute! (lambda ()))
+ (subr? (lambda (obj) bool))
+ (supported-character-encoding? (lambda (id) bool))
+ (supported-character-encodings (lambda () list))
+ (symbol-bound? (lambda (id) bool))
+ (syntax-error (syntax))
+ (syntax-errorf (syntax))
+ (sys-abort (lambda () undefined))
+ (sys-access (lambda (filename (flags amode R_OK W_OK X_OK F_OK))))
+ (sys-alarm (lambda (x1) x2))
+ (sys-asctime (lambda (time) str))
+ (sys-basename (lambda (filename) str))
+ (sys-chdir (lambda (dirname)))
+ (sys-chmod (lambda (filename n)))
+ (sys-chown (lambda (filename uid gid)))
+ (sys-close (lambda (fileno)))
+ (sys-crypt (lambda (key-str salt-str) str))
+ (sys-ctermid (lambda () string))
+ (sys-ctime (lambda (time) string))
+ (sys-difftime (lambda (time1 time2) x1))
+ (sys-dirname (lambda (filename) string))
+ (sys-exec (lambda (command-string list) n))
+ (sys-exit (lambda (n) undefined))
+ (sys-fchmod (lambda (port-or-fileno n)))
+ (sys-fdset-max-fd (lambda (fdset)))
+ (sys-fdset-ref (lambda (fdset port-or-fileno)))
+ (sys-fdset-set! (lambda (fdset port-or-fileno)))
+ (sys-fork (lambda () n))
+ (sys-fork-and-exec (lambda (command-string list) n))
+ (sys-fstat (lambda (port-or-fileno) sys-stat))
+ (sys-ftruncate (lambda (port-or-fileno n)))
+ (sys-getcwd (lambda () string))
+ (sys-getdomainname (lambda () string))
+ (sys-getegid (lambda () gid))
+ (sys-getenv (lambda (name) string))
+ (sys-geteuid (lambda () uid))
+ (sys-getgid (lambda () gid))
+ (sys-getgrgid (lambda () gid))
+ (sys-getgrnam (lambda (name)))
+ (sys-getgroups (lambda () list))
+ (sys-gethostname (lambda () string))
+ (sys-getloadavg (lambda () list))
+ (sys-getlogin (lambda () string))
+ (sys-getpgid (lambda () gid))
+ (sys-getpgrp (lambda () gid))
+ (sys-getpid (lambda () pid))
+ (sys-getppid (lambda () pid))
+ (sys-getpwnam (lambda (name)))
+ (sys-getpwuid (lambda () uid))
+ (sys-gettimeofday (lambda () (values x1 x2)))
+ (sys-getuid (lambda () uid))
+ (sys-gid->group-name (lambda (gid) name))
+ (sys-glob (lambda (string) list))
+ (sys-gmtime (lambda (time) string))
+ (sys-group-name->gid (lambda (name) gid))
+ (sys-isatty (lambda (port-or-fileno) bool))
+ (sys-kill (lambda (pid)))
+ (sys-lchown (lambda (filename uid gid)))
+ (sys-link (lambda (old-filename new-filename)))
+ (sys-localeconv (lambda () alist))
+ (sys-localtime (lambda (time) string))
+ (sys-lstat (lambda (filename) sys-stat))
+ (sys-mkdir (lambda (dirname)))
+ (sys-mkfifo (lambda (filename)))
+ (sys-mkstemp (lambda (filename)))
+ (sys-mktime (lambda (time) x1))
+ (sys-nanosleep (lambda (x1)))
+ (sys-normalize-pathname (lambda (filename) string))
+ (sys-pause (lambda (x1)))
+ (sys-pipe (lambda (:optional buffering) (values input-port output-port)))
+ (sys-putenv (lambda (name string)))
+ (sys-random (lambda () n))
+ (sys-readdir (lambda (dirname) list))
+ (sys-readlink (lambda (filename) string))
+ (sys-realpath (lambda (filename) string))
+ (sys-remove (lambda (filename)))
+ (sys-rename (lambda (old-filename new-filename)))
+ (sys-rmdir (lambda (dirname)))
+ (sys-select (lambda (read-filenos write-filenos execpt-filenos :optional timeout-x)))
+ (sys-select! (lambda (read-filenos write-filenos execpt-filenos :optional timeout-x)))
+ (sys-setenv (lambda (name string)))
+ (sys-setgid (lambda (gid)))
+ (sys-setlocale (lambda (locale-string)))
+ (sys-setpgid (lambda (gid)))
+ (sys-setsid (lambda ()))
+ (sys-setuid (lambda (uid)))
+ (sys-sigmask (lambda ((set how SIG_SETMASK SIG_BLOCK SIG_UNBLOCK) sigset)))
+ (sys-signal-name (lambda (n)))
+ (sys-sigset (lambda (n \.\.\.) sigset))
+ (sys-sigset-add! (lambda (sigset n)))
+ (sys-sigset-delete! (lambda (sigset n)))
+ (sys-sigset-empty! (lambda (sigset)))
+ (sys-sigset-fill! (lambda (sigset)))
+ (sys-sigsuspend (lambda (sigset)))
+ (sys-sigwait (lambda (sigset)))
+ (sys-sleep (lambda (x1)))
+ (sys-srandom (lambda (n)))
+ (sys-stat (lambda (filename)))
+;; deprecated
+;; (sys-stat->atime (lambda ()))
+;; (sys-stat->ctime (lambda ()))
+;; (sys-stat->dev (lambda ()))
+;; (sys-stat->file-type (lambda ()))
+;; (sys-stat->gid (lambda ()))
+;; (sys-stat->ino (lambda ()))
+;; (sys-stat->mode (lambda ()))
+;; (sys-stat->mtime (lambda ()))
+;; (sys-stat->nlink (lambda ()))
+;; (sys-stat->rdev (lambda ()))
+;; (sys-stat->size (lambda ()))
+;; (sys-stat->type (lambda ()))
+;; (sys-stat->uid (lambda ()))
+ (sys-strerror (lambda (errno) string))
+ (sys-strftime (lambda (format-string time)))
+ (sys-symlink (lambda (old-filename new-filename)))
+ (sys-system (lambda (command) n))
+ (sys-time (lambda () n))
+ (sys-times (lambda () list))
+;; (sys-tm->alist (lambda ()))
+ (sys-tmpnam (lambda () string))
+ (sys-truncate (lambda (filename n)))
+ (sys-ttyname (lambda (port-or-fileno) string))
+ (sys-uid->user-name (lambda (uid) name))
+ (sys-umask (lambda () n))
+ (sys-uname (lambda () string))
+ (sys-unlink (lambda (filename)))
+ (sys-unsetenv (lambda (name)))
+ (sys-user-name->uid (lambda (name) uid))
+ (sys-utime (lambda (filename)))
+ (sys-wait (lambda ()))
+ (sys-wait-exit-status (lambda (n) n))
+ (sys-wait-exited? (lambda (n) bool))
+ (sys-wait-signaled? (lambda (n) bool))
+ (sys-wait-stopped? (lambda (n) bool))
+ (sys-wait-stopsig (lambda (n) n))
+ (sys-wait-termsig (lambda (n) n))
+ (sys-waitpid (lambda (pid)))
+ (tanh (lambda (z) z))
+ (time (syntax))
+ (time->seconds (lambda (time) x1))
+ (time? (lambda (obj) bool))
+ (toplevel-closure? (lambda (obj) bool))
+ (touch-instance! (lambda ()))
+ (ucs->char (lambda (n) ch))
+ (undefined (lambda () undefined))
+ (undefined? (lambda (obj) bool))
+ (unless (syntax))
+ (until (syntax))
+ (unwrap-syntax (lambda (obj)))
+ (update! (syntax))
+ (update-direct-method! (lambda ()))
+ (update-direct-subclass! (lambda ()))
+ (use (special symbol scheme-gauche-available-modules))
+ (use-version (syntax))
+ (values-ref (syntax))
+ (vector-copy (lambda (vector :optional start end fill) vector))
+ (vm-dump (lambda () undefined))
+ (vm-get-stack-trace (lambda () undefined))
+ (vm-get-stack-trace-lite (lambda () undefined))
+ (vm-set-default-exception-handler (lambda (handler) undefined))
+ (warn (lambda (message-str args) undefined))
+ (weak-vector-length (lambda (vector) n))
+ (weak-vector-ref (lambda (vector i)))
+ (weak-vector-set! (lambda (vector i value) undefined))
+ (when (syntax))
+ (while (syntax))
+ (with-error-handler (lambda (handler thunk)))
+ (with-error-to-port (lambda (port thunk)))
+ (with-exception-handler (lambda (handler thunk)))
+ (with-input-from-port (lambda (port thunk)))
+ (with-input-from-string (lambda (string thunk)))
+ (with-module (syntax))
+ (with-output-to-port (lambda (port thunk)))
+ (with-output-to-string (lambda (thunk) string))
+ (with-port-locking (lambda (port thunk)))
+ (with-ports (lambda (input-port output-port error-port thunk)))
+ (with-signal-handlers (syntax))
+ (with-string-io (lambda (string thunk) string))
+ (write* (lambda (obj :optional output-port) undefined))
+ (write-byte (lambda (n :optional output-port) undefined))
+ (write-limited (lambda (obj :optional output-port)))
+ (write-object (lambda (obj output-port)))
+ (write-to-string (lambda (obj) string))
+ (write-with-shared-structure (lambda (obj :optional output-port)))
+ (write/ss (lambda (obj :optional output-port)))
+ (x->integer (lambda (obj) integer))
+ (x->number (lambda (obj) number))
+ (x->string (lambda (obj) string))
+ )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; special lookups (XXXX add more impls, try to abstract better)
+
+(defvar *scheme-chicken-base-repo*
+ (or (getenv "CHICKEN_REPOSITORY")
+ (let ((dir
+ (car (remove-if-not #'file-directory-p
+ '("/usr/lib/chicken"
+ "/usr/local/lib/chicken"
+ "/opt/lib/chicken"
+ "/opt/local/lib/chicken")))))
+ (and dir
+ (car (reverse (sort (directory-files dir t "^[0-9]+$")
+ #'string-lessp)))))
+ (and (fboundp 'shell-command-to-string)
+ (let* ((res (shell-command-to-string "chicken-setup -R"))
+ (res (substring res 0 (- (length res) 1))))
+ (and res (file-directory-p res) res)))
+ "/usr/local/lib/chicken"))
+
+(defvar *scheme-chicken-repo-dirs*
+ (remove-if-not
+ #'(lambda (x) (and (stringp x) (not (equal x ""))))
+ (let ((home (getenv "CHICKEN_HOME")))
+ (if (and home (not (equal home "")))
+ (let ((res (split-string home ";")))
+ (if (member *scheme-chicken-repo-dirs* res)
+ res
+ (cons *scheme-chicken-repo-dirs* res)))
+ (list *scheme-chicken-base-repo*)))))
+
+(defun scheme-chicken-available-modules (&optional sym)
+ (append
+ (mapcar #'symbol-name (mapcar #'car *scheme-chicken-modules*))
+ (mapcar
+ #'file-name-sans-extension
+ (directory-files "." nil ".*\\.scm$" t))
+ (scheme-append-map
+ #'(lambda (dir)
+ (mapcar
+ #'file-name-sans-extension
+ (directory-files dir nil ".*\\.\\(so\\|scm\\)$" t)))
+ *scheme-chicken-repo-dirs*)))
+
+(defvar *scheme-gauche-repo-path*
+ (or (car (remove-if-not #'file-directory-p
+ '("/usr/share/gauche"
+ "/usr/local/share/gauche"
+ "/opt/share/gauche"
+ "/opt/local/share/gauche")))
+ (and (fboundp 'shell-command-to-string)
+ (let* ((res (shell-command-to-string "gauche-config --syslibdir"))
+ (res (substring res 0 (- (length res) 1))))
+ (and res (file-directory-p res) res)))
+ "/usr/local/share/gauche"))
+
+(defvar *scheme-gauche-site-repo-path*
+ (concat *scheme-gauche-repo-path* "/site/lib"))
+
+(defun scheme-gauche-available-modules (&optional sym)
+ (let ((version-dir
+ (concat
+ (car (directory-files *scheme-gauche-repo-path* t "^[0-9]"))
+ "/lib"))
+ (site-dir *scheme-gauche-site-repo-path*)
+ (other-dirs
+ (remove-if-not
+ #'(lambda (d) (and (not (equal d "")) (file-directory-p d)))
+ (split-string (or (getenv "GAUCHE_LOAD_PATH") "") ":"))))
+ (mapcar
+ #'(lambda (f) (subst-char-in-string ?/ ?. f))
+ (mapcar
+ #'file-name-sans-extension
+ (scheme-append-map
+ #'(lambda (dir)
+ (let ((len (length dir)))
+ (mapcar #'(lambda (f) (substring f (+ 1 len)))
+ (scheme-directory-tree-files dir t "\\.scm"))))
+ (cons version-dir (cons site-dir other-dirs)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; utilities
+
+(defun scheme-append-map (proc init-ls)
+ (if (null init-ls)
+ '()
+ (let* ((ls (reverse init-ls))
+ (res (funcall proc (pop ls))))
+ (while (consp ls)
+ (setq res (append (funcall proc (pop ls)) res)))
+ res)))
+
+(defun scheme-flatten (ls)
+ (cond
+ ((consp ls) (cons (car ls) (scheme-flatten (cdr ls))))
+ ((null ls) '())
+ (t (list ls))))
+
+(defun scheme-in-string-p ()
+ (let ((orig (point)))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((parses (parse-partial-sexp (point) orig)))
+ (nth 3 parses)))))
+
+(defun scheme-beginning-of-sexp ()
+ (let ((syn (char-syntax (char-before (point)))))
+ (if (or (eq syn ?\()
+ (and (eq syn ?\") (scheme-in-string-p)))
+ (forward-char -1)
+ (forward-sexp -1))))
+
+(defun scheme-find-file-in-path (file path)
+ (car (remove-if-not
+ #'(lambda (dir) (file-exists-p (concat dir file)))
+ path)))
+
+;; visit a file and kill the buffer only if it wasn't already open
+(defmacro scheme-with-find-file (path-expr &rest body)
+ (let ((path (gensym))
+ (buf (gensym))
+ (res (gensym)))
+ `(save-window-excursion
+ (let* ((,path (file-truename ,path-expr))
+ (,buf (find-if #'(lambda (x) (equal ,path (buffer-file-name x)))
+ (buffer-list))))
+ (if ,buf
+ (switch-to-buffer ,buf)
+ (switch-to-buffer (find-file-noselect ,path t t)))
+ (let ((,res (save-excursion ,@body)))
+ (unless ,buf (kill-buffer (current-buffer)))
+ ,res)))))
+
+(defun scheme-directory-tree-files (init-dir &optional full match)
+ (let ((res '())
+ (stack (list init-dir)))
+ (while (consp stack)
+ (let* ((dir (pop stack))
+ (files (cddr (directory-files dir full))))
+ (setq res (append (if match
+ (remove-if-not
+ #'(lambda (f) (string-match match f))
+ files)
+ files)
+ res))
+ (setq stack
+ (append
+ (remove-if-not 'file-directory-p
+ (if full
+ files
+ (mapcar #'(lambda (f) (concat dir "/" f))
+ files)))
+ stack))))
+ res))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; sexp manipulation
+
+;; returns current argument position within sexp
+(defun scheme-beginning-of-current-sexp-operator ()
+ (let ((pos 0))
+ (skip-syntax-backward "w_")
+ (while (and (not (bobp)) (not (eq ?\( (char-before))))
+ (scheme-beginning-of-sexp)
+ (incf pos))
+ pos))
+
+(defun scheme-beginning-of-next-sexp ()
+ (forward-sexp 2)
+ (backward-sexp 1))
+
+(defun scheme-beginning-of-string ()
+ (interactive)
+ (search-backward "\"" nil t)
+ (while (and (> (point) (point-min)) (eq ?\\ (char-before)))
+ (search-backward "\"" nil t)))
+
+;; for the enclosing sexp, returns a cons of the leading symbol (if
+;; any) and the current position within the sexp (starting at 0)
+;; (defun scheme-enclosing-sexp-prefix ()
+;; (save-excursion
+;; (let ((pos (scheme-beginning-of-current-sexp-operator)))
+;; (cons (scheme-symbol-at-point) pos))))
+
+(defun scheme-enclosing-2-sexp-prefixes ()
+ (save-excursion
+ (let* ((pos1 (scheme-beginning-of-current-sexp-operator))
+ (sym1 (scheme-symbol-at-point)))
+ (backward-char)
+ (or
+ (ignore-errors
+ (let ((pos2 (scheme-beginning-of-current-sexp-operator)))
+ (list sym1 pos1 (scheme-symbol-at-point) pos2)))
+ (list sym1 pos1 nil 0)))))
+
+;; sexp-at-point is always fragile, both because the user can input
+;; incomplete sexps and because some scheme sexps are not valid elisp
+;; sexps. this is one of the few places we use it, so we're careful
+;; to wrap it in ignore-errors.
+(defun scheme-nth-sexp-at-point (n)
+ (ignore-errors
+ (save-excursion
+ (forward-sexp (+ n 1))
+ (let ((end (point)))
+ (forward-sexp -1)
+ (car (read-from-string (buffer-substring (point) end)))))))
+
+(defun scheme-symbol-at-point ()
+ (save-excursion
+ (skip-syntax-backward "w_")
+ (let ((start (point)))
+ (skip-syntax-forward "w_")
+ (and (< start (point))
+ (intern (buffer-substring start (point)))))))
+
+(defun scheme-goto-next-top-level ()
+ (let ((here (point)))
+ (or (ignore-errors (end-of-defun) (end-of-defun)
+ (beginning-of-defun)
+ (< here (point)))
+ (progn (forward-char) (re-search-forward "^(" nil t))
+ (goto-char (point-max)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; variable extraction
+
+(defun scheme-sexp-type-at-point (&optional env)
+ (case (char-syntax (char-after))
+ ((?\()
+ (forward-char 1)
+ (if (eq ?w (char-syntax (char-after)))
+ (let ((op (scheme-symbol-at-point)))
+ (cond
+ ((eq op 'lambda)
+ (let ((params
+ (scheme-nth-sexp-at-point 1)))
+ `(lambda ,params)))
+ (t
+ (let ((spec (scheme-env-lookup env op)))
+ (and spec
+ (consp (cadr spec))
+ (eq 'lambda (caadr spec))
+ (cddadr spec)
+ (car (cddadr spec)))))))
+ nil))
+ ((?\")
+ 'string)
+ ((?\w)
+ (if (string-match "[0-9]" (string (char-after)))
+ 'number
+ nil))
+ (t
+ nil)))
+
+(defun scheme-let-vars-at-point (&optional env)
+ (let ((end (or (ignore-errors
+ (save-excursion (forward-sexp) (point)))
+ (point-min)))
+ (vars '()))
+ (forward-char 1)
+ (while (< (point) end)
+ (when (eq ?\( (char-after))
+ (save-excursion
+ (forward-char 1)
+ (if (eq ?w (char-syntax (char-after)))
+ (let* ((sym (scheme-symbol-at-point))
+ (type (ignore-errors
+ (scheme-beginning-of-next-sexp)
+ (scheme-sexp-type-at-point env))))
+ (push (if type (list sym type) (list sym)) vars)))))
+ (unless (ignore-errors (let ((here (point)))
+ (scheme-beginning-of-next-sexp)
+ (> (point) here)))
+ (goto-char end)))
+ (reverse vars)))
+
+(defun scheme-extract-match-clause-vars (x)
+ (cond
+ ((null x) '())
+ ((symbolp x)
+ (if (memq x '(_ ___ \.\.\.))
+ '()
+ (list (list x))))
+ ((consp x)
+ (case (car x)
+ ((or not)
+ (scheme-extract-match-clause-vars (cdr x)))
+ ((and)
+ (if (and (consp (cdr x))
+ (consp (cddr x))
+ (symbolp (cadr x))
+ (consp (caddr x))
+ (not (memq (caaddr x)
+ '(= $ @ ? and or not quote quasiquote get! set!))))
+ (cons (list (cadr x) (if (listp (caddr x)) 'list 'pair))
+ (scheme-extract-match-clause-vars (cddr x)))
+ (scheme-extract-match-clause-vars (cddr x))))
+ ((= $ @)
+ (if (consp (cdr x)) (scheme-extract-match-clause-vars (cddr x)) '()))
+ ((\?)
+ (if (and (consp (cdr x))
+ (consp (cddr x))
+ (symbolp (cadr x))
+ (symbolp (caddr x)))
+ (cons (list (caddr x) (scheme-predicate->type (cadr x)))
+ (scheme-extract-match-clause-vars (cdddr x)))
+ (scheme-extract-match-clause-vars (cddr x))))
+ ((get! set!)
+ (if (consp (cdr x)) (scheme-extract-match-clause-vars (cadr x)) '()))
+ ((quote) '())
+ ((quasiquote) '()) ; XXXX
+ (t (union (scheme-extract-match-clause-vars (car x))
+ (scheme-extract-match-clause-vars (cdr x))))))
+ ((vectorp x)
+ (scheme-extract-match-clause-vars (concatenate 'list x)))
+ (t
+ '())))
+
+;; call this from the first opening paren of the match clauses
+(defun scheme-extract-match-vars (&optional pos limit)
+ (let ((match-vars '())
+ (limit (or limit
+ (save-excursion
+ (or
+ (ignore-errors (end-of-defun) (point))
+ (point-max))))))
+ (save-excursion
+ (while (< (point) limit)
+ (let* ((end (ignore-errors (forward-sexp) (point)))
+ (start (and end (progn (backward-sexp) (point)))))
+ (cond
+ ((and pos start end (or (< pos start) (> pos end)))
+ (goto-char (if end (+ end 1) limit)))
+ (t
+ (forward-char 1)
+ (let* ((pat (scheme-nth-sexp-at-point 0))
+ (new-vars (ignore-errors
+ (scheme-extract-match-clause-vars pat))))
+ (setq match-vars (append new-vars match-vars)))
+ (goto-char (if (or pos (not end)) limit (+ end 1)))))))
+ match-vars)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; You can set the *scheme-default-implementation* to your preferred
+;; implementation, for when we can't figure out the file from
+;; heuristics. Alternately, in any given buffer, just
+;;
+;; (setq *scheme-current-implementation* whatever)
+
+(defgroup scheme-complete nil
+ "Smart tab completion"
+ :group 'scheme)
+
+(defcustom scheme-default-implementation nil
+ "Default scheme implementation to provide completion for
+when scheme-complete can't infer the current implementation."
+ :type 'symbol
+ :group 'scheme-complete)
+
+(defvar *scheme-current-implementation* nil)
+(make-variable-buffer-local '*scheme-current-implementation*)
+
+;; most implementations use their name as the script name
+(defvar *scheme-interpreter-alist*
+ '(("csi" . chicken)
+ ("gosh" . gauche)
+ ("gsi" . gambit)
+ ))
+
+(defvar *scheme-imported-modules* '())
+
+(defun scheme-current-implementation ()
+ (unless *scheme-current-implementation*
+ (setq *scheme-current-implementation*
+ (save-excursion
+ (goto-char (point-min))
+ (or (if (looking-at "#! *\\([^ \t\n]+\\)")
+ (let ((script (file-name-nondirectory (match-string 1))))
+ (or (cdr (assoc script *scheme-interpreter-alist*))
+ (intern script))))
+ (cond
+ ((re-search-forward "(define-module +\\(.\\)" nil t)
+ (if (equal "(" (match-string 1))
+ 'guile
+ 'gauche))
+ ((re-search-forward "(use " nil t)
+ 'chicken)
+ ((re-search-forward "(module " nil t)
+ 'mzscheme))))))
+ (or *scheme-current-implementation*
+ scheme-default-implementation))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun scheme-current-local-vars (&optional env)
+ (let ((vars '())
+ (limit (save-excursion (beginning-of-defun) (+ (point) 1)))
+ (start (point))
+ (scan-internal))
+ (save-excursion
+ (while (> (point) limit)
+ (or (ignore-errors
+ (progn
+ (skip-chars-backward " \t\n" limit)
+ (scheme-beginning-of-sexp)
+ t))
+ (goto-char limit))
+ (when (and (> (point) (point-min))
+ (eq ?\( (char-syntax (char-before (point))))
+ (eq ?w (char-syntax (char-after (point)))))
+ (setq scan-internal t)
+ (let ((sym (scheme-symbol-at-point)))
+ (case sym
+ ((lambda)
+ (setq vars
+ (append
+ (mapcar #'list
+ (scheme-flatten (scheme-nth-sexp-at-point 1)))
+ vars)))
+ ((match match-let match-let*)
+ (setq vars
+ (append
+ (ignore-errors
+ (save-excursion
+ (let ((limit (save-excursion
+ (cond
+ ((eq sym 'match)
+ (backward-char 1)
+ (forward-sexp 1))
+ (t
+ (forward-sexp 2)))
+ (point))))
+ (forward-sexp 2)
+ (if (eq sym 'match)
+ (forward-sexp 1))
+ (backward-sexp 1)
+ (if (not (eq sym 'match))
+ (forward-char 1))
+ (scheme-extract-match-vars
+ (and (or (eq sym 'match) (< start limit)) start)
+ limit))))
+ vars)))
+ ((let let* letrec letrec* let-syntax letrec-syntax and-let* do)
+ (or
+ (ignore-errors
+ (save-excursion
+ (scheme-beginning-of-next-sexp)
+ (if (and (eq sym 'let)
+ (eq ?w (char-syntax (char-after (point)))))
+ ;; named let
+ (let* ((sym (scheme-symbol-at-point))
+ (args (progn
+ (scheme-beginning-of-next-sexp)
+ (scheme-let-vars-at-point env))))
+ (setq vars (cons `(,sym (lambda ,(mapcar #'car args)))
+ (append args vars))))
+ (setq vars (append (scheme-let-vars-at-point env) vars)))
+ t))
+ (goto-char limit)))
+ ((let-values let*-values)
+ (setq vars
+ (append (mapcar
+ #'list
+ (scheme-append-map
+ #'scheme-flatten
+ (remove-if-not #'consp
+ (scheme-nth-sexp-at-point 1))))
+ vars)))
+ ((receive defun defmacro)
+ (setq vars
+ (append (mapcar #'list
+ (scheme-flatten
+ (scheme-nth-sexp-at-point 1)))
+ vars)))
+ (t
+ (if (string-match "^define\\(-.*\\)?" (symbol-name sym))
+ (let ((defs (save-excursion
+ (backward-char)
+ (scheme-extract-definitions))))
+ (setq vars
+ (append (scheme-append-map
+ #'(lambda (x)
+ (and (consp (cdr x))
+ (consp (cadr x))
+ (eq 'lambda (caadr x))
+ (mapcar #'list
+ (scheme-flatten
+ (cadadr x)))))
+ defs)
+ defs
+ vars)))
+ (setq scan-internal nil))))
+ ;; check for internal defines
+ (when scan-internal
+ (ignore-errors
+ (save-excursion
+ (forward-sexp
+ (+ 1 (if (numberp scan-internal) scan-internal 2)))
+ (backward-sexp)
+ (if (< (point) start)
+ (setq vars (append (scheme-current-definitions) vars))
+ ))))))))
+ (reverse vars)))
+
+(defun scheme-extract-import-module-name (sexp &optional mzschemep)
+ (case (car sexp)
+ ((prefix)
+ (scheme-extract-import-module-name
+ (if mzschemep (caddr sexp) (cadr sexp))))
+ ((prefix-all-except)
+ (scheme-extract-import-module-name (caddr sexp)))
+ ((for only except rename lib library)
+ (scheme-extract-import-module-name (cadr sexp) mzschemep))
+ ((import)
+ (scheme-extract-import-module-name (cadr sexp) mzschemep))
+ ((require)
+ (scheme-extract-import-module-name (cadr sexp) t))
+ (t sexp)))
+
+(defun scheme-extract-import-module-imports (sexp &optional mzschemep)
+ (case (car sexp)
+ ((prefix)
+ (let* ((ids (scheme-extract-import-module-name
+ (if mzschemep (caddr sexp) (cadr sexp))
+ mzschemep))
+ (prefix0 (if mzschemep (cadr sexp) (caddr sexp)))
+ (prefix (if (symbolp prefix0) (symbol-name prefix0) prefix0)))
+ (mapcar #'(lambda (x) (intern (concat prefix (symbol-name x)))) ids)))
+ ((prefix-all-except)
+ (let ((prefix
+ (if (symbolp (cadr sexp)) (symbol-name (cadr sexp)) (cadr sexp)))
+ (exceptions (cddr sexp)))
+ (mapcar #'(lambda (x)
+ (if (memq x exceptions)
+ x
+ (intern (concat prefix (symbol-name x)))))
+ (scheme-extract-import-module-name (caddr sexp) t))))
+ ((for)
+ (scheme-extract-import-module-name (cadr sexp) mzschemep))
+ ((rename)
+ (if mzschemep
+ (list (caddr sexp))
+ (mapcar 'cadr (cddr sexp))))
+ ((except)
+ (remove-if #'(lambda (x) (memq x (cddr sexp)))
+ (scheme-extract-import-module-imports (cadr sexp) mzschemep)))
+ ((only)
+ (cddr sexp))
+ ((import)
+ (scheme-extract-import-module-imports (cadr sexp) mzschemep))
+ ((require for-syntax)
+ (scheme-extract-import-module-imports (cadr sexp) t))
+ ((library)
+ (if (and (stringp (cadr sexp)) (file-exists-p (cadr sexp)))
+ (scheme-module-exports (intern (cadr sexp)))))
+ ((lib)
+ (if (and (equal "srfi" (caddr sexp))
+ (stringp (cadr sexp))
+ (string-match "^[0-9]+\\." (cadr sexp)))
+ (scheme-module-exports
+ (intern (file-name-sans-extension (concat "srfi-" (cadr sexp)))))
+ (scheme-module-exports
+ (intern (apply 'concat (append (cddr sexp) (list (cadr sexp))))))))
+ (t sexp)))
+
+(defun scheme-extract-sexp-imports (sexp)
+ (case (car sexp)
+ ((begin)
+ (scheme-append-map #'scheme-extract-sexp-imports (cdr sexp)))
+ ((cond-expand)
+ (scheme-append-map #'scheme-extract-sexp-imports
+ (scheme-append-map #'cdr (cdr sexp))))
+ ((use require-extension)
+ (scheme-append-map #'scheme-module-exports (cdr sexp)))
+ ((autoload)
+ (unless (member (cadr sexp) *scheme-imported-modules*)
+ (push (cadr sexp) *scheme-imported-modules*)
+ (mapcar #'(lambda (x) (cons (if (consp x) (car x) x) '((lambda obj))))
+ (cddr sexp))))
+ ((load)
+ (unless (member (cadr sexp) *scheme-imported-modules*)
+ (push (cadr sexp) *scheme-imported-modules*)
+ (and (file-exists-p (cadr sexp))
+ (scheme-with-find-file (cadr sexp)
+ (scheme-current-globals)))))
+ ((library module)
+ (scheme-append-map #'scheme-extract-import-module-imports
+ (remove-if #'(lambda (x) (memq (car x) '(import require)))
+ (cdr sexp))))
+ (t '())))
+
+(defun scheme-module-symbol-p (sym)
+ (memq sym '(use require require-extension begin cond-expand
+ module library define-module autoload load)))
+
+(defun scheme-skip-shebang ()
+ ;; skip shebang if present
+ (if (looking-at "#!")
+ ;; guile skips until a closing !#
+ (if (eq 'guile (scheme-current-implementation))
+ (re-search-forward "!#" nil t)
+ (next-line))))
+
+(defun scheme-current-imports ()
+ (let ((imports '())
+ (*scheme-imported-modules* '()))
+ (save-excursion
+ (goto-char (point-min))
+ (scheme-skip-shebang)
+ ;; scan for module forms
+ (while (not (eobp))
+ (if (ignore-errors (progn (forward-sexp) t))
+ (let ((end (point)))
+ (backward-sexp)
+ (when (eq ?\( (char-after))
+ (forward-char)
+ (when (and (not (eq ?\( (char-after)))
+ (scheme-module-symbol-p (scheme-symbol-at-point)))
+ (backward-char)
+ (ignore-errors
+ (setq imports
+ (append (scheme-extract-sexp-imports
+ (scheme-nth-sexp-at-point 0))
+ imports)))))
+ (goto-char end))
+ ;; if an incomplete sexp is found, try to recover at the
+ ;; next line beginning with an open paren
+ (scheme-goto-next-top-level))))
+ imports))
+
+;; we should be just inside the opening paren of an expression
+(defun scheme-name-of-define ()
+ (save-excursion
+ (scheme-beginning-of-next-sexp)
+ (if (eq ?\( (char-syntax (char-after)))
+ (forward-char))
+ (and (memq (char-syntax (char-after)) '(?\w ?\_))
+ (scheme-symbol-at-point))))
+
+(defun scheme-type-of-define ()
+ (save-excursion
+ (scheme-beginning-of-next-sexp)
+ (cond
+ ((eq ?\( (char-syntax (char-after)))
+ `(lambda ,(cdr (scheme-nth-sexp-at-point 0))))
+ (t
+ (scheme-beginning-of-next-sexp)
+ (scheme-sexp-type-at-point)))))
+
+;; we should be at the opening paren of an expression
+(defun scheme-extract-definitions (&optional env)
+ (save-excursion
+ (let ((sym (ignore-errors (and (eq ?\( (char-syntax (char-after)))
+ (progn (forward-char)
+ (scheme-symbol-at-point))))))
+ (case sym
+ ((define-syntax defmacro define-macro)
+ (list (list (scheme-name-of-define) '(syntax))))
+ ((define define-inline define-constant define-primitive defun)
+ (let ((name (scheme-name-of-define))
+ (type (scheme-type-of-define)))
+ (list (if type (list name type) (list name)))))
+ ((defvar define-class)
+ (list (list (scheme-name-of-define) 'non-procedure)))
+ ((define-record)
+ (backward-char)
+ (ignore-errors
+ (let* ((sexp (scheme-nth-sexp-at-point 0))
+ (name (symbol-name (cadr sexp))))
+ `((,(intern (concat name "?")) (lambda (obj) boolean))
+ (,(intern (concat "make-" name)) (lambda ,(cddr sexp) ))
+ ,@(scheme-append-map
+ #'(lambda (x)
+ `((,(intern (concat name "-" (symbol-name x)))
+ (lambda (non-procedure)))
+ (,(intern (concat name "-" (symbol-name x) "-set!"))
+ (lambda (non-procedure val) undefined))))
+ (cddr sexp))))))
+ ((define-record-type)
+ (backward-char)
+ (ignore-errors
+ (let ((sexp (scheme-nth-sexp-at-point 0)))
+ `((,(caaddr sexp) (lambda ,(cdaddr sexp)))
+ (,(cadddr sexp) (lambda (obj)))
+ ,@(scheme-append-map
+ #'(lambda (x)
+ (if (consp x)
+ (if (consp (cddr x))
+ `((,(cadr x) (lambda (non-procedure)))
+ (,(caddr x)
+ (lambda (non-procedure val) undefined)))
+ `((,(cadr x) (lambda (non-procedure)))))))
+ (cddddr sexp))))))
+ ((begin progn)
+ (forward-sexp)
+ (scheme-current-definitions))
+ (t
+ '())))))
+
+;; a little more liberal than -definitions, we try to scan to a new
+;; top-level form (i.e. a line beginning with an open paren) if
+;; there's an error during normal sexp movement
+(defun scheme-current-globals ()
+ (let ((globals '()))
+ (save-excursion
+ (goto-char (point-min))
+ (or (ignore-errors (end-of-defun) (beginning-of-defun) t)
+ (re-search-forward "^(" nil t)
+ (goto-char (point-max)))
+ (while (not (eobp))
+ (setq globals
+ (append (ignore-errors (scheme-extract-definitions)) globals))
+ (scheme-goto-next-top-level)))
+ globals))
+
+;; for internal defines, etc.
+(defun scheme-current-definitions (&optional enclosing-end)
+ (let ((defs '())
+ (end (or enclosing-end (point-max))))
+ (save-excursion
+ (while (< (point) end)
+ (let ((here (point))
+ (new-defs (scheme-extract-definitions)))
+ (cond
+ (new-defs
+ (setq defs (append new-defs defs))
+ (or (ignore-errors (scheme-beginning-of-next-sexp)
+ (> (point) here))
+ (goto-char end)))
+ (t ;; non-definition form, stop scanning
+ (goto-char end))))))
+ defs))
+
+(defun scheme-srfi-exports (i)
+ (and (integerp i)
+ (>= i 0)
+ (< i (length *scheme-srfi-info*))
+ (let ((info (cdr (aref *scheme-srfi-info* i))))
+ (if (and (consp info) (null (cdr info)) (symbolp (car info)))
+ (scheme-module-exports (car info))
+ info))))
+
+(defun scheme-module-exports (mod)
+ (unless (member mod *scheme-imported-modules*)
+ (push mod *scheme-imported-modules*)
+ (cond
+ ((and (consp mod) (eq 'srfi (car mod)))
+ (scheme-append-map #'scheme-srfi-exports (cdr mod)))
+ ((not (symbolp mod))
+ '())
+ ((string-match "^srfi-" (symbol-name mod))
+ (scheme-srfi-exports
+ (string-to-number (substring (symbol-name mod) 5))))
+ (t
+ (case (scheme-current-implementation)
+ ((chicken)
+ (let ((predefined (assq mod *scheme-chicken-modules*)))
+ (if predefined
+ (cdr predefined)
+ (mapcar
+ #'(lambda (x) (cons x '((lambda obj))))
+ (or (mapcar #'intern
+ (scheme-file->lines
+ (concat "/usr/local/lib/chicken/3/"
+ (symbol-name mod)
+ ".exports")))
+ (let ((setup-info (concat "/usr/local/lib/chicken/3/"
+ (symbol-name mod)
+ ".setup-info")))
+ (and (file-exists-p setup-info)
+ (scheme-with-find-file setup-info
+ (let* ((alist (scheme-nth-sexp-at-point 0))
+ (cell (assq 'exports alist)))
+ (cdr cell))))))))))
+ ((gauche)
+ (let ((path (scheme-find-file-in-path
+ (concat (subst-char-in-string ?. ?/ (symbol-name mod))
+ ".scm")
+ (list (concat
+ (car (directory-files
+ "/usr/local/share/gauche/"
+ t
+ "^[0-9]"))
+ "/lib")
+ "/usr/local/share/gauche/site/lib"))))
+ (if (not (file-exists-p path))
+ '()
+ ;; XXXX parse, don't use regexps
+ (scheme-with-find-file path
+ (when (re-search-forward "(export" nil t)
+ (backward-sexp)
+ (backward-char)
+ (mapcar #'list (cdr (ignore-errors
+ (scheme-nth-sexp-at-point 0)))))))))
+ ((mzscheme)
+ (let ((path (scheme-find-file-in-path
+ (symbol-name mod)
+ '("."
+ "/usr/local/lib/plt/collects"
+ "/usr/local/lib/plt/collects/mzlib"))))
+ (if (not (file-exists-p path))
+ '()
+ ;; XXXX parse, don't use regexps
+ (scheme-with-find-file path
+ (when (re-search-forward "(provide" nil t)
+ (backward-sexp)
+ (backward-char)
+ (mapcar #'list (cdr (ignore-errors
+ (scheme-nth-sexp-at-point 0)))))))))
+ (t '()))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; This is rather complicated because we to auto-generate docstring
+;; summaries from the type information, which means inferring various
+;; types from common names. The benefit is that you don't have to
+;; input the same information twice, and can often cut&paste&munge
+;; procedure descriptions from the original documentation.
+
+(defun scheme-translate-type (type)
+ (if (not (symbolp type))
+ type
+ (case type
+ ((pred proc thunk handler dispatch producer consumer f fn g kons)
+ 'procedure)
+ ((num) 'number)
+ ((z) 'complex)
+ ((x1 x2 x3 y timeout seconds nanoseconds) 'real)
+ ((i j k n m int index size count len length bound nchars start end
+ pid uid gid fd fileno errno)
+ 'integer)
+ ((ch) 'char)
+ ((str name pattern) 'string)
+ ((file path pathname) 'filename)
+ ((dir dirname) 'directory)
+ ((sym id identifier) 'symbol)
+ ((ls alist lists) 'list)
+ ((vec) 'vector)
+ ((exc excn err error) 'exception)
+ ((ptr) 'pointer)
+ ((bool) 'boolean)
+ ((env) 'environment)
+ ((char string boolean number complex real integer procedure char-set
+ port input-port output-port pair list vector array stream hash-table
+ thread mutex condition-variable time exception date duration locative
+ random-source state condition condition-type queue sequence pointer
+ u8vector s8vector u16vector s16vector u32vector s32vector
+ u64vector s64vector f32vector f64vector undefined symbol
+ block filename directory mmap listener environment non-procedure
+ read-table continuation blob generic method class regexp regmatch
+ sys-stat fdset)
+ type)
+ ((parent seed option mode) 'non-procedure)
+ (t
+ (let* ((str (symbol-name type))
+ (i (string-match "-?[0-9]+$" str)))
+ (if i
+ (scheme-translate-type (intern (substring str 0 i)))
+ (let ((i (string-match "-\\([^-]+\\)$" str)))
+ (if i
+ (scheme-translate-type (intern (substring str (+ i 1))))
+ (if (string-match "\\?$" str)
+ 'boolean
+ 'object)))))))))
+
+(defun scheme-lookup-type (spec pos)
+ (let ((i 1)
+ (type nil))
+ (while (and (consp spec) (<= i pos))
+ (cond
+ ((eq :optional (car spec))
+ (if (and (= i pos) (consp (cdr spec)))
+ (setq type (cadr spec)))
+ (setq i (+ pos 1)))
+ ((= i pos)
+ (setq type (car spec))
+ (setq spec nil))
+ ((and (consp (cdr spec)) (eq '\.\.\. (cadr spec)))
+ (setq type (car spec))
+ (setq spec nil)))
+ (setq spec (cdr spec))
+ (incf i))
+ (if type
+ (setq type (scheme-translate-type type)))
+ type))
+
+(defun scheme-predicate->type (pred)
+ (case pred
+ ((even? odd?) 'integer)
+ ((char-upper-case? char-lower-case?
+ char-alphabetic? char-numeric? char-whitespace?)
+ 'char)
+ (t
+ ;; catch all the `type?' predicates with pattern matching
+ ;; ... we could be smarter if the env was passed
+ (let ((str (symbol-name pred)))
+ (if (string-match "\\?$" str)
+ (scheme-translate-type
+ (intern (substring str 0 (- (length str) 1))))
+ 'object)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; completion
+
+(eval-when (compile load eval)
+ (unless (fboundp 'event-matches-key-specifier-p)
+ (defalias 'event-matches-key-specifier-p 'eq)))
+
+(unless (fboundp 'read-event)
+ (defun read-event ()
+ (aref (read-key-sequence nil) 0)))
+
+(unless (fboundp 'event-basic-type)
+ (defalias 'event-basic-type 'event-key))
+
+(defun scheme-string-prefix-p (pref str)
+ (let ((p-len (length pref))
+ (s-len (length str)))
+ (and (<= p-len s-len)
+ (equal pref (substring str 0 p-len)))))
+
+(defun scheme-do-completion (str coll &optional strs pred)
+ (let* ((coll (mapcar #'(lambda (x)
+ (cond
+ ((symbolp x) (list (symbol-name x)))
+ ((stringp x) (list x))
+ (t x)))
+ coll))
+ (completion1 (try-completion str coll pred))
+ (completion2 (and strs (try-completion str strs pred)))
+ (completion (if (and completion2
+ (or (not completion1)
+ (< (length completion2)
+ (length completion1))))
+ completion2
+ completion1)))
+ (cond
+ ((eq completion t))
+ ((not completion)
+ (message "Can't find completion for \"%s\"" str)
+ (ding))
+ ((not (string= str completion))
+ (let ((prefix-p (scheme-string-prefix-p completion completion1)))
+ (unless prefix-p
+ (save-excursion
+ (backward-char (length str))
+ (insert "\"")))
+ (insert (substring completion (length str)))
+ (unless prefix-p
+ (insert "\"")
+ (backward-char))))
+ (t
+ (let ((win-config (current-window-configuration))
+ (done nil))
+ (message "Hit space to flush")
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list
+ (sort
+ (all-completions str (append strs coll) pred)
+ 'string-lessp)))
+ (while (not done)
+ (let* ((orig-event
+ (with-current-buffer (get-buffer "*Completions*")
+ (read-event)))
+ (event (event-basic-type orig-event)))
+ (cond
+ ((or (event-matches-key-specifier-p event 'tab)
+ (event-matches-key-specifier-p event 9))
+ (save-selected-window
+ (select-window (get-buffer-window "*Completions*"))
+ (if (pos-visible-in-window-p (point-max))
+ (goto-char (point-min))
+ (scroll-up))))
+ (t
+ (set-window-configuration win-config)
+ (if (or (event-matches-key-specifier-p event 'space)
+ (event-matches-key-specifier-p event 32))
+ (bury-buffer (get-buffer "*Completions*"))
+ (setq unread-command-events (list orig-event)))
+ (setq done t))))))
+ ))))
+
+(defun scheme-env-lookup (env sym)
+ (let ((spec nil)
+ (ls env))
+ (while (and ls (not spec))
+ (setq spec (assq sym (pop ls))))
+ spec))
+
+(defun scheme-current-env ()
+ ;; r5rs
+ (let ((env (list *scheme-r5rs-info*)))
+ ;; base language
+ (let ((base (cdr (assq (scheme-current-implementation)
+ *scheme-implementation-exports*))))
+ (if base (push base env)))
+ ;; imports
+ (let ((imports (ignore-errors (scheme-current-imports))))
+ (if imports (push imports env)))
+ ;; top-level defs
+ (let ((top (ignore-errors (scheme-current-globals))))
+ (if top (push top env)))
+ ;; current local vars
+ (let ((locals (ignore-errors (scheme-current-local-vars env))))
+ (if locals (push locals env)))
+ env))
+
+(defun scheme-env-filter (pred env)
+ (mapcar #'car
+ (apply #'concatenate
+ 'list
+ (mapcar #'(lambda (e) (remove-if-not pred e))
+ env))))
+
+;; checking return values:
+;; a should be capable of returning instances of b
+(defun scheme-type-match-p (a b)
+ (let ((a1 (scheme-translate-type a))
+ (b1 (scheme-translate-type b)))
+ (and (not (eq a1 'undefined)) ; check a *does* return something
+ (or (eq a1 b1) ; and they're the same
+ (eq a1 'object) ; ... or a can return anything
+ (eq b1 'object) ; ... or b can receive anything
+ (if (symbolp a1)
+ (if (symbolp b1)
+ (case a1 ; ... or the types overlap
+ ((number complex real rational integer)
+ (memq b1 '(number complex real rational integer)))
+ ((port input-port output-port)
+ (memq b1 '(port input-port output-port)))
+ ((pair list)
+ (memq b1 '(pair list)))
+ ((non-procedure)
+ (not (eq 'procedure b1))))
+ (and
+ (consp b1)
+ (if (eq 'or (car b1))
+ ;; type unions
+ (find-if
+ #'(lambda (x)
+ (scheme-type-match-p
+ a1 (scheme-translate-type x)))
+ (cdr b1))
+ (let ((b2 (scheme-translate-special-type b1)))
+ (and (not (equal b1 b2))
+ (scheme-type-match-p a1 b2))))))
+ (and (consp a1)
+ ;; type unions
+ (if (eq 'or (car a1))
+ (find-if
+ #'(lambda (x)
+ (scheme-type-match-p (scheme-translate-type x) b1))
+ (cdr a1))
+ ;; other special types
+ (let ((a2 (scheme-translate-special-type a1))
+ (b2 (scheme-translate-special-type b1)))
+ (and (or (not (equal a1 a2)) (not (equal b1 b2)))
+ (scheme-type-match-p a2 b2))))
+ ))))))
+
+(defun scheme-translate-special-type (x)
+ (if (not (consp x))
+ x
+ (case (car x)
+ ((list string) (car x))
+ ((set special) (cadr x))
+ ((flags) 'integer)
+ (t x))))
+
+(defun scheme-nth* (n ls)
+ (while (and (consp ls) (> n 0))
+ (setq n (- n 1)
+ ls (cdr ls)))
+ (and (consp ls) (car ls)))
+
+(defun scheme-file->lines (file)
+ (and (file-readable-p file)
+ (scheme-with-find-file file
+ (goto-char (point-min))
+ (let ((res '()))
+ (while (not (eobp))
+ (let ((start (point)))
+ (forward-line)
+ (push (buffer-substring-no-properties start (- (point) 1))
+ res)))
+ (reverse res)))))
+
+(defun scheme-passwd-file-names (file &optional pat)
+ (delete
+ nil
+ (mapcar
+ #'(lambda (line)
+ (and (not (string-match "^[ ]*#" line))
+ (or (not pat) (string-match pat line))
+ (string-match "^\\([^:]*\\):" line)
+ (match-string 1 line)))
+ (scheme-file->lines file))))
+
+(defun scheme-host-file-names (file)
+ (scheme-append-map
+ #'(lambda (line)
+ (let ((i (string-match "#" line)))
+ (if i (setq line (substring line 0 i))))
+ (cdr (split-string line)))
+ (scheme-file->lines file)))
+
+(defun scheme-ssh-known-hosts-file-names (file)
+ (scheme-append-map
+ #'(lambda (line)
+ (split-string (car (split-string line)) ","))
+ (scheme-file->lines file)))
+
+(defun scheme-ssh-config-file-names (file)
+ (scheme-append-map
+ #'(lambda (line)
+ (and (string-match "^ *Host" line)
+ (cdr (split-string line))))
+ (scheme-file->lines file)))
+
+(defun scheme-complete-user-name (trans sym)
+ (if (string-match "apple" (emacs-version))
+ (append (scheme-passwd-file-names "/etc/passwd" "^[^_].*")
+ (delete "Shared" (directory-files "/Users" nil "^[^.].*")))
+ (scheme-passwd-file-names "/etc/passwd")))
+
+(defun scheme-complete-host-name (trans sym)
+ (append (scheme-host-file-names "/etc/hosts")
+ (scheme-ssh-known-hosts-file-names "~/.ssh/known_hosts")
+ (scheme-ssh-config-file-names "~/.ssh/config")))
+
+;; my /etc/services is 14k lines, so we try to optimize this
+(defun scheme-complete-port-name (trans sym)
+ (and (file-readable-p "/etc/services")
+ (scheme-with-find-file "/etc/services"
+ (goto-char (point-min))
+ (let ((rx (concat "^\\(" (regexp-quote (if (symbolp sym)
+ (symbol-name sym)
+ sym))
+ "[^ ]*\\)"))
+ (res '()))
+ (while (not (eobp))
+ (if (not (re-search-forward rx nil t))
+ (goto-char (point-max))
+ (let ((str (match-string-no-properties 1)))
+ (if (not (equal str (car res)))
+ (push str res)))
+ (forward-char 1)))
+ res))))
+
+(defun scheme-complete-file-name (trans sym)
+ (let* ((file (file-name-nondirectory sym))
+ (dir (file-name-directory sym))
+ (res (file-name-all-completions file (or dir "."))))
+ (if dir
+ (mapcar #'(lambda (f) (concat dir f)) res)
+ res)))
+
+(defun scheme-complete-directory-name (trans sym)
+ (let* ((file (file-name-nondirectory sym))
+ (dir (file-name-directory sym))
+ (res (file-name-all-completions file (or dir ".")))
+ (res2 (if dir (mapcar #'(lambda (f) (concat dir f)) res) res)))
+ (remove-if-not #'file-directory-p res2)))
+
+(defun scheme-string-completer (type)
+ (case type
+ ((filename)
+ '(scheme-complete-file-name file-name-nondirectory))
+ ((directory)
+ '(scheme-complete-directory-name file-name-nondirectory))
+ (t
+ (cond
+ ((and (consp type) (eq 'string (car type)))
+ (cadr type))
+ ((and (consp type) (eq 'or (car type)))
+ (car (delete nil (mapcar #'scheme-string-completer (cdr type)))))))))
+
+(defun scheme-apply-string-completer (cmpl sym)
+ (let ((func (if (consp cmpl) (car cmpl) cmpl))
+ (trans (and (consp cmpl) (cadr cmpl))))
+ (funcall func trans sym)))
+
+(defun scheme-smart-complete (&optional arg)
+ (interactive "P")
+ (let* ((end (point))
+ (start (save-excursion (skip-syntax-backward "w_") (point)))
+ (sym (buffer-substring-no-properties start end))
+ (in-str-p (scheme-in-string-p))
+ (x (save-excursion
+ (if in-str-p (scheme-beginning-of-string))
+ (scheme-enclosing-2-sexp-prefixes)))
+ (inner-proc (car x))
+ (inner-pos (cadr x))
+ (outer-proc (caddr x))
+ (outer-pos (cadddr x))
+ (env (save-excursion
+ (if in-str-p (scheme-beginning-of-string))
+ (scheme-current-env)))
+ (outer-spec (scheme-env-lookup env outer-proc))
+ (outer-type (scheme-translate-type (cadr outer-spec)))
+ (inner-spec (scheme-env-lookup env inner-proc))
+ (inner-type (scheme-translate-type (cadr inner-spec))))
+ (cond
+ ;; return all env symbols when a prefix arg is given
+ (arg
+ (scheme-do-completion sym (scheme-env-filter #'(lambda (x) t) env)))
+ ;; for now just do file-name completion in strings
+ (in-str-p
+ (let* ((param-type
+ (and (consp inner-type)
+ (eq 'lambda (car inner-type))
+ (scheme-lookup-type (cadr inner-type) inner-pos)))
+ (completer (or (scheme-string-completer param-type)
+ '(scheme-complete-file-name
+ file-name-nondirectory))))
+ (scheme-do-completion
+ ;;(if (consp completer) (funcall (cadr completer) sym) sym)
+ sym
+ (scheme-apply-string-completer completer sym))))
+ ;; outer special
+ ((and (consp outer-type)
+ (eq 'special (car outer-type))
+ (cadddr outer-type))
+ (scheme-do-completion sym (funcall (cadddr outer-type) sym)))
+ ;; inner special
+ ((and (consp inner-type)
+ (eq 'special (car inner-type))
+ (caddr inner-type))
+ (scheme-do-completion sym (funcall (caddr inner-type) sym)))
+ ;; completing inner procedure, complete procedures with a
+ ;; matching return type
+ ((and (consp outer-type)
+ (eq 'lambda (car outer-type))
+ (not (zerop outer-pos))
+ (scheme-nth* (- outer-pos 1) (cadr outer-type))
+ (or (zerop inner-pos)
+ (and (>= 1 inner-pos)
+ (consp inner-type)
+ (eq 'lambda (car inner-type))
+ (let ((param-type
+ (scheme-lookup-type (cadr inner-type) inner-pos)))
+ (and (consp param-type)
+ (eq 'lambda (car param-type))
+ (eq (caddr inner-type) (caddr param-type)))))))
+ (let ((want-type (scheme-lookup-type (cadr outer-type) outer-pos)))
+ (scheme-do-completion
+ sym
+ (scheme-env-filter
+ #'(lambda (x)
+ (let ((type (cadr x)))
+ (or (memq type '(procedure object nil))
+ (and (consp type)
+ (or (and (eq 'syntax (car type))
+ (not (eq 'undefined (caddr type))))
+ (and (eq 'lambda (car type))
+ (scheme-type-match-p (caddr type)
+ want-type)))))))
+ env))))
+ ;; completing a normal parameter
+ ((and inner-proc
+ (not (zerop inner-pos))
+ (consp inner-type)
+ (eq 'lambda (car inner-type)))
+ (let* ((param-type (scheme-lookup-type (cadr inner-type) inner-pos))
+ (set-or-flags
+ (or (and (consp param-type)
+ (case (car param-type)
+ ((set) (cddr param-type))
+ ((flags) (cdr param-type))))
+ ;; handle nested arithmetic functions inside a flags
+ ;; parameter
+ (and (not (zerop outer-pos))
+ (consp outer-type)
+ (eq 'lambda (car outer-type))
+ (let ((outer-param-type
+ (scheme-lookup-type (cadr outer-type)
+ outer-pos)))
+ (and (consp outer-param-type)
+ (eq 'flags (car outer-param-type))
+ (memq (scheme-translate-type param-type)
+ '(number complex real rational integer))
+ (memq (scheme-translate-type (caddr inner-type))
+ '(number complex real rational integer))
+ (cdr outer-param-type))))))
+ (base-type (if set-or-flags
+ (if (and (consp param-type)
+ (eq 'set (car param-type)))
+ (scheme-translate-type (cadr param-type))
+ 'integer)
+ param-type))
+ (base-completions
+ (scheme-env-filter
+ #'(lambda (x)
+ (scheme-type-match-p (cadr x) base-type))
+ env))
+ (str-completions
+ (let ((completer (scheme-string-completer base-type)))
+ (and
+ completer
+ (scheme-apply-string-completer completer sym)))))
+ (scheme-do-completion
+ sym
+ (append set-or-flags base-completions)
+ str-completions)))
+ ;; completing a function
+ ((zerop inner-pos)
+ (scheme-do-completion
+ sym
+ (scheme-env-filter
+ #'(lambda (x)
+ (or (null (cdr x))
+ (memq (cadr x) '(procedure object nil))
+ (and (consp (cadr x))
+ (memq (caadr x) '(lambda syntax)))))
+ env)))
+ ;; complete everything
+ (t
+ (scheme-do-completion sym (scheme-env-filter #'(lambda (x) t) env)) ))))
+
+(defun scheme-complete-or-indent (&optional arg)
+ (interactive "P")
+ (let* ((end (point))
+ (func
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward "\\S-" end t)
+ 'scheme-smart-complete
+ 'lisp-indent-line))))
+ (funcall func arg)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; optional eldoc function
+
+(defun scheme-translate-dot-to-optional (ls)
+ (let ((res '()))
+ (while (consp ls)
+ (setq res (cons (car ls) res))
+ (setq ls (cdr ls)))
+ (if (not (null ls))
+ (setq res (cons ls (cons :optional res))))
+ (reverse res)))
+
+(defun scheme-optional-in-brackets (ls)
+ ;; put optional arguments inside brackets (via a vector)
+ (if (memq :optional ls)
+ (let ((res '()))
+ (while (and (consp ls) (not (eq :optional (car ls))))
+ (push (pop ls) res))
+ (reverse (cons (apply #'vector (cdr ls)) res)))
+ ls))
+
+(defun scheme-base-type (x)
+ (if (not (consp x))
+ x
+ (case (car x)
+ ((string list) (car x))
+ ((set) (or (cadr x) (car x)))
+ ((flags) 'integer)
+ ((lambda) 'procedure)
+ ((syntax) 'syntax)
+ (t x))))
+
+(defun scheme-sexp-to-string (sexp)
+ (with-output-to-string (princ sexp)))
+
+(defun scheme-get-current-symbol-info ()
+ (let* ((sym (eldoc-current-symbol))
+ (fnsym0 (eldoc-fnsym-in-current-sexp))
+ (fnsym (if (consp fnsym0) (car fnsym0) fnsym0))
+ (env (save-excursion
+ (if (scheme-in-string-p) (scheme-beginning-of-string))
+ (scheme-current-env)))
+ (spec (or (and sym (scheme-env-lookup env sym))
+ (and fnsym (scheme-env-lookup env fnsym)))))
+ (and (consp spec)
+ (consp (cdr spec))
+ (let ((type (cadr spec)))
+ (concat
+ (cond
+ ((nth 3 spec)
+ "")
+ ((and (consp type)
+ (memq (car type) '(syntax lambda)))
+ (concat
+ (if (eq (car type) 'syntax)
+ "syntax: "
+ "")
+ (scheme-sexp-to-string
+ (cons (car spec)
+ (scheme-optional-in-brackets
+ (mapcar #'scheme-base-type
+ (scheme-translate-dot-to-optional
+ (cadr type))))))
+ (if (and (consp (cddr type))
+ (not (memq (caddr type) '(obj object))))
+ (concat " => " (scheme-sexp-to-string (caddr type)))
+ "")))
+ ((and (consp type) (eq (car type) 'special))
+ (scheme-sexp-to-string (car spec)))
+ (t
+ (scheme-sexp-to-string type)))
+ (if (and (not (nth 3 spec)) (nth 4 spec)) " - " "")
+ (or (nth 4 spec) ""))))))
+
+(provide 'scheme-complete)
+
+;; Local Variables:
+;; eval: (put 'scheme-with-find-file 'lisp-indent-hook 1)
+;; End:
--- /dev/null
+;;; scheme48.el --- A major mode for Scheme48 development
+
+;; Copyright (C) 1992 Jonathan Rees
+;; Copyright (C) 2005, 2006 Jorgen Schaefer
+
+;; Version: 9
+;; Author: Jonathan Rees (cmuscheme48.el)
+;; Jorgen Schaefer <forcer@forcix.cx> (scheme48-mode)
+;; URL: http://www.emacswiki.org/cgi-bin/emacs/Scheme48Mode
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+;; 3. The name of the authors may not be used to endorse or promote products
+;; derived from this software without specific prior written permission.
+
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; Commentary:
+
+;; This file provides `scheme48-mode', a major mode for improved
+;; interaction with Scheme48. It's the same as the canonical
+;; `scheme-mode', but provides some commands which tell Scheme48 from
+;; which a specific definition came from. This allows Scheme48 to put
+;; the definition in the correct package by itself.
+
+;; This is based om the cmuscheme48.el which comes with Scheme48.
+
+;; You can set a buffer-local variable named `scheme48-package' to
+;; send definitions to that package. This can be done by file
+;; variables, so the following works:
+
+;; -*- mode: scheme48; scheme48-package: mypackage -*-
+
+;; To use the special packages CONFIG, USER and EXEC, use the package
+;; name in parens, like this:
+
+;; -*- mode: scheme48; scheme48-package: (exec) -*-
+
+;;; Thanks:
+
+;; Thanks to Taylor Campbell (Riastradh on irc.freenode.net) for his
+;; extensive list of indentation settings and the idea with the
+;; scheme48-package local variable.
+
+;; Thanks to Emilio Lopes for the idea to highlight the new keywords
+;; as well.
+
+;;; Code:
+
+(require 'cmuscheme)
+(require 'scheme)
+
+(defcustom scheme48-compatibility-bindings-p nil
+ "Use the compatbility bindings?
+The old cmuscheme48.el provided a few non-standard bindings,
+which can be re-enabled by setting this variable to a non-nil
+value before loading this file."
+ :group 'scheme
+ :type 'boolean)
+
+(defcustom scheme48-keywords
+ '(;; R5RS
+ (dynamic-wind 0)
+
+ ;; Scheme48
+ (destructure 1)
+ (enum-case 2)
+ (environment-define! 2 no-font-lock)
+ (environment-set! 2 no-font-lock)
+ (guard 1)
+ (iterate 3)
+ (make-usual-resumer 2 no-font-lock)
+ (mvlet 1)
+ (mvlet* 1)
+ (search-tree-modify! 2 no-font-lock)
+ (usual-resumer 0 no-font-lock)
+ (with-exception-handler 1)
+ (with-handler 1)
+ (with-interaction-environment 1)
+ (with-nondeterminism 0)
+
+ ;; I/O-related
+ (call-with-current-input-port 1)
+ (call-with-current-noise-port 1)
+ (call-with-current-output-port 1)
+ (call-with-string-output-port 0)
+ (limit-output 2 no-font-lock)
+ (recurring-write 2 no-font-lock)
+ (silently 0)
+ (with-current-ports 3)
+
+ ;; Configuration language
+ (define-interface 1)
+ (define-structure 2)
+ (structure 1)
+ (structures 1)
+ ;; These don't improve (for some, even degrade) the readability.
+ ;; (modify 1 no-font-lock)
+ ;; (subset 1 no-font-lock)
+
+ ;; Concurrency-related
+ (atomically 0)
+ (atomically! 0)
+ (call-ensuring-atomicity 0)
+ (call-ensuring-atomicity! 0)
+ (ensure-atomicity 0)
+ (ensure-atomicity! 0)
+ (interrupt-thread 1 no-font-lock)
+ (let-fluid 2)
+ (let-fluids defun)
+ (spawn-on-scheduler 1 no-font-lock)
+ (with-new-proposal 1)
+
+ ;; SCSH
+ (with-current-input-port 2)
+ (with-current-output-port 2)
+ (awk 3)
+ (close-after 2 no-font-lock)
+ (if-match 2)
+ (with-cwd 1)
+ (with-cwd* 1)
+
+ ;; Others
+ (let-optionals scheme-let-indent)
+ (let-optionals* scheme-let-indent)
+
+ ;; SRFI-2
+ (and-let* 1)
+
+ ;; SRFI-8
+ (receive 2)
+
+ ;; SRFI-11
+ (let-values 1)
+ (let*-values 1)
+ )
+ "A list of Scheme48-related keywords.
+The list consists of lists of the form (KEYWORD INDENT [NO-FONT-LOCK].
+The keywords named KEYWORD will be indented according to INDENT,
+and will also be highlighted as keywords unless NO-FONT-LOCK is
+non-nil."
+ :group 'scheme
+ :type '(repeat (list symbol sexp boolean)))
+
+(defvar scheme48-package nil
+ "The name of the package definitions from this file should go to.")
+(make-variable-buffer-local 'scheme48-package)
+
+(put 'scheme48-package 'safe-local-variable 'scheme48-safe-variable)
+
+(defun scheme48-safe-variable (var)
+ "Return non-nil when VAR is a valid value of `scheme48-package'."
+ (or (symbolp var)
+ (stringp var)
+ (and (consp var)
+ (or (and (null (cdr var))
+ (memq (car var)
+ '(config user exec)))
+ (and (null (cddr var))
+ (eq 'for-syntax (car var))
+ (or (symbolp (cadr var))
+ (stringp (cadr var))))))))
+
+(defvar scheme48-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\M-\C-x" 'scheme48-send-definition) ;gnu convention
+ (define-key map "\C-x\C-e" 'scheme48-send-last-sexp) ;gnu convention
+ (define-key map "\C-c\C-e" 'scheme48-send-definition)
+ (define-key map "\C-c\M-e" 'scheme48-send-definition-and-go)
+ (define-key map "\C-c\C-r" 'scheme48-send-region)
+ (define-key map "\C-c\M-r" 'scheme48-send-region-and-go)
+ (define-key map "\C-c\C-l" 'scheme48-load-file)
+ (when scheme48-compatibility-bindings-p
+ (define-key map "\C-ce" 'scheme48-send-definition)
+ (define-key map "\C-c\C-e" 'scheme48-send-definition-and-go)
+ (define-key map "\C-cr" 'scheme48-send-region)
+ (define-key map "\C-c\C-r" 'scheme48-send-region-and-go)
+ (define-key map "\C-cl" 'scheme48-load-file))
+ map)
+ "The keymap used in `scheme48-mode'.")
+
+(define-derived-mode scheme48-mode scheme-mode "Scheme48"
+ "Major mode for improved Scheme48 interaction.
+This mode is derived from `scheme-mode', so see there for
+information.
+
+The commands that send code to the Scheme48 process attach
+information as to from which file the code comes from. This
+allows Scheme48 to put the corresponding definitions in the
+package associated with that file name.
+
+\\{scheme48-mode-map}"
+ (scheme48-initialize)
+ (set (make-local-variable 'scheme-trace-command)
+ ",trace %s")
+ (set (make-local-variable 'scheme-untrace-command)
+ ",untrace %s")
+ (set (make-local-variable 'scheme-macro-expand-command)
+ ",expand %s")
+ (when (boundp 'package)
+ (message "The `package' local variable is deprecated. Use `scheme48-package' instead.")
+ (when (not scheme48-package)
+ (setq scheme48-package package))))
+
+(defvar scheme48-mode-initialized-p nil
+ "This is non-nil when `scheme48-mode' has been initialized.
+Set it to nil if you want the next invocation of `scheme48-mode'
+to re-read `scheme48-keywords'.")
+
+(defun scheme48-initialize ()
+ "Initialize `scheme48-mode' from `scheme48-keywords'.
+Only run when `scheme48-mode-initialized-p' is nil.
+This is done so that the user can modify `scheme48-keywords'
+before the first time the mode is run, but after this package has
+been loaded."
+ (when (not scheme48-mode-initialized-p)
+ (mapc (lambda (entry)
+ (put (car entry)
+ 'scheme-indent-function
+ (cadr entry))
+ (put (intern (upcase (symbol-name (car entry))))
+ 'scheme-indent-function
+ (cadr entry)))
+ scheme48-keywords)
+ (let ((regexp (concat "("
+ (regexp-opt
+ (delete nil
+ (mapcar (lambda (elt)
+ (if (nth 2 elt)
+ nil
+ (symbol-name (car elt))))
+ scheme48-keywords))
+ t)
+ "\\>")))
+ (font-lock-add-keywords 'scheme48-mode
+ (list (list regexp 1 'font-lock-keyword-face))))
+ (setq scheme48-mode-initialized-p t)))
+
+(defun scheme48-send-region (start end)
+ "Send the current region to the inferior Scheme process."
+ (interactive "r")
+ (cond
+ (scheme48-package
+ (scheme48-send-with-prefix (scheme48-package-sender scheme48-package)
+ start
+ end))
+ ((buffer-file-name (current-buffer))
+ (comint-send-string (scheme-proc)
+ (concat ",from-file "
+ (scheme48-enough-scheme-file-name
+ (buffer-file-name (current-buffer)))
+ "\n"))
+ (comint-send-region (scheme-proc) start end)
+ (comint-send-string (scheme-proc) " ,end\n"))
+ (t
+ (comint-send-region (scheme-proc) start end)
+ (comint-send-string (scheme-proc) "\n"))))
+
+(defun scheme48-send-with-prefix (prefix start end)
+ "Send all Scheme definitions in the region to the Scheme process."
+ (let ((region (buffer-substring-no-properties start end))
+ (p prefix)) ; Emacs lossage - prefix is suddenly nil below
+ (with-temp-buffer
+ (insert region "\n")
+ ;; `backward-sexp' relies on this. Thanks to Riastradh for
+ ;; finding it out :-)
+ (set-syntax-table scheme-mode-syntax-table)
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ ;; Add prefix
+ (while (> (point)
+ (progn (backward-sexp)
+ (point)))
+ (save-excursion
+ (insert "\n" p " ")))
+ (comint-send-region (scheme-proc)
+ (point-min)
+ (point-max)))))
+
+(defun scheme48-send-definition ()
+ "Send the current definition to the inferior Scheme48 process."
+ (interactive)
+ (save-excursion
+ (end-of-defun)
+ (let ((end (point)))
+ (beginning-of-defun)
+ (scheme48-send-region (point) end))))
+
+(defun scheme48-send-last-sexp ()
+ "Send the previous sexp to the inferior Scheme process."
+ (interactive)
+ (scheme48-send-region (save-excursion (backward-sexp) (point)) (point)))
+
+(defun scheme48-send-region-and-go (start end)
+ "Send the current region to the inferior Scheme48 process,
+and switch to the process buffer."
+ (interactive "r")
+ (scheme48-send-region start end)
+ (switch-to-scheme t))
+
+(defun scheme48-send-definition-and-go ()
+ "Send the current definition to the inferior Scheme48,
+and switch to the process buffer."
+ (interactive)
+ (scheme48-send-definition)
+ (switch-to-scheme t))
+
+(defun scheme48-load-file (file-name)
+ "Load a Scheme file into the inferior Scheme48 process."
+ (interactive (comint-get-source "Load Scheme48 file: "
+ scheme-prev-l/c-dir/file
+ scheme-source-modes t)) ; T because LOAD
+ ; needs an exact name
+ (comint-check-source file-name) ; Check to see if buffer needs saved.
+ (setq scheme-prev-l/c-dir/file (cons (file-name-directory file-name)
+ (file-name-nondirectory file-name)))
+ (comint-send-string
+ (scheme-proc)
+ (concat (if scheme48-package
+ (concat (scheme48-package-sender scheme48-package)
+ " ")
+ "")
+ ",load "
+ (scheme48-enough-scheme-file-name file-name)
+ "\n")))
+
+(defun scheme48-package-sender (package)
+ "Return the prefix to send a definition to PACKAGE."
+ (cond
+ ((equal package '(config))
+ ",config")
+ ((equal package '(user))
+ ",user")
+ ((equal package '(exec))
+ ",exec")
+ ((and (consp package)
+ (eq 'for-syntax (car package)))
+ (format ",in %s ,for-syntax" (cadr package)))
+ (t
+ (format ",in %s" package))))
+
+;;; This assumes that when you load things into Scheme 48, you type
+;;; names of files in your home directory using the syntax "~/".
+;;; Similarly for current directory. Maybe we ought to send multiple
+;;; file names to Scheme and let it look at all of them.
+
+(defcustom scheme48-home-directory-kludge t
+ "*Whether the home directory should be simplified.
+
+When telling Scheme48 about the file name, it's a difference
+whether we send a file name beginning with \"~/\" or the actual
+expanded path name. If this is non-nil and the file name for
+`scheme48-enough-scheme-file-name' starts with the user's home
+directory, that is replaced with \"~/\"."
+ :group 'scheme
+ :type 'boolean)
+
+(defun scheme48-enough-scheme-file-name (file)
+ "Return a canonical name for FILE.
+This will trim off the directory used in the *scheme* buffer,
+or replace a home directory at the beginning with ~/ if
+`scheme48-home-directory-kludge' is non-nil."
+ (let ((file (expand-file-name file))
+ (scheme-dir (with-current-buffer scheme-buffer
+ (expand-file-name default-directory))))
+ (or (scheme48-replace-prefix file scheme-dir)
+ (and scheme48-home-directory-kludge
+ (scheme48-replace-prefix file (expand-file-name "~/") "~/"))
+ file)))
+
+(defun scheme48-replace-prefix (file prefix &optional replace)
+ "Replace PREFIX at the beginning of FILE with REPLACE, or \"\"."
+ (let ((replace (or replace ""))
+ (len (length prefix)))
+ (if (and (> (length file)
+ len)
+ (string-equal (substring file 0 len)
+ prefix))
+ (concat replace (substring file len))
+ nil)))
+
+(provide 'scheme48)
+;;; scheme48.el ends here
--- /dev/null
+;;; screencast.el --- demonstrate the capabilities of Emacs
+
+;; Copyright (C) 2009 ESBEN Andreasen <esbenandreasen@gmail.com>
+
+;; Authors: Esben Andreasen <esbenandreasen@gmail.com>
+
+;; Keywords: demo screencast
+
+;; This file is not an official part of Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file allows you to create video-like sessions, which
+;; demonstrates the capabilities of Emacs.
+
+;;; Usage:
+
+;; Install this file to an appropriate directory in your load-path,
+;; and add these expressions to your ~/.emacs
+
+;; (auto-load 'screencast "screencast")
+
+;; Try it out by evaluating (screencast-screencast-producer) and (screencast-screencast-user)
+
+;; Your own screencast files should have a (require 'screencast)
+
+;;; Conventions:
+
+;; PRODUCER : creates a screencast
+
+;; USER : sees a screencast
+
+;; producer sections in this document contains variables which the producer
+;; should modify as need be, and functions to be called during the creation of a
+;; screencast
+
+;;; Change-log:
+
+;; 1.0: core functionality
+
+;; 1.1: PRODUCER ADDITIONS:
+;; public variables which contain information about the current screencast
+;; ability to change last-command and last-command-char
+;; ability to use let and flet, while still outputting command descriptions
+;; ability to create blinking sections to move the attention towards those
+;; ability to show the region as if transient-mark-mode was on
+;;
+;; split the screencasts for the producer into a basic and an advanced
+;; voice synthesizing of typed text. Requires festival to be installed.
+;; global speed control
+;; typed strings in screencasts can not contain tabs and newlines
+;;; Code:
+
+(defconst screencast-message-buffer-name "*Screencast Messages*"
+ "The name of the buffer to put messages from the screencast in")
+
+(defconst screencast-version 1.1 "The version number of the screencast-mode")
+
+(defconst screencast-speed-relation-speech-type 18.0
+ "When this is correctly adjusted, speech and typing should end
+at the same time. Lower values means faster speech.")
+;;;; BEGIN USER VARIABLES
+(defvar screencast-pause-length 2 "The length of a pause ('p) in the screencast")
+
+(defvar screencast-pause-char-length 0.12
+ "The time between each typed character in the function `screencast-insert-with-delay'")
+
+(defvar screencast-pause-command-length 3
+ "The time between the announcement of the function call, and the call itself.")
+
+(defvar screencast-speech nil "If non-nil, slowly typed strings are read aloud")
+
+(defvar screencast-speed 1.0 "How fast the screencast should be. Higher values equals higher speed. This can not be changed _during_ the screencast.")
+;;;; BEGIN PRODUCER VARIABLES
+;; these variables should be changed as needed by the producer
+
+(defvar screencast-dont-print-list '(
+ progn
+ let
+ flet
+ save-excursion
+ save-window-excursion
+ i
+ screencast-producer-insert-with-delay
+ screencast-producer-set-last-command
+ screencast-producer-set-last-char
+ screencast-producer-new-buffer
+ screencast-producer-show-region
+ screencast-producer-blink-regions)
+ "A list of lists of function names which aren't printed as
+ being evaluated in the messages, this includes all producer
+ functions by default")
+
+(defvar screencast-producer-blink-time 0.5
+ "The time a blink lasts.")
+
+;; variables which can be read during run-time to obtain information about the
+;; current screencast
+(defvar screencast-producer-nopause nil
+ "Variable to be used for producer functions if they are using
+ pauses, they should deactivate the pause if this variable is non-nil.")
+
+(defvar screencast-producer-command-buffer nil
+ "Variable to be used for producer functions if they are using
+ need the current command-buffer.")
+
+(defvar screencast-producer-step-number 0
+ "Variable to be used for producer functions if they need to
+know the current step number.
+This is a _COPY_ of the value the screencast uses!")
+
+(defvar screencast-producer-beginat 0
+ "Variable to be used for producer functions if they need to
+ know where the screencast is supposed to be using pauses at")
+;;;; END PRODUCER VARIABLES
+
+
+;;;; BEGIN MODE
+(defvar screencast-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") 'screencast-goto-step)
+ map)
+ "Keymap for `screencast-mode'."
+ )
+
+(define-derived-mode screencast-mode nil "screencast"
+ "Major mode for viewing screencasts."
+ (auto-fill-mode 1)
+ )
+;;;; END MODE
+
+;;;; BEGIN PRODUCER FUNCTIONS
+(defun screencast-producer-insert-with-delay (string)
+ "Screencast producer function. _i_nserts STRING with a delay between each character.
+See `screencast-insert-with-delay' for more details."
+ (let ((screencast-speech nil))
+ (screencast-insert-with-delay string screencast-producer-nopause)))
+
+(defalias 'i 'screencast-producer-insert-with-delay
+ "Short name for `screencast-producer-insert-with-delay'.
+This is chosen as it improves readability a lot in the screencast-source.")
+
+(defun screencast-producer-set-last-command (f last)
+ "Sets the last-command to LAST before evaluating F.
+Also prints the info about F, like it would have done normally."
+ (screencast-producer-show-command (car f))
+ (eval-with-last f last)
+ )
+
+(defun eval-with-last (f last)
+ (eval (list 'progn
+ ;; wtf? that's the only way it works (lines can be permuted!)
+ '(setq last-command last)
+ '(setq this-command last)
+ f)))
+
+(defun screencast-producer-set-last-char (char f)
+ "Sets the last-command to CHAR before evaluating F.
+Also prints the info about F, like it would have done normally."
+ (screencast-producer-show-command (car f))
+ (eval (list 'progn
+ '(setq last-command-char (string-to-char char))
+ f)))
+
+(defun screencast-producer-show-command (command)
+ "Shows the COMMAND, and how it can be called in the message-buffer."
+ (pop-to-buffer (get-buffer screencast-message-buffer-name))
+ (screencast-show-command command
+ screencast-producer-step-number
+ screencast-producer-command-buffer)
+ (pop-to-buffer (get-buffer screencast-producer-command-buffer)))
+
+(defun screencast-producer-new-buffer (list command-buffer-name)
+ "Screencast producer function. Creates an new screencast with
+ COMMAND-BUFFER-NAME as the command-buffer. The message-buffer
+ remains the same. Once the inner screencast ends, the original
+ command-buffer regains its status.
+
+
+IMPORTANT:
+
+You are responsible for killing the `COMMAND-BUFFER'
+before the outermost screencast ends, otherwise you'll receive
+the modified buffer the next time you run the outermost
+screencast."
+ ;; we want to start an 'inner screencast', but the current buffer is the
+ ;; command-buffer, and the expected starting buffer is the
+ ;; screencast-message-buffer
+ (pop-to-buffer (get-buffer screencast-message-buffer-name))
+ (screencast-internal list
+ (get-buffer command-buffer-name)
+ screencast-producer-beginat)
+ )
+
+(defun screencast-producer-show-region (beg end)
+ "Marks the currently active region as if transient mark mode was on."
+ (unless screencast-producer-nopause
+ (let ((overlay (make-overlay beg end)))
+ (overlay-put overlay 'face (cons beg end))
+ ;; unless there's a LOT of regions, the blinks will be synchronous
+ (run-with-timer screencast-pause-length nil 'delete-overlay overlay)
+ )
+ (sit-for screencast-pause-length)
+ )
+ )
+
+(defun screencast-producer-blink-regions (regions)
+ "The REGIONS will blink.
+A region is a pair: (beg . end)."
+ (unless screencast-producer-nopause
+ (dotimes (n 5)
+ (dolist (region regions)
+ (let ((overlay (make-overlay (car region) (cdr region))))
+ (overlay-put overlay 'face 'region)
+ ;; unless there's a LOT of regions, the blinks will be synchronous
+ (run-with-timer screencast-producer-blink-time nil 'delete-overlay overlay))
+ )
+ (sit-for (* 2 screencast-producer-blink-time))
+ )))
+
+;;;; END PRODUCER FUNCTIONS
+;;;; BEGIN CORE
+(defun make-region-clickable (beg end action &optional key)
+ "Makes the chosen region clickable, executing chosen action.
+Default key is [mouse-1]."
+ (let ((map (make-sparse-keymap))
+ (keyc (if key
+ key
+ [mouse-1]))
+ )
+ (define-key map keyc action)
+ (put-text-property
+ beg
+ end
+ 'keymap map))
+ )
+
+(defun screencast-fontify-step-region ()
+ "Fontifies regions with step-references.
+To be called immediately after functions which put step-numbers
+in the message-buffer. Will fontify from the beginning of the
+line with the step number to the end of the buffer."
+ (save-excursion
+ (goto-char (point-max))
+ (let ((beg (search-backward-regexp "^Step [[:digit:]]+:" (point-min))))
+ (screencast-put-shadow-and-make-clickable beg (point-max))
+ )))
+
+(defun screencast-put-shadow-and-make-clickable (beg end)
+ "The region between BEG and END becomes shadowed and clickable.
+`screencast-goto-step' is evalled when clicked"
+ (add-text-properties beg (- end 0)
+ (list
+ 'face 'shadow
+ 'mouse-face 'highlight
+ 'help-echo "mouse-1: continue from this step"
+ ))
+ (make-region-clickable beg (- end 0) 'screencast-goto-step))
+
+(defun screencast-get-step ()
+ "Returns the step-number of a step-reference region.
+If not in step-reference region, returns nil"
+
+ (if
+ ;; check if we are at a step-reference region
+ (save-excursion
+ (goto-char (line-end-position))
+ (or
+ ;; first line
+ (search-backward-regexp "^Step [[:digit:]]+:" (line-beginning-position) t)
+ ;; second line
+ (search-backward-regexp "^ Callable with:" (line-beginning-position) t)))
+ ;; get the step number
+ (save-excursion
+ (search-backward-regexp "^Step \\([[:digit:]]+\\):")
+ (let ((beg (match-beginning 1))
+ (end (match-end 1)))
+ (string-to-number
+ (buffer-substring-no-properties beg end))))
+ ;; not in step-reference region
+ nil))
+
+(defun repeat-string (s n)
+ (apply 'concat (make-list n s)))
+
+(defun screencast-make-break (nopause)
+ (screencast-newline-only-once)
+ (newline)
+ (screencast-line)
+ (newline)
+ (screencast-pause-maybe nopause)
+ (screencast-pause-maybe nopause)
+ )
+
+(defun screencast-pause-maybe (nopause &optional length)
+ "Pauses the program, unless NOPAUSE is non-nil.
+ If length is nil, a default pause LENGTH is used."
+ (unless nopause
+ (let ((l (if length
+ length
+ screencast-pause-length)))
+ (sit-for l))))
+
+(defun n-first (n list)
+ "The n first elements of a list."
+ (loop for x in list repeat n collect x))
+
+(defun buffer-recreate (buffer-name)
+ "Kills the buffer with BUFFER-NAME, and recreates it."
+ (let ((buffer (get-buffer buffer-name)))
+ (when buffer
+ (when (buffer-file-name buffer)
+ (save-excursion
+ (set-buffer buffer)
+ (unless (let ((start (substring-no-properties buffer-name 0 1)))
+ (or (string= start " ") (string= start "*")))
+ (save-buffer)))
+ (kill-buffer buffer-name)))
+ (get-buffer-create buffer-name))
+ )
+(defun screencast-goto-step (&optional arg)
+ "Restarts the screencast at the chosen ARG step. Default is the first step."
+ (interactive "p")
+ (let ((step (if (not (= 1 arg))
+ arg
+ (screencast-get-step)))
+ ;; bug? using (point), standing at point max gives nil values!
+ (list (get-text-property (point-min) 'screencast-list))
+ (name (get-text-property (point-min) 'screencast-command-buffer-name)))
+ ;; (print step)
+ ;; (print list)
+ ;; (print name)
+ (screencast list name
+ -1 ; we just ran the screencast, so version should be no problem
+ (if step
+ (- step 1) ; the command just before!
+
+ 0))
+ ))
+
+(defun screencast-newline-only-once ()
+ "Inserts a newline at point if, and only if the current line is nonempty."
+ (unless (= (line-beginning-position) (line-end-position))
+ (newline))
+ )
+
+(defun screencast-make-region-clickable (beg end action &optional key)
+ "Makes the chosen region clickable, executing chosen action.
+Default key is [mouse-1]."
+ (let ((map (make-sparse-keymap))
+ (keyc (if key
+ key
+ [mouse-1]))
+ )
+ (define-key map keyc action)
+ (put-text-property
+ beg
+ end
+ 'keymap map))
+ )
+
+(defun screencast-show-command (com step command-buffer)
+ "Inserts the STEP number and key-binding for a command, COM."
+ (screencast-newline-only-once)
+ (insert "Step " (number-to-string step) ": `" (symbol-name com) "'")
+ (newline)
+ (insert " Callable with: ")
+ (insert (where-is-return com command-buffer))
+ (screencast-fontify-step-region)
+ (newline)
+ )
+
+(defun screencast-line (&optional length)
+ (let ((l (if length
+ length
+ 25)))
+ (screencast-newline-only-once)
+ (insert (repeat-string "-" l))
+ (center-line)
+ (newline)
+ ))
+
+(defun screencast-header ()
+ (screencast-newline-only-once)
+ (newline)
+ (screencast-line 50)
+ (newline))
+
+(defun screencast-speech-start (string nopause)
+ "Starts the speech-synthesizer with STRING, unless NOPAUSE is nonnil.
+Also requires `screencast-speech' to be non-nil.
+The speech speed depends on the typing speed (`screencast-speed-relation-speech-type')."
+ (when (and (not nopause) screencast-speech)
+ (let* ((duration (concat
+ "-b \"(Parameter.set 'Duration_Stretch "
+ (number-to-string (* screencast-pause-char-length
+ screencast-speed-relation-speech-type)) ")\""))
+ (tosay (replace-regexp-in-string "'" "'\"'\"'" string))
+ (say (concat "-b '(SayText \"" tosay "\")'"))
+ )
+ (save-window-excursion
+ (shell-command
+ (concat "festival " duration " " say "&"))
+ ))))
+
+(defun screencast-speech-wait-for (nopause)
+ "Blocks until the speech synthesizer is done speaking."
+ (when (and (not nopause) screencast-speech)
+ (shell-command "while [ `pgrep festival` ] ; do sleep 0.1; done;")
+ (sit-for 0.1)) ; needed
+ )
+
+(defun screencast-insert-with-delay (string &optional nopause)
+ "Inserts STRING with a delay between each character.
+If NOPAUSE is non-nil, the delay will be 0.
+
+The pause between each character is given by `screencast-pause-char-length'."
+ (let ((string (screencast-strip-newlines-and-normalize-whitespace string)))
+ (screencast-speech-start string nopause)
+ (let ((l (string-to-list string)))
+ (dolist (c l)
+ (insert c)
+ ;; simple filling. If the char position equals fill-column. The
+ ;; whole word is moved to the next line.
+ (when (and (= (- (line-end-position) (line-beginning-position)) fill-column))
+ (search-backward " ")
+ (insert "\n ") ; two space indentation as the previous space is moved too
+ (end-of-line) ; ?
+ )
+ (screencast-pause-maybe nopause screencast-pause-char-length)))
+ (screencast-speech-wait-for nopause)
+ )
+ )
+
+(defun screencast-strip-newlines-and-normalize-whitespace (string)
+ "Replaces all newlines and tabs in STRING by a single
+whitespace, also collapses multiple whitespaces."
+ (replace-regexp-in-string "[ ]+" " " (replace-regexp-in-string "\n" " " string)))
+
+(defalias 'screencast 'screencast-producer-screencast "Renaming for simplicity")
+
+(defun screencast-producer-screencast (list command-buffer-name
+ version &optional beginat init)
+ "Prints and evaluates a list, LIST, of strings and functions in a tempo humans can follow.
+The strings in LIST is printed to the screencast-message-buffer.
+Functions are evaluated in the buffer named COMMAND-BUFFER-NAME.
+VERSION is the version of screencast-mode the screencast is
+written for, older versions of screencast-mode might not support
+everything in newer screencasts.
+The first BEGINAT elements of the list will be done without
+delays.
+INIT is a list of functions to be evaluated in the message-buffer
+prior to the first message"
+ (when (> version screencast-version)
+ (error
+ (concat "The version of the screencast (" (number-to-string
+ version) ") is newer than the version of the screencast-mode
+itself (" (number-to-string screencast-version) "). You might still be able
+to run the screencast successfully though, just change the
+screencasts version number to try it out.")))
+
+
+ ;; preparations:
+ (let* (
+ ;; speed adjustments
+ (screencast-pause-length (/ screencast-pause-length
+ screencast-speed))
+ (screencast-pause-char-length (/
+ screencast-pause-char-length
+ screencast-speed))
+ (screencast-pause-command-length (/
+ screencast-pause-command-length
+ screencast-speed))
+ ;; buffers
+ (message-buffer (buffer-recreate screencast-message-buffer-name))
+ (command-buffer (if (string= command-buffer-name
+ screencast-message-buffer-name)
+ message-buffer
+ (buffer-recreate command-buffer-name)))
+ ;; numbers
+ (screencast-step-number 0)
+ (beginat (if beginat
+ beginat
+ 0)))
+ (delete-other-windows)
+ (split-window-horizontally)
+ (switch-to-buffer message-buffer)
+ (pop-to-buffer message-buffer)
+ (display-buffer command-buffer)
+ (screencast-mode)
+ (toggle-read-only 0)
+ ;; evaluate all the functions of init
+ (dolist (f init)
+ (eval f))
+
+ ;; show
+ (screencast-internal list command-buffer beginat)
+ ;; save the arguments in the buffer
+ (add-text-properties (point-min) (point-max)
+ (list 'screencast-list list
+ 'screencast-command-buffer-name command-buffer-name))
+ (toggle-read-only 1)
+ )
+ )
+
+(defun screencast-internal (list command-buffer beginat)
+ "The internal version of screencast, refer to the documentation string
+ there."
+ ;; producer variables
+ (setq screencast-producer-command-buffer command-buffer)
+ (setq screencast-producer-beginat beginat)
+ ;; make sure we are visiting the file in case it is needed (e.g. compile!)
+ (save-excursion
+ (set-buffer command-buffer)
+ (unless (buffer-file-name)
+ (set-visited-file-name (buffer-name))
+ ))
+ ;; for each element in the list
+ (dolist (c list)
+ (let ((nopause
+ (if (>= screencast-step-number beginat)
+ nil
+ t)))
+ ;; producer variables
+ (setq screencast-producer-nopause nopause)
+ (setq screencast-producer-step-number screencast-step-number)
+ (cond
+ ((symbolp c)
+ ;; special symbols
+ (cond
+ ((eq 's c) ; step
+ (screencast-newline-only-once)
+ (insert "Step " (number-to-string screencast-step-number) ":")
+ (screencast-fontify-step-region)
+ )
+ ((eq 'l c) ; line
+ (screencast-line))
+ ((eq 'n c) ; newline
+ (newline))
+ ((eq 'p c) ; pause
+ (screencast-pause-maybe nopause))
+ ((eq 'b c) ; break
+ (screencast-make-break nopause)
+ )
+ (t
+ (error (concat "Screencast-internal encountered an error: Unknown symbol: " (symbol-name c)))))
+ )
+ ((listp c)
+ ;; function
+ (progn
+ (unless (member (car c) screencast-dont-print-list) ; these need no print
+ (screencast-show-command (car c) screencast-step-number command-buffer)
+ )
+ (unless nopause
+ (screencast-pause-maybe nopause screencast-pause-command-length) ; pause
+ )
+ (if (member (car c) '(let flet))
+ (progn
+ ;; we want the environment - but also to print the commands!
+ (eval (list (car c) ; the members above
+ (cadr c) ;the lets of flets
+ '(screencast-internal (cddr c) command-buffer beginat))) ;the rest
+ )
+ ;; evaluate standard
+ (progn
+ ;; save excursion style which allows for inner screencasts
+ (pop-to-buffer command-buffer)
+ (eval c)
+ (pop-to-buffer screencast-message-buffer-name)))
+ (pop-to-buffer screencast-message-buffer-name) ; needed to regain real focus!
+ ))
+ ((stringp c)
+ ;; it's a string - instert it.
+ (screencast-insert-with-delay c nopause))
+ (t
+ (error (concat "I don't know what to do with element:" c)))
+ )
+ (setq screencast-step-number (+ 1 screencast-step-number)) ; inc the step number
+ )
+ )
+ )
+
+(defun where-is-return (definition buffer)
+ "A modification of where-is, which returns the message-string instead of printing it.
+ Also skips the removes name from the output.
+ BUFFER is the buffer to call where-is in."
+ (save-excursion
+ (set-buffer buffer)
+ (let ((func (indirect-function definition))
+ (defs nil)
+ (return-string ""))
+ ;; In DEFS, find all symbols that are aliases for DEFINITION.
+ (mapatoms (lambda (symbol)
+ (and (fboundp symbol)
+ (not (eq symbol definition))
+ (eq func (condition-case ()
+ (indirect-function symbol)
+ (error symbol)))
+ (push symbol defs))))
+ ;; Look at all the symbols--first DEFINITION,
+ ;; then its aliases.
+ (dolist (symbol (cons definition defs))
+ (let* ((remapped (command-remapping symbol))
+ (keys (where-is-internal
+ symbol overriding-local-map nil nil remapped))
+ (keys (mapconcat 'key-description keys ", "))
+ string)
+ (setq string
+ (if t
+ (if (> (length keys) 0)
+ (if remapped
+ (format "%s (%s) (remapped from %s)"
+ keys remapped symbol)
+ (format "%s" keys))
+ (format "M-x %s RET" symbol))
+ (if (> (length keys) 0)
+ (if remapped
+ (format "%s is remapped to %s which is on %s"
+ symbol remapped keys)
+ (format "%s is on %s" symbol keys))
+ ;; If this is the command the user asked about,
+ ;; and it is not on any key, say so.
+ ;; For other symbols, its aliases, say nothing
+ ;; about them unless they are on keys.
+ (if (eq symbol definition)
+ (format "%s is not on any key" symbol)))))
+ (when string
+ (unless (eq symbol definition)
+ (setq return-string (concat return-string ";\n its alias "))) ;
+ (setq return-string (concat return-string string)))))
+ return-string)))
+;;;; END CORE
+
+;;;; BEGIN DOCUMENTATION
+(defconst screencast-screencast-text-producer
+ '(
+ "Hello, this is the screencast for creating your own
+ screencasts." n
+ "If you create a list (first argument) of strings, each
+ string will be typed to the message buffer (this buffer), at
+ a human-readable pace." n
+ "If you put a 'p in the list, a pause will be inserted. " p
+ p p p p "See?" p p
+ l
+ "(The above line was inserted instantly with the symbol 'l)"
+ n
+ "(Blank lines can be inserted using the 'n symbol, newlines
+ in strings are removed)" n n n
+ "All of the above is combined in the symbol 'b, which creates
+ a break in the screencast. This could be used between two
+ different sections for instance." b
+ "You can also put functions in the list, these will be
+ evaluated in the command-buffer (second argument)." n
+ "The function is written as a list, with the function name
+ first, and the arguments after that, e.g. '(backward-char
+ 2)." n n p
+ "Each time a function is evaluated, a message is displayed in
+ the message buffer, using the where-is function." n
+ "In addition to this a step-number is displayed, this
+ step-number corresponds to the functions position in the
+ list." n
+ "Let's try out some functions:" n
+ "((insert \"THIS IS AN INSERTION\n\") will be evaluated)" p
+ (insert "THIS IS AN INSERTION\n")
+ "You can call the special function `screencast-producer-insert-with-delay', aliased to `i' to insert with delay in the command-buffer."n
+ (i
+ "this is also an insertion, but it is done at typing speed")
+ "Hmm.." p p "let's delete the line we just typed in the
+ command buffer [[(kill-whole-line 1)]]"
+ (kill-whole-line 1)
+ "Notice the keybindings which are displayed." b
+ "The fourth (optional) argument given to the screencast
+ function is the step-number to start using pauses, and output
+ to the message buffer at, e.g. it is a fast-forward. Which is
+ _very_ nice when producing a screencast." n
+ "These step-numbers can also be printed separately in the
+ message-buffer using the 's symbol in the list." n s n
+ "See?" b
+ "Once you have finished a screencast and want it published,
+ you can record it as a video (.ogv) using
+ `screencast-record'."n
+ "As a part of the recording - the
+ font-size (`screencast-record-font') is changed, as well as
+ the fill-column variable (`screencast-record-fill-column')
+ for improved readability on a video."n
+ "As a consequence, you should _never_ use fill-paragraph and
+ the like, to get a nicely formatted source-file."n
+ "But the Emacs community will benefit the most if you publish
+ the screencast file itself - so please do!"n
+ "You can publish it at
+ http://www.emacswiki.org/emacs/ScreencastSources" b
+ "This screencast should cover the basic options for creating
+ a screencast, and can be seen in the constant
+ `screencast-screencast-text-producer'."n
+ "A screencast covering the more advanced functions of
+ screencast is available in the function
+ `screencast-screencast-producer-advanced'." b
+ "Happy screencasting!" )
+ "The text the screencast-screencast-producer is based upon")
+
+(defconst screencast-screencast-text-user '(
+ "Hello, welcome to the screencast for viewing screencasts in
+ screencast mode."n
+ "Screencasts are like movies, they type some explanatory
+ text (like this), and executes functions in order to show you
+ the capabilities of different tools in Emacs."n
+ "Once a screencast has finished, you can move the cursor to
+ an executed function and press RET or MOUSE-1 to review the
+ screencast from that step."n
+ "Alternatively you can use the numeric prefix argument to
+ pinpoint the step to begin at."n
+ "If no prefix argument is given, and point isn't at an
+ executed function, the screencast is restarted from the first
+ step." ))
+
+(defconst screencast-screencast-text-producer-advanced
+ '(
+ "This screencast covers the advanced functions of screencast-mode."n
+ "Please read the documentation for the functions as well."n
+ "Regarding the functions and variables in this file:"n
+ "You, as a producer, are supposed to be using the functions starting with `screencast-producer-' (and `screencast' itself ofcourse), they are tailored for ease of use. The others are for internal use - and there's no guarantee they are stable throughout versions."
+ b
+ "It is possible to use multiple command-buffers:"
+ (screencast-producer-new-buffer
+ '((i "I'm a new command-buffer"))
+ "new-command-buffer")
+ (progn (kill-buffer "new-command-buffer"))
+ "It is done via the function `screencast-producer-new-buffer' which takes a list and a buffer - almost like the screencast function itself. "
+ b
+ "If you don't want to document everything you do, for instance moving the cursor, you can put the functions you want to \"hide\" inside a `progn'."
+ b
+ "If you need temporary variables or functions (for instance when you need to override a function which uses the mini-buffer), you can just put in a `let' or `flet'"
+ b
+ "If you need to modify the last-command-char (for self-insert-commands) or the last-command (for continued killing) there's also support for that:"n
+ "Use `screencast-producer-set-last-char' or `screencast-producer-set-last-command'"
+ "The text the screencast-screencast-producer-advanced is based upon"))
+
+(defun screencast-screencast-producer-advanced(&optional arg)
+ "Displays the screencast for creating advanced screencasts."
+ (interactive "P")
+ (apply (if arg
+ 'screencast-record
+ 'screencast)
+ screencast-screencast-text-producer-advanced "screencast-screencast-producer" 1.1 ()))
+
+(defun screencast-screencast-producer(&optional arg)
+ "Displays the screencast for creating screencasts."
+ (interactive "P")
+ (apply (if arg
+ 'screencast-record
+ 'screencast)
+ screencast-screencast-text-producer "screencast-screencast-producer" 1 ()))
+
+(defun screencast-screencast-user(&optional arg)
+ "Displays the screencast for using screencasts."
+ (interactive "P")
+ (apply (if arg
+ 'screencast-record
+ 'screencast)
+ screencast-screencast-text-user "screencast-screencast-user" 1 ()))
+;;;; END DOCUMENTATION
+(provide 'screencast)
+
--- /dev/null
+;;; sml-mode.el --- Major mode for editing (Standard) ML -*- lexical-binding: t; coding: utf-8 -*-
+
+;; Copyright (C) 1989,1999,2000,2004,2007,2010-2012 Free Software Foundation, Inc.
+
+;; Maintainer: (Stefan Monnier) <monnier@iro.umontreal.ca>
+;; Version: 6.1
+;; Keywords: SML
+;; Author: Lars Bo Nielsen
+;; Olin Shivers
+;; Fritz Knabe (?)
+;; Steven Gilmore (?)
+;; Matthew Morley <mjm@scs.leeds.ac.uk>
+;; Matthias Blume <blume@cs.princeton.edu>
+;; (Stefan Monnier) <monnier@iro.umontreal.ca>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A major mode to edit Standard ML (SML) code.
+;; Provides the following features, among others:
+;; - Indentation.
+;; - Syntax highlighting.
+;; - Prettified display of ->, =>, fn, ...
+;; - Imenu.
+;; - which-function-mode.
+;; - Skeletons/templates.
+;; - Electric pipe key.
+;; - outline-minor-mode (with some known problems).
+;; - Interaction with a read-eval-print loop.
+
+;;;; Known bugs:
+
+;; - Indentation after "functor toto() where type foo = bar ="
+;; Because the last is treated as an equality comparison.
+;; - indentation of a declaration after a long `datatype' can be slow.
+
+;;;; News:
+
+;;;;; Changes since 5.0:
+
+;; - sml-electric-pipe-mode to make the | key electric.
+;; - Removal of a lot of compatibility code. Requires Emacs-24.
+;; - Integrate in GNU ELPA.
+
+;;;;; Changes since 4.1:
+
+;; - New indentation code using SMIE when available.
+;; - `sml-back-to-outer-indent' is now on S-tab (aka `backtab') rather
+;; than M-tab.
+;; - Support for electric-layout-mode and electric-indent-mode.
+;; - `sml-mark-defun' tries to be more clever.
+;; - A single file (sml-mode.el) is needed unless you want to use an
+;; interactive process like SML/NJ, or if your Emacs does not provide SMIE.
+
+;;;;; Changes since 4.0:
+
+;; - Switch to GPLv3+.
+;; - When possible (i.e. running under Emacs>=23), be case-sensitive when
+;; expanding abbreviations, and don't expand them in comments and strings.
+;; - When you `next-error' to a type error, highlight the actual parts of the
+;; types that differ.
+;; - Flush the recorded errors not only upon sml-compile and friends, but also
+;; when typing commands directly at the prompt.
+;; - New command sml-mlton-typecheck.
+;; - Simple support to parse errors and warnings in MLton's output.
+;; - Simple support for MLton's def-use files.
+
+;;;;; Changes since 3.9.5:
+
+;; - No need to add the dir to your load-path any more.
+;; The sml-mode-startup.el file does it for you.
+;; - Symbols like -> can be displayed as real arrows.
+;; See sml-font-lock-symbols.
+;; - Fix some incompatibilities with the upcoming Emacs-21.4.
+;; - Indentation rules improved. New customizable variable
+;; `sml-rightalign-and'. Also `sml-symbol-indent' is now customizable.
+
+;;;;; Changes since 3.9.3:
+
+;; - New add-log support (try C-x 4 a from within an SML function).
+;; - Imenu support
+;; - sml-bindings has disappeared.
+;; - The code skeletons are now abbrevs as well.
+;; - A new *sml* process is sent the content of sml-config-file
+;; (~/.sml-proc.sml) if it exists.
+;; - `sml-compile' works yet a bit differently. The command can begin
+;; with `cd "path";' and it will be replaced by OS.FileSys.chDir.
+;; - run-sml now pops up the new buffer. It can also run the command on
+;; another machine. And it always prompts for the command name.
+;; Use a prefix argument if you want to give args or to specify a host on
+;; which to run the command.
+;; - mouse-2 to yank in *sml* should work again (but won't work for next-error
+;; any more).
+;; - New major-modes sml-cm-mode, sml-lex-mode and sml-yacc-mode.
+;; - sml-load-hook has disappeared as has inferior-sml-load-hook.
+;; - sml-mode-startup.el is now automatically generated and you're supposed to
+;; `load' it from .emacs or site-start.el.
+;; - Minor bug fixes.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'smie nil 'noerror)
+(require 'electric)
+
+(defgroup sml ()
+ "Editing SML code."
+ :group 'languages)
+
+(defcustom sml-indent-level 4
+ "Basic indentation step for SML code."
+ :type 'integer)
+
+(defcustom sml-indent-args sml-indent-level
+ "Indentation of args placed on a separate line."
+ :type 'integer)
+
+(defcustom sml-rightalign-and t
+ "If non-nil, right-align `and' with its leader.
+If nil: If t:
+ datatype a = A datatype a = A
+ and b = B and b = B"
+ :type 'boolean)
+
+(defcustom sml-electric-pipe-mode t
+ "If non-nil, automatically insert appropriate template when hitting |."
+ :type 'boolean)
+
+(defvar sml-mode-hook nil
+ "Run upon entering `sml-mode'.
+This is a good place to put your preferred key bindings.")
+
+;; font-lock setup
+
+(defvar sml-outline-regexp
+ ;; `st' and `si' are to match structure and signature.
+ "\f\\|s[ti]\\|[ \t]*\\(let[ \t]+\\)?\\(fun\\|and\\)\\_>"
+ "Regexp matching a major heading.
+This actually can't work without extending `outline-minor-mode' with the
+notion of \"the end of an outline\".")
+
+;;
+;; Internal defines
+;;
+
+(defvar sml-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Text-formatting commands:
+ (define-key map "\C-c\C-m" 'sml-insert-form)
+ (define-key map "\M-|" 'sml-electric-pipe)
+ (define-key map "\M-\ " 'sml-electric-space)
+ (define-key map [backtab] 'sml-back-to-outer-indent)
+ map)
+ "The keymap used in `sml-mode'.")
+
+(defvar sml-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?\* ". 23n" st)
+ (modify-syntax-entry ?\( "()1" st)
+ (modify-syntax-entry ?\) ")(4" st)
+ (mapc (lambda (c) (modify-syntax-entry c "_" st)) "._'")
+ (mapc (lambda (c) (modify-syntax-entry c "." st)) ",;")
+ ;; `!' is not really a prefix-char, oh well!
+ (mapc (lambda (c) (modify-syntax-entry c "'" st)) "~#!")
+ (mapc (lambda (c) (modify-syntax-entry c "." st)) "%&$+-/:<=>?@`^|")
+ st)
+ "The syntax table used in `sml-mode'.")
+
+
+(easy-menu-define sml-mode-menu sml-mode-map "Menu used in `sml-mode'."
+ '("SML"
+ ("Process"
+ ["Start SML repl" sml-run t]
+ ["-" nil nil]
+ ["Compile the project" sml-prog-proc-compile t]
+ ["Send file" sml-prog-proc-load-file t]
+ ["Switch to SML repl" sml-prog-proc-switch-to t]
+ ["--" nil nil]
+ ["Send buffer" sml-prog-proc-send-buffer t]
+ ["Send region" sml-prog-proc-send-region t]
+ ["Send function" sml-send-function t]
+ ["Goto next error" next-error t])
+ ["Insert SML form" sml-insert-form t]
+ ("Forms" :filter sml-forms-menu)
+ ["Indent region" indent-region t]
+ ["Outdent line" sml-back-to-outer-indent t]
+ ["-----" nil nil]
+ ["Customize SML-mode" (customize-group 'sml) t]
+ ["SML mode help" describe-mode t]))
+
+;;
+;; Regexps
+;;
+
+(defun sml-syms-re (syms)
+ (concat "\\_<" (regexp-opt syms t) "\\_>"))
+
+;;
+
+(defconst sml-module-head-syms
+ '("signature" "structure" "functor" "abstraction"))
+
+
+(defconst sml-=-starter-syms
+ (list* "|" "val" "fun" "and" "datatype" "type" "abstype" "eqtype"
+ sml-module-head-syms)
+ "Symbols that can be followed by a `='.")
+(defconst sml-=-starter-re
+ (concat "\\S.|\\S.\\|" (sml-syms-re (cdr sml-=-starter-syms)))
+ "Symbols that can be followed by a `='.")
+
+(defconst sml-non-nested-of-starter-re
+ (sml-syms-re '("datatype" "abstype" "exception"))
+ "Symbols that can introduce an `of' that shouldn't behave like a paren.")
+
+(defconst sml-starters-syms
+ (append sml-module-head-syms
+ '("abstype" "datatype" "exception" "fun"
+ "local" "infix" "infixr" "sharing" "nonfix"
+ "open" "type" "val" "and"
+ "withtype" "with"))
+ "The starters of new expressions.")
+
+(defconst sml-pipeheads
+ '("|" "of" "fun" "fn" "and" "handle" "datatype" "abstype"
+ "(" "{" "[")
+ "A `|' corresponds to one of these.")
+
+(defconst sml-keywords-regexp
+ (sml-syms-re '("abstraction" "abstype" "and" "andalso" "as" "before" "case"
+ "datatype" "else" "end" "eqtype" "exception" "do" "fn"
+ "fun" "functor" "handle" "if" "in" "include" "infix"
+ "infixr" "let" "local" "nonfix" "o" "of" "op" "open" "orelse"
+ "overload" "raise" "rec" "sharing" "sig" "signature"
+ "struct" "structure" "then" "type" "val" "where" "while"
+ "with" "withtype"))
+ "A regexp that matches any and all keywords of SML.")
+
+(eval-and-compile
+ (defconst sml-id-re "\\sw\\(?:\\sw\\|\\s_\\)*"))
+
+(defconst sml-tyvarseq-re
+ (concat "\\(?:\\(?:'+" sml-id-re "\\|(\\(?:[,']\\|" sml-id-re
+ "\\|\\s-\\)+)\\)\\s-+\\)?"))
+
+;;; Font-lock settings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defcustom sml-font-lock-symbols nil
+ "Display \\ and -> and such using symbols in fonts.
+This may sound like a neat trick, but be extra careful: it changes the
+alignment and can thus lead to nasty surprises w.r.t layout."
+ :type 'boolean)
+
+(defconst sml-font-lock-symbols-alist
+ '(("fn" . ?λ)
+ ("andalso" . ?∧) ;; ?⋀
+ ("orelse" . ?∨) ;; ?⋁
+ ;; ("as" . ?≡)
+ ("not" . ?¬)
+ ("div" . ?÷)
+ ("*" . ?×)
+ ("o" . ?○)
+ ("->" . ?→)
+ ("=>" . ?⇒)
+ ("<-" . ?←)
+ ("<>" . ?≠)
+ (">=" . ?≥)
+ ("<=" . ?≤)
+ ("..." . ?⋯)
+ ;; ("::" . ?∷)
+ ;; Some greek letters for type parameters.
+ ("'a" . ?α)
+ ("'b" . ?β)
+ ("'c" . ?γ)
+ ("'d" . ?δ)
+ ))
+
+(defun sml-font-lock-compose-symbol ()
+ "Compose a sequence of ascii chars into a symbol.
+Regexp match data 0 points to the chars."
+ ;; Check that the chars should really be composed into a symbol.
+ (let* ((start (match-beginning 0))
+ (end (match-end 0))
+ (syntaxes (if (eq (char-syntax (char-after start)) ?w)
+ '(?w) '(?. ?\\))))
+ (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
+ (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
+ (memq (get-text-property start 'face)
+ '(font-lock-doc-face font-lock-string-face
+ font-lock-comment-face)))
+ ;; No composition for you. Let's actually remove any composition
+ ;; we may have added earlier and which is now incorrect.
+ (remove-text-properties start end '(composition))
+ ;; That's a symbol alright, so add the composition.
+ (compose-region start end (cdr (assoc (match-string 0)
+ sml-font-lock-symbols-alist)))))
+ ;; Return nil because we're not adding any face property.
+ nil)
+
+(defun sml-font-lock-symbols-keywords ()
+ (when sml-font-lock-symbols
+ `((,(regexp-opt (mapcar 'car sml-font-lock-symbols-alist) t)
+ (0 (sml-font-lock-compose-symbol))))))
+
+;; The font lock regular expressions.
+
+(defconst sml-font-lock-keywords
+ `(;;(sml-font-comments-and-strings)
+ (,(concat "\\_<\\(fun\\|and\\)\\s-+" sml-tyvarseq-re
+ "\\(" sml-id-re "\\)\\s-+[^ \t\n=]")
+ (1 font-lock-keyword-face)
+ (2 font-lock-function-name-face))
+ (,(concat "\\_<\\(\\(?:data\\|abs\\|with\\|eq\\)?type\\)\\s-+"
+ sml-tyvarseq-re "\\(" sml-id-re "\\)")
+ (1 font-lock-keyword-face)
+ (2 font-lock-type-def-face))
+ (,(concat "\\_<\\(val\\)\\s-+\\(?:" sml-id-re "\\_>\\s-*\\)?\\("
+ sml-id-re "\\)\\s-*[=:]")
+ (1 font-lock-keyword-face)
+ (2 font-lock-variable-name-face))
+ (,(concat "\\_<\\(structure\\|functor\\|abstraction\\)\\s-+\\("
+ sml-id-re "\\)")
+ (1 font-lock-keyword-face)
+ (2 font-lock-module-def-face))
+ (,(concat "\\_<\\(signature\\)\\s-+\\(" sml-id-re "\\)")
+ (1 font-lock-keyword-face)
+ (2 font-lock-interface-def-face))
+
+ (,sml-keywords-regexp . font-lock-keyword-face)
+ ,@(sml-font-lock-symbols-keywords))
+ "Regexps matching standard SML keywords.")
+
+(defface font-lock-type-def-face
+ '((t (:bold t)))
+ "Font Lock mode face used to highlight type definitions."
+ :group 'font-lock-highlighting-faces)
+(defvar font-lock-type-def-face 'font-lock-type-def-face
+ "Face name to use for type definitions.")
+
+(defface font-lock-module-def-face
+ '((t (:bold t)))
+ "Font Lock mode face used to highlight module definitions."
+ :group 'font-lock-highlighting-faces)
+(defvar font-lock-module-def-face 'font-lock-module-def-face
+ "Face name to use for module definitions.")
+
+(defface font-lock-interface-def-face
+ '((t (:bold t)))
+ "Font Lock mode face used to highlight interface definitions."
+ :group 'font-lock-highlighting-faces)
+(defvar font-lock-interface-def-face 'font-lock-interface-def-face
+ "Face name to use for interface definitions.")
+
+;;
+;; Code to handle nested comments and unusual string escape sequences
+;;
+
+(defvar sml-syntax-prop-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?\\ "." st)
+ (modify-syntax-entry ?* "." st)
+ st)
+ "Syntax table for text-properties.")
+
+(defconst sml-font-lock-syntactic-keywords
+ `(("^\\s-*\\(\\\\\\)" (1 ',sml-syntax-prop-table))))
+
+(defconst sml-font-lock-defaults
+ '(sml-font-lock-keywords nil nil nil nil
+ (font-lock-syntactic-keywords . sml-font-lock-syntactic-keywords)))
+
+
+;;; Indentation with SMIE
+
+(defconst sml-smie-grammar
+ ;; We have several problem areas where SML's syntax can't be handled by an
+ ;; operator precedence grammar:
+ ;;
+ ;; "= A before B" is "= A) before B" if this is the
+ ;; `boolean-=' but it is "= (A before B)" if it's the `definitional-='.
+ ;; We can work around the problem by tweaking the lexer to return two
+ ;; different tokens for the two different kinds of `='.
+ ;; "of A | B" in a "case" we want "of (A | B, but in a `datatype'
+ ;; we want "of A) | B".
+ ;; "= A | B" can be "= A ) | B" if the = is from a "fun" definition,
+ ;; but it is "= (A | B" if it is a `datatype' definition (of course, if
+ ;; the previous token introducing the = is `and', deciding whether
+ ;; it's a datatype or a function requires looking even further back).
+ ;; "functor foo (...) where type a = b = ..." the first `=' looks very much
+ ;; like a `definitional-=' even tho it's just an equality constraint.
+ ;; Currently I don't even try to handle `where' at all.
+ (smie-prec2->grammar
+ (smie-merge-prec2s
+ (smie-bnf->prec2
+ '((exp ("if" exp "then" exp "else" exp)
+ ("case" exp "of" branches)
+ ("let" decls "in" cmds "end")
+ ("struct" decls "end")
+ ("sig" decls "end")
+ (sexp)
+ (sexp "handle" branches)
+ ("fn" sexp "=>" exp))
+ ;; "simple exp"s are the ones that can appear to the left of `handle'.
+ (sexp (sexp ":" type) ("(" exps ")")
+ (sexp "orelse" sexp)
+ (marg ":>" type)
+ (sexp "andalso" sexp))
+ (cmds (cmds ";" cmds) (exp))
+ (exps (exps "," exps) (exp)) ; (exps ";" exps)
+ (branches (sexp "=>" exp) (branches "|" branches))
+ ;; Operator precedence grammars handle separators much better then
+ ;; starters/terminators, so let's pretend that let/fun are separators.
+ (decls (sexp "d=" exp)
+ (sexp "d=" databranches)
+ (funbranches "|" funbranches)
+ (sexp "=of" type) ;After "exception".
+ ;; FIXME: Just like PROCEDURE in Pascal and Modula-2, this
+ ;; interacts poorly with the other constructs since I
+ ;; can't make "local" a separator like fun/val/type/...
+ ("local" decls "in" decls "end")
+ ;; (decls "local" decls "in" decls "end")
+ (decls "functor" decls)
+ (decls "signature" decls)
+ (decls "structure" decls)
+ (decls "type" decls)
+ (decls "open" decls)
+ (decls "and" decls)
+ (decls "infix" decls)
+ (decls "infixr" decls)
+ (decls "nonfix" decls)
+ (decls "abstype" decls)
+ (decls "datatype" decls)
+ (decls "exception" decls)
+ (decls "fun" decls)
+ (decls "val" decls))
+ (type (type "->" type)
+ (type "*" type))
+ (funbranches (sexp "d=" exp))
+ (databranches (sexp "=of" type) (databranches "d|" databranches))
+ ;; Module language.
+ ;; (mexp ("functor" marg "d=" mexp)
+ ;; ("structure" marg "d=" mexp)
+ ;; ("signature" marg "d=" mexp))
+ (marg (marg ":" type) (marg ":>" type))
+ (toplevel (decls) (exp) (toplevel ";" toplevel)))
+ ;; '(("local" . opener))
+ ;; '((nonassoc "else") (right "handle"))
+ '((nonassoc "of") (assoc "|")) ; "case a of b => case c of d => e | f"
+ '((nonassoc "handle") (assoc "|")) ; Idem for "handle".
+ '((assoc "->") (assoc "*"))
+ '((assoc "val" "fun" "type" "datatype" "abstype" "open" "infix" "infixr"
+ "nonfix" "functor" "signature" "structure" "exception"
+ ;; "local"
+ )
+ (assoc "and"))
+ '((assoc "orelse") (assoc "andalso") (nonassoc ":"))
+ '((assoc ";")) '((assoc ",")) '((assoc "d|")))
+
+ (smie-precs->prec2
+ '((nonassoc "andalso") ;To anchor the prec-table.
+ (assoc "before") ;0
+ (assoc ":=" "o") ;3
+ (nonassoc ">" ">=" "<>" "<" "<=" "=") ;4
+ (assoc "::" "@") ;5
+ (assoc "+" "-" "^") ;6
+ (assoc "/" "*" "quot" "rem" "div" "mod") ;7
+ (nonassoc " -dummy- "))) ;Bogus anchor at the end.
+ )))
+
+(defvar sml-indent-separator-outdent 2)
+
+(defun sml-smie-rules (kind token)
+ ;; I much preferred the pcase version of the code, especially while
+ ;; edebugging the code. But that will have to wait until we get rid of
+ ;; support for Emacs-23.
+ (case kind
+ (:elem (case token
+ (basic sml-indent-level)
+ (args sml-indent-args)))
+ (:list-intro (member token '("fn")))
+ (:after
+ (cond
+ ((equal token "struct") 0)
+ ((equal token "=>") (if (smie-rule-hanging-p) 0 2))
+ ((equal token "in") (if (smie-rule-parent-p "local") 0))
+ ((equal token "of") 3)
+ ((member token '("(" "{" "[")) (if (not (smie-rule-hanging-p)) 2))
+ ((equal token "else") (if (smie-rule-hanging-p) 0)) ;; (:next "if" 0)
+ ((member token '("|" "d|" ";" ",")) (smie-rule-separator kind))
+ ((equal token "d=")
+ (if (and (smie-rule-parent-p "val") (smie-rule-next-p "fn")) -3))))
+ (:before
+ (cond
+ ((equal token "=>") (if (smie-rule-parent-p "fn") 3))
+ ((equal token "of") 1)
+ ;; In case the language is extended to allow a | directly after of.
+ ((and (equal token "|") (smie-rule-prev-p "of")) 1)
+ ((member token '("|" "d|" ";" ",")) (smie-rule-separator kind))
+ ;; Treat purely syntactic block-constructs as being part of their parent,
+ ;; when the opening statement is hanging.
+ ((member token '("let" "(" "[" "{"))
+ (if (smie-rule-hanging-p) (smie-rule-parent)))
+ ;; Treat if ... else if ... as a single long syntactic construct.
+ ;; Similarly, treat fn a => fn b => ... as a single construct.
+ ((member token '("if" "fn"))
+ (and (not (smie-rule-bolp))
+ (smie-rule-prev-p (if (equal token "if") "else" "=>"))
+ (smie-rule-parent)))
+ ((equal token "and")
+ ;; FIXME: maybe "and" (c|sh)ould be handled as an smie-separator.
+ (cond
+ ((smie-rule-parent-p "datatype") (if sml-rightalign-and 5 0))
+ ((smie-rule-parent-p "fun" "val") 0)))
+ ((equal token "d=")
+ (cond
+ ((smie-rule-parent-p "datatype") (if (smie-rule-bolp) 2))
+ ((smie-rule-parent-p "structure" "signature") 0)))
+ ;; Indent an expression starting with "local" as if it were starting
+ ;; with "fun".
+ ((equal token "local") (smie-indent-keyword "fun"))
+ ;; FIXME: type/val/fun/... are separators but "local" is not, even though
+ ;; it appears in the same list. Try to fix up the problem by hand.
+ ;; ((or (equal token "local")
+ ;; (equal (cdr (assoc token smie-grammar))
+ ;; (cdr (assoc "fun" smie-grammar))))
+ ;; (let ((parent (save-excursion (smie-backward-sexp))))
+ ;; (when (or (and (equal (nth 2 parent) "local")
+ ;; (null (car parent)))
+ ;; (progn
+ ;; (setq parent (save-excursion (smie-backward-sexp "fun")))
+ ;; (eq (car parent) (nth 1 (assoc "fun" smie-grammar)))))
+ ;; (goto-char (nth 1 parent))
+ ;; (cons 'column (smie-indent-virtual)))))
+ ))))
+
+(defun sml-smie-definitional-equal-p ()
+ "Figure out which kind of \"=\" this is.
+Assumes point is right before the = sign."
+ ;; The idea is to look backward for the first occurrence of a token that
+ ;; requires a definitional "=" and then see if there's such a definitional
+ ;; equal between that token and ourselves (in which case we're not
+ ;; a definitional = ourselves).
+ ;; The "search for =" is naive and will match "=>" and "<=", but it turns
+ ;; out to be OK in practice because such tokens very rarely (if ever) appear
+ ;; between the =-starter and the corresponding definitional equal.
+ ;; One known problem case is code like:
+ ;; "functor foo (structure s : S) where type t = s.t ="
+ ;; where the "type t = s.t" is mistaken for a type definition.
+ (let ((re (concat "\\(" sml-=-starter-re "\\)\\|=")))
+ (save-excursion
+ (and (re-search-backward re nil t)
+ (or (match-beginning 1)
+ ;; If we first hit a "=", then that = is probably definitional
+ ;; and we're an equality, but not necessarily. One known
+ ;; problem case is code like:
+ ;; "functor foo (structure s : S) where type t = s.t ="
+ ;; where the first = is more like an equality (tho it doesn't
+ ;; matter much) and the second is definitional.
+ ;;
+ ;; FIXME: The test below could be used to recognize that the
+ ;; second = is not a mere equality, but that's not enough to
+ ;; parse the construct properly: we'd need something
+ ;; like a third kind of = token for structure definitions, in
+ ;; order for the parser to be able to skip the "type t = s.t"
+ ;; as a sub-expression.
+ ;;
+ ;; (and (not (looking-at "=>"))
+ ;; (not (eq ?< (char-before))) ;Not a <=
+ ;; (re-search-backward re nil t)
+ ;; (match-beginning 1)
+ ;; (equal "type" (buffer-substring (- (match-end 1) 4)
+ ;; (match-end 1))))
+ )))))
+
+(defun sml-smie-non-nested-of-p ()
+ ;; FIXME: Maybe datatype-|-p makes this nested-of business unnecessary.
+ "Figure out which kind of \"of\" this is.
+Assumes point is right before the \"of\" symbol."
+ (save-excursion
+ (and (re-search-backward (concat "\\(" sml-non-nested-of-starter-re
+ "\\)\\|\\_<case\\_>") nil t)
+ (match-beginning 1))))
+
+(defun sml-smie-datatype-|-p ()
+ "Figure out which kind of \"|\" this is.
+Assumes point is right before the | symbol."
+ (save-excursion
+ (forward-char 1) ;Skip the |.
+ (let ((after-type-def
+ '("|" "of" "in" "datatype" "and" "exception" "abstype" "infix"
+ "infixr" "nonfix" "local" "val" "fun" "structure" "functor"
+ "signature")))
+ (or (member (sml-smie-forward-token-1) after-type-def) ;Skip the tag.
+ (member (sml-smie-forward-token-1) after-type-def)))))
+
+(defun sml-smie-forward-token-1 ()
+ (forward-comment (point-max))
+ (buffer-substring-no-properties
+ (point)
+ (progn
+ (or (/= 0 (skip-syntax-forward "'w_"))
+ (skip-syntax-forward ".'"))
+ (point))))
+
+(defun sml-smie-forward-token ()
+ (let ((sym (sml-smie-forward-token-1)))
+ (cond
+ ((equal "op" sym)
+ (concat "op " (sml-smie-forward-token-1)))
+ ((member sym '("|" "of" "="))
+ ;; The important lexer for indentation's performance is the backward
+ ;; lexer, so for the forward lexer we delegate to the backward one.
+ (save-excursion (sml-smie-backward-token)))
+ (t sym))))
+
+(defun sml-smie-backward-token-1 ()
+ (forward-comment (- (point)))
+ (buffer-substring-no-properties
+ (point)
+ (progn
+ (or (/= 0 (skip-syntax-backward ".'"))
+ (skip-syntax-backward "'w_"))
+ (point))))
+
+(defun sml-smie-backward-token ()
+ (let ((sym (sml-smie-backward-token-1)))
+ (unless (zerop (length sym))
+ ;; FIXME: what should we do if `sym' = "op" ?
+ (let ((point (point)))
+ (if (equal "op" (sml-smie-backward-token-1))
+ (concat "op " sym)
+ (goto-char point)
+ (cond
+ ((string= sym "=") (if (sml-smie-definitional-equal-p) "d=" "="))
+ ((string= sym "of") (if (sml-smie-non-nested-of-p) "=of" "of"))
+ ((string= sym "|") (if (sml-smie-datatype-|-p) "d|" "|"))
+ (t sym)))))))
+
+;;;;
+;;;; Imenu support
+;;;;
+
+(defvar sml-imenu-regexp
+ (concat "^[ \t]*\\(let[ \t]+\\)?"
+ (regexp-opt (append sml-module-head-syms
+ '("and" "fun" "datatype" "abstype" "type")) t)
+ "\\_>"))
+
+(defun sml-imenu-create-index ()
+ (let (alist)
+ (goto-char (point-max))
+ (while (re-search-backward sml-imenu-regexp nil t)
+ (save-excursion
+ (let ((kind (match-string 2))
+ (column (progn (goto-char (match-beginning 2)) (current-column)))
+ (location
+ (progn (goto-char (match-end 0))
+ (forward-comment (point-max))
+ (when (looking-at sml-tyvarseq-re)
+ (goto-char (match-end 0)))
+ (point)))
+ (name (sml-smie-forward-token)))
+ ;; Eliminate trivial renamings.
+ (when (or (not (member kind '("structure" "signature")))
+ (progn (search-forward "=")
+ (forward-comment (point-max))
+ (looking-at "sig\\|struct")))
+ (push (cons (concat (make-string (/ column 2) ?\ ) name) location)
+ alist)))))
+ alist))
+
+;;; Generic prog-proc interaction.
+
+(require 'comint)
+(require 'compile)
+
+(defvar sml-prog-proc-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?\C-c ?\C-l] 'sml-prog-proc-load-file)
+ (define-key map [?\C-c ?\C-c] 'sml-prog-proc-compile)
+ (define-key map [?\C-c ?\C-z] 'sml-prog-proc-switch-to)
+ (define-key map [?\C-c ?\C-r] 'sml-prog-proc-send-region)
+ (define-key map [?\C-c ?\C-b] 'sml-prog-proc-send-buffer)
+ ;; FIXME: Add
+ ;; (define-key map [?\M-C-x] 'sml-prog-proc-send-defun)
+ ;; (define-key map [?\C-x ?\C-e] 'sml-prog-proc-send-last-sexp)
+ ;; FIXME: Add menu. Now, that's trickier because keymap inheritance
+ ;; doesn't play nicely with menus!
+ map)
+ "Keymap for `sml-prog-proc-mode'.")
+
+(defvar sml-prog-proc--buffer nil
+ "The inferior-process buffer to which to send code.")
+(make-variable-buffer-local 'sml-prog-proc--buffer)
+
+(defstruct (sml-prog-proc-descriptor
+ (:constructor sml-prog-proc-make)
+ (:predicate nil)
+ (:copier nil))
+ (name nil :read-only t)
+ (run nil :read-only t)
+ (load-cmd nil :read-only t)
+ (chdir-cmd nil :read-only t)
+ (command-eol "\n" :read-only t)
+ (compile-commands-alist nil :read-only t))
+
+(defvar sml-prog-proc-descriptor nil
+ "Struct containing the various functions to create a new process, ...")
+
+(defmacro sml-prog-proc--prop (prop)
+ `(,(intern (format "sml-prog-proc-descriptor-%s" prop))
+ (or sml-prog-proc-descriptor
+ ;; FIXME: Look for available ones and pick one.
+ (error "Not a `sml-prog-proc' buffer"))))
+(defmacro sml-prog-proc--call (method &rest args)
+ `(funcall (sml-prog-proc--prop ,method) ,@args))
+
+;; The inferior process and his buffer are basically interchangeable.
+;; Currently the code takes sml-prog-proc--buffer as the main reference,
+;; but all users should either use sml-prog-proc-proc or sml-prog-proc-buffer
+;; to find the info.
+
+(defun sml-prog-proc-proc ()
+ "Return the inferior process for the code in current buffer."
+ (or (and (buffer-live-p sml-prog-proc--buffer)
+ (get-buffer-process sml-prog-proc--buffer))
+ (when (derived-mode-p 'sml-prog-proc-mode 'sml-prog-proc-comint-mode)
+ (setq sml-prog-proc--buffer (current-buffer))
+ (get-buffer-process sml-prog-proc--buffer))
+ (let ((ppd sml-prog-proc-descriptor)
+ (buf (sml-prog-proc--call run)))
+ (with-current-buffer buf
+ (if (and ppd (null sml-prog-proc-descriptor))
+ (set (make-local-variable 'sml-prog-proc-descriptor) ppd)))
+ (setq sml-prog-proc--buffer buf)
+ (get-buffer-process sml-prog-proc--buffer))))
+
+(defun sml-prog-proc-buffer ()
+ "Return the buffer of the inferior process."
+ (process-buffer (sml-prog-proc-proc)))
+
+(defun sml-prog-proc-switch-to ()
+ "Switch to the buffer running the read-eval-print process."
+ (pop-to-buffer (sml-prog-proc-buffer)))
+
+(defun sml-prog-proc-send-string (proc str)
+ "Send command STR to PROC, with an EOL terminator appended."
+ (with-current-buffer (process-buffer proc)
+ ;; FIXME: comint-send-string does not pass the string through
+ ;; comint-input-filter-function, so we have to do it by hand.
+ ;; Maybe we should insert the command into the buffer and then call
+ ;; comint-send-input?
+ (sml-prog-proc-comint-input-filter-function nil)
+ (comint-send-string proc (concat str (sml-prog-proc--prop command-eol)))))
+
+(defun sml-prog-proc-load-file (file &optional and-go)
+ "Load FILE into the read-eval-print process.
+FILE is the file visited by the current buffer.
+If prefix argument AND-GO is used, then we additionally switch
+to the buffer where the process is running."
+ (interactive
+ (list (or buffer-file-name
+ (read-file-name "File to load: " nil nil t))
+ current-prefix-arg))
+ (comint-check-source file)
+ (let ((proc (sml-prog-proc-proc)))
+ (sml-prog-proc-send-string proc (sml-prog-proc--call load-cmd file))
+ (when and-go (pop-to-buffer (process-buffer proc)))))
+
+(defvar sml-prog-proc--tmp-file nil)
+
+(defun sml-prog-proc-send-region (start end &optional and-go)
+ "Send the content of the region to the read-eval-print process.
+START..END delimit the region; AND-GO if non-nil indicate to additionally
+switch to the process's buffer."
+ (interactive "r\nP")
+ (if (> start end) (let ((tmp end)) (setq end start) (setq start tmp))
+ (if (= start end) (error "Nothing to send: the region is empty")))
+ (let ((proc (sml-prog-proc-proc))
+ (tmp (make-temp-file "emacs-region")))
+ (write-region start end tmp nil 'silently)
+ (when sml-prog-proc--tmp-file
+ (ignore-errors (delete-file (car sml-prog-proc--tmp-file)))
+ (set-marker (cdr sml-prog-proc--tmp-file) nil))
+ (setq sml-prog-proc--tmp-file (cons tmp (copy-marker start)))
+ (sml-prog-proc-send-string proc (sml-prog-proc--call load-cmd tmp))
+ (when and-go (pop-to-buffer (process-buffer proc)))))
+
+(defun sml-prog-proc-send-buffer (&optional and-go)
+ "Send the content of the current buffer to the read-eval-print process.
+AND-GO if non-nil indicate to additionally switch to the process's buffer."
+ (interactive "P")
+ (sml-prog-proc-send-region (point-min) (point-max) and-go))
+
+(define-derived-mode sml-prog-proc-mode prog-mode "Sml-Prog-Proc"
+ "Major mode for editing source code and interact with an interactive loop."
+ )
+
+;;; Extended comint-mode for Sml-Prog-Proc.
+
+(defun sml-prog-proc-chdir (dir)
+ "Change the working directory of the inferior process to DIR."
+ (interactive "DChange to directory: ")
+ (let ((dir (expand-file-name dir))
+ (proc (sml-prog-proc-proc)))
+ (with-current-buffer (process-buffer proc)
+ (sml-prog-proc-send-string proc (sml-prog-proc--call chdir-cmd dir))
+ (setq default-directory (file-name-as-directory dir)))))
+
+(defun sml-prog-proc-comint-input-filter-function (str)
+ ;; `compile.el' doesn't know that file location info from errors should be
+ ;; recomputed afresh (without using stale info from earlier compilations).
+ (compilation-forget-errors) ;Has to run before compilation-fake-loc.
+ (if (and sml-prog-proc--tmp-file (marker-buffer (cdr sml-prog-proc--tmp-file)))
+ (compilation-fake-loc (cdr sml-prog-proc--tmp-file)
+ (car sml-prog-proc--tmp-file)))
+ str)
+
+(defvar sml-prog-proc-comint-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-l" 'sml-prog-proc-load-file)
+ map))
+
+(define-derived-mode sml-prog-proc-comint-mode comint-mode "Sml-Prog-Proc-Comint"
+ "Major mode for an inferior process used to run&compile source code."
+ ;; Enable compilation-minor-mode, but only after the child mode is setup
+ ;; since the child-mode might want to add rules to
+ ;; compilation-error-regexp-alist.
+ (add-hook 'after-change-major-mode-hook #'compilation-minor-mode nil t)
+ ;; The keymap of compilation-minor-mode is too unbearable, so we
+ ;; need to hide most of the bindings.
+ (let ((map (make-sparse-keymap)))
+ (dolist (keys '([menu-bar] [follow-link]))
+ ;; Preserve some of the bindings.
+ (define-key map keys (lookup-key compilation-minor-mode-map keys)))
+ (add-to-list 'minor-mode-overriding-map-alist
+ (cons 'compilation-minor-mode map)))
+
+ (add-hook 'comint-input-filter-functions
+ #'sml-prog-proc-comint-input-filter-function nil t))
+
+(defvar sml-prog-proc--compile-command nil
+ "The command used by default by `sml-prog-proc-compile'.")
+
+(defun sml-prog-proc-compile (command &optional and-go)
+ "Pass COMMAND to the read-eval-loop process to compile the current file.
+
+You can then use the command \\[next-error] to find the next error message
+and move to the source code that caused it.
+
+Interactively, prompts for the command if `compilation-read-command' is
+non-nil. With prefix arg, always prompts.
+
+Prefix arg AND-GO also means to switch to the read-eval-loop buffer afterwards."
+ (interactive
+ (let* ((dir default-directory)
+ (cmd "cd \"."))
+ ;; Look for files to determine the default command.
+ (while (and (stringp dir)
+ (progn
+ (dolist (cf (sml-prog-proc--prop compile-commands-alist))
+ (when (file-exists-p (expand-file-name (cdr cf) dir))
+ (setq cmd (concat cmd "\"; " (car cf)))
+ (return nil)))
+ (not cmd)))
+ (let ((newdir (file-name-directory (directory-file-name dir))))
+ (setq dir (unless (equal newdir dir) newdir))
+ (setq cmd (concat cmd "/.."))))
+ (setq cmd
+ (cond
+ ((local-variable-p 'sml-prog-proc--compile-command)
+ sml-prog-proc--compile-command)
+ ((string-match "^\\s-*cd\\s-+\"\\.\"\\s-*;\\s-*" cmd)
+ (substring cmd (match-end 0)))
+ ((string-match "^\\s-*cd\\s-+\"\\(\\./\\)" cmd)
+ (replace-match "" t t cmd 1))
+ ((string-match ";" cmd) cmd)
+ (t sml-prog-proc--compile-command)))
+ ;; code taken from compile.el
+ (list (if (or compilation-read-command current-prefix-arg)
+ (read-from-minibuffer "Compile command: "
+ cmd nil nil '(compile-history . 1))
+ cmd))))
+ ;; ;; now look for command's file to determine the directory
+ ;; (setq dir default-directory)
+ ;; (while (and (stringp dir)
+ ;; (dolist (cf (sml-prog-proc--prop compile-commands-alist) t)
+ ;; (when (and (equal cmd (car cf))
+ ;; (file-exists-p (expand-file-name (cdr cf) dir)))
+ ;; (return nil))))
+ ;; (let ((newdir (file-name-directory (directory-file-name dir))))
+ ;; (setq dir (unless (equal newdir dir) newdir))))
+ ;; (setq dir (or dir default-directory))
+ ;; (list cmd dir)))
+ (set (make-local-variable 'sml-prog-proc--compile-command) command)
+ (save-some-buffers (not compilation-ask-about-save) nil)
+ (let ((dir default-directory))
+ (when (string-match "^\\s-*cd\\s-+\"\\([^\"]+\\)\"\\s-*;" command)
+ (setq dir (match-string 1 command))
+ (setq command (replace-match "" t t command)))
+ (setq dir (expand-file-name dir))
+ (let ((proc (sml-prog-proc-proc))
+ (eol (sml-prog-proc--prop command-eol)))
+ (with-current-buffer (process-buffer proc)
+ (setq default-directory dir)
+ (sml-prog-proc-send-string
+ proc (concat (sml-prog-proc--call chdir-cmd dir)
+ ;; Strip the newline, to avoid adding a prompt.
+ (if (string-match "\n\\'" eol)
+ (replace-match " " t t eol) eol)
+ command))
+ (when and-go (pop-to-buffer (process-buffer proc)))))))
+
+
+;;; SML Sml-Prog-Proc support.
+
+(defcustom sml-program-name "sml"
+ "Program to run as Standard SML read-eval-print loop."
+ :type 'string)
+
+(defcustom sml-default-arg ""
+ "Default command line option to pass to `sml-program-name', if any."
+ :type 'string)
+
+(defcustom sml-host-name ""
+ "Host on which to run `sml-program-name'."
+ :type 'string)
+
+(defcustom sml-config-file "~/.smlproc.sml"
+ "File that should be fed to the SML process when started."
+ :type 'string)
+
+
+(defcustom sml-prompt-regexp "^[-=>#] *"
+ "Regexp used to recognise prompts in the inferior SML process."
+ :type 'regexp)
+
+(defcustom sml-compile-commands-alist
+ '(("CMB.make()" . "all-files.cm")
+ ("CMB.make()" . "pathconfig")
+ ("CM.make()" . "sources.cm")
+ ("use \"load-all\"" . "load-all"))
+ "Commands used by default by `sml-sml-prog-proc-compile'.
+Each command is associated with its \"main\" file.
+It is perfectly OK to associate several files with a command or several
+commands with the same file.")
+
+;; FIXME: Try to auto-detect the process and set those vars accordingly.
+
+(defvar sml-use-command "use \"%s\""
+ "Template for loading a file into the inferior SML process.
+Set to \"use \\\"%s\\\"\" for SML/NJ or Edinburgh ML;
+set to \"PolyML.use \\\"%s\\\"\" for Poly/ML, etc.")
+
+(defvar sml-cd-command "OS.FileSys.chDir \"%s\""
+ "Command template for changing working directories under SML.
+Set this to nil if your compiler can't change directories.
+
+The format specifier \"%s\" will be converted into the directory name
+specified when running the command \\[sml-cd].")
+
+(defvar sml-error-regexp-alist
+ `( ;; Poly/ML messages
+ ("^\\(Error\\|Warning:\\) in '\\(.+\\)', line \\([0-9]+\\)" 2 3)
+ ;; Moscow ML
+ ("^File \"\\([^\"]+\\)\", line \\([0-9]+\\)\\(-\\([0-9]+\\)\\)?, characters \\([0-9]+\\)-\\([0-9]+\\):" 1 2 5)
+ ;; SML/NJ: the file-pattern is anchored to avoid
+ ;; pathological behavior with very long lines.
+ ("^[-= ]*\\(.*[^\n)]\\)\\( (.*)\\)?:\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)? \\(Error\\|Warnin\\(g\\)\\): .*" 1
+ (3 . 6) (4 . 7) (9))
+ ;; SML/NJ's exceptions: see above.
+ ("^ +\\(raised at: \\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2
+ (3 . 6) (4 . 7)))
+ "Alist that specifies how to match errors in compiler output.
+See `compilation-error-regexp-alist' for a description of the format.")
+
+(defconst sml-pp-functions
+ (sml-prog-proc-make :name "SML"
+ :run (lambda () (call-interactively #'sml-run))
+ :load-cmd (lambda (file) (format sml-use-command file))
+ :chdir-cmd (lambda (dir) (format sml-cd-command dir))
+ :compile-commands-alist sml-compile-commands-alist
+ :command-eol ";\n"
+ ))
+
+;; font-lock support
+(defconst inferior-sml-font-lock-keywords
+ `(;; prompt and following interactive command
+ ;; FIXME: Actually, this should already be taken care of by comint.
+ (,(concat "\\(" sml-prompt-regexp "\\)\\(.*\\)")
+ (1 font-lock-prompt-face)
+ (2 font-lock-command-face keep))
+ ;; CM's messages
+ ("^\\[\\(.*GC #.*\n\\)*.*\\]" . font-lock-comment-face)
+ ;; SML/NJ's irritating GC messages
+ ("^GC #.*" . font-lock-comment-face))
+ "Font-locking specification for inferior SML mode.")
+
+(defface font-lock-prompt-face
+ '((t (:bold t)))
+ "Font Lock mode face used to highlight prompts."
+ :group 'font-lock-highlighting-faces)
+(defvar font-lock-prompt-face 'font-lock-prompt-face
+ "Face name to use for prompts.")
+
+(defface font-lock-command-face
+ '((t (:bold t)))
+ "Font Lock mode face used to highlight interactive commands."
+ :group 'font-lock-highlighting-faces)
+(defvar font-lock-command-face 'font-lock-command-face
+ "Face name to use for interactive commands.")
+
+(defconst inferior-sml-font-lock-defaults
+ '(inferior-sml-font-lock-keywords nil nil nil nil))
+
+(defun sml--read-run-cmd ()
+ (list
+ (read-string "SML command: " sml-program-name)
+ (if (or current-prefix-arg (> (length sml-default-arg) 0))
+ (read-string "Any args: " sml-default-arg)
+ sml-default-arg)
+ (if (or current-prefix-arg (> (length sml-host-name) 0))
+ (read-string "On host: " sml-host-name)
+ sml-host-name)))
+
+;;;###autoload
+(defalias 'run-sml 'sml-run)
+
+;;;###autoload
+(defun sml-run (cmd arg &optional host)
+ "Run the program CMD with given arguments ARG.
+The command is run in buffer *CMD* using mode `inferior-sml-mode'.
+If the buffer already exists and has a running process, then
+just go to this buffer.
+
+If a prefix argument is used, the user is also prompted for a HOST
+on which to run CMD using `remote-shell-program'.
+
+\(Type \\[describe-mode] in the process's buffer for a list of commands.)"
+ (interactive (sml--read-run-cmd))
+ (let* ((pname (file-name-nondirectory cmd))
+ (args (split-string arg))
+ (file (when (and sml-config-file (file-exists-p sml-config-file))
+ sml-config-file)))
+ ;; And this -- to keep these as defaults even if
+ ;; they're set in the mode hooks.
+ (setq sml-program-name cmd)
+ (setq sml-default-arg arg)
+ (setq sml-host-name host)
+ ;; For remote execution, use `remote-shell-program'
+ (when (> (length host) 0)
+ (setq args (list* host "cd" default-directory ";" cmd args))
+ (setq cmd remote-shell-program))
+ ;; Go for it.
+ (save-current-buffer
+ (let ((exec-path (if (and (file-name-directory cmd)
+ (not (file-name-absolute-p cmd)))
+ ;; If the command has slashes, make sure we
+ ;; first look relative to the current directory.
+ ;; Emacs-21 does it for us, but not Emacs-20.
+ (cons default-directory exec-path) exec-path)))
+ (pop-to-buffer (apply 'make-comint pname cmd file args)))
+
+ (inferior-sml-mode)
+ (goto-char (point-max))
+ (current-buffer))))
+
+(defun sml-send-function (&optional and-go)
+ "Send current paragraph to the inferior SML process.
+With a prefix argument AND-GO switch to the repl buffer as well."
+ (interactive "P")
+ (save-excursion
+ (sml-mark-function)
+ (sml-prog-proc-send-region (point) (mark)))
+ (if and-go (sml-prog-proc-switch-to)))
+
+(defvar inferior-sml-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map comint-mode-map)
+ (define-key map "\C-c\C-s" 'sml-run)
+ (define-key map "\t" 'completion-at-point)
+ map)
+ "Keymap for inferior-sml mode.")
+
+
+(declare-function smerge-refine-subst "smerge-mode"
+ (beg1 end1 beg2 end2 props-c))
+
+(defun inferior-sml-next-error-hook ()
+ ;; Try to recognize SML/NJ type error message and to highlight finely the
+ ;; difference between the two types (in case they're large, it's not
+ ;; always obvious to spot it).
+ ;;
+ ;; Sample messages:
+ ;;
+ ;; Data.sml:31.9-33.33 Error: right-hand-side of clause doesn't agree with function result type [tycon mismatch]
+ ;; expression: Hstring
+ ;; result type: Hstring * int
+ ;; in declaration:
+ ;; des2hs = (fn SYM_ID hs => hs
+ ;; | SYM_OP hs => hs
+ ;; | SYM_CHR hs => hs)
+ ;; Data.sml:35.44-35.63 Error: operator and operand don't agree [tycon mismatch]
+ ;; operator domain: Hstring * Hstring
+ ;; operand: (Hstring * int) * (Hstring * int)
+ ;; in expression:
+ ;; HSTRING.ieq (h1,h2)
+ ;; vparse.sml:1861.6-1922.14 Error: case object and rules don't agree [tycon mismatch]
+ ;; rule domain: STConstraints list list option
+ ;; object: STConstraints list option
+ ;; in expression:
+ (save-current-buffer
+ (when (and (derived-mode-p 'sml-mode 'inferior-sml-mode)
+ (boundp 'next-error-last-buffer)
+ (bufferp next-error-last-buffer)
+ (set-buffer next-error-last-buffer)
+ (derived-mode-p 'inferior-sml-mode)
+ ;; The position of `point' is not guaranteed :-(
+ (looking-at (concat ".*\\[tycon mismatch\\]\n"
+ " \\(operator domain\\|expression\\|rule domain\\): +")))
+ (require 'smerge-mode)
+ (save-excursion
+ (let ((b1 (match-end 0))
+ e1 b2 e2)
+ (when (re-search-forward "\n in \\(expression\\|declaration\\):\n"
+ nil t)
+ (setq e2 (match-beginning 0))
+ (when (re-search-backward
+ "\n \\(operand\\|result type\\|object\\): +"
+ b1 t)
+ (setq e1 (match-beginning 0))
+ (setq b2 (match-end 0))
+ (smerge-refine-subst b1 e1 b2 e2
+ '((face . smerge-refined-change))))))))))
+
+(define-derived-mode inferior-sml-mode sml-prog-proc-comint-mode "Inferior-SML"
+ "Major mode for interacting with an inferior SML process.
+
+The following commands are available:
+\\{inferior-sml-mode-map}
+
+An SML process can be fired up (again) with \\[sml].
+
+Customisation: Entry to this mode runs the hooks on `comint-mode-hook'
+and `inferior-sml-mode-hook' (in that order).
+
+Variables controlling behaviour of this mode are
+
+`sml-program-name' (default \"sml\")
+ Program to run as SML.
+
+`sml-use-command' (default \"use \\\"%s\\\"\")
+ Template for loading a file into the inferior SML process.
+
+`sml-cd-command' (default \"System.Directory.cd \\\"%s\\\"\")
+ SML command for changing directories in SML process (if possible).
+
+`sml-prompt-regexp' (default \"^[\\-=] *\")
+ Regexp used to recognise prompts in the inferior SML process.
+
+You can send text to the inferior SML process from other buffers containing
+SML source.
+ `switch-to-sml' switches the current buffer to the SML process buffer.
+ `sml-send-function' sends the current *paragraph* to the SML process.
+ `sml-send-region' sends the current region to the SML process.
+
+ Prefixing the sml-send-<whatever> commands with \\[universal-argument]
+ causes a switch to the SML process buffer after sending the text.
+
+For information on running multiple processes in multiple buffers, see
+documentation for variable `sml-buffer'.
+
+Commands:
+RET after the end of the process' output sends the text from the
+ end of process to point.
+RET before the end of the process' output copies the current line
+ to the end of the process' output, and sends it.
+DEL converts tabs to spaces as it moves back.
+TAB file name completion, as in shell-mode, etc.."
+ (setq comint-prompt-regexp sml-prompt-regexp)
+ (sml-mode-variables)
+
+ ;; We have to install it globally, 'cause it's run in the *source* buffer :-(
+ (add-hook 'next-error-hook 'inferior-sml-next-error-hook)
+
+ ;; Make TAB add a " rather than a space at the end of a file name.
+ (set (make-local-variable 'comint-completion-addsuffix) '(?/ . ?\"))
+
+ (set (make-local-variable 'font-lock-defaults)
+ inferior-sml-font-lock-defaults)
+
+ ;; Compilation support (used for `next-error').
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ sml-error-regexp-alist)
+ ;; FIXME: move it to sml-mode?
+ (set (make-local-variable 'compilation-error-screen-columns) nil)
+
+ (setq mode-line-process '(": %s")))
+
+;;; MORE CODE FOR SML-MODE
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . sml-mode))
+
+(defvar comment-quote-nested)
+
+;;;###autoload
+(define-derived-mode sml-mode sml-prog-proc-mode "SML"
+ "\\<sml-mode-map>Major mode for editing Standard ML code.
+This mode runs `sml-mode-hook' just before exiting.
+See also (info \"(sml-mode)Top\").
+\\{sml-mode-map}"
+ (set (make-local-variable 'sml-prog-proc-descriptor) sml-pp-functions)
+ (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)
+ (set (make-local-variable 'outline-regexp) sml-outline-regexp)
+ (set (make-local-variable 'imenu-create-index-function)
+ 'sml-imenu-create-index)
+ (set (make-local-variable 'add-log-current-defun-function)
+ 'sml-current-fun-name)
+ ;; Treat paragraph-separators in comments as paragraph-separators.
+ (set (make-local-variable 'paragraph-separate)
+ (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)"))
+ (set (make-local-variable 'require-final-newline) t)
+ (set (make-local-variable 'electric-indent-chars)
+ (cons ?\; (if (boundp 'electric-indent-chars)
+ electric-indent-chars '(?\n))))
+ (set (make-local-variable 'electric-layout-rules)
+ `((?\; . ,(lambda ()
+ (save-excursion
+ (skip-chars-backward " \t;")
+ (unless (or (bolp)
+ (progn (skip-chars-forward " \t;")
+ (eolp)))
+ 'after))))))
+ (when sml-electric-pipe-mode
+ (add-hook 'post-self-insert-hook #'sml-post-self-insert-pipe nil t))
+ (sml-mode-variables))
+
+(defun sml-mode-variables ()
+ (set-syntax-table sml-mode-syntax-table)
+ (setq local-abbrev-table sml-mode-abbrev-table)
+ ;; Setup indentation and sexp-navigation.
+ (smie-setup sml-smie-grammar #'sml-smie-rules
+ :backward-token #'sml-smie-backward-token
+ :forward-token #'sml-smie-forward-token)
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (set (make-local-variable 'comment-start) "(* ")
+ (set (make-local-variable 'comment-end) " *)")
+ (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*")
+ (set (make-local-variable 'comment-end-skip) "\\s-*\\*+)")
+ ;; No need to quote nested comments markers.
+ (set (make-local-variable 'comment-quote-nested) nil))
+
+(defun sml-funname-of-and ()
+ "Name of the function this `and' defines, or nil if not a function.
+Point has to be right after the `and' symbol and is not preserved."
+ (forward-comment (point-max))
+ (if (looking-at sml-tyvarseq-re) (goto-char (match-end 0)))
+ (let ((sym (sml-smie-forward-token)))
+ (forward-comment (point-max))
+ (unless (or (member sym '(nil "d="))
+ (member (sml-smie-forward-token) '("d=")))
+ sym)))
+
+(defun sml-find-forward (re)
+ (while (progn (forward-comment (point-max))
+ (not (looking-at re)))
+ (or (ignore-errors (forward-sexp 1) t) (forward-char 1))))
+
+(defun sml-electric-pipe ()
+ "Insert a \"|\".
+Depending on the context insert the name of function, a \"=>\" etc."
+ (interactive)
+ (unless (save-excursion (skip-chars-backward "\t ") (bolp)) (insert "\n"))
+ (insert "| ")
+ (unless (sml-post-self-insert-pipe (1- (point)))
+ (indent-according-to-mode)))
+
+(defun sml-post-self-insert-pipe (&optional acp)
+ (when (or acp (and (eq ?| last-command-event)
+ (setq acp (electric--after-char-pos))))
+ (let ((text
+ (save-excursion
+ (goto-char (1- acp)) ;Jump before the "|" we just inserted.
+ (let ((sym (sml-find-matching-starter sml-pipeheads
+ ;; (sml-op-prec "|" 'back)
+ )))
+ (sml-smie-forward-token)
+ (forward-comment (point-max))
+ (cond
+ ((string= sym "|")
+ (let ((f (sml-smie-forward-token)))
+ (sml-find-forward "\\(=>\\|=\\||\\)\\S.")
+ (cond
+ ((looking-at "|") nil) ; A datatype or an OR pattern?
+ ((looking-at "=>") " => ") ;`case', or `fn' or `handle'.
+ ((looking-at "=") ;A function.
+ (cons (concat f " ")" = ")))))
+ ((string= sym "and")
+ ;; Could be a datatype or a function.
+ (let ((funname (sml-funname-of-and)))
+ (if funname (cons (concat funname " ") " = ") nil)))
+ ((string= sym "fun")
+ (while (and (setq sym (sml-smie-forward-token))
+ (string-match "^'" sym))
+ (forward-comment (point-max)))
+ (cons (concat sym " ") " = "))
+ ((member sym '("case" "handle" "of")) " => ") ;; "fn"?
+ ;;((member sym '("abstype" "datatype")) "")
+ (t nil))))))
+ (when text
+ (save-excursion
+ (goto-char (1- acp))
+ (unless (save-excursion (skip-chars-backward "\t ") (bolp))
+ (insert "\n")))
+ (unless (memq (char-before) '(?\s ?\t)) (insert " "))
+ (let ((use-region (and (use-region-p) (< (point) (mark)))))
+ ;; (skeleton-proxy-new `(nil ,(if (consp text) (pop text)) _ ,text))
+ (when (consp text) (insert (pop text)))
+ (if (not use-region)
+ (save-excursion (insert text))
+ (goto-char (mark))
+ (insert text)))
+ (indent-according-to-mode)
+ t))))
+
+
+;;; Misc
+
+(defun sml-mark-function ()
+ "Mark the surrounding function. Or try to at least."
+ (interactive)
+ ;; FIXME: Provide beginning-of-defun-function so mark-defun "just works".
+ (let ((start (point)))
+ (sml-beginning-of-defun)
+ (let ((beg (point)))
+ (smie-forward-sexp 'halfsexp)
+ (if (or (< start beg) (> start (point)))
+ (progn
+ (goto-char start)
+ (mark-paragraph))
+ (push-mark nil t t)
+ (goto-char beg)))))
+
+(defun sml-back-to-outer-indent ()
+ "Unindents to the next outer level of indentation."
+ (interactive)
+ (save-excursion
+ (forward-line 0)
+ (let ((start-column (current-indentation))
+ indent)
+ (when (> start-column 0)
+ (save-excursion
+ (while (>= (setq indent
+ (if (re-search-backward "^[ \t]*[^\n\t]" nil t)
+ (current-indentation)
+ 0))
+ start-column))
+ (skip-chars-forward " \t")
+ (let ((pos (point)))
+ (move-to-column start-column)
+ (when (re-search-backward " \\([^ \t\n]\\)" pos t)
+ (goto-char (match-beginning 1))
+ (setq indent (current-column)))))
+ (indent-line-to indent)))))
+
+(defun sml-find-matching-starter (syms)
+ (let ((halfsexp nil)
+ tok)
+ ;;(sml-smie-forward-token)
+ (while (not (or (bobp)
+ (member (nth 2 (setq tok (smie-backward-sexp halfsexp)))
+ syms)))
+ (cond
+ ((null (car tok)) nil)
+ ((numberp (car tok)) (setq halfsexp 'half))
+ (t (goto-char (cadr tok)))))
+ (if (nth 2 tok) (goto-char (cadr tok)))
+ (nth 2 tok)))
+
+(defun sml-skip-siblings ()
+ (let (tok)
+ (while (and (not (bobp))
+ (progn (setq tok (smie-backward-sexp 'half))
+ (cond
+ ((null (car tok)) t)
+ ((numberp (car tok)) t)
+ (t nil)))))
+ (if (nth 2 tok) (goto-char (cadr tok)))
+ (nth 2 tok)))
+
+(defun sml-beginning-of-defun ()
+ (let ((sym (sml-find-matching-starter sml-starters-syms)))
+ (if (member sym '("fun" "and" "functor" "signature" "structure"
+ "abstraction" "datatype" "abstype"))
+ (save-excursion (sml-smie-forward-token) (forward-comment (point-max))
+ (sml-smie-forward-token))
+ ;; We're inside a "non function declaration": let's skip all other
+ ;; declarations that we find at the same level and try again.
+ (sml-skip-siblings)
+ ;; Obviously, let's not try again if we're at bobp.
+ (unless (bobp) (sml-beginning-of-defun)))))
+
+(defcustom sml-max-name-components 3
+ "Maximum number of components to use for the current function name."
+ :type 'integer)
+
+(defun sml-current-fun-name ()
+ (save-excursion
+ (let ((count sml-max-name-components)
+ fullname name)
+ (end-of-line)
+ (while (and (> count 0)
+ (setq name (sml-beginning-of-defun)))
+ (decf count)
+ (setq fullname (if fullname (concat name "." fullname) name))
+ ;; Skip all other declarations that we find at the same level.
+ (sml-skip-siblings))
+ fullname)))
+
+
+;;; INSERTING PROFORMAS (COMMON SML-FORMS)
+
+(defvar sml-forms-alist nil
+ "Alist of code templates.
+You can extend this alist to your heart's content. For each additional
+template NAME in the list, declare a keyboard macro or function (or
+interactive command) called 'sml-form-NAME'.
+If 'sml-form-NAME' is a function it takes no arguments and should
+insert the template at point\; if this is a command it may accept any
+sensible interactive call arguments\; keyboard macros can't take
+arguments at all.
+`sml-forms-alist' understands let, local, case, abstype, datatype,
+signature, structure, and functor by default.")
+
+(defmacro sml-def-skeleton (name interactor &rest elements)
+ (let ((fsym (intern (concat "sml-form-" name))))
+ `(progn
+ (add-to-list 'sml-forms-alist ',(cons name fsym))
+ (define-abbrev sml-mode-abbrev-table ,name "" ',fsym nil 'system)
+ (let ((abbrev (abbrev-symbol ,name sml-mode-abbrev-table)))
+ (abbrev-put abbrev :case-fixed t)
+ (abbrev-put abbrev :enable-function
+ (lambda () (not (nth 8 (syntax-ppss))))))
+ (define-skeleton ,fsym
+ ,(format "SML-mode skeleton for `%s..' expressions" name)
+ ,interactor
+ ,(concat name " ") >
+ ,@elements))))
+(put 'sml-def-skeleton 'lisp-indent-function 2)
+
+(sml-def-skeleton "let" nil
+ @ "\nin " > _ "\nend" >)
+
+(sml-def-skeleton "if" nil
+ @ " then " > _ "\nelse " > _)
+
+(sml-def-skeleton "local" nil
+ @ "\nin" > _ "\nend" >)
+
+(sml-def-skeleton "case" "Case expr: "
+ str "\nof " > _ " => ")
+
+(sml-def-skeleton "signature" "Signature name: "
+ str " =\nsig" > "\n" > _ "\nend" >)
+
+(sml-def-skeleton "structure" "Structure name: "
+ str " =\nstruct" > "\n" > _ "\nend" >)
+
+(sml-def-skeleton "functor" "Functor name: "
+ str " () : =\nstruct" > "\n" > _ "\nend" >)
+
+(sml-def-skeleton "datatype" "Datatype name and type params: "
+ str " =" \n)
+
+(sml-def-skeleton "abstype" "Abstype name and type params: "
+ str " =" \n _ "\nwith" > "\nend" >)
+
+;;
+
+(sml-def-skeleton "struct" nil
+ _ "\nend" >)
+
+(sml-def-skeleton "sig" nil
+ _ "\nend" >)
+
+(sml-def-skeleton "val" nil
+ @ " = " > _)
+
+(sml-def-skeleton "fn" nil
+ @ " =>" > _)
+
+(sml-def-skeleton "fun" nil
+ @ " =" > _)
+
+;;
+
+(defun sml-forms-menu (_menu)
+ (mapcar (lambda (x) (vector (car x) (cdr x) t))
+ sml-forms-alist))
+
+(defvar sml-last-form "let")
+
+(defun sml-electric-space ()
+ "Expand a symbol into an SML form, or just insert a space.
+If the point directly precedes a symbol for which an SML form exists,
+the corresponding form is inserted."
+ (interactive)
+ (let ((abbrev-mode (not abbrev-mode))
+ (last-command-event ?\s)
+ ;; Bind `this-command' to fool skeleton's special abbrev handling.
+ (this-command 'self-insert-command))
+ (call-interactively 'self-insert-command)))
+
+(defun sml-insert-form (name newline)
+ "Interactive short-cut to insert the NAME common SML form.
+If a prefix argument is given insert a NEWLINE and indent first, or
+just move to the proper indentation if the line is blank\; otherwise
+insert at point (which forces indentation to current column).
+
+The default form to insert is 'whatever you inserted last time'
+\(just hit return when prompted\)\; otherwise the command reads with
+completion from `sml-forms-alist'."
+ (interactive
+ (list (completing-read
+ (format "Form to insert (default %s): " sml-last-form)
+ sml-forms-alist nil t nil nil sml-forms-alist)
+ current-prefix-arg))
+ (setq sml-last-form name)
+ (unless (or (not newline)
+ (save-excursion (beginning-of-line) (looking-at "\\s-*$")))
+ (insert "\n"))
+ (when (memq (char-syntax (preceding-char)) '(?_ ?w)) (insert " "))
+ (let ((f (cdr (assoc name sml-forms-alist))))
+ (cond
+ ((commandp f) (command-execute f))
+ (f (funcall f))
+ (t (error "Undefined SML form: %s" name)))))
+
+;;;
+;;; MLton support
+;;;
+
+(defvar sml-mlton-command "mlton"
+ "Command to run MLton. Can include arguments.")
+
+(defvar sml-mlton-mainfile nil)
+
+(defconst sml-mlton-error-regexp-alist
+ ;; I wish they just changed MLton to use one of the standard
+ ;; error formats.
+ `(("^\\(?:Error\\|\\(Warning\\)\\): \\(.+\\) \\([0-9]+\\)\\.\\([0-9]+\\)\\.$"
+ 2 3 4
+ ;; If subgroup 1 matched, then it's a warning, otherwise it's an error.
+ (1))))
+
+(defvar compilation-error-regexp-alist)
+(eval-after-load "compile"
+ '(dolist (x sml-mlton-error-regexp-alist)
+ (add-to-list 'compilation-error-regexp-alist x)))
+
+(defun sml-mlton-typecheck (mainfile)
+ "Typecheck using MLton.
+MAINFILE is the top level file of the project."
+ (interactive
+ (list (if (and sml-mlton-mainfile (not current-prefix-arg))
+ sml-mlton-mainfile
+ (read-file-name "Main file: "))))
+ (setq sml-mlton-mainfile mainfile)
+ (save-some-buffers)
+ (require 'compile)
+ (dolist (x sml-mlton-error-regexp-alist)
+ (add-to-list 'compilation-error-regexp-alist x))
+ (with-current-buffer (find-file-noselect mainfile)
+ (compile (concat sml-mlton-command
+ " -stop tc " ;Stop right after type checking.
+ (shell-quote-argument
+ (file-relative-name buffer-file-name))))))
+
+;;;
+;;; MLton's def-use info.
+;;;
+
+(defvar sml-defuse-file nil)
+
+(defun sml-defuse-file ()
+ (or sml-defuse-file (sml-defuse-set-file)))
+
+(defun sml-defuse-set-file ()
+ "Specify the def-use file to use."
+ (interactive)
+ (setq sml-defuse-file (read-file-name "Def-use file: ")))
+
+(defun sml-defuse-symdata-at-point ()
+ (save-excursion
+ (sml-smie-forward-token)
+ (let ((symname (sml-smie-backward-token)))
+ (if (equal symname "op")
+ (save-excursion (setq symname (sml-smie-forward-token))))
+ (when (string-match "op " symname)
+ (setq symname (substring symname (match-end 0)))
+ (forward-word)
+ (forward-comment (point-max)))
+ (list symname
+ ;; Def-use files seem to count chars, not columns.
+ ;; We hope here that they don't actually count bytes.
+ ;; Also they seem to start counting at 1.
+ (1+ (- (point) (progn (beginning-of-line) (point))))
+ (save-restriction
+ (widen) (1+ (count-lines (point-min) (point))))
+ buffer-file-name))))
+
+(defconst sml-defuse-def-regexp
+ "^[[:alpha:]]+ \\([^ \n]+\\) \\(.+\\) \\([0-9]+\\)\\.\\([0-9]+\\)$")
+(defconst sml-defuse-use-regexp-format "^ %s %d\\.%d $")
+
+(defun sml-defuse-jump-to-def ()
+ "Jump to the definition corresponding to the symbol at point."
+ (interactive)
+ (let ((symdata (sml-defuse-symdata-at-point)))
+ (if (null (car symdata))
+ (error "Not on a symbol")
+ (with-current-buffer (find-file-noselect (sml-defuse-file))
+ (goto-char (point-min))
+ (unless (re-search-forward
+ (format sml-defuse-use-regexp-format
+ (concat "\\(?:"
+ ;; May be an absolute file name.
+ (regexp-quote (nth 3 symdata))
+ "\\|"
+ ;; Or a relative file name.
+ (regexp-quote (file-relative-name
+ (nth 3 symdata)))
+ "\\)")
+ (nth 2 symdata)
+ (nth 1 symdata))
+ nil t)
+ ;; FIXME: This is typically due to editing: any minor editing will
+ ;; mess everything up. We should try to fail more gracefully.
+ (error "Def-use info not found"))
+ (unless (re-search-backward sml-defuse-def-regexp nil t)
+ ;; This indicates a bug in this code.
+ (error "Internal failure while looking up def-use"))
+ (unless (equal (match-string 1) (nth 0 symdata))
+ ;; FIXME: This again is most likely due to editing.
+ (error "Incoherence in the def-use info found"))
+ (let ((line (string-to-number (match-string 3)))
+ (char (string-to-number (match-string 4))))
+ (pop-to-buffer (find-file-noselect (match-string 2)))
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (forward-char (1- char)))))))
+
+;;;
+;;; SML/NJ's Compilation Manager support
+;;;
+
+(defvar sml-cm-mode-syntax-table sml-mode-syntax-table)
+(defvar sml-cm-font-lock-keywords
+ `(,(concat "\\_<" (regexp-opt '("library" "group" "is" "structure"
+ "functor" "signature" "funsig") t)
+ "\\_>")))
+;;;###autoload
+(add-to-list 'completion-ignored-extensions ".cm/")
+;; This was used with the old compilation manager.
+(add-to-list 'completion-ignored-extensions "CM/")
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.cm\\'" . sml-cm-mode))
+;;;###autoload
+(define-derived-mode sml-cm-mode fundamental-mode "SML-CM"
+ "Major mode for SML/NJ's Compilation Manager configuration files."
+ (set (make-local-variable 'sml-prog-proc-descriptor) sml-pp-functions)
+ (set (make-local-variable 'font-lock-defaults)
+ '(sml-cm-font-lock-keywords nil t nil nil)))
+
+;;;
+;;; ML-Lex support
+;;;
+
+(defvar sml-lex-font-lock-keywords
+ (append
+ `((,(concat "^%" sml-id-re) . font-lock-builtin-face)
+ ("^%%" . font-lock-module-def-face))
+ sml-font-lock-keywords))
+(defconst sml-lex-font-lock-defaults
+ (cons 'sml-lex-font-lock-keywords (cdr sml-font-lock-defaults)))
+
+;;;###autoload
+(define-derived-mode sml-lex-mode sml-mode "SML-Lex"
+ "Major Mode for editing ML-Lex files."
+ (set (make-local-variable 'font-lock-defaults) sml-lex-font-lock-defaults))
+
+;;;
+;;; ML-Yacc support
+;;;
+
+(defface sml-yacc-bnf-face
+ '((t (:foreground "darkgreen")))
+ "Face used to highlight (non)terminals in `sml-yacc-mode'.")
+(defvar sml-yacc-bnf-face 'sml-yacc-bnf-face)
+
+(defcustom sml-yacc-indent-action 16
+ "Indentation column of the opening paren of actions."
+ :type 'integer)
+
+(defcustom sml-yacc-indent-pipe nil
+ "Indentation column of the pipe char in the BNF.
+If nil, align it with `:' or with previous cases."
+ :type 'integer)
+
+(defcustom sml-yacc-indent-term nil
+ "Indentation column of the (non)term part.
+If nil, align it with previous cases."
+ :type 'integer)
+
+(defvar sml-yacc-font-lock-keywords
+ (cons `((concat "^\\(" sml-id-re "\\s-*:\\|\\s-*|\\)\\(\\s-*" sml-id-re
+ "\\)*\\s-*\\(\\(%" sml-id-re "\\)\\s-+" sml-id-re "\\|\\)")
+ (0 (save-excursion
+ (save-match-data
+ (goto-char (match-beginning 0))
+ (unless (or (re-search-forward "\\_<of\\_>"
+ (match-end 0) 'move)
+ (progn (forward-comment (point-max))
+ (not (looking-at "("))))
+ sml-yacc-bnf-face))))
+ (4 font-lock-builtin-face t t))
+ sml-lex-font-lock-keywords))
+(defconst sml-yacc-font-lock-defaults
+ (cons 'sml-yacc-font-lock-keywords (cdr sml-font-lock-defaults)))
+
+(defun sml-yacc-indent-line ()
+ "Indent current line of ML-Yacc code."
+ (let ((savep (> (current-column) (current-indentation)))
+ (indent (max (or (ignore-errors (sml-yacc-indentation)) 0) 0)))
+ (if savep
+ (save-excursion (indent-line-to indent))
+ (indent-line-to indent))))
+
+(defun sml-yacc-indentation ()
+ (save-excursion
+ (back-to-indentation)
+ (or (and (looking-at (eval-when-compile
+ (concat "%\\|" sml-id-re "\\s-*:")))
+ 0)
+ (when (save-excursion
+ (condition-case nil (progn (up-list -1) nil) (scan-error t)))
+ ;; We're outside an action.
+ (cond
+ ;; Special handling of indentation inside %term and %nonterm
+ ((save-excursion
+ (and (re-search-backward "^%\\(\\sw+\\)" nil t)
+ (member (match-string 1) '("term" "nonterm"))))
+ (if (numberp sml-yacc-indent-term) sml-yacc-indent-term
+ (let ((offset (if (looking-at "|") -2 0)))
+ (forward-line -1)
+ (looking-at "\\s-*\\(%\\sw*\\||\\)?\\s-*")
+ (goto-char (match-end 0))
+ (+ offset (current-column)))))
+ ((looking-at "(") sml-yacc-indent-action)
+ ((looking-at "|")
+ (if (numberp sml-yacc-indent-pipe) sml-yacc-indent-pipe
+ (backward-sexp 1)
+ (while (progn (forward-comment (- (point)))
+ (/= 0 (skip-syntax-backward "w_"))))
+ (forward-comment (- (point)))
+ (if (not (looking-at "\\s-$"))
+ (1- (current-column))
+ (skip-syntax-forward " ")
+ (- (current-column) 2))))))
+ ;; default to SML rules
+ (smie-indent-calculate))))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.grm\\'" . sml-yacc-mode))
+;;;###autoload
+(define-derived-mode sml-yacc-mode sml-mode "SML-Yacc"
+ "Major Mode for editing ML-Yacc files."
+ (set (make-local-variable 'indent-line-function) 'sml-yacc-indent-line)
+ (set (make-local-variable 'font-lock-defaults) sml-yacc-font-lock-defaults))
+
+\f
+
+;;;; ChangeLog:
+
+;; 2012-10-31 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * sml-mode.el: Integrate BUGS&NEWS; re-add run-sml.
+;;
+;; 2012-10-22 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Add SML-mode.
+;;
+;; 2012-10-22 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Cleanup copyright; Merge prog-proc into sml-mode.el
+;;
+;; 2012-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Move sml-compile to prog-proc.
+;;
+;; 2012-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * sml-mode.el (sml-electric-pipe-mode): New var.
+;; (sml-pipeheads): Add (, {, and [ to more reliably detect cases where
+;; the pipe is not part of a case/fun/...
+;; (sml-tyvarseq-re): Use shy groups.
+;; (sml-font-lock-keywords): Adjust accordingly.
+;; (sml-compile): Avoid the 3rd part of dolist's spec.
+;; (sml-post-self-insert-pipe): New fun, extracted from sml-electric-pipe.
+;; (sml-mode): Use it to obey sml-electric-pipe-mode.
+;; (sml-electric-pipe): Use sml-post-self-insert-pipe.
+;; * makefile.pkg (ELFILES): Remove sml-proc.el.
+;; * prog-proc.el: Rename from sml-prog-proc.el.
+;;
+;; 2012-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Add sml-compile back into sml-mode
+;;
+;; 2012-10-04 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Move sml-proc to either prog-proc or sml-mode.
+;;
+;; 2012-10-04 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Fix compilation
+;;
+;; 2012-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Start preparing for the move to ELPA.
+;;
+;; 2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Merge from trunk
+;;
+;; 2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Merge sml-defs.el into sml-mode.el.
+;; * sml-mode.el: Merge code from sml-defs.el.
+;; Remove ":group 'sml" since they're now redundant.
+;; * makefile.pkg (ELFILES): Adjust.
+;;
+;; 2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * sml-mode.el (sml-mark-function): New implementation using SMIE.
+;; * sml-defs.el (sml-mode-map): Use backtab.
+;; Remove leftover unused sml-drag-region binding.
+;;
+;; 2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; -
+;;
+;; 2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Merge from trunk
+;;
+;; 2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Use SMIE by default and make sml-oldindent optional.
+;; * sml-mode.el: Only load sml-oldindent if necessary.
+;; (sml-use-smie): Default to t.
+;; (sml-smie-datatype-|-p): Better handle incomplete datatype branch.
+;; (sml-mode): Use prog-mode. Setup electric-layout and electric-indent.
+;; (sml-mode-variables): Always setup SMIE if possible.
+;; (sml-imenu-create-index, sml-funname-of-and, sml-electric-pipe)
+;; (sml-beginning-of-defun, sml-defuse-symdata-at-point)
+;; (sml-yacc-font-lock-keywords, sml-yacc-indentation):
+;; Avoid sml-oldindent functions.
+;; (sml-find-forward): Move from sml-oldindent and re-implement.
+;; (sml-electric-semi): Use self-insert-command so electric-layout and
+;; electric-indent can do their job.
+;; (sml-smie-find-matching-starter, sml-find-matching-starter)
+;; (sml-smie-skip-siblings, sml-skip-siblings): New functions.
+;; * sml-oldindent.el (sml-starters-indent-after, sml-exptrail-syms):
+;; Remove, unused.
+;; (sml-find-forward): Move back to sml-mode.el.
+;; (sml-old-find-matching-starter): Rename from sml-find-matching-starter.
+;; (sml-old-skip-siblings): Move&rename from sml-mode:sml-skip-siblings.
+;;
+;; 2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Merge from trunk
+;;
+
+(provide 'sml-mode)
+
+;;; sml-mode.el ends here
--- /dev/null
+(require 'solarized-dark-theme)
+(require 'solarized-light-theme)
+
+(provide 'solarized-theme)
--- /dev/null
+;;; solarized.el --- Solarized for Emacs.
+
+;; Copyright (C) 2011-2013 Bozhidar Batsov
+
+;; Author: Bozhidar Batsov <bozhidar@batsov.com>
+;; Author: Thomas Frössman <thomasf@jossystem.se>
+;; URL: http://github.com/bbatsov/solarized-emacs
+;; Version: 1.0.0
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; A port of Solarized to Emacs.
+;;
+;;; Installation:
+;;
+;; Drop the `solarized-theme.el` somewhere in your `load-path` and
+;; the two themes in a folder that is on `custom-theme-load-path'
+;; and enjoy!
+;;
+;; Don't forget that the theme requires Emacs 24.
+;;
+;;; Bugs
+;;
+;; None that I'm aware of.
+;;
+;;; Credits
+;;
+;; Ethan Schoonover created the original theme for vim on such this port
+;; is based.
+;;
+;;; Code:
+
+(defun create-solarized-theme (variant theme-name &optional childtheme)
+ (let* ((class '((class color) (min-colors 89)))
+ ;; Solarized palette
+ (base03 "#002b36")
+ (base02 "#073642")
+ ;; emphasized content
+ (base01 "#586e75")
+ ;; primary content
+ (base00 "#657b83")
+ (base0 "#839496")
+ ;; comments
+ (base1 "#93a1a1")
+ ;; background highlight light
+ (base2 "#eee8d5")
+ ;; background light
+ (base3 "#fdf6e3")
+
+ ;; Solarized accented colors
+ (yellow "#b58900")
+ (orange "#cb4b16")
+ (red "#dc322f")
+ (magenta "#d33682")
+ (violet "#6c71c4")
+ (blue "#268bd2")
+ (cyan "#2aa198")
+ (green "#859900")
+
+ ;; Darker and lighter accented colors
+ ;; Only use these in exceptional circumstances!
+ (yellow-d "#7B6000")
+ (yellow-l "#DEB542")
+ (orange-d "#8B2C02")
+ (orange-l "#F2804F")
+ (red-d "#990A1B")
+ (red-l "#FF6E64")
+ (magenta-d "#93115C")
+ (magenta-l "#F771AC")
+ (violet-d "#3F4D91")
+ (violet-l "#9EA0E5")
+ (blue-d "#00629D")
+ (blue-l "#69B7F0")
+ (cyan-d "#00736F")
+ (cyan-l "#69CABF")
+ (green-d "#546E00")
+ (green-l "#B4C342")
+
+ ;; Light/Dark adaptive solarized colors
+ (solarized-fg (if (eq variant 'light) base00 base0))
+ (solarized-bg (if (eq variant 'light) base3 base03))
+ (solarized-hl (if (eq variant 'light) base2 base02))
+ (solarized-emph (if (eq variant 'light) base01 base1))
+ (solarized-comments (if (eq variant 'light) base1 base01))
+
+ ;; Light/Dark adaptive higher/lower contrast accented colors
+ ;; Only use these in exceptional cirmumstances!
+ (solarized-fg-hc (if (eq variant 'light) base3 base03))
+ (solarized-fg-lc (if (eq variant 'light) base03 base3))
+
+ (yellow-hc (if (eq variant 'light) yellow-d yellow-l))
+ (yellow-lc (if (eq variant 'light) yellow-l yellow-d))
+ (orange-hc (if (eq variant 'light) orange-d orange-l))
+ (orange-lc (if (eq variant 'light) orange-l orange-d))
+ (red-hc (if (eq variant 'light) red-d red-l))
+ (red-lc (if (eq variant 'light) red-l red-d))
+ (magenta-hc (if (eq variant 'light) magenta-d magenta-l))
+ (magenta-lc (if (eq variant 'light) magenta-l magenta-d))
+ (violet-hc (if (eq variant 'light) violet-d violet-l))
+ (violet-lc (if (eq variant 'light) violet-l violet-d))
+ (blue-hc (if (eq variant 'light) blue-d blue-l))
+ (blue-lc (if (eq variant 'light) blue-l blue-d))
+ (cyan-hc (if (eq variant 'light) cyan-d cyan-l))
+ (cyan-lc (if (eq variant 'light) cyan-l cyan-d))
+ (green-hc (if (eq variant 'light) green-d green-l))
+ (green-lc (if (eq variant 'light) green-l green-d)))
+ (custom-theme-set-faces
+ theme-name
+ '(button ((t (:underline t))))
+
+ ;; basic coloring
+ `(default ((,class (:foreground ,solarized-fg :background ,solarized-bg))))
+ `(shadow ((,class (:foreground ,solarized-comments))))
+ `(match ((,class (:background ,solarized-hl :foreground ,solarized-emph :weight bold))))
+ `(cursor ((,class (:foreground ,solarized-bg :background ,solarized-fg :inverse-video t))))
+ `(escape-glyph-face ((,class (:foreground ,red))))
+ `(fringe ((,class (:foreground ,solarized-fg :background ,solarized-hl))))
+ `(header-line ((,class (:foreground ,yellow
+ :background ,solarized-hl
+ :box (:line-width -1 :style released-button)))))
+ `(highlight ((,class (:background ,solarized-hl))))
+ `(link ((,class (:foreground ,yellow :underline t :weight bold))))
+ `(link-visited ((,class (:foreground ,yellow :underline t :weight normal))))
+ `(success ((,class (:foreground ,green ))))
+ `(warning ((,class (:foreground ,yellow ))))
+ `(error ((,class (:foreground ,orange))))
+ `(lazy-highlight ((,class (:foreground ,solarized-emph :background ,solarized-hl :bold t))))
+ `(escape-glyph ((,class (:foreground ,violet))))
+
+ ;; compilation
+ `(compilation-column-face ((,class (:foreground ,yellow))))
+ `(compilation-enter-directory-face ((,class (:foreground ,green))))
+ `(compilation-error-face ((,class (:foreground ,red :weight bold :underline t))))
+ `(compilation-face ((,class (:foreground ,solarized-fg))))
+ `(compilation-info-face ((,class (:foreground ,blue))))
+ `(compilation-info ((,class (:foreground ,green :underline t))))
+ `(compilation-leave-directory-face ((,class (:foreground ,green))))
+ `(compilation-line-face ((,class (:foreground ,yellow))))
+ `(compilation-line-number ((,class (:foreground ,yellow))))
+ `(compilation-message-face ((,class (:foreground ,blue))))
+ `(compilation-warning-face ((,class (:foreground ,yellow :weight bold :underline t))))
+
+ `(compilation-mode-line-exit
+ ((,class (:inherit compilation-info :foreground ,green :weight bold))))
+ `(compilation-mode-line-fail
+ ((,class (:inherit compilation-error :foreground ,red :weight bold))))
+ `(compilation-mode-line-run ((,class (:foreground ,orange :weight bold))))
+
+ ;; cua
+ `(cua-global-mark ((,class (:background ,yellow :foreground ,solarized-bg))))
+ `(cua-rectangle ((,class (:inherit region :background ,magenta :foreground ,solarized-bg))))
+ `(cua-rectangle-noselect ((,class (:inherit region :background ,solarized-hl
+ :foreground ,solarized-comments))))
+
+ ;; diary
+ `(diary ((,class (:foreground ,yellow))))
+
+ ;; dired
+ `(dired-directory ((,class (:foreground ,blue :weight normal))))
+ `(dired-flagged ((,class (:foreground ,red))))
+ `(dired-header ((,class (:foreground ,solarized-bg :background ,blue))))
+ `(dired-ignored ((,class (:inherit shadow))))
+ `(dired-mark ((,class (:foreground ,yellow :weight bold))))
+ `(dired-marked ((,class (:foreground ,magenta :weight bold))))
+ `(dired-perm-write ((,class (:foreground ,solarized-fg :underline t))))
+ `(dired-symlink ((,class (:foreground ,cyan :weight normal :slant italic))))
+ `(dired-warning ((,class (:foreground ,orange :underline t))))
+
+ ;; dropdown
+ `(dropdown-list-face ((,class (:background ,solarized-hl :foreground ,cyan))))
+ `(dropdown-list-selection-face ((,class (:background ,cyan-lc :foreground ,cyan-hc))))
+
+ ;; grep
+ `(grep-context-face ((,class (:foreground ,solarized-fg))))
+ `(grep-error-face ((,class (:foreground ,red :weight bold :underline t))))
+ `(grep-hit-face ((,class (:foreground ,blue))))
+ `(grep-match-face ((,class (:foreground ,orange :weight bold))))
+
+ ;; faces used by isearch
+ `(isearch ((,class (:foreground ,yellow :background ,solarized-hl :bold t))))
+ `(isearch-fail ((,class (:foreground ,red :background ,solarized-bg :bold t))))
+
+ ;; man
+ `(Man-overstrike ((,class (:foreground ,blue :weight bold))))
+ `(Man-reverse ((,class (:foreground ,orange))))
+ `(Man-underline ((,class (:foreground ,green :underline t))))
+
+ ;; misc faces
+ `(menu ((,class (:foreground ,solarized-fg :background ,solarized-bg))))
+ `(minibuffer-prompt ((,class (:foreground ,solarized-emph))))
+ `(mode-line
+ ((,class (:foreground ,solarized-fg
+ :background ,solarized-hl
+ :box (:line-width -1 :style released-button)))))
+ `(mode-line-buffer-id ((,class (:foreground ,solarized-emph :weight bold))))
+ `(mode-line-inactive
+ ((,class (:foreground ,solarized-fg
+ :background ,solarized-bg
+ :box (:line-width -1 :style released-button)))))
+ `(region ((,class (:foreground ,solarized-bg :background ,solarized-emph))))
+ `(secondary-selection ((,class (:background ,solarized-hl))))
+
+ `(trailing-whitespace ((,class (:background ,red))))
+ `(vertical-border ((,class (:foreground ,solarized-fg))))
+
+ ;; font lock
+ `(font-lock-builtin-face ((,class (:foreground ,blue :slant italic))))
+ `(font-lock-comment-delimiter-face ((,class (:foreground ,solarized-comments))))
+ `(font-lock-comment-face ((,class (:foreground ,solarized-comments))))
+ `(font-lock-constant-face ((,class (:foreground ,blue :weight bold))))
+ `(font-lock-doc-face ((,class (:foreground ,cyan :slant italic))))
+ `(font-lock-doc-string-face ((,class (:foreground ,blue))))
+ `(font-lock-function-name-face ((,class (:foreground ,blue))))
+ `(font-lock-keyword-face ((,class (:foreground ,green :weight bold))))
+ `(font-lock-negation-char-face ((,class (:foreground ,solarized-fg))))
+ `(font-lock-preprocessor-face ((,class (:foreground ,blue))))
+ `(font-lock-string-face ((,class (:foreground ,cyan))))
+ `(font-lock-type-face ((,class (:foreground ,yellow))))
+ `(font-lock-variable-name-face ((,class (:foreground ,blue))))
+ `(font-lock-warning-face ((,class (:foreground ,orange :weight bold :underline t))))
+
+ `(c-annotation-face ((,class (:inherit font-lock-constant-face))))
+
+ ;;; external
+
+ ;; ace-jump-mode
+ `(ace-jump-face-background
+ ((,class (:foreground ,solarized-comments :background ,solarized-bg :inverse-video nil))))
+ `(ace-jump-face-foreground
+ ((,class (:foreground ,red :background ,solarized-bg :inverse-video nil))))
+
+ ;; auto-complete
+ `(ac-candidate-face ((,class (:background ,solarized-hl :foreground ,cyan))))
+ `(ac-selection-face ((,class (:background ,cyan-lc :foreground ,cyan-hc))))
+ `(ac-candidate-mouse-face ((,class (:background ,cyan-hc :foreground ,cyan-lc))))
+ `(ac-completion-face ((,class (:foreground ,solarized-emph :underline t))))
+ `(ac-gtags-candidate-face ((,class (:background ,solarized-hl :foreground ,blue))))
+ `(ac-gtags-selection-face ((,class (:background ,blue-lc :foreground ,blue-hc))))
+ `(ac-yasnippet-candidate-face ((,class (:background ,solarized-hl :foreground ,yellow))))
+ `(ac-yasnippet-selection-face ((,class (:background ,yellow-lc :foreground ,yellow-hc))))
+
+ ;; auto highlight symbol
+ `(ahs-definition-face ((,class (:foreground ,solarized-bg :background ,blue :underline t))))
+ `(ahs-edit-mode-face ((,class (:foreground ,solarized-bg :background ,yellow))))
+ `(ahs-face ((,class (:foreground ,solarized-bg :background ,blue))))
+ `(ahs-plugin-bod-face ((,class (:foreground ,solarized-bg :background ,blue))))
+ `(ahs-plugin-defalt-face ((,class (:foreground ,solarized-bg :background ,cyan))))
+ `(ahs-plugin-whole-buffer-face ((,class (:foreground ,solarized-bg :background ,green))))
+ `(ahs-warning-face ((,class (:foreground ,red :weight bold))))
+
+ ;; android mode
+ `(android-mode-debug-face ((,class (:foreground ,green))))
+ `(android-mode-error-face ((,class (:foreground ,orange :weight bold))))
+ `(android-mode-info-face ((,class (:foreground ,solarized-fg))))
+ `(android-mode-verbose-face ((,class (:foreground ,solarized-comments))))
+ `(android-mode-warning-face ((,class (:foreground ,yellow))))
+
+ ;; bm
+ `(bm-face ((,class (:background ,yellow-lc :foreground ,solarized-bg))))
+ `(bm-fringe-face ((,class (:background ,yellow-lc :foreground ,solarized-bg))))
+ `(bm-fringe-persistent-face ((,class (:background ,green-lc :foreground ,solarized-bg))))
+ `(bm-persistent-face ((,class (:background ,green-lc :foreground ,solarized-bg))))
+
+ ;; calfw
+ `(cfw:face-day-title ((,class (:background ,solarized-hl))))
+ `(cfw:face-annotation ((,class (:inherit cfw:face-day-title :foreground ,yellow))))
+ `(cfw:face-default-content ((,class (:foreground ,green))))
+ `(cfw:face-default-day ((,class (:inherit cfw:face-day-title :weight bold))))
+ `(cfw:face-disable ((,class (:inherit cfw:face-day-title :foreground ,solarized-comments))))
+ `(cfw:face-grid ((,class (:foreground ,solarized-comments))))
+ `(cfw:face-header ((,class (:foreground ,blue-hc :background ,blue-lc :weight bold))))
+ `(cfw:face-holiday ((,class (:background nil :foreground ,red :weight bold))))
+ `(cfw:face-periods ((,class (:foreground ,magenta))))
+ `(cfw:face-select ((,class (:background ,magenta-lc :foreground ,magenta-hc))))
+ `(cfw:face-saturday ((,class (:foreground ,cyan-hc :background ,cyan-lc))))
+ `(cfw:face-sunday ((,class (:foreground ,red-hc :background ,red-lc :weight bold))))
+ `(cfw:face-title ((,class (:inherit variable-pitch :foreground ,yellow :weight bold :height 2.0))))
+ `(cfw:face-today ((,class (:weight bold :background ,solarized-hl :foreground nil))))
+ `(cfw:face-today-title ((,class (:background ,yellow-lc :foreground ,yellow-hc :weight bold))))
+ `(cfw:face-toolbar ((,class (:background ,solarized-hl :foreground ,solarized-fg))))
+ `(cfw:face-toolbar-button-off ((,class (:background ,yellow-lc :foreground ,yellow-hc :weight bold))))
+ `(cfw:face-toolbar-button-on ((,class (:background ,yellow-hc :foreground ,yellow-lc :weight bold))))
+
+ ;; clojure-test-mode
+ `(clojure-test-failure-face ((t (:foreground ,orange :weight bold :underline t))))
+ `(clojure-test-error-face ((t (:foreground ,red :weight bold :underline t))))
+ `(clojure-test-success-face ((t (:foreground ,green :weight bold :underline t))))
+
+ ;; ctable
+ `(ctbl:face-cell-select ((,class (:background ,blue :foreground ,solarized-bg))))
+ `(ctbl:face-continue-bar ((,class (:background ,solarized-hl :foreground ,solarized-bg))))
+ `(ctbl:face-row-select ((,class (:background ,cyan :foreground ,solarized-bg))))
+
+ ;; coffee
+ `(coffee-mode-class-name ((,class (:foreground ,yellow :weight bold))))
+ `(coffee-mode-function-param ((,class (:foreground ,violet :slant italic))))
+
+ ;; custom
+ `(custom-variable-tag ((,class (:foreground ,cyan))))
+ `(custom-comment-tag ((,class (:foreground ,solarized-comments))))
+ `(custom-group-tag ((,class (:foreground ,blue))))
+ `(custom-state ((,class (:foreground ,green))))
+
+ ;; diff
+ `(diff-added ((,class (:foreground ,green :background ,solarized-bg))))
+ `(diff-changed ((,class (:foreground ,yellow :background ,solarized-bg))))
+ `(diff-removed ((,class (:foreground ,red :background ,solarized-bg))))
+ `(diff-header ((,class (:background ,solarized-bg))))
+ `(diff-file-header
+ ((,class (:background ,solarized-bg :foreground ,solarized-fg :weight bold))))
+
+ ;; ediff
+ `(ediff-fine-diff-A ((,class (:background ,orange-lc))))
+ `(ediff-fine-diff-B ((,class (:background ,green-lc))))
+ `(ediff-even-diff-A ((,class (:background ,solarized-comments :foreground ,solarized-fg-lc ))))
+ `(ediff-odd-diff-A ((,class (:background ,solarized-comments :foreground ,solarized-fg-hc ))))
+ `(ediff-even-diff-B ((,class (:background ,solarized-comments :foreground ,solarized-fg-hc ))))
+ `(ediff-odd-diff-B ((,class (:background ,solarized-comments :foreground ,solarized-fg-lc ))))
+
+ ;; epc
+ `(epc:face-title ((,class (:foreground ,magenta :weight bold))))
+
+ ;; eshell
+ `(eshell-prompt ((,class (:foreground ,yellow :weight bold))))
+ `(eshell-ls-archive ((,class (:foreground ,red :weight bold))))
+ `(eshell-ls-backup ((,class (:inherit font-lock-comment))))
+ `(eshell-ls-clutter ((,class (:inherit font-lock-comment))))
+ `(eshell-ls-directory ((,class (:foreground ,blue :weight bold))))
+ `(eshell-ls-executable ((,class (:foreground ,red :weight bold))))
+ `(eshell-ls-unreadable ((,class (:foreground ,solarized-fg))))
+ `(eshell-ls-missing ((,class (:inherit font-lock-warning))))
+ `(eshell-ls-product ((,class (:inherit font-lock-doc))))
+ `(eshell-ls-special ((,class (:foreground ,yellow :weight bold))))
+ `(eshell-ls-symlink ((,class (:foreground ,cyan :weight bold))))
+
+ ;; fic
+ `(fic-author-face ((,class (:background ,solarized-bg :foreground ,orange :underline t :slant italic))))
+ `(fic-face ((,class (:background ,solarized-bg :foreground ,orange :weight normal :slant italic))))
+
+ ;; flymake
+ `(flymake-errline
+ ((,class (:foreground ,red-hc :background ,red-lc :weight bold :underline t))))
+ `(flymake-infoline ((,class (:foreground ,green-hc :background ,green-lc))))
+ `(flymake-warnline
+ ((,class (:foreground ,yellow-hc :background ,yellow-lc :weight bold :underline t))))
+
+ ;; flycheck
+ `(flycheck-error-face
+ ((,class (:foreground ,red-hc :background ,red-lc :weight bold :underline t))))
+ `(flycheck-warning-face
+ ((,class (:foreground ,yellow-hc :background ,yellow-lc :weight bold :underline t))))
+
+ ;; flyspell
+ `(flyspell-duplicate ((,class (:foreground ,yellow :weight bold :underline t))))
+ `(flyspell-incorrect ((,class (:foreground ,red :weight bold :underline t))))
+
+ ;; erc
+ `(erc-action-face ((,class (:inherit erc-default-face))))
+ `(erc-bold-face ((,class (:weight bold))))
+ `(erc-current-nick-face ((,class (:foreground ,blue :weight bold))))
+ `(erc-dangerous-host-face ((,class (:inherit font-lock-warning))))
+ `(erc-default-face ((,class (:foreground ,solarized-fg))))
+ `(erc-direct-msg-face ((,class (:inherit erc-default))))
+ `(erc-error-face ((,class (:inherit font-lock-warning))))
+ `(erc-fool-face ((,class (:inherit erc-default))))
+ `(erc-highlight-face ((,class (:inherit hover-highlight))))
+ `(erc-input-face ((,class (:foreground ,yellow))))
+ `(erc-keyword-face ((,class (:foreground ,blue :weight bold))))
+ `(erc-nick-default-face ((,class (:foreground ,yellow :weight bold))))
+ `(erc-my-nick-face ((,class (:foreground ,red :weight bold))))
+ `(erc-nick-msg-face ((,class (:inherit erc-default))))
+ `(erc-notice-face ((,class (:foreground ,green))))
+ `(erc-pal-face ((,class (:foreground ,orange :weight bold))))
+ `(erc-prompt-face ((,class (:foreground ,orange :background ,solarized-bg :weight bold))))
+ `(erc-timestamp-face ((,class (:foreground ,green))))
+ `(erc-underline-face ((t (:underline t))))
+
+ ;; git-gutter
+ `(git-gutter:added ((,class (:background ,green :foreground ,solarized-bg :weight bold))))
+ `(git-gutter:deleted ((,class (:background ,red :foreground ,solarized-bg :weight bold))))
+ `(git-gutter:modified ((,class (:background ,blue :foreground ,solarized-bg :weight bold))))
+ `(git-gutter:unchanged ((,class (:background ,solarized-hl :foreground ,solarized-bg :weight bold))))
+ ;; I use the following git-gutter settings along with those faces
+ ;; (when window-system
+ ;; (let ((symbol "."))
+ ;; (setq git-gutter:added-sign symbol
+ ;; git-gutter:deleted-sign symbol
+ ;; git-gutter:modified-sign symbol
+ ;; git-gutter:unchanged-sign " ")))
+
+ ;; git-gutter-fr
+ `(git-gutter-fr:added ((,class (:foreground ,green :weight bold))))
+ `(git-gutter-fr:deleted ((,class (:foreground ,red :weight bold))))
+ `(git-gutter-fr:modified ((,class (:foreground ,blue :weight bold))))
+
+ ;; guide-key
+ `(guide-key/highlight-command-face ((,class (:foreground ,blue))))
+ `(guide-key/key-face ((,class (:foreground ,solarized-comments))))
+ `(guide-key/prefix-command-face ((,class (:foreground ,green))))
+
+ ;; gnus
+ `(gnus-group-mail-1-face ((,class (:weight bold :inherit gnus-group-mail-1-empty))))
+ `(gnus-group-mail-1-empty-face ((,class (:inherit gnus-group-news-1-empty))))
+ `(gnus-group-mail-2-face ((,class (:weight bold :inherit gnus-group-mail-2-empty))))
+ `(gnus-group-mail-2-empty-face ((,class (:inherit gnus-group-news-2-empty))))
+ `(gnus-group-mail-3-face ((,class (:weight bold :inherit gnus-group-mail-3-empty))))
+ `(gnus-group-mail-3-empty-face ((,class (:inherit gnus-group-news-3-empty))))
+ `(gnus-group-mail-4-face ((,class (:weight bold :inherit gnus-group-mail-4-empty))))
+ `(gnus-group-mail-4-empty-face ((,class (:inherit gnus-group-news-4-empty))))
+ `(gnus-group-mail-5-face ((,class (:weight bold :inherit gnus-group-mail-5-empty))))
+ `(gnus-group-mail-5-empty-face ((,class (:inherit gnus-group-news-5-empty))))
+ `(gnus-group-mail-6-face ((,class (:weight bold :inherit gnus-group-mail-6-empty))))
+ `(gnus-group-mail-6-empty-face ((,class (:inherit gnus-group-news-6-empty))))
+ `(gnus-group-mail-low-face ((,class (:weight bold :inherit gnus-group-mail-low-empty))))
+ `(gnus-group-mail-low-empty-face ((,class (:inherit gnus-group-news-low-empty))))
+ `(gnus-group-news-1-face ((,class (:weight bold :inherit gnus-group-news-1-empty))))
+ `(gnus-group-news-2-face ((,class (:weight bold :inherit gnus-group-news-2-empty))))
+ `(gnus-group-news-3-face ((,class (:weight bold :inherit gnus-group-news-3-empty))))
+ `(gnus-group-news-4-face ((,class (:weight bold :inherit gnus-group-news-4-empty))))
+ `(gnus-group-news-5-face ((,class (:weight bold :inherit gnus-group-news-5-empty))))
+ `(gnus-group-news-6-face ((,class (:weight bold :inherit gnus-group-news-6-empty))))
+ `(gnus-group-news-low-face ((,class (:weight bold :inherit gnus-group-news-low-empty))))
+ `(gnus-header-content-face ((,class (:inherit message-header-other))))
+ `(gnus-header-from-face ((,class (:inherit message-header-from))))
+ `(gnus-header-name-face ((,class (:inherit message-header-name))))
+ `(gnus-header-newsgroups-face ((,class (:inherit message-header-other))))
+ `(gnus-header-subject-face ((,class (:inherit message-header-subject))))
+ `(gnus-summary-cancelled-face ((,class (:foreground ,orange))))
+ `(gnus-summary-high-ancient-face ((,class (:foreground ,blue))))
+ `(gnus-summary-high-read-face ((,class (:foreground ,green :weight bold))))
+ `(gnus-summary-high-ticked-face ((,class (:foreground ,orange :weight bold))))
+ `(gnus-summary-high-unread-face ((,class (:foreground ,solarized-fg :weight bold))))
+ `(gnus-summary-low-ancient-face ((,class (:foreground ,blue))))
+ `(gnus-summary-low-read-face ((t (:foreground ,green))))
+ `(gnus-summary-low-ticked-face ((,class (:foreground ,orange :weight bold))))
+ `(gnus-summary-low-unread-face ((,class (:foreground ,solarized-fg))))
+ `(gnus-summary-normal-ancient-face ((,class (:foreground ,blue))))
+ `(gnus-summary-normal-read-face ((,class (:foreground ,green))))
+ `(gnus-summary-normal-ticked-face ((,class (:foreground ,orange :weight bold))))
+ `(gnus-summary-normal-unread-face ((,class (:foreground ,solarized-fg))))
+ `(gnus-summary-selected-face ((,class (:foreground ,yellow :weight bold))))
+ `(gnus-cite-1-face ((,class (:foreground ,blue))))
+ `(gnus-cite-10-face ((,class (:foreground ,yellow))))
+ `(gnus-cite-11-face ((,class (:foreground ,yellow))))
+ `(gnus-cite-2-face ((,class (:foreground ,blue))))
+ `(gnus-cite-3-face ((,class (:foreground ,blue))))
+ `(gnus-cite-4-face ((,class (:foreground ,green))))
+ `(gnus-cite-5-face ((,class (:foreground ,green))))
+ `(gnus-cite-6-face ((,class (:foreground ,green))))
+ `(gnus-cite-7-face ((,class (:foreground ,red))))
+ `(gnus-cite-8-face ((,class (:foreground ,red))))
+ `(gnus-cite-9-face ((,class (:foreground ,red))))
+ `(gnus-group-news-1-empty-face ((,class (:foreground ,yellow))))
+ `(gnus-group-news-2-empty-face ((,class (:foreground ,green))))
+ `(gnus-group-news-3-empty-face ((,class (:foreground ,green))))
+ `(gnus-group-news-4-empty-face ((,class (:foreground ,blue))))
+ `(gnus-group-news-5-empty-face ((,class (:foreground ,blue))))
+ `(gnus-group-news-6-empty-face ((,class (:foreground ,solarized-bg))))
+ `(gnus-group-news-low-empty-face ((,class (:foreground ,solarized-bg))))
+ `(gnus-signature-face ((,class (:foreground ,yellow))))
+ `(gnus-x-face ((,class (:background ,solarized-fg :foreground ,solarized-bg))))
+
+ ;; helm (these probably needs tweaking)
+ `(helm-apt-deinstalled ((,class (:foreground ,solarized-comments))))
+ `(helm-apt-installed ((,class (:foreground ,green))))
+ `(helm-bookmark-directory ((,class (:inherit helm-ff-directory))))
+ `(helm-bookmark-file ((,class (:foreground ,solarized-fg))))
+ `(helm-bookmark-gnus ((,class (:foreground ,cyan))))
+ `(helm-bookmark-info ((,class (:foreground ,green))))
+ `(helm-bookmark-man ((,class (:foreground ,violet))))
+ `(helm-bookmark-w3m ((,class (:foreground ,yellow))))
+ `(helm-bookmarks-su ((,class (:foreground ,orange))))
+ `(helm-buffer-not-saved ((,class (:foreground ,orange))))
+ `(helm-buffer-saved-out ((,class (:foreground ,red :background ,solarized-bg
+ :inverse-video t))))
+ `(helm-buffer-size ((,class (:foreground ,solarized-comments))))
+ `(helm-candidate-number ((,class (:background ,solarized-hl :foreground ,solarized-emph
+ :bold t))))
+ `(helm-ff-directory ((,class (:background ,solarized-bg :foreground ,blue))))
+ `(helm-ff-executable ((,class (:foreground ,green))))
+ `(helm-ff-file ((,class (:background ,solarized-bg :foreground ,solarized-fg))))
+ `(helm-ff-invalid-symlink ((,class (:background ,solarized-bg :foreground ,orange
+ :slant italic))))
+ `(helm-ff-prefix ((,class (:background ,yellow :foreground ,solarized-bg))))
+ `(helm-ff-symlink ((,class (:foreground ,cyan))))
+ `(helm-grep-file ((,class (:foreground ,cyan :underline t))))
+ `(helm-grep-finish ((,class (:foreground ,green))))
+ `(helm-grep-lineno ((,class (:foreground ,orange))))
+ `(helm-grep-match ((,class (:inherit match))))
+ `(helm-grep-running ((,class (:foreground ,red))))
+ `(helm-header ((,class (:inherit header-line))))
+ `(helm-lisp-completion-info ((,class (:foreground ,solarized-fg))))
+ `(helm-lisp-show-completion ((,class (:foreground ,yellow :background ,solarized-hl
+ :bold t))))
+ `(helm-M-x-key ((,class (:foreground ,orange :underline t))))
+ `(helm-moccur-buffer ((,class (:foreground ,cyan :underline t))))
+ `(helm-match ((,class (:inherit match))))
+ `(helm-selection ((,class (:background ,solarized-hl :underline t))))
+ `(helm-selection-line ((,class (:background ,solarized-hl :foreground ,solarized-emph
+ :underline nil))))
+ `(helm-separator ((,class (:foreground ,red))))
+ `(helm-source-header ((,class (:background ,blue-lc :foreground ,solarized-bg
+ :underline nil))))
+ `(helm-time-zone-current ((,class (:foreground ,green))))
+ `(helm-time-zone-home ((,class (:foreground ,red))))
+ `(helm-visible-mark ((,class (:background ,solarized-bg :foreground ,magenta :bold t))))
+
+ ;; hi-lock-mode
+ `(hi-yellow ((,class (:foreground ,yellow-lc :background ,yellow-hc))))
+ `(hi-pink ((,class (:foreground ,magenta-lc :background ,magenta-hc))))
+ `(hi-green ((,class (:foreground ,green-lc :background ,green-hc))))
+ `(hi-blue ((,class (:foreground ,blue-lc :background ,blue-hc))))
+ `(hi-black-b ((,class (:foreground ,solarized-emph :background ,solarized-bg :weight bold))))
+ `(hi-blue-b ((,class (:foreground ,blue-lc :weight bold))))
+ `(hi-green-b ((,class (:foreground ,green-lc :weight bold))))
+ `(hi-red-b ((,class (:foreground ,red :weight bold))))
+ `(hi-black-hb ((,class (:foreground ,solarized-emph :background ,solarized-bg :weight bold))))
+
+ ;; highlight-changes
+ `(highlight-changes ((,class (:foreground ,orange))))
+ `(highlight-changes-delete ((,class (:foreground ,red :underline t))))
+
+ ;; hl-line-mode
+ `(hl-line ((,class (:background ,solarized-hl))))
+ `(hl-line-face ((,class (:background ,solarized-hl))))
+
+ ;; ido-mode
+ `(ido-first-match ((,class (:foreground ,green :weight bold))))
+ `(ido-only-match ((,class (:foreground ,solarized-bg :background ,green :weight bold))))
+ `(ido-subdir ((,class (:foreground ,blue))))
+ `(ido-incomplete-regexp ((,class (:foreground ,red :weight bold ))))
+ `(ido-indicator ((,class (:background ,red :foreground ,solarized-bg :width condensed))))
+ `(ido-virtual ((,class (:foreground ,cyan))))
+
+ `(jabber-activity-face ((,class (:weight bold :foreground ,red))))
+ `(jabber-activity-personal-face ((,class (:weight bold :foreground ,blue))))
+ `(jabber-chat-error ((,class (:weight bold :foreground ,red))))
+ `(jabber-chat-prompt-foreign ((,class (:weight bold :foreground ,red))))
+ `(jabber-chat-prompt-local ((,class (:weight bold :foreground ,blue))))
+ `(jabber-chat-prompt-system ((,class (:weight bold :foreground ,green))))
+ `(jabber-chat-text-foreign ((,class (:foreground ,base1))))
+ `(jabber-chat-text-local ((,class (:foreground ,base0))))
+ `(jabber-chat-rare-time-face ((,class (:underline t :foreground ,green))))
+ `(jabber-roster-user-away ((,class (:slant italic :foreground ,green))))
+ `(jabber-roster-user-chatty ((,class (:weight bold :foreground ,orange))))
+ `(jabber-roster-user-dnd ((,class (:slant italic :foreground ,red))))
+ `(jabber-roster-user-error ((,class (:weight light :slant italic :foreground ,red))))
+ `(jabber-roster-user-offline ((,class (:foreground ,base01))))
+ `(jabber-roster-user-online ((,class (:weight bold :foreground ,blue))))
+ `(jabber-roster-user-xa ((,class (:slant italic :foreground ,magenta))))
+
+ ;; js2-mode colors
+ `(js2-error ((,class (:foreground ,red))))
+ `(js2-external-variable ((,class (:foreground ,orange))))
+ `(js2-function-param ((,class (:foreground ,green))))
+ `(js2-instance-member ((,class (:foreground ,magenta))))
+ `(js2-jsdoc-html-tag-delimiter ((,class (:foreground ,cyan))))
+ `(js2-jsdoc-html-tag-name ((,class (:foreground ,orange))))
+ `(js2-jsdoc-tag ((,class (:foreground ,cyan))))
+ `(js2-jsdoc-type ((,class (:foreground ,blue))))
+ `(js2-jsdoc-value ((,class (:foreground ,violet))))
+ `(js2-magic-paren ((,class (:underline t))))
+ `(js2-private-function-call ((,class (:foreground ,yellow))))
+ `(js2-private-member ((,class (:foreground ,blue))))
+ `(js2-warning ((,class (:underline ,orange))))
+
+ ;; jedi
+ `(jedi:highlight-function-argument ((,class (:inherit bold))))
+
+ ;; linum-mode
+ `(linum ((,class (:foreground ,solarized-fg :background ,solarized-bg))))
+
+ ;; magit
+ `(magit-section-title ((,class (:foreground ,yellow :weight bold))))
+ `(magit-branch ((,class (:foreground ,orange :weight bold))))
+ `(magit-item-highlight ((,class (:background ,solarized-hl))))
+ `(magit-log-author ((,class (:foreground ,cyan))))
+ `(magit-log-graph ((,class (:foreground ,solarized-comments))))
+ `(magit-log-head-label-bisect-bad ((,class (:background ,red-hc :foreground ,red-lc :box 1))))
+ `(magit-log-head-label-bisect-good ((,class (:background ,green-hc :foreground ,green-lc
+ :box 1))))
+ `(magit-log-head-label-default ((,class (:background ,solarized-hl :box 1))))
+ `(magit-log-head-label-local ((,class (:background ,blue-lc :foreground ,blue-hc :box 1))))
+ `(magit-log-head-label-patches ((,class (:background ,red-lc :foreground ,red-hc :box 1))))
+ `(magit-log-head-label-remote ((,class (:background ,green-lc :foreground ,green-hc :box 1))))
+ `(magit-log-head-label-tags ((,class (:background ,yellow-lc :foreground ,yellow-hc :box 1))))
+ `(magit-log-sha1 ((,class (:foreground ,yellow))))
+
+ ;; message-mode
+ `(message-cited-text ((,class (:foreground ,solarized-comments))))
+ `(message-header-name ((,class (:foreground ,green))))
+ `(message-header-other ((,class (:foreground ,green))))
+ `(message-header-to ((,class (:foreground ,yellow :weight bold))))
+ `(message-header-cc ((,class (:foreground ,orange :weight bold))))
+ `(message-header-newsgroups ((,class (:foreground ,yellow :weight bold))))
+ `(message-header-subject ((,class (:foreground ,orange))))
+ `(message-header-xheader ((,class (:foreground ,cyan))))
+ `(message-mml ((,class (:foreground ,yellow :weight bold))))
+ `(message-separator ((,class (:foreground ,solarized-comments :slant italic))))
+
+ ;; mew
+ `(mew-face-header-subject ((,class (:foreground ,orange))))
+ `(mew-face-header-from ((,class (:foreground ,yellow))))
+ `(mew-face-header-date ((,class (:foreground ,green))))
+ `(mew-face-header-to ((,class (:foreground ,red))))
+ `(mew-face-header-key ((,class (:foreground ,green))))
+ `(mew-face-header-private ((,class (:foreground ,green))))
+ `(mew-face-header-important ((,class (:foreground ,blue))))
+ `(mew-face-header-marginal ((,class (:foreground ,solarized-fg :weight bold))))
+ `(mew-face-header-warning ((,class (:foreground ,red))))
+ `(mew-face-header-xmew ((,class (:foreground ,green))))
+ `(mew-face-header-xmew-bad ((,class (:foreground ,red))))
+ `(mew-face-body-url ((,class (:foreground ,orange))))
+ `(mew-face-body-comment ((,class (:foreground ,solarized-fg :slant italic))))
+ `(mew-face-body-cite1 ((,class (:foreground ,green))))
+ `(mew-face-body-cite2 ((,class (:foreground ,blue))))
+ `(mew-face-body-cite3 ((,class (:foreground ,orange))))
+ `(mew-face-body-cite4 ((,class (:foreground ,yellow))))
+ `(mew-face-body-cite5 ((,class (:foreground ,red))))
+ `(mew-face-mark-review ((,class (:foreground ,blue))))
+ `(mew-face-mark-escape ((,class (:foreground ,green))))
+ `(mew-face-mark-delete ((,class (:foreground ,red))))
+ `(mew-face-mark-unlink ((,class (:foreground ,yellow))))
+ `(mew-face-mark-refile ((,class (:foreground ,green))))
+ `(mew-face-mark-unread ((,class (:foreground ,red))))
+ `(mew-face-eof-message ((,class (:foreground ,green))))
+ `(mew-face-eof-part ((,class (:foreground ,yellow))))
+
+ ;; mingus
+ `(mingus-directory-face ((,class (:foreground ,blue))))
+ `(mingus-pausing-face ((,class (:foreground ,magenta))))
+ `(mingus-playing-face ((,class (:foreground ,cyan))))
+ `(mingus-playlist-face ((,class (:foreground ,cyan ))))
+ `(mingus-song-file-face ((,class (:foreground ,yellow))))
+ `(mingus-stopped-face ((,class (:foreground ,red))))
+
+ ;; moccur
+ `(moccur-current-line-face ((,class (:underline t))))
+ `(moccur-edit-done-face ((,class
+ (:foreground ,solarized-comments
+ :background ,solarized-bg
+ :slant italic))))
+ `(moccur-edit-face
+ ((,class (:background ,yellow :foreground ,solarized-bg))))
+ `(moccur-edit-file-face ((,class (:background ,solarized-hl))))
+ `(moccur-edit-reject-face ((,class (:foreground ,red))))
+ `(moccur-face ((,class (:background ,solarized-hl :foreground ,solarized-emph
+ :weight bold))))
+ `(search-buffers-face ((,class (:background ,solarized-hl :foreground ,solarized-emph
+ :weight bold))))
+ `(search-buffers-header-face ((,class (:background ,solarized-hl :foreground ,yellow
+ :weight bold))))
+
+ ;; mu4e
+ `(mu4e-cited-1-face ((,class (:foreground ,green :slant italic :weight normal))))
+ `(mu4e-cited-2-face ((,class (:foreground ,blue :slant italic :weight normal))))
+ `(mu4e-cited-3-face ((,class (:foreground ,orange :slant italic :weight normal))))
+ `(mu4e-cited-4-face ((,class (:foreground ,yellow :slant italic :weight normal))))
+ `(mu4e-cited-5-face ((,class (:foreground ,cyan :slant italic :weight normal))))
+ `(mu4e-cited-6-face ((,class (:foreground ,green :slant italic :weight normal))))
+ `(mu4e-cited-7-face ((,class (:foreground ,blue :slant italic :weight normal))))
+ `(mu4e-flagged-face ((,class (:foreground ,magenta :weight bold))))
+ `(mu4e-view-url-number-face ((,class (:foreground ,orange :weight bold))))
+ `(mu4e-warning-face ((,class (:foreground ,red :slant normal :weight bold))))
+
+ ;; mumamo
+ `(mumamo-background-chunk-submode1 ((,class (:background ,solarized-hl))))
+
+ ;; nav
+ `(nav-face-heading ((,class (:foreground ,yellow))))
+ `(nav-face-button-num ((,class (:foreground ,cyan))))
+ `(nav-face-dir ((,class (:foreground ,green))))
+ `(nav-face-hdir ((,class (:foreground ,red))))
+ `(nav-face-file ((,class (:foreground ,solarized-fg))))
+ `(nav-face-hfile ((,class (:foreground ,red))))
+
+ ;; nav-flash
+ `(nav-flash-face ((,class (:background ,solarized-hl))))
+
+ ;; org-mode
+ `(org-agenda-structure
+ ((,class (:inherit font-lock-comment-face :foreground ,magenta :inverse-video t))))
+ `(org-agenda-date
+ ((,class (:foreground ,solarized-fg :background ,solarized-hl :weight bold
+ :box (:line-width 4 :color ,solarized-hl) ))) t)
+ `(org-agenda-date-weekend ((,class (:inherit org-agenda-date :slant italic))) t)
+ `(org-agenda-date-today
+ ((,class (:inherit org-agenda-date :slant italic underline: t))) t)
+ `(org-agenda-done ((,class (:foreground ,green))) t)
+ `(org-archived ((,class (:foreground ,solarized-comments :weight normal))))
+ `(org-block ((,class (:foreground ,solarized-comments))))
+ `(org-block-begin-line ((,class (:foreground ,solarized-comments :slant italic))))
+ `(org-checkbox ((,class (:background ,solarized-bg :foreground ,solarized-fg
+ :box (:line-width 1 :style released-button)))))
+ `(org-code ((,class (:foreground ,solarized-comments))))
+ `(org-date ((,class (:foreground ,blue :underline t))))
+ `(org-done ((,class (:weight bold :foreground ,green))))
+ `(org-ellipsis ((,class (:foreground ,solarized-comments))))
+ `(org-formula ((,class (:foreground ,yellow))))
+ `(org-headline-done ((,class (:foreground ,green))))
+ `(org-hide ((,class (:foreground ,solarized-bg))))
+ `(org-level-1 ((,class (:foreground ,orange))))
+ `(org-level-2 ((,class (:foreground ,green))))
+ `(org-level-3 ((,class (:foreground ,blue))))
+ `(org-level-4 ((,class (:foreground ,yellow))))
+ `(org-level-5 ((,class (:foreground ,cyan))))
+ `(org-level-6 ((,class (:foreground ,green))))
+ `(org-level-7 ((,class (:foreground ,red))))
+ `(org-level-8 ((,class (:foreground ,blue))))
+ `(org-link ((,class (:foreground ,yellow :underline t))))
+ `(org-sexp-date ((,class (:foreground ,violet))))
+ `(org-scheduled ((,class (:foreground ,green))))
+ `(org-scheduled-previously ((,class (:foreground ,yellow))))
+ `(org-scheduled-today ((,class (:foreground ,blue :weight normal))))
+ `(org-special-keyword ((,class (:foreground ,solarized-comments :weight bold))))
+ `(org-table ((,class (:foreground ,green))))
+ `(org-tag ((,class (:weight bold))))
+ `(org-time-grid ((,class (:foreground ,cyan))))
+ `(org-todo ((,class (:foreground ,red :weight bold))))
+ `(org-upcoming-deadline ((,class (:foreground ,yellow :weight normal :underline nil))))
+ `(org-warning ((,class (:foreground ,orange :weight normal :underline nil))))
+ ;; org-habit (clear=blue, ready=green, alert=yellow, overdue=red. future=lower contrast)
+ `(org-habit-clear-face ((,class (:background ,blue-lc :foreground ,blue-hc))))
+ `(org-habit-clear-future-face ((,class (:background ,blue-lc))))
+ `(org-habit-ready-face ((,class (:background ,green-lc :foreground ,green))))
+ `(org-habit-ready-future-face ((,class (:background ,green-lc))))
+ `(org-habit-alert-face ((,class (:background ,yellow :foreground ,yellow-lc))))
+ `(org-habit-alert-future-face ((,class (:background ,yellow-lc))))
+ `(org-habit-overdue-face ((,class (:background ,red :foreground ,red-lc))))
+ `(org-habit-overdue-future-face ((,class (:background ,red-lc))))
+ ;; latest additions
+ `(org-agenda-dimmed-todo-face ((,class (:foreground ,solarized-comments))))
+ `(org-agenda-restriction-lock ((,class (:background ,yellow))))
+ `(org-clock-overlay ((,class (:background ,yellow))))
+ `(org-column ((,class (:background ,solarized-hl :strike-through nil
+ :underline nil :slant normal :weight normal))))
+ `(org-column-title ((,class (:background ,solarized-hl :underline t :weight bold))))
+ `(org-date-selected ((,class (:foreground ,red :inverse-video t))))
+ `(org-document-info ((,class (:foreground ,solarized-fg))))
+ `(org-document-title ((,class (:foreground ,solarized-emph :weight bold :height 1.44))))
+ `(org-drawer ((,class (:foreground ,cyan))))
+ `(org-footnote ((,class (:foreground ,magenta :underline t))))
+ `(org-latex-and-export-specials ((,class (:foreground ,orange))))
+ `(org-mode-line-clock-overrun ((,class (:inherit modeline :background ,red))))
+
+ ;; outline
+ `(outline-8 ((,class (:inherit default))))
+ `(outline-7 ((,class (:inherit outline-8 :height 1.0))))
+ `(outline-6 ((,class (:inherit outline-7 :height 1.0))))
+ `(outline-5 ((,class (:inherit outline-6 :height 1.0))))
+ `(outline-4 ((,class (:inherit outline-5 :height 1.0))))
+ `(outline-3 ((,class (:inherit outline-4 :height 1.0))))
+ `(outline-2 ((,class (:inherit outline-3 :height 1.0))))
+ `(outline-1 ((,class (:inherit outline-2 :height 1.0))))
+
+ ;; pretty-mode
+ `(pretty-mode-symbol-face ((,class (:foreground ,green))))
+
+ ;; popup
+ `(popup-face ((,class (:background ,solarized-hl :foreground ,solarized-fg))))
+ `(popup-isearch-match ((,class (:background ,yellow :foreground ,solarized-bg))))
+ `(popup-menu-face ((,class (:background ,solarized-hl :foreground ,solarized-fg))))
+ `(popup-menu-mouse-face ((,class (:background ,blue :foreground ,solarized-fg))))
+ `(popup-menu-selection-face ((,class (:background ,magenta :foreground ,solarized-bg))))
+ `(popup-scroll-bar-background-face ((,class (:background ,solarized-comments))))
+ `(popup-scroll-bar-foreground-face ((,class (:background ,solarized-emph))))
+ `(popup-tip-face ((,class (:background ,solarized-hl :foreground ,solarized-fg))))
+
+ ;; rainbow-delimiters
+ `(rainbow-delimiters-depth-1-face ((,class (:foreground ,cyan))))
+ `(rainbow-delimiters-depth-2-face ((,class (:foreground ,yellow))))
+ `(rainbow-delimiters-depth-3-face ((,class (:foreground ,blue))))
+ `(rainbow-delimiters-depth-4-face ((,class (:foreground ,orange))))
+ `(rainbow-delimiters-depth-5-face ((,class (:foreground ,green))))
+ `(rainbow-delimiters-depth-6-face ((,class (:foreground ,yellow))))
+ `(rainbow-delimiters-depth-7-face ((,class (:foreground ,blue))))
+ `(rainbow-delimiters-depth-8-face ((,class (:foreground ,orange))))
+ `(rainbow-delimiters-depth-9-face ((,class (:foreground ,green))))
+ `(rainbow-delimiters-depth-10-face ((,class (:foreground ,yellow))))
+ `(rainbow-delimiters-depth-11-face ((,class (:foreground ,blue))))
+ `(rainbow-delimiters-depth-12-face ((,class (:foreground ,orange))))
+ `(rainbow-delimiters-unmatched-face
+ ((,class (:foreground ,solarized-fg :background ,solarized-bg :inverse-video t))))
+
+ ;; rst-mode
+ `(rst-level-1-face ((,class (:background ,yellow :foreground ,solarized-bg))))
+ `(rst-level-2-face ((,class (:background ,cyan :foreground ,solarized-bg))))
+ `(rst-level-3-face ((,class (:background ,blue :foreground ,solarized-bg))))
+ `(rst-level-4-face ((,class (:background ,violet :foreground ,solarized-bg))))
+ `(rst-level-5-face ((,class (:background ,magenta :foreground ,solarized-bg))))
+ `(rst-level-6-face ((,class (:background ,red :foreground ,solarized-bg))))
+
+ ;; rpm-mode
+ `(rpm-spec-dir-face ((,class (:foreground ,green))))
+ `(rpm-spec-doc-face ((,class (:foreground ,green))))
+ `(rpm-spec-ghost-face ((,class (:foreground ,red))))
+ `(rpm-spec-macro-face ((,class (:foreground ,yellow))))
+ `(rpm-spec-obsolete-tag-face ((,class (:foreground ,red))))
+ `(rpm-spec-package-face ((,class (:foreground ,red))))
+ `(rpm-spec-section-face ((,class (:foreground ,yellow))))
+ `(rpm-spec-tag-face ((,class (:foreground ,blue))))
+ `(rpm-spec-var-face ((,class (:foreground ,red))))
+
+ ;; sh-mode
+ `(sh-quoted-exec ((,class (:foreground ,violet :weight bold))))
+ `(sh-escaped-newline ((,class (:foreground ,yellow :weight bold))))
+ `(sh-heredoc ((,class (:foreground ,yellow :weight bold))))
+
+ ;; smartparens
+ `(sp-pair-overlay-face ((,class (:background ,solarized-hl))))
+ `(sp-wrap-overlay-face ((,class (:background ,solarized-hl))))
+ `(sp-wrap-tag-overlay-face ((,class (:background ,solarized-hl))))
+
+ ;; show-paren
+ `(show-paren-match
+ ((,class (:foreground ,cyan :background ,solarized-bg :weight normal :inverse-video t))))
+ `(show-paren-mismatch
+ ((,class (:foreground ,red :background ,solarized-bg :weight normal :inverse-video t))))
+
+ ;; mic-paren
+ `(paren-face-match
+ ((,class (:foreground ,cyan :background ,solarized-bg :weight normal :inverse-video t))))
+ `(paren-face-mismatch
+ ((,class (:foreground ,red :background ,solarized-bg :weight normal :inverse-video t))))
+ `(paren-face-no-match
+ ((,class (:foreground ,red :background ,solarized-bg :weight normal :inverse-video t))))
+
+ ;; SLIME
+ `(slime-repl-inputed-output-face ((,class (:foreground ,red))))
+
+ ;; speedbar
+ `(speedbar-button-face ((,class (:inherit variable-pitch :foreground ,solarized-comments))))
+ `(speedbar-directory-face ((,class (:inherit variable-pitch :foreground ,blue))))
+ `(speedbar-file-face ((,class (:inherit variable-pitch :foreground ,solarized-fg))))
+ `(speedbar-highlight-face ((,class (:inherit variable-pitch :background ,solarized-hl))))
+ `(speedbar-selected-face ((,class (:inherit variable-pitch :foreground ,yellow :underline t))))
+ `(speedbar-separator-face ((,class (:inherit variable-pitch
+ :background ,blue :foreground ,solarized-bg
+ :overline ,cyan-lc))))
+ `(speedbar-tag-face ((,class (:inherit variable-pitch :foreground ,green))))
+
+ ;; sunrise commander headings
+ `(sr-active-path-face ((,class (:background ,blue :foreground ,solarized-bg
+ :height 100 :weight bold))))
+ `(sr-editing-path-face ((,class (:background ,yellow :foreground ,solarized-bg
+ :weight bold :height 100))))
+ `(sr-highlight-path-face ((,class (:background ,green :foreground ,solarized-bg
+ :weight bold :height 100))))
+ `(sr-passive-path-face ((,class (:background ,solarized-comments :foreground ,solarized-bg
+ :weight bold :height 100))))
+ ;; sunrise commander marked
+ `(sr-marked-dir-face ((,class (:inherit dired-marked))))
+ `(sr-marked-file-face ((,class (:inherit dired-marked))))
+ `(sr-alt-marked-dir-face ((,class (:background ,magenta :foreground ,solarized-bg
+ :weight bold))))
+ `(sr-alt-marked-file-face ((,class (:background ,magenta :foreground ,solarized-bg
+ :weight bold))))
+ ;; sunrise commander fstat
+ `(sr-directory-face ((,class (:inherit dired-directory :weight normal))))
+ `(sr-symlink-directory-face ((,class (:inherit dired-directory :slant italic :weight normal))))
+ `(sr-symlink-face ((,class (:inherit dired-symlink :slant italic :weight normal))))
+ `(sr-broken-link-face ((,class (:inherit dired-warning :slant italic :weight normal))))
+ ;; sunrise commander file types
+ `(sr-compressed-face ((,class (:foreground ,solarized-fg))))
+ `(sr-encrypted-face ((,class (:foreground ,solarized-fg))))
+ `(sr-log-face ((,class (:foreground ,solarized-fg))))
+ `(sr-packaged-face ((,class (:foreground ,solarized-fg))))
+ `(sr-html-face ((,class (:foreground ,solarized-fg))))
+ `(sr-xml-face ((,class (:foreground ,solarized-fg))))
+ ;; sunrise commander misc
+ `(sr-clex-hotchar-face ((,class (:background ,red :foreground ,solarized-bg :weight bold))))
+
+ ;; table
+ `(table-cell ((,class (:foreground ,solarized-fg :background ,solarized-hl))))
+
+ ;; term
+ `(term-color-black ((t (:foreground ,base03
+ :background ,base02))))
+ `(term-color-red ((t (:foreground ,red
+ :background ,red-d))))
+ `(term-color-green ((t (:foreground ,green
+ :background ,green-d))))
+ `(term-color-yellow ((t (:foreground ,yellow
+ :background ,yellow-d))))
+ `(term-color-blue ((t (:foreground ,blue
+ :background ,blue-d))))
+ `(term-color-magenta ((t (:foreground ,magenta
+ :background ,magenta-d))))
+ `(term-color-cyan ((t (:foreground ,cyan
+ :background ,cyan-d))))
+ `(term-color-white ((t (:foreground ,base00
+ :background ,base0))))
+ '(term-default-fg-color ((t (:inherit term-color-white))))
+ '(term-default-bg-color ((t (:inherit term-color-black))))
+
+
+ ;; tooltip. (NOTE: This setting has no effect on the os widgets for me
+ ;; zencoding uses this)
+ `(tooltip ((,class (:background ,yellow-lc :foreground ,yellow-hc
+ :inherit variable-pitch))))
+
+ ;; tuareg
+ `(tuareg-font-lock-governing-face ((,class (:foreground ,magenta :weight bold))))
+ `(tuareg-font-lock-multistage-face ((,class (:foreground ,blue :background ,solarized-hl :weight bold))))
+ `(tuareg-font-lock-operator-face ((,class (:foreground ,solarized-emph))))
+ `(tuareg-font-lock-error-face ((,class (:foreground ,yellow :background ,red :weight bold))))
+ `(tuareg-font-lock-interactive-output-face ((,class (:foreground ,cyan))))
+ `(tuareg-font-lock-interactive-error-face ((,class (:foreground ,red))))
+
+ ;; undo-tree
+ `(undo-tree-visualizer-default-face
+ ((,class (:foreground ,solarized-comments :background ,solarized-bg))))
+ `(undo-tree-visualizer-unmodified-face ((,class (:foreground ,green))))
+ `(undo-tree-visualizer-current-face ((,class (:foreground ,blue :inverse-video t))))
+ `(undo-tree-visualizer-active-branch-face
+ ((,class (:foreground ,solarized-emph :background ,solarized-bg :weight bold))))
+ `(undo-tree-visualizer-register-face ((,class (:foreground ,yellow))))
+
+ ;; volatile highlights
+ `(vhl/default-face ((,class (:background ,green-lc :foreground ,green-hc))))
+
+ ;; w3m
+ `(w3m-anchor ((,class (:inherit link))))
+ `(w3m-arrived-anchor ((,class (:inherit link-visited))))
+ `(w3m-form ((,class (:background ,solarized-bg :foreground ,solarized-fg))))
+ `(w3m-header-line-location-title ((,class (:background ,solarized-hl :foreground ,yellow))))
+ `(w3m-header-line-location-content ((,class (:background ,solarized-hl :foreground ,solarized-fg))))
+ `(w3m-bold ((,class (:foreground ,solarized-emph :weight bold))))
+ `(w3m-image-anchor ((,class (:background ,solarized-bg :foreground ,cyan :inherit link))))
+ `(w3m-image ((,class (:background ,solarized-bg :foreground ,cyan))))
+ `(w3m-lnum-minibuffer-prompt ((,class (:foreground ,solarized-emph))))
+ `(w3m-lnum-match ((,class (:background ,solarized-hl))))
+ `(w3m-lnum ((,class (:underline nil :bold nil :foreground ,red))))
+ `(w3m-session-select ((,class (:foreground ,solarized-fg))))
+ `(w3m-session-selected ((,class (:foreground ,solarized-emph :bold t :underline t))))
+ `(w3m-tab-background ((,class (:background ,solarized-bg :foreground ,solarized-fg))))
+ `(w3m-tab-selected-background ((,class (:background ,solarized-bg :foreground ,solarized-fg))))
+ `(w3m-tab-mouse ((,class (:background ,solarized-hl :foreground ,yellow))))
+ `(w3m-tab-selected ((,class (:background ,solarized-hl :foreground ,solarized-emph :bold t))))
+ `(w3m-tab-unselected ((,class (:background ,solarized-hl :foreground ,solarized-fg))))
+ `(w3m-tab-selected-retrieving ((,class (:background ,solarized-hl :foreground ,red))))
+ `(w3m-tab-unselected-retrieving ((,class (:background ,solarized-hl :foreground ,orange))))
+ `(w3m-tab-unselected-unseen ((,class (:background ,solarized-hl :foreground ,violet))))
+
+ ;; web-mode
+ `(web-mode-builtin-face ((,class (:foreground ,red))))
+ `(web-mode-comment-face ((,class (:foreground ,solarized-comments))))
+ `(web-mode-constant-face ((,class (:foreground ,blue :weight bold))))
+ `(web-mode-css-at-rule-face ((,class (:foreground ,violet :slant italic))))
+ `(web-mode-css-prop-face ((,class (:foreground ,violet))))
+ `(web-mode-css-pseudo-class-face ((,class (:foreground ,green :slant italic))))
+ `(web-mode-css-rule-face ((,class (:foreground ,blue))))
+ `(web-mode-doctype-face ((,class (:foreground ,solarized-comments
+ :slant italic :weight bold))))
+ `(web-mode-folded-face ((,class (:underline t))))
+ `(web-mode-function-name-face ((,class (:foreground ,blue))))
+ `(web-mode-html-attr-name-face ((,class (:foreground ,blue :slant normal))))
+ `(web-mode-html-attr-value-face ((,class (:foreground ,cyan :slant italic))))
+ `(web-mode-html-tag-face ((,class (:foreground ,green))))
+ `(web-mode-keyword-face ((,class (:foreground ,yellow :weight bold))))
+ `(web-mode-preprocessor-face ((,class (:foreground ,yellow :slant italic :weight bold))))
+ `(web-mode-string-face ((,class (:foreground ,cyan))))
+ `(web-mode-type-face ((,class (:foreground ,yellow))))
+ `(web-mode-variable-name-face ((,class (:foreground ,blue))))
+
+ ;; whitespace-mode
+ `(whitespace-space ((,class (:background ,solarized-bg :foreground ,yellow-lc
+ :inverse-video t))))
+ `(whitespace-hspace ((,class (:background ,solarized-bg :foreground ,red-lc
+ :inverse-video t))))
+ `(whitespace-tab ((,class (:background ,solarized-bg :foreground ,orange-lc
+ :inverse-video t))))
+ `(whitespace-newline ((,class (:foreground ,solarized-comments))))
+ `(whitespace-trailing ((,class (:foreground ,blue-lc :background ,solarized-bg
+ :inverse-video t))))
+ ; removing inverse video on this
+ `(whitespace-line ((,class (:background ,solarized-bg :foreground ,magenta
+ :inverse-video nil))))
+ `(whitespace-space-before-tab ((,class (:background ,solarized-bg :foreground ,green-lc
+ :inverse-video t))))
+ `(whitespace-indentation ((,class (:background ,solarized-bg :foreground ,magenta-lc
+ :inverse-video t))))
+ `(whitespace-empty ((,class (:background ,solarized-fg :foreground ,red-lc :inverse-video t))))
+ `(whitespace-space-after-tab ((,class (:background ,solarized-bg :foreground ,violet-lc
+ :inverse-video t))))
+
+ ;; wanderlust
+ `(wl-highlight-folder-few-face ((,class (:foreground ,red))))
+ `(wl-highlight-folder-many-face ((,class (:foreground ,red))))
+ `(wl-highlight-folder-path-face ((,class (:foreground ,orange))))
+ `(wl-highlight-folder-unread-face ((,class (:foreground ,blue))))
+ `(wl-highlight-folder-zero-face ((,class (:foreground ,solarized-fg))))
+ `(wl-highlight-folder-unknown-face ((,class (:foreground ,blue))))
+ `(wl-highlight-message-citation-header ((,class (:foreground ,red))))
+ `(wl-highlight-message-cited-text-1 ((,class (:foreground ,red))))
+ `(wl-highlight-message-cited-text-2 ((,class (:foreground ,green))))
+ `(wl-highlight-message-cited-text-3 ((,class (:foreground ,blue))))
+ `(wl-highlight-message-cited-text-4 ((,class (:foreground ,blue))))
+ `(wl-highlight-message-header-contents-face ((,class (:foreground ,green))))
+ `(wl-highlight-message-headers-face ((,class (:foreground ,red))))
+ `(wl-highlight-message-important-header-contents ((,class (:foreground ,green))))
+ `(wl-highlight-message-header-contents ((,class (:foreground ,green))))
+ `(wl-highlight-message-important-header-contents2 ((,class (:foreground ,green))))
+ `(wl-highlight-message-signature ((,class (:foreground ,green))))
+ `(wl-highlight-message-unimportant-header-contents ((,class (:foreground ,solarized-fg))))
+ `(wl-highlight-summary-answered-face ((,class (:foreground ,blue))))
+ `(wl-highlight-summary-disposed-face ((,class (:foreground ,solarized-fg
+ :slant italic))))
+ `(wl-highlight-summary-new-face ((,class (:foreground ,blue))))
+ `(wl-highlight-summary-normal-face ((,class (:foreground ,solarized-fg))))
+ `(wl-highlight-summary-thread-top-face ((,class (:foreground ,yellow))))
+ `(wl-highlight-thread-indent-face ((,class (:foreground ,magenta))))
+ `(wl-highlight-summary-refiled-face ((,class (:foreground ,solarized-fg))))
+ `(wl-highlight-summary-displaying-face ((,class (:underline t :weight bold))))
+
+ ;; which-func-mode
+ `(which-func ((,class (:foreground ,green))))
+
+ ;; window-number-mode
+ `(window-number-face ((,class (:foreground ,green))))
+
+ ;; yascroll
+ `(yascroll:thumb-text-area
+ ((,class (:foreground ,solarized-comments :background ,solarized-comments))))
+ `(yascroll:thumb-fringe
+ ((,class (:foreground ,solarized-comments :background ,solarized-comments))))
+
+ ;; zencoding
+ `(zencoding-preview-input ((,class (:background ,solarized-hl :box ,solarized-emph)))))
+
+
+ (custom-theme-set-variables
+ theme-name
+ `(ansi-color-names-vector [,solarized-bg ,red ,green ,yellow
+ ,blue ,magenta ,cyan ,solarized-fg])
+ ;; fill-column-indicator
+ `(fci-rule-color ,solarized-hl)
+
+ ;; highlight-changes
+ `(highlight-changes-colors '(,magenta ,violet))
+
+ ;; highlight-tail
+ `(highlight-tail-colors
+ '((,solarized-hl . 0)(,green-lc . 20)(,cyan-lc . 30)(,blue-lc . 50)
+ (,yellow-lc . 60)(,orange-lc . 70)(,magenta-lc . 85)(,solarized-hl . 100)))
+
+ `(vc-annotate-color-map
+ '((20 . ,red)
+ (40 . "#CF4F1F")
+ (60 . "#C26C0F")
+ (80 . ,yellow)
+ (100 . "#AB8C00")
+ (120 . "#A18F00")
+ (140 . "#989200")
+ (160 . "#8E9500")
+ (180 . ,green)
+ (200 . "#729A1E")
+ (220 . "#609C3C")
+ (240 . "#4E9D5B")
+ (260 . "#3C9F79")
+ (280 . ,cyan)
+ (300 . "#299BA6")
+ (320 . "#2896B5")
+ (340 . "#2790C3")
+ (360 . ,blue)))
+ `(vc-annotate-very-old-color nil)
+ `(vc-annotate-background nil))
+
+ ;; call chained theme function
+ (when childtheme (funcall childtheme))))
+
+;;;###autoload
+(when (and (boundp 'custom-theme-load-path) load-file-name)
+ (add-to-list 'custom-theme-load-path
+ (file-name-as-directory (file-name-directory load-file-name))))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+(provide 'solarized)
+
+;;; solarized.el ends here
--- /dev/null
+;;; sql-complete.el --- provide completion for tables and columns
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; Author: Alex Schroeder <alex@gnu.org>
+;; Maintainer: Alex Schroeder <alex@gnu.org>
+;; Version: 0.0.1
+;; Keywords: comm languages processes
+
+;; This file is NOT part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Trying to provide a framework for completion that will eventually
+;; make it into sql.el.
+
+
+
+;;; Code:
+
+(require 'sql)
+
+(defcustom sql-oracle-data-dictionary
+ "select '(\"'||table_name||'\" \"'||column_name||'\")'
+ from user_tab_columns
+ order by table_name;"
+ "SQL Statement to determine all tables and columns."
+ :group 'SQL
+ :type 'string)
+
+;; backends
+
+(defun sql-data-dictionary (statement)
+ "Return table and columns from the Oracle Data Dictionary using SQL.
+STATEMENT must be a SQL statement that returns the data dictionary
+one column per line. Each line must look like this:
+
+\(\"table-name\" \"column-name\")
+
+Any lines not looking like this will be skipped to allow for column
+headers and other fancy markup.
+
+This currently depends very much on a good `comint-prompt-regexp'."
+ (when (null sql-buffer)
+ (error "No SQLi buffer available"))
+ (save-excursion
+ (set-buffer sql-buffer)
+ (let (result end)
+ (comint-simple-send sql-buffer statement)
+ (comint-previous-prompt 1)
+ (while (= 0 (forward-line 1))
+ (message "%S" (point))
+ (when (looking-at "^(.*)$")
+ (let* ((entry (car (read-from-string (match-string 0))))
+ (table (car entry))
+ (column (cadr entry))
+ (item (cdr (assoc table result))))
+ (if item
+ (nconc item (list column))
+ (setq result (append (list entry) result))))))
+ result)))
+
+;; framework
+
+(defvar sql-data-dictionary nil
+ "The data dictionary to use for completion.
+Each element of the list has the form
+\(TABLE COLUMN1 COLUMN2 ...)")
+
+(defun sql-oracle-data-dictionary ()
+ (interactive)
+ ;; FIXME No cleanup
+ (setq sql-data-dictionary
+ (sql-data-dictionary sql-oracle-data-dictionary)))
+
+(defun sql-complete ()
+ (interactive)
+ (let ((completions (apply 'append sql-data-dictionary)))
+ (comint-dynamic-simple-complete
+ (comint-word "A-Za-z_")
+ completions)))
+
+(defun sql-complete-table ()
+ (interactive)
+ (let ((completions (mapcar 'car sql-data-dictionary)))
+ (comint-dynamic-simple-complete
+ (comint-word "A-Za-z_")
+ completions)))
+
+;;; sql-complete.el ends here
--- /dev/null
+;;; sunrise-commander.el --- two-pane file manager for Emacs based on Dired and inspired by MC -*- lexical-binding: t -*-
+
+;; Copyright (C) 2007-2012 José Alfredo Romero Latouche.
+
+;; Author: José Alfredo Romero L. <escherdragon@gmail.com>
+;; Štěpán Němec <stepnem@gmail.com>
+;; Maintainer: José Alfredo Romero L. <escherdragon@gmail.com>
+;; Created: 24 Sep 2007
+;; Version: 6
+;; RCS Version: $Rev: 434 $
+;; Keywords: files, dired, midnight commander, norton, orthodox
+;; URL: http://www.emacswiki.org/emacs/sunrise-commander.el
+;; Compatibility: GNU Emacs 22+
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free Software
+;; Foundation, either version 3 of the License, or (at your option) any later
+;; version.
+;;
+;; This program is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more de-
+;; tails.
+
+;; You should have received a copy of the GNU General Public License along with
+;; this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The Sunrise Commmander is an double-pane file manager for Emacs. It's built
+;; atop of Dired and takes advantage of all its power, but also provides many
+;; handy features of its own:
+
+;; * Sunrise is implemented as a derived major mode confined inside the pane
+;; buffers, so its buffers and Dired ones can live together without easymenu or
+;; viper to avoid key binding collisions.
+
+;; * It automatically closes unused buffers and tries to never keep open more
+;; than the one or two used to display the panes, though this behavior may be
+;; disabled if desired.
+
+;; * Each pane has its own history stack: press M-y / M-u for moving backwards /
+;; forwards in the history of directories.
+
+;; * Press M-t to swap (transpose) the panes.
+
+;; * Press C-= for "smart" file comparison using `ediff'. It compares together
+;; the first two files marked on each pane or, if no files have been marked, it
+;; assumes that the second pane contains a file with the same name as the
+;; selected one and tries to compare these two. You can also mark whole lists of
+;; files to be compared and then just press C-= for comparing the next pair.
+
+;; * Press = for fast "smart" file comparison -- like above, but using regular
+;; diff.
+
+;; * Press C-M-= for directory comparison (by date / size / contents of files).
+
+;; * Press C-c C-s to change the layout of the panes (horizontal/vertical/top)
+
+;; * Press C-c / to interactively refine the contents of the current pane using
+;; fuzzy (a.k.a. flex) matching, then:
+;; - press Delete or Backspace to revert the buffer to its previous state
+;; - press Return, C-n or C-p to exit and accept the current narrowed state
+;; - press Esc or C-g to abort the operation and revert the buffer
+;; - use ! to prefix characters that should NOT appear after a given position
+;; Once narrowed and accepted, you can restore the original contents of the pane
+;; by pressing g (revert-buffer).
+
+;; * Sticky search: press C-c s to launch an interactive search that will remain
+;; active from directory to directory, until you hit a regular file or press C-g
+
+;; * Press C-x C-q to put the current pane in Editable Dired mode (allows to
+;; edit the pane as if it were a regular file -- press C-c C-c to commit your
+;; changes to the filesystem, or C-c C-k to abort).
+
+;; * Press y to recursively calculate the total size (in bytes) of all files and
+;; directories currently selected/marked in the active pane.
+
+;; * Sunrise VIRTUAL mode integrates dired-virtual mode to Sunrise, allowing to
+;; capture find and locate results in regular files and to use them later as if
+;; they were directories with all Dired and Sunrise operations at your
+;; fingertips.
+;; The results of the following operations are displayed in VIRTUAL mode:
+;; - find-name-dired (press C-c C-n),
+;; - find-grep-dired (press C-c C-g),
+;; - find-dired (press C-c C-f),
+;; - locate (press C-c C-l),
+;; - list all recently visited files (press C-c C-r -- requires recentf),
+;; - list all directories in active pane's history ring (press C-c C-d).
+
+;; * Supports AVFS (http://avf.sourceforge.net/) for transparent navigation
+;; inside compressed archives (*.zip, *.tgz, *.tar.bz2, *.deb, etc. etc.)
+;; You need to have AVFS with coda or fuse installed and running on your system
+;; for this to work, though.
+
+;; * Opening terminals directly from Sunrise:
+;; - Press C-c C-t to inconditionally open a new terminal into the currently
+;; selected directory in the active pane.
+;; - Use C-c t to switch to the last opened terminal, or (when already inside
+;; a terminal) to cycle through all open terminals.
+;; - Press C-c T to switch to the last opened terminal and change directory
+;; to the one in the current directory.
+;; - Press C-c M-t to be prompted for a program name, and then open a new
+;; terminal using that program into the currently selected directory
+;; (eshell is a valid value; if no program can be found with the given name
+;; then the value of `sr-terminal-program' is used instead).
+
+;; * Terminal integration and Command line expansion: integrates tightly with
+;; `eshell' and `term-mode' to allow interaction between terminal emulators in
+;; line mode (C-c C-j) and the panes: the most important navigation commands
+;; (up, down, mark, unmark, go to parent dir) can be executed on the active pane
+;; directly from the terminal by pressing the usual keys with Meta: <M-up>,
+;; <M-down>, etc. Additionally, the following substitutions are automagically
+;; performed in `eshell' and `term-line-mode':
+;; %f - expands to the currently selected file in the left pane
+;; %F - expands to the currently selected file in the right pane
+;; %m - expands to the list of paths of all marked files in the left pane
+;; %M - expands to the list of paths of all marked files in the right pane
+;; %n - expands to the list of names of all marked files in the left pane
+;; %N - expands to the list of names of all marked files in the right pane
+;; %d - expands to the current directory in the left pane
+;; %D - expands to the current directory in the right pane
+;; %a - expands to the list of paths of all marked files in the active pane
+;; %A - expands to the current directory in the active pane
+;; %p - expands to the list of paths of all marked files in the passive pane
+;; %P - expands to the current directory in the passive pane
+
+;; * Cloning of complete directory trees: press K to clone the selected files
+;; and directories into the passive pane. Cloning is a more general operation
+;; than copying, in which all directories are recursively created with the same
+;; names and structures at the destination, while what happens to the files
+;; within them depends on the option you choose:
+;; - "(D)irectories only" ignores all files, copies only directories,
+;; - "(C)opies" performs a regular recursive copy of all files and dirs,
+;; - "(H)ardlinks" makes every new file a (hard) link to the original one
+;; - "(S)ymlinks" creates absolute symbolic links for all files in the tree,
+;; - "(R)elative symlinks” creates relative symbolic links.
+
+;; * Passive navigation: the usual navigation keys (n, p, Return, U, ;) combined
+;; with Meta allow to move across the passive pane without actually having to
+;; switch to it.
+
+;; * Synchronized navigation: press C-c C-z to enable / disable synchronized
+;; navigation. In this mode, the passive navigation keys (M-n, M-p, M-Return,
+;; etc.) operate on both panes simultaneously. I've found this quite useful for
+;; comparing hierarchically small to medium-sized directory trees (for large to
+;; very large directory trees one needs something on the lines of diff -r
+;; though).
+
+;; * And much more -- press ? while in Sunrise mode for basic help, or h for a
+;; complete list of all keybindings available (use C-e and C-y to scroll).
+
+;; There is no help window like in MC, but if you really miss it, just get and
+;; install the sunrise-x-buttons extension.
+
+;; A lot of this code was once adapted from Kevin's mc.el, but it has evolved
+;; considerably since then. Another part (the code for file copying and
+;; renaming) derives originally from the Dired extensions written by Kurt
+;; Nørmark for LAML (http://www.cs.aau.dk/~normark/scheme/distribution/laml/).
+
+;; It was written on GNU Emacs 24 on Linux and tested on GNU Emacs 22, 23 and 24
+;; for Linux and on EmacsW32 (version 23) for Windows. I have also received
+;; feedback from users reporting it works OK on the Mac. It does not work either
+;; on GNU Emacs 21 or XEmacs -- please drop me a line if you would like to help
+;; porting it. All contributions and/or bug reports will be very welcome.
+
+;; For more details on the file manager, several available extensions and many
+;; cool tips & tricks visit http://www.emacswiki.org/emacs/Sunrise_Commander
+
+;;; Installation and Usage:
+
+;; 1) Put this file somewhere in your Emacs `load-path'.
+
+;; 2) Add a (require 'sunrise-commander) to your .emacs file.
+
+;; 3) Choose some unused extension for files to be opened in Sunrise VIRTUAL
+;; mode and add it to `auto-mode-alist', e.g. if you want to name your virtual
+;; directories like *.svrm just add to your .emacs file a line like the
+;; following:
+;;
+;; (add-to-list 'auto-mode-alist '("\\.srvm\\'" . sr-virtual-mode))
+
+;; 4) Evaluate the new lines, or reload your .emacs file, or restart Emacs.
+
+;; 5) Type M-x sunrise to invoke the Sunrise Commander (or much better: bind the
+;; function to your favorite key combination). The command `sunrise-cd' invokes
+;; Sunrise and automatically selects the current file wherever it is in the
+;; filesystem. Type h at any moment for information on available key bindings.
+
+;; 6) Type M-x customize-group <RET> sunrise <RET> to customize options, fonts
+;; and colors (activate AVFS support here, too).
+
+;; 7) Enjoy :)
+
+;;; Code:
+
+(require 'dired)
+(require 'dired-x)
+(require 'enriched)
+(require 'find-dired)
+(require 'font-lock)
+(require 'hl-line)
+(require 'sort)
+(require 'term)
+(eval-when-compile (require 'cl)
+ (require 'desktop)
+ (require 'dired-aux)
+ (require 'esh-mode)
+ (require 'recentf)
+ (require 'tramp))
+
+(defgroup sunrise nil
+ "The Sunrise Commander File Manager."
+ :group 'files)
+
+(defcustom sr-show-file-attributes t
+ "Whether to initially display file attributes in Sunrise panes.
+You can always toggle file attributes display pressing
+\\<sr-mode-map>\\[sr-toggle-attributes]."
+ :group 'sunrise
+ :type 'boolean)
+
+(defcustom sr-autoload-extensions t
+ "Whether to load extensions immediately after their declaration, or when the
+SC core is loaded (e.g. when using autoload cookies)."
+ :group 'sunrise
+ :type 'boolean)
+
+(defcustom sr-show-hidden-files nil
+ "Whether to initially display hidden files in Sunrise panes.
+You can always toggle hidden files display pressing
+\\<sr-mode-map>\\[dired-omit-mode].
+You can also customize what files are considered hidden by setting
+`dired-omit-files' and `dired-omit-extensions' in your .emacs file."
+ :group 'sunrise
+ :type 'boolean)
+
+(defcustom sr-terminal-kill-buffer-on-exit t
+ "Whether to kill terminal buffers after their shell process ends."
+ :group 'sunrise
+ :type 'boolean)
+
+(defcustom sr-terminal-program "eshell"
+ "The program to use for terminal emulation.
+If this value is set to \"eshell\", the Emacs shell (`eshell')
+will be used."
+ :group 'sunrise
+ :type 'string)
+
+(defcustom sr-listing-switches "-al"
+ "Listing switches passed to `ls' when building Sunrise buffers.
+\(Cf. `dired-listing-switches'.)
+ Most portable value: -al
+ Recommended value on GNU systems: \
+--time-style=locale --group-directories-first -alDhgG"
+ :group 'sunrise
+ :type 'string)
+
+(defcustom sr-virtual-listing-switches "-ald"
+ "Listing switches for building buffers in `sr-virtual-mode'.
+Should not contain the -D option. See also `sr-listing-switches'."
+ :group 'sunrise
+ :type 'string)
+
+(defcustom sr-avfs-root nil
+ "Root of the AVFS virtual filesystem used for navigating compressed archives.
+Setting this value activates AVFS support."
+ :group 'sunrise
+ :type '(choice
+ (const :tag "AVFS support disabled" nil)
+ (directory :tag "AVFS root directory")))
+
+(defcustom sr-avfs-handlers-alist '(("\\.[jwesh]ar$" . "#uzip/")
+ ("\\.wsar$" . "#uzip/")
+ ("\\.xpi$" . "#uzip/")
+ ("\\.apk$" . "#uzip/")
+ ("\\.iso$" . "#iso9660/")
+ ("\\.patch$" . "#/")
+ ("\\.txz$" . "#/")
+ ("." . "#/"))
+ "List of AVFS handlers to manage specific file extensions."
+ :group 'sunrise
+ :type 'alist)
+
+(defcustom sr-md5-shell-command "md5sum %f | cut -d' ' -f1 2>/dev/null"
+ "Shell command to use for calculating MD5 sums for files.
+Used when comparing directories using the ``(c)ontents'' option.
+Use %f as a placeholder for the name of the file."
+ :group 'sunrise
+ :type 'string)
+
+(defcustom sr-window-split-style 'horizontal
+ "The current window split configuration.
+May be `horizontal', `vertical' or `top'."
+ :group 'sunrise
+ :type '(choice
+ (const horizontal)
+ (const vertical)
+ (const top)))
+
+(defcustom sr-windows-locked t
+ "When non-nil, vertical size of the panes will remain constant."
+ :group 'sunrise
+ :type 'boolean)
+
+(defcustom sr-windows-default-ratio 66
+ "Percentage of the total height of the frame to use by default for the Sunrise
+Commander panes."
+ :group 'sunrise
+ :type 'integer
+ :set (defun sr-set-windows-default-ratio (symbol value)
+ "Setter function for the `sr-windows-default-ratio' custom option."
+ (if (and (integerp value) (>= value 0) (<= value 100))
+ (set-default symbol value)
+ (error "Invalid value: %s" value))))
+
+(defcustom sr-history-length 20
+ "Number of entries to keep in each pane's history rings."
+ :group 'sunrise
+ :type 'integer)
+
+(defcustom sr-kill-unused-buffers t
+ "Whether buffers should be killed automatically by Sunrise when not displayed
+in any of the panes."
+ :group 'sunrise
+ :type 'boolean)
+
+(defcustom sr-confirm-kill-viewer t
+ "Whether to ask for confirmation before killing a buffer opened in quick-view
+mode."
+ :group 'sunrise
+ :type 'boolean)
+
+(defcustom sr-attributes-display-mask nil
+ "Contols hiding/transforming columns with `sr-toggle-attributes'.
+If set, its value must be a list of symbols, one for each
+attributes column. If the symbol is nil, then the corresponding
+column will be hidden, and if it's not nil then the column will
+be left untouched. The symbol may also be the name of a function
+that takes one string argument and evaluates to a different
+string -- in this case this function will be used to transform
+the contents of the corresponding column and its result will be
+displayed instead."
+ :group 'sunrise
+ :type '(repeat symbol))
+
+(defcustom sr-fast-backup-extension ".bak"
+ "Determines the extension to append to the names of new files
+created with the `sr-fast-backup-files' function (@!). This can
+be either a simple string or an s-expression to be evaluated at
+run-time."
+ :group 'sunrise
+ :type '(choice
+ (string :tag "Literal text")
+ (sexp :tag "Symbolic expression")))
+
+(defcustom sr-fuzzy-negation-character ?!
+ "Character to use for negating patterns when fuzzy-narrowing a pane."
+ :group 'sunrise
+ :type '(choice
+ (const :tag "Fuzzy matching negation disabled" nil)
+ (character :tag "Fuzzy matching negation character" ?!)))
+
+(defcustom sr-init-hook nil
+ "List of functions to be called before the Sunrise panes are displayed."
+ :group 'sunrise
+ :type 'hook
+ :options '(auto-insert))
+
+(defcustom sr-start-hook nil
+ "List of functions to be called after the Sunrise panes are displayed."
+ :group 'sunrise
+ :type 'hook
+ :options '(auto-insert))
+
+(defcustom sr-refresh-hook nil
+ "List of functions to be called every time a pane is refreshed."
+ :group 'sunrise
+ :type 'hook
+ :options '(auto-insert))
+
+(defcustom sr-quit-hook nil
+ "List of functions to be called after the Sunrise panes are hidden."
+ :group 'sunrise
+ :type 'hook
+ :options '(auto-insert))
+
+(defvar sr-restore-buffer nil
+ "Buffer to restore when Sunrise quits.")
+
+(defvar sr-prior-window-configuration nil
+ "Window configuration before Sunrise was started.")
+
+(defvar sr-running nil
+ "True when Sunrise commander mode is running.")
+
+(defvar sr-synchronized nil
+ "True when synchronized navigation is on")
+
+(defvar sr-current-window-overlay nil
+ "Holds the current overlay which marks the current Dired buffer.")
+
+(defvar sr-clex-hotchar-overlay nil
+ "Overlay used to highlight the hot character (%) during CLEX operations.")
+
+(defvar sr-left-directory "~/"
+ "Dired directory for the left window. See variable `dired-directory'.")
+
+(defvar sr-left-buffer nil
+ "Dired buffer for the left window.")
+
+(defvar sr-left-window nil
+ "The left window of Dired.")
+
+(defvar sr-right-directory "~/"
+ "Dired directory for the right window. See variable `dired-directory'.")
+
+(defvar sr-right-buffer nil
+ "Dired buffer for the right window.")
+
+(defvar sr-right-window nil
+ "The right window of Dired.")
+
+(defvar sr-current-frame nil
+ "The frame Sunrise is active on (if any).")
+
+(defvar sr-this-directory "~/"
+ "Dired directory in the active pane.
+This isn't necessarily the same as `dired-directory'.")
+
+(defvar sr-other-directory "~/"
+ "Dired directory in the passive pane.")
+
+(defvar sr-selected-window 'left
+ "The window to select when Sunrise starts up.")
+
+(defvar sr-selected-window-width nil
+ "The width the selected window should have on startup.")
+
+(defvar sr-history-registry '((left) (right))
+ "Registry of visited directories for both panes.")
+
+(defvar sr-history-stack '((left 0 . 0) (right 0 . 0))
+ "History stack counters.
+The first counter on each side tracks (by value) the absolute
+depth of the stack and (by sign) the direction it is currently
+being traversed. The second counter points at the position of the
+element that is immediately beneath the top of the stack.")
+
+(defvar sr-ti-openterms nil
+ "Stack of currently open terminal buffers.")
+
+(defvar sr-ediff-on nil
+ "Flag that indicates whether an `ediff' is being currently done.")
+
+(defvar sr-clex-on nil
+ "Flag that indicates that a CLEX operation is taking place.")
+
+(defvar sr-virtual-buffer nil
+ "Local flag that indicates the current buffer was originally in
+ VIRTUAL mode.")
+
+(defvar sr-dired-directory ""
+ "Directory inside which `sr-mode' is currently active.")
+
+(defvar sr-start-message
+ "Been coding all night? Enjoy the Sunrise! (or press q to quit)"
+ "Message to display when Sunrise is started.")
+
+(defvar sr-panes-height nil
+ "Current height of the pane windows.
+Initial value is 2/3 the viewport height.")
+
+(defvar sr-current-path-faces nil
+ "List of faces to display the path in the current pane (first wins)")
+(make-variable-buffer-local 'sr-current-path-faces)
+
+(defvar sr-inhibit-highlight nil
+ "Special variable used to temporarily inhibit highlighting in panes.")
+
+(defvar sr-find-items nil
+ "Special variable used by `sr-find' to control the scope of find operations.")
+
+(defvar sr-desktop-save-handlers nil
+ "List of extension-defined handlers to save Sunrise buffers with desktop.")
+
+(defvar sr-desktop-restore-handlers nil
+ "List of extension-defined handlers to restore Sunrise buffers from desktop.")
+
+(defvar sr-backup-buffer nil
+ "Variable holding a buffer-local value of the backup buffer.")
+(make-variable-buffer-local 'sr-backup-buffer)
+
+(defvar sr-goto-dir-function nil
+ "Function to use to navigate to a given directory, or nil to do
+the default. The function receives one argument DIR, which is
+the directory to go to.")
+
+(defconst sr-side-lookup (list '(left . right) '(right . left))
+ "Trivial alist used by the Sunrise Commander to lookup its own passive side.")
+
+(defface sr-active-path-face
+ '((((type tty) (class color) (min-colors 8))
+ :background "green" :foreground "yellow" :bold t)
+ (((type tty) (class mono)) :inverse-video t)
+ (t :background "#ace6ac" :foreground "yellow" :bold t :height 120))
+ "Face of the directory path in the active pane."
+ :group 'sunrise)
+
+(defface sr-passive-path-face
+ '((((type tty) (class color) (min-colors 8) (background dark))
+ :background "black" :foreground "cyan")
+ (((type tty) (class color) (min-colors 8) (background light))
+ :background "white" :foreground "cyan")
+ (t :background "white" :foreground "lightgray" :bold t :height 120))
+ "Face of the directory path in the passive pane."
+ :group 'sunrise)
+
+(defface sr-editing-path-face
+ '((t :background "red" :foreground "yellow" :bold t :height 120))
+ "Face of the directory path in the active pane while in editable pane mode."
+ :group 'sunrise)
+
+(defface sr-highlight-path-face
+ '((t :background "yellow" :foreground "#ace6ac" :bold t :height 120))
+ "Face of the directory path on mouse hover."
+ :group 'sunrise)
+
+(defface sr-clex-hotchar-face
+ '((t :foreground "red" :bold t))
+ "Face of the hot character (%) in CLEX mode.
+Indicates that a CLEX substitution may be about to happen."
+ :group 'sunrise)
+
+;;; ============================================================================
+;;; This is the core of Sunrise: the main idea is to apply `sr-mode' only inside
+;;; Sunrise buffers while keeping all of `dired-mode' untouched.
+
+;;; preserve this variable when switching from `dired-mode' to another mode
+(put 'dired-subdir-alist 'permanent-local t)
+
+;;;###autoload
+(define-derived-mode sr-mode dired-mode "Sunrise Commander"
+ "Two-pane file manager for Emacs based on Dired and inspired by MC.
+The following keybindings are available:
+
+ /, j .......... go to directory
+ p, n .......... move cursor up/down
+ M-p, M-n ...... move cursor up/down in passive pane
+ ^, J .......... go to parent directory
+ M-^, M-J ...... go to parent directory in passive pane
+ Tab ........... switch to other pane
+ C-Tab.......... switch to viewer window
+ C-c Tab ....... switch to viewer window (console compatible)
+ RET, f ........ visit selected file/directory
+ M-RET, M-f .... visit selected file/directory in passive pane
+ C-c RET ....... visit selected in passive pane (console compatible)
+ b ............. visit selected file/directory in default browser
+ F ............. visit all marked files, each in its own window
+ C-u F ......... visit all marked files in the background
+ o,v ........... quick visit selected file (scroll with C-M-v, C-M-S-v)
+ C-u o, C-u v .. kill quick-visited buffer (restores normal scrolling)
+ X ............. execute selected file
+ C-u X.......... execute selected file with arguments
+
+ + ............. create new directory
+ M-+ ........... create new empty file(s)
+ C ............. copy marked (or current) files and directories
+ R ............. rename marked (or current) files and directories
+ D ............. delete marked (or current) files and directories
+ S ............. soft-link selected file/directory to passive pane
+ Y ............. do relative soft-link of selected file in passive pane
+ H ............. hard-link selected file to passive pane
+ K ............. clone selected files and directories into passive pane
+ M-C ........... copy (using traditional dired-do-copy)
+ M-R ........... rename (using traditional dired-do-rename)
+ M-D ........... delete (using traditional dired-do-delete)
+ M-S............ soft-link (using traditional dired-do-symlink)
+ M-Y............ do relative soft-link (traditional dired-do-relsymlink)
+ M-H............ hard-link selected file/directory (dired-do-hardlink)
+ A ............. search marked files for regular expression
+ Q ............. perform query-replace-regexp on marked files
+ C-c s ......... start a \"sticky\" interactive search in the current pane
+
+ M-a ........... move to beginning of current directory
+ M-e ........... move to end of current directory
+ M-y ........... go to previous directory in history
+ M-u ........... go to next directory in history
+ C-M-y ......... go to previous directory in history on passive pane
+ C-M-u ......... go to next directory in history on passive pane
+
+ g, C-c C-c .... refresh pane
+ s ............. sort entries (by name, number, size, time or extension)
+ r ............. reverse the order of entries in the active pane (sticky)
+ C-o ........... show/hide hidden files (requires dired-omit-mode)
+ C-Backspace ... hide/show file attributes in pane
+ C-c Backspace . hide/show file attributes in pane (console compatible)
+ y ............. show file type / size of selected files and directories.
+ M-l ........... truncate/continue long lines in pane
+ C-c v ......... put current panel in VIRTUAL mode
+ C-c C-v ....... create new pure VIRTUAL buffer
+ C-c C-w ....... browse directory tree using w3m
+
+ M-t ........... transpose panes
+ M-o ........... synchronize panes
+ C-c C-s ....... change panes layout (vertical/horizontal/top-only)
+ [ ............. enlarges the right pane by 5 columns
+ ] ............. enlarges the left pane by 5 columns
+ } ............. enlarges the panes vertically by 1 row
+ C-} ........... enlarges the panes vertically as much as it can
+ C-c } ......... enlarges the panes vertically as much as it can
+ { ............. shrinks the panes vertically by 1 row
+ C-{ ........... shrinks the panes vertically as much as it can
+ C-c { ......... shrinks the panes vertically as much as it can
+ \\ ............. restores the size of all windows back to «normal»
+ C-c C-z ....... enable/disable synchronized navigation
+
+ C-= ........... smart compare files (ediff)
+ C-c = ......... smart compare files (console compatible)
+ = ............. fast smart compare files (plain diff)
+ C-M-= ......... compare panes
+ C-x = ......... compare panes (console compatible)
+
+ C-c C-f ....... execute Find-dired in Sunrise VIRTUAL mode
+ C-c C-n ....... execute find-Name-dired in Sunrise VIRTUAL mode
+ C-c C-g ....... execute find-Grep-dired in Sunrise VIRTUAL mode
+ C-u C-c C-g ... execute find-Grep-dired with additional grep options
+ C-c C-l ....... execute Locate in Sunrise VIRTUAL mode
+ C-c C-r ....... browse list of Recently visited files (requires recentf)
+ C-c C-c ....... [after find, locate or recent] dismiss virtual buffer
+ C-c / ......... narrow the contents of current pane using fuzzy matching
+ C-c b ......... partial Branch view of selected items in current pane
+ C-c p ......... Prune paths matching regular expression from current pane
+ ; ............. follow file (go to same directory as selected file)
+ M-; ........... follow file in passive pane
+ C-M-o ......... follow a projection of current directory in passive pane
+
+ C-> ........... save named checkpoint (a.k.a. \"bookmark panes\")
+ C-c > ......... save named checkpoint (console compatible)
+ C-. ........ restore named checkpoint
+ C-c . ........ restore named checkpoint
+
+ C-x C-q ....... put pane in Editable Dired mode (commit with C-c C-c)
+ @! ............ fast backup files (not dirs!), each to [filename].bak
+
+ C-c t ......... open new terminal or switch to already open one
+ C-c T ......... open terminal AND/OR change directory to current
+ C-c C-t ....... open always a new terminal in current directory
+ C-c M-t ....... open a new terminal using an alternative shell program
+ q, C-x k ...... quit Sunrise Commander, restore previous window setup
+ M-q ........... quit Sunrise Commander, don't restore previous windows
+
+Additionally, the following traditional commander-style keybindings are provided
+\(these may be disabled by customizing the `sr-use-commander-keys' option):
+
+ F2 ............ go to directory
+ F3 ............ quick visit selected file
+ F4 ............ visit selected file
+ F5 ............ copy marked (or current) files and directories
+ F6 ............ rename marked (or current) files and directories
+ F7 ............ create new directory
+ F8 ............ delete marked (or current) files and directories
+ F10 ........... quit Sunrise Commander
+ C-F3 .......... sort contents of current pane by name
+ C-F4 .......... sort contents of current pane by extension
+ C-F5 .......... sort contents of current pane by time
+ C-F6 .......... sort contents of current pane by size
+ C-F7 .......... sort contents of current pane numerically
+ S-F7 .......... soft-link selected file/directory to passive pane
+ Insert ........ mark file
+ C-PgUp ........ go to parent directory
+
+Any other dired keybinding (not overridden by any of the above) can be used in
+Sunrise, like G for changing group, M for changing mode and so on.
+
+Some more bindings are available in terminals opened using any of the Sunrise
+functions (i.e. one of: C-c t, C-c T, C-c C-t, C-c M-t):
+
+ C-c Tab ....... switch focus to the active pane
+ C-c t ......... cycle through all currently open terminals
+ C-c T ......... cd to the directory in the active pane
+ C-c C-t ....... open new terminal, cd to directory in the active pane
+ C-c ; ......... follow the current directory in the active pane
+ C-c { ......... shrink the panes vertically as much as possible
+ C-c } ......... enlarge the panes vertically as much as possible
+ C-c \\ ......... restore the size of all windows back to «normal»
+ C-c C-j ....... put terminal in line mode
+ C-c C-k ....... put terminal back in char mode
+
+The following bindings are available only in line mode (eshell is considered to
+be *always* in line mode):
+
+ M-<up>, M-P ... move cursor up in the active pane
+ M-<down>, M-N . move cursor down in the active pane
+ M-Return ...... visit selected file/directory in the active pane
+ M-J ........... go to parent directory in the active pane
+ M-G ........... refresh active pane
+ M-Tab ......... switch to passive pane (without leaving the terminal)
+ M-M ........... mark selected file/directory in the active pane
+ M-Backspace ... unmark previous file/directory in the active pane
+ M-U ........... remove all marks from the active pane
+ C-Tab ......... switch focus to the active pane
+
+In a terminal in line mode the following substitutions are also performed
+automatically:
+
+ %f - expands to the currently selected file in the left pane
+ %F - expands to the currently selected file in the right pane
+ %m - expands to the list of paths of all marked files in the left pane
+ %M - expands to the list of paths of all marked files in the right pane
+ %n - expands to the list of names of all marked files in the left pane
+ %N - expands to the list of names of all marked files in the right pane
+ %d - expands to the current directory in the left pane
+ %D - expands to the current directory in the right pane
+ %a - expands to the list of paths of all marked files in the active pane
+ %A - expands to the current directory in the active pane
+ %p - expands to the list of paths of all marked files in the passive pane
+ %P - expands to the current directory in the passive pane
+ %% - inserts a single % sign.
+"
+ :group 'sunrise
+ (unless (string-match "\\(Sunrise\\)" (buffer-name))
+ (rename-buffer (concat (buffer-name) " (Sunrise)") t))
+ (set-keymap-parent sr-mode-map dired-mode-map)
+ (sr-highlight)
+ (dired-omit-mode dired-omit-mode)
+
+ (make-local-variable 'truncate-partial-width-windows)
+ (setq truncate-partial-width-windows (sr-truncate-v t))
+
+ (set (make-local-variable 'dired-header-face) 'sr-passive-path-face)
+ (set (make-local-variable 'dired-recursive-deletes) 'top)
+ (set (make-local-variable 'truncate-lines) nil)
+ (set (make-local-variable 'desktop-save-buffer) 'sr-desktop-save-buffer)
+ (set (make-local-variable 'revert-buffer-function) 'sr-revert-buffer)
+ (set (make-local-variable 'buffer-quit-function) 'sr-quit)
+ (set (make-local-variable 'sr-show-file-attributes) sr-show-file-attributes)
+ (set (make-local-variable 'hl-line-sticky-flag) nil)
+ (hl-line-mode 1)
+)
+
+;;;###autoload
+(define-derived-mode sr-virtual-mode dired-virtual-mode "Sunrise VIRTUAL"
+ "Sunrise Commander Virtual Mode. Useful for reusing find and locate results."
+ :group 'sunrise
+ (set-keymap-parent sr-virtual-mode-map sr-mode-map)
+ (sr-highlight)
+ (enriched-mode -1)
+
+ (make-local-variable 'truncate-partial-width-windows)
+ (setq truncate-partial-width-windows (sr-truncate-v t))
+
+ (set (make-local-variable 'dired-header-face) 'sr-passive-path-face)
+ (set (make-local-variable 'truncate-lines) nil)
+ (set (make-local-variable 'desktop-save-buffer) 'sr-desktop-save-buffer)
+ (set (make-local-variable 'revert-buffer-function) 'sr-revert-buffer)
+ (set (make-local-variable 'buffer-quit-function) 'sr-quit)
+ (set (make-local-variable 'sr-show-file-attributes) sr-show-file-attributes)
+ (set (make-local-variable 'hl-line-sticky-flag) nil)
+ (hl-line-mode 1)
+
+ (define-key sr-virtual-mode-map "\C-c\C-c" 'sr-virtual-dismiss))
+
+(defmacro sr-within (dir form)
+ "Evaluate FORM in Sunrise context."
+ `(unwind-protect
+ (progn
+ (setq sr-dired-directory
+ (file-name-as-directory (abbreviate-file-name ,dir)))
+ (ad-activate 'dired-find-buffer-nocreate)
+ ,form)
+ (ad-deactivate 'dired-find-buffer-nocreate)
+ (setq sr-dired-directory "")))
+
+(defmacro sr-save-aspect (&rest body)
+ "Restore omit mode, hidden attributes and point after a directory transition."
+ `(let ((inhibit-read-only t)
+ (omit (or dired-omit-mode -1))
+ (attrs (eval 'sr-show-file-attributes))
+ (path-faces sr-current-path-faces))
+ ,@body
+ (dired-omit-mode omit)
+ (if path-faces
+ (setq sr-current-path-faces path-faces))
+ (if (string= "NUMBER" (get sr-selected-window 'sorting-order))
+ (sr-sort-by-operation 'sr-numerical-sort-op))
+ (if (get sr-selected-window 'sorting-reverse)
+ (sr-reverse-pane))
+ (setq sr-show-file-attributes attrs)
+ (sr-display-attributes (point-min) (point-max) sr-show-file-attributes)
+ (sr-restore-point-if-same-buffer)))
+
+(defmacro sr-alternate-buffer (form)
+ "Execute FORM in a new buffer, after killing the previous one."
+ `(let ((dispose nil))
+ (unless (or (not (or dired-directory (eq major-mode 'sr-tree-mode)))
+ (eq sr-left-buffer sr-right-buffer))
+ (setq dispose (current-buffer)))
+ ,form
+ (setq sr-this-directory default-directory)
+ (sr-keep-buffer)
+ (sr-highlight)
+ (when (and sr-kill-unused-buffers (buffer-live-p dispose))
+ (with-current-buffer dispose
+ (bury-buffer)
+ (set-buffer-modified-p nil)
+ (unless (kill-buffer dispose)
+ (kill-local-variable 'sr-current-path-faces))))))
+
+(defmacro sr-in-other (form)
+ "Execute FORM in the context of the passive pane.
+Helper macro for passive & synchronized navigation."
+ `(let ((home sr-selected-window))
+ (let ((sr-inhibit-highlight t))
+ (if sr-synchronized ,form)
+ (sr-change-window)
+ (condition-case description
+ ,form
+ (error (message (cadr description)))))
+ (if (not sr-running)
+ (sr-select-window home)
+ (run-hooks 'sr-refresh-hook)
+ (sr-change-window))))
+
+(defmacro sr-silently (&rest body)
+ "Inhibit calls to `message' in BODY."
+ `(letf (((symbol-function 'message) (lambda (_msg &rest _args) (ignore))))
+ ,@body))
+
+(eval-and-compile
+ (defun sr-symbol (side type)
+ "Synthesize Sunrise symbols (`sr-left-buffer', `sr-right-window', etc.)."
+ (intern (concat "sr-" (symbol-name side) "-" (symbol-name type)))))
+
+(defun sr-dired-mode ()
+ "Set Sunrise mode in every Dired buffer opened in Sunrise (called in a hook)."
+ (if (and sr-running
+ (eq (selected-frame) sr-current-frame)
+ (sr-equal-dirs dired-directory default-directory)
+ (not (eq major-mode 'sr-mode)))
+ (let ((dired-listing-switches dired-listing-switches)
+ (sorting-options (or (get sr-selected-window 'sorting-options) "")))
+ (unless (and (featurep 'tramp)
+ (string-match tramp-file-name-regexp default-directory))
+ (setq dired-listing-switches
+ (concat sr-listing-switches sorting-options)))
+ (sr-mode)
+ (dired-unadvertise dired-directory))))
+(add-hook 'dired-before-readin-hook 'sr-dired-mode)
+
+(defun sr-bookmark-jump ()
+ "Handle panes opened from bookmarks in Sunrise."
+ (when (and sr-running
+ (memq (selected-window) (list sr-left-window sr-right-window)))
+ (let ((last-buf (symbol-value (sr-symbol sr-selected-window 'buffer))))
+ (setq dired-omit-mode (with-current-buffer last-buf dired-omit-mode))
+ (setq sr-this-directory default-directory)
+ (if (sr-equal-dirs sr-this-directory sr-other-directory)
+ (sr-synchronize-panes t)
+ (revert-buffer))
+ (sr-keep-buffer)
+ (unless (memq last-buf (list (current-buffer) (sr-other 'buffer)))
+ (kill-buffer last-buf)))))
+(add-hook 'bookmark-after-jump-hook 'sr-bookmark-jump)
+
+(defun sr-virtualize-pane ()
+ "Put the current normal view in VIRTUAL mode."
+ (interactive)
+ (when (eq major-mode 'sr-mode)
+ (let ((focus (dired-get-filename 'verbatim t)))
+ (sr-save-aspect
+ (when (eq sr-left-buffer sr-right-buffer)
+ (dired default-directory)
+ (sr-keep-buffer))
+ (sr-virtual-mode))
+ (if focus (sr-focus-filename focus)))))
+
+(defun sr-virtual-dismiss ()
+ "Restore normal pane view in Sunrise VIRTUAL mode."
+ (interactive)
+ (when (eq major-mode 'sr-virtual-mode)
+ (let ((focus (dired-get-filename 'verbatim t)))
+ (sr-process-kill)
+ (sr-save-aspect
+ (sr-alternate-buffer (sr-goto-dir sr-this-directory))
+ (if focus (sr-focus-filename focus))
+ (revert-buffer)))))
+
+(defun sr-select-window (side)
+ "Select/highlight the given Sunrise window (right or left)."
+ (select-window (symbol-value (sr-symbol side 'window)))
+ (setq sr-selected-window side)
+ (setq sr-this-directory default-directory)
+ (sr-highlight))
+
+(defun sr-viewer-window ()
+ "Return an active window that can be used as the viewer."
+ (if (or (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
+ (memq (current-buffer) (list sr-left-buffer sr-right-buffer)))
+ (let ((current-window (selected-window)) (target-window))
+ (dotimes (_times 2)
+ (setq current-window (next-window current-window))
+ (unless (memq current-window (list sr-left-window sr-right-window))
+ (setq target-window current-window)))
+ target-window)
+ (selected-window)))
+
+(defun sr-select-viewer-window (&optional force-setup)
+ "Select a window that is not a Sunrise pane.
+If no suitable active window can be found and FORCE-SETUP is set,
+calls the function `sr-setup-windows' and tries once again."
+ (interactive "p")
+ (let ((viewer (sr-viewer-window)))
+ (if (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
+ (hl-line-mode 1))
+ (if viewer
+ (select-window viewer)
+ (when force-setup
+ (sr-setup-windows)
+ (select-window (sr-viewer-window))))))
+
+(defun sr-backup-buffer ()
+ "Create a backup copy of the current buffer.
+Used as a cache during revert operations."
+ (if (buffer-live-p sr-backup-buffer) (sr-kill-backup-buffer))
+ (let ((buf (current-buffer)))
+ (setq sr-backup-buffer (generate-new-buffer "*Sunrise Backup*"))
+ (with-current-buffer sr-backup-buffer
+ (insert-buffer-substring buf))
+ (run-hooks 'sr-refresh-hook)))
+
+(defun sr-kill-backup-buffer ()
+ "Kill the backup buffer associated to the current one, if there is any."
+ (when (buffer-live-p sr-backup-buffer)
+ (kill-buffer sr-backup-buffer)
+ (setq sr-backup-buffer nil)))
+(add-hook 'kill-buffer-hook 'sr-kill-backup-buffer)
+(add-hook 'change-major-mode-hook 'sr-kill-backup-buffer)
+
+(add-to-list 'enriched-translations '(invisible (t "x-invisible")))
+(defun sr-enrich-buffer ()
+ "Activate `enriched-mode' before saving a Sunrise buffer to a file.
+This is done so all its dired-filename attributes are kept in the file."
+ (if (memq major-mode '(sr-mode sr-virtual-mode))
+ (enriched-mode 1)))
+(add-hook 'before-save-hook 'sr-enrich-buffer)
+
+(defun sr-extend-with (extension &optional filename)
+ "Try to enhance Sunrise with EXTENSION (argument must be a symbol).
+An extension can be loaded from optional FILENAME. If found, the extension is
+immediately loaded, but only if `sr-autoload-extensions' is not nil."
+ (when sr-autoload-extensions
+ (require extension filename t)))
+
+(defadvice dired-find-buffer-nocreate
+ (before sr-advice-findbuffer (dirname &optional mode))
+ "A hack to avoid some Dired mode quirks in the Sunrise Commander."
+ (if (sr-equal-dirs sr-dired-directory dirname)
+ (setq mode 'sr-mode)))
+;; ^--- activated by sr-within macro
+
+(defadvice dired-dwim-target-directory
+ (around sr-advice-dwim-target ())
+ "Tweak the target directory guessing mechanism when Sunrise Commander is on."
+ (if (and sr-running (eq (selected-frame) sr-current-frame))
+ (setq ad-return-value sr-other-directory)
+ ad-do-it))
+(ad-activate 'dired-dwim-target-directory)
+
+(defadvice other-window
+ (around sr-advice-other-window (count &optional all-frames))
+ "Select the correct Sunrise Commander pane when switching from other windows."
+ (if (or (not sr-running) sr-ediff-on)
+ ad-do-it
+ (let ((from (selected-window)))
+ ad-do-it
+ (unless (memq from (list sr-left-window sr-right-window))
+ ;; switching from outside
+ (sr-select-window sr-selected-window))
+ (with-no-warnings
+ (when (eq (selected-window) (sr-other 'window))
+ ;; switching from the other pane
+ (sr-change-window))))))
+(ad-activate 'other-window)
+
+(defadvice use-hard-newlines
+ (around sr-advice-use-hard-newlines (&optional arg insert))
+ "Stop asking if I want hard lines the in Sunrise Commander, just guess."
+ (if (memq major-mode '(sr-mode sr-virtual-mode))
+ (let ((inhibit-read-only t))
+ (setq insert 'guess)
+ ad-do-it)
+ ad-do-it))
+(ad-activate 'use-hard-newlines)
+
+(defadvice dired-insert-set-properties
+ (after sr-advice-dired-insert-set-properties (beg end))
+ "Manage hidden attributes in files added externally (e.g. from find-dired) to
+the Sunrise Commander."
+ (when (memq major-mode '(sr-mode sr-virtual-mode))
+ (with-no-warnings
+ (sr-display-attributes beg end sr-show-file-attributes))))
+(ad-activate 'dired-insert-set-properties)
+
+;;; ============================================================================
+;;; Sunrise Commander keybindings:
+
+(define-key sr-mode-map "\C-m" 'sr-advertised-find-file)
+(define-key sr-mode-map "f" 'sr-advertised-find-file)
+(define-key sr-mode-map "X" 'sr-advertised-execute-file)
+(define-key sr-mode-map "o" 'sr-quick-view)
+(define-key sr-mode-map "v" 'sr-quick-view)
+(define-key sr-mode-map "/" 'sr-goto-dir)
+(define-key sr-mode-map "j" 'sr-goto-dir)
+(define-key sr-mode-map "^" 'sr-dired-prev-subdir)
+(define-key sr-mode-map "J" 'sr-dired-prev-subdir)
+(define-key sr-mode-map ";" 'sr-follow-file)
+(define-key sr-mode-map "\M-t" 'sr-transpose-panes)
+(define-key sr-mode-map "\M-o" 'sr-synchronize-panes)
+(define-key sr-mode-map "\C-\M-o" 'sr-project-path)
+(define-key sr-mode-map "\M-y" 'sr-history-prev)
+(define-key sr-mode-map "\M-u" 'sr-history-next)
+(define-key sr-mode-map "\C-c>" 'sr-checkpoint-save)
+(define-key sr-mode-map "\C-c." 'sr-checkpoint-restore)
+(define-key sr-mode-map "\C-c\C-z" 'sr-sync)
+(define-key sr-mode-map "\C-c\C-c" 'revert-buffer)
+
+(define-key sr-mode-map "\t" 'sr-change-window)
+(define-key sr-mode-map "\C-c\t" 'sr-select-viewer-window)
+(define-key sr-mode-map "\M-a" 'sr-beginning-of-buffer)
+(define-key sr-mode-map "\M-e" 'sr-end-of-buffer)
+(define-key sr-mode-map "\C-c\C-s" 'sr-split-toggle)
+(define-key sr-mode-map "]" 'sr-enlarge-left-pane)
+(define-key sr-mode-map "[" 'sr-enlarge-right-pane)
+(define-key sr-mode-map "}" 'sr-enlarge-panes)
+(define-key sr-mode-map "{" 'sr-shrink-panes)
+(define-key sr-mode-map "\\" 'sr-lock-panes)
+(define-key sr-mode-map "\C-c}" 'sr-max-lock-panes)
+(define-key sr-mode-map "\C-c{" 'sr-min-lock-panes)
+(define-key sr-mode-map "\C-o" 'dired-omit-mode)
+(define-key sr-mode-map "b" 'sr-browse-file)
+(define-key sr-mode-map "\C-c\C-w" 'sr-browse-pane)
+(define-key sr-mode-map "\C-c\d" 'sr-toggle-attributes)
+(define-key sr-mode-map "\M-l" 'sr-toggle-truncate-lines)
+(define-key sr-mode-map "s" 'sr-interactive-sort)
+(define-key sr-mode-map "r" 'sr-reverse-pane)
+(define-key sr-mode-map "\C-e" 'sr-scroll-up)
+(define-key sr-mode-map "\C-y" 'sr-scroll-down)
+(define-key sr-mode-map " " 'sr-scroll-quick-view)
+(define-key sr-mode-map "\M- " 'sr-scroll-quick-view-down)
+(define-key sr-mode-map [?\S- ] 'sr-scroll-quick-view-down)
+
+(define-key sr-mode-map "C" 'sr-do-copy)
+(define-key sr-mode-map "K" 'sr-do-clone)
+(define-key sr-mode-map "R" 'sr-do-rename)
+(define-key sr-mode-map "D" 'sr-do-delete)
+(define-key sr-mode-map "x" 'sr-do-flagged-delete)
+(define-key sr-mode-map "S" 'sr-do-symlink)
+(define-key sr-mode-map "Y" 'sr-do-relsymlink)
+(define-key sr-mode-map "H" 'sr-do-hardlink)
+(define-key sr-mode-map "\M-C" 'dired-do-copy)
+(define-key sr-mode-map "\M-R" 'dired-do-rename)
+(define-key sr-mode-map "\M-D" 'dired-do-delete)
+(define-key sr-mode-map "\M-S" 'dired-do-symlink)
+(define-key sr-mode-map "\M-Y" 'dired-do-relsymlink)
+(define-key sr-mode-map "\M-H" 'dired-do-hardlink)
+(define-key sr-mode-map "\C-x\C-q" 'sr-editable-pane)
+(define-key sr-mode-map "@" 'sr-fast-backup-files)
+(define-key sr-mode-map "\M-+" 'sr-create-files)
+
+(define-key sr-mode-map "=" 'sr-diff)
+(define-key sr-mode-map "\C-c=" 'sr-ediff)
+(define-key sr-mode-map "\C-x=" 'sr-compare-panes)
+
+(define-key sr-mode-map "\C-c\C-f" 'sr-find)
+(define-key sr-mode-map "\C-c\C-n" 'sr-find-name)
+(define-key sr-mode-map "\C-c\C-g" 'sr-find-grep)
+(define-key sr-mode-map "\C-cb" 'sr-flatten-branch)
+(define-key sr-mode-map "\C-cp" 'sr-prune-paths)
+(define-key sr-mode-map "\C-c\C-l" 'sr-locate)
+(define-key sr-mode-map "\C-c/" 'sr-fuzzy-narrow)
+(define-key sr-mode-map "\C-c\C-r" 'sr-recent-files)
+(define-key sr-mode-map "\C-c\C-d" 'sr-recent-directories)
+(define-key sr-mode-map "\C-cv" 'sr-virtualize-pane)
+(define-key sr-mode-map "\C-c\C-v" 'sr-pure-virtual)
+(define-key sr-mode-map "Q" 'sr-do-query-replace-regexp)
+(define-key sr-mode-map "F" 'sr-do-find-marked-files)
+(define-key sr-mode-map "A" 'sr-do-search)
+(define-key sr-mode-map "\C-cs" 'sr-sticky-isearch-forward)
+(define-key sr-mode-map "\C-cr" 'sr-sticky-isearch-backward)
+(define-key sr-mode-map "\C-x\C-f" 'sr-find-file)
+(define-key sr-mode-map "y" 'sr-show-files-info)
+
+(define-key sr-mode-map "\M-n" 'sr-next-line-other)
+(define-key sr-mode-map [M-down] 'sr-next-line-other)
+(define-key sr-mode-map [A-down] 'sr-next-line-other)
+(define-key sr-mode-map "\M-p" 'sr-prev-line-other)
+(define-key sr-mode-map [M-up] 'sr-prev-line-other)
+(define-key sr-mode-map [A-up] 'sr-prev-line-other)
+(define-key sr-mode-map "\M-j" 'sr-goto-dir-other)
+(define-key sr-mode-map "\M-\C-m" 'sr-advertised-find-file-other)
+(define-key sr-mode-map "\M-f" 'sr-advertised-find-file-other)
+(define-key sr-mode-map "\C-c\C-m" 'sr-advertised-find-file-other)
+(define-key sr-mode-map "\M-^" 'sr-prev-subdir-other)
+(define-key sr-mode-map "\M-J" 'sr-prev-subdir-other)
+(define-key sr-mode-map "\M-m" 'sr-mark-other)
+(define-key sr-mode-map "\M-M" 'sr-unmark-backward-other)
+(define-key sr-mode-map "\M-U" 'sr-unmark-all-marks-other)
+(define-key sr-mode-map "\M-;" 'sr-follow-file-other)
+(define-key sr-mode-map "\C-\M-y" 'sr-history-prev-other)
+(define-key sr-mode-map "\C-\M-u" 'sr-history-next-other)
+
+(define-key sr-mode-map "\C-ct" 'sr-term)
+(define-key sr-mode-map "\C-cT" 'sr-term-cd)
+(define-key sr-mode-map "\C-c\C-t" 'sr-term-cd-newterm)
+(define-key sr-mode-map "\C-c\M-t" 'sr-term-cd-program)
+(define-key sr-mode-map "\C-c;" 'sr-follow-viewer)
+(define-key sr-mode-map "q" 'sr-quit)
+(define-key sr-mode-map "\C-xk" 'sr-kill-pane-buffer)
+(define-key sr-mode-map "\M-q" 'sunrise-cd)
+(define-key sr-mode-map "h" 'sr-describe-mode)
+(define-key sr-mode-map "?" 'sr-summary)
+(define-key sr-mode-map "k" 'dired-do-kill-lines)
+(define-key sr-mode-map [remap undo] 'sr-undo)
+(define-key sr-mode-map [remap undo-only] 'sr-undo)
+(define-key sr-mode-map [backspace] 'dired-unmark-backward)
+
+(define-key sr-mode-map [mouse-1] 'sr-mouse-advertised-find-file)
+(define-key sr-mode-map [mouse-2] 'sr-mouse-change-window)
+
+(define-key sr-mode-map [(control >)] 'sr-checkpoint-save)
+(define-key sr-mode-map [(control .)] 'sr-checkpoint-restore)
+(define-key sr-mode-map [(control tab)] 'sr-select-viewer-window)
+(define-key sr-mode-map [(control backspace)] 'sr-toggle-attributes)
+(define-key sr-mode-map [(control ?\=)] 'sr-ediff)
+(define-key sr-mode-map [(control meta ?\=)] 'sr-compare-panes)
+(define-key sr-mode-map [(control })] 'sr-max-lock-panes)
+(define-key sr-mode-map [(control {)] 'sr-min-lock-panes)
+
+(define-key sr-mode-map (kbd "<down-mouse-1>") 'ignore)
+
+(defvar sr-commander-keys
+ '(([(f2)] . sr-goto-dir)
+ ([(f3)] . sr-quick-view)
+ ([(f4)] . sr-advertised-find-file)
+ ([(f5)] . sr-do-copy)
+ ([(f6)] . sr-do-rename)
+ ([(f7)] . dired-create-directory)
+ ([(f8)] . sr-do-delete)
+ ([(f10)] . sr-quit)
+ ([(control f3)] . sr-sort-by-name)
+ ([(control f4)] . sr-sort-by-extension)
+ ([(control f5)] . sr-sort-by-time)
+ ([(control f6)] . sr-sort-by-size)
+ ([(control f7)] . sr-sort-by-number)
+ ([(shift f7)] . sr-do-symlink)
+ ([(insert)] . sr-mark-toggle)
+ ([(control prior)] . sr-dired-prev-subdir))
+ "Traditional commander-style keybindings for the Sunrise Commander.")
+
+(defcustom sr-use-commander-keys t
+ "Whether to use traditional commander-style function keys (F5 = copy, etc)"
+ :group 'sunrise
+ :type 'boolean
+ :set (defun sr-set-commander-keys (symbol value)
+ "Setter function for the `sr-use-commander-keys' custom option."
+ (if value
+ (mapc (lambda (x)
+ (define-key sr-mode-map (car x) (cdr x))) sr-commander-keys)
+ (mapc (lambda (x)
+ (define-key sr-mode-map (car x) nil)) sr-commander-keys))
+ (set-default symbol value)))
+
+;;; ============================================================================
+;;; Initialization and finalization functions:
+
+;;;###autoload
+(defun sunrise (&optional left-directory right-directory filename)
+ "Toggle the Sunrise Commander file manager.
+If LEFT-DIRECTORY is given, the left window will display that
+directory (same for RIGHT-DIRECTORY). Specifying nil for any of
+these values uses the default, ie. $HOME."
+ (interactive)
+ (message "Starting Sunrise Commander...")
+
+ (if (not sr-running)
+ (let ((welcome sr-start-message))
+ (if left-directory
+ (setq sr-left-directory left-directory))
+ (if right-directory
+ (setq sr-right-directory right-directory))
+
+ (sr-switch-to-nonpane-buffer)
+ (setq sr-restore-buffer (current-buffer)
+ sr-current-frame (window-frame (selected-window))
+ sr-prior-window-configuration (current-window-configuration)
+ sr-running t)
+ (sr-setup-windows)
+ (if filename
+ (condition-case description
+ (sr-focus-filename (file-name-nondirectory filename))
+ (error (setq welcome (cadr description)))))
+ (setq sr-this-directory default-directory)
+ (message "%s" welcome)
+ (sr-highlight) ;;<-- W32Emacs needs this
+ (hl-line-mode 1))
+ (let ((my-frame (window-frame (selected-window))))
+ (sr-quit)
+ (message "All life leaps out to greet the light...")
+ (unless (eq my-frame (window-frame (selected-window)))
+ (select-frame my-frame)
+ (sunrise left-directory right-directory filename)))))
+
+;;;###autoload
+(defun sr-dired (&optional target switches)
+ "Visit the given target (file or directory) in `sr-mode'."
+ (interactive
+ (list
+ (read-file-name "Visit (file or directory): " nil nil nil)))
+ (let* ((target (expand-file-name (or target default-directory)))
+ (file (if (file-directory-p target) nil target))
+ (directory (if file (file-name-directory target) target))
+ (dired-omit-mode (if sr-show-hidden-files -1 1))
+ (sr-listing-switches (or switches sr-listing-switches)))
+ (unless (file-readable-p directory)
+ (error "%s is not readable!" (sr-directory-name-proper directory)))
+ (unless (and sr-running (eq (selected-frame) sr-current-frame)) (sunrise))
+ (sr-select-window sr-selected-window)
+ (if file
+ (sr-follow-file file)
+ (sr-goto-dir directory))
+ (hl-line-mode 1)
+ (sr-display-attributes (point-min) (point-max) sr-show-file-attributes)
+ (sr-this 'buffer)))
+
+(defun sr-choose-cd-target ()
+ "Select a suitable target directory for cd operations."
+ (if (and sr-running (eq (selected-frame) sr-current-frame))
+ sr-this-directory
+ default-directory))
+
+;;;###autoload
+(defun sunrise-cd ()
+ "Toggle the Sunrise Commander FM keeping the current file in focus.
+If Sunrise is off, enable it and focus the file displayed in the current buffer.
+If Sunrise is on, disable it and switch to the buffer currently displayed in the
+viewer window."
+ (interactive)
+ (if (not (and sr-running
+ (eq (window-frame sr-left-window) (selected-frame))))
+ (sr-dired (or (buffer-file-name) (sr-choose-cd-target)))
+ (sr-quit t)
+ (message "Hast thou a charm to stay the morning-star in his deep course?")))
+
+(defun sr-this (&optional type)
+ "Return object of type TYPE corresponding to the active side of the manager.
+If TYPE is not specified (nil), returns a symbol (`left' or `right').
+If TYPE is `buffer' or `window', returns the corresponding buffer
+or window."
+ (if type
+ (symbol-value (sr-symbol sr-selected-window type))
+ sr-selected-window))
+
+(defun sr-other (&optional type)
+ "Return object of type TYPE corresponding to the passive side of the manager.
+If TYPE is not specified (nil), returns a symbol (`left' or `right').
+If TYPE is `buffer' or `window', returns the corresponding
+buffer or window."
+ (let ((side (cdr (assq sr-selected-window sr-side-lookup))))
+ (if type
+ (symbol-value (sr-symbol side type))
+ side)))
+
+;;; ============================================================================
+;;; Window management functions:
+
+(defmacro sr-setup-pane (side)
+ "Helper macro for the function `sr-setup-windows'."
+ `(let ((sr-selected-window ',side))
+ (setq ,(sr-symbol side 'window) (selected-window))
+ (if (buffer-live-p ,(sr-symbol side 'buffer))
+ (progn
+ (switch-to-buffer ,(sr-symbol side 'buffer))
+ (setq ,(sr-symbol side 'directory) default-directory))
+ (sr-dired ,(sr-symbol side 'directory)))))
+
+(defun sr-setup-visible-panes ()
+ "Set up sunrise on all visible panes."
+ (sr-setup-pane left)
+ (unless (eq sr-window-split-style 'top)
+ (other-window 1)
+ (sr-setup-pane right)))
+
+(defun sr-setup-windows()
+ "Set up the Sunrise window configuration (two windows in `sr-mode')."
+ (run-hooks 'sr-init-hook)
+ ;;get rid of all windows except one (not any of the panes!)
+ (sr-select-viewer-window)
+ (delete-other-windows)
+ (if (buffer-live-p other-window-scroll-buffer)
+ (switch-to-buffer other-window-scroll-buffer)
+ (sr-switch-to-nonpane-buffer))
+
+ ;;now create the viewer window
+ (unless (and sr-panes-height (< sr-panes-height (frame-height)))
+ (setq sr-panes-height (sr-get-panes-size)))
+ (if (and (<= sr-panes-height (* 2 window-min-height))
+ (eq sr-window-split-style 'vertical))
+ (setq sr-panes-height (* 2 window-min-height)))
+ (split-window (selected-window) sr-panes-height)
+
+ (case sr-window-split-style
+ (horizontal (split-window-horizontally))
+ (vertical (split-window-vertically))
+ (top (ignore))
+ (t (error "Unrecognised `sr-window-split-style' value: %s"
+ sr-window-split-style)))
+
+ (sr-setup-visible-panes)
+
+ ;;select the correct window
+ (sr-select-window sr-selected-window)
+ (sr-restore-panes-width)
+ (run-hooks 'sr-start-hook))
+
+(defun sr-switch-to-nonpane-buffer ()
+ "Try to switch to a buffer that is *not* a Sunrise pane."
+ (let ((start (current-buffer)))
+ (while (and
+ start
+ (or (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
+ (memq (current-buffer) (list sr-left-buffer sr-right-buffer))))
+ (bury-buffer)
+ (if (eq start (current-buffer)) (setq start nil)))))
+
+(defun sr-restore-prior-configuration ()
+ "Restore the configuration stored in `sr-prior-window-configuration' if any."
+ (set-window-configuration sr-prior-window-configuration)
+ (if (buffer-live-p sr-restore-buffer)
+ (set-buffer sr-restore-buffer)))
+
+(defun sr-lock-window (_frame)
+ "Resize the left Sunrise pane to have the \"right\" size."
+ (when sr-running
+ (if (not (window-live-p sr-left-window))
+ (setq sr-running nil)
+ (let ((sr-windows-locked sr-windows-locked))
+ (when (> window-min-height (- (frame-height)
+ (window-height sr-left-window)))
+ (setq sr-windows-locked nil))
+ (and sr-windows-locked
+ (not sr-ediff-on)
+ (not (eq sr-window-split-style 'vertical))
+ (window-live-p sr-left-window)
+ (save-selected-window
+ (select-window sr-left-window)
+ (let ((my-delta (- sr-panes-height (window-height))))
+ (enlarge-window my-delta))
+ (scroll-right)
+ (when (window-live-p sr-right-window)
+ (select-window sr-right-window)
+ (scroll-right))))))))
+
+;; This keeps the size of the Sunrise panes constant:
+(add-hook 'window-size-change-functions 'sr-lock-window)
+
+(defun sr-highlight(&optional face)
+ "Set up the path line in the current buffer.
+With optional FACE, register this face as the current face to display the active
+path line."
+ (when (and (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
+ (not sr-inhibit-highlight))
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char (point-min))
+ (sr-hide-avfs-root)
+ (sr-highlight-broken-links)
+ (sr-graphical-highlight face)
+ (sr-force-passive-highlight)
+ (run-hooks 'sr-refresh-hook)))))
+
+(defun sr-unhighlight (face)
+ "Remove FACE from the list of faces of the active path line."
+ (when face
+ (setq sr-current-path-faces (delq face sr-current-path-faces))
+ (overlay-put sr-current-window-overlay 'face
+ (or (car sr-current-path-faces) 'sr-active-path-face))))
+
+(defun sr-hide-avfs-root ()
+ "Hide the AVFS virtual filesystem root (if any) on the path line."
+ (if sr-avfs-root
+ (let ((start nil) (end nil)
+ (next (search-forward sr-avfs-root (point-at-eol) t)))
+ (if next (setq start (- next (length sr-avfs-root))))
+ (while next
+ (setq end (point)
+ next (search-forward sr-avfs-root (point-at-eol) t)))
+ (when end
+ (add-text-properties start end '(invisible t))))))
+
+(defun sr-highlight-broken-links ()
+ "Mark broken symlinks with an exclamation mark."
+ (let ((dired-marker-char ?!))
+ (while (search-forward-regexp dired-re-sym nil t)
+ (unless (or (not (eq 32 (char-after (line-beginning-position))))
+ (file-exists-p (dired-get-filename)))
+ (dired-mark 1)))))
+
+(defsubst sr-invalid-overlayp ()
+ "Test for invalidity of the current buffer's graphical path line overlay.
+Returns t if the overlay is no longer valid and should be replaced."
+ (or (not (overlayp sr-current-window-overlay))
+ (eq (overlay-start sr-current-window-overlay)
+ (overlay-end sr-current-window-overlay))))
+
+(defun sr-graphical-highlight (&optional face)
+ "Set up the graphical path line in the current buffer.
+\(Fancy fonts and clickable path.)"
+ (let ((begin) (end) (inhibit-read-only t))
+
+ (when (sr-invalid-overlayp)
+ ;;determine begining and end
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward-regexp "\\S " nil t)
+ (setq begin (1- (point)))
+ (end-of-line)
+ (setq end (1- (point))))
+
+ ;;build overlay
+ (when sr-current-window-overlay
+ (delete-overlay sr-current-window-overlay))
+ (set (make-local-variable 'sr-current-window-overlay)
+ (make-overlay begin end))
+
+ ;;path line hover effect:
+ (add-text-properties
+ begin
+ end
+ '(mouse-face sr-highlight-path-face
+ help-echo "click to move up")
+ nil))
+ (when face
+ (setq sr-current-path-faces (cons face sr-current-path-faces)))
+ (overlay-put sr-current-window-overlay 'face
+ (or (car sr-current-path-faces) 'sr-active-path-face))
+ (overlay-put sr-current-window-overlay 'window (selected-window))))
+
+(defun sr-force-passive-highlight (&optional revert)
+ "Set up the graphical path line in the passive pane.
+With optional argument REVERT, executes `revert-buffer' on the passive buffer."
+ (unless (or (not (buffer-live-p (sr-other 'buffer)))
+ (eq sr-left-buffer sr-right-buffer))
+ (with-current-buffer (sr-other 'buffer)
+ (when sr-current-window-overlay
+ (delete-overlay sr-current-window-overlay))
+ (when (and revert
+ (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode)))
+ (revert-buffer)))))
+
+(defun sr-quit (&optional norestore)
+ "Quit Sunrise and restore Emacs to the previous state."
+ (interactive)
+ (if sr-running
+ (progn
+ (setq sr-running nil)
+ (sr-save-directories)
+ (sr-save-panes-width)
+ (if norestore
+ (progn
+ (sr-select-viewer-window)
+ (delete-other-windows))
+ (sr-restore-prior-configuration))
+ (sr-bury-panes)
+ (setq buffer-read-only nil)
+ (run-hooks 'sr-quit-hook)
+ (setq sr-current-frame nil))
+ (bury-buffer)))
+
+(add-hook 'delete-frame-functions
+ (lambda (frame)
+ (if (and sr-running (eq frame sr-current-frame)) (sr-quit))))
+
+(defun sr-save-directories ()
+ "Save current directories in the panes to use them at the next startup."
+ (when (window-live-p sr-left-window)
+ (set-buffer (window-buffer sr-left-window))
+ (when (memq major-mode '(sr-mode sr-tree-mode))
+ (setq sr-left-directory default-directory)
+ (setq sr-left-buffer (current-buffer))))
+
+ (when (window-live-p sr-right-window)
+ (set-buffer (window-buffer sr-right-window))
+ (when (memq major-mode '(sr-mode sr-tree-mode))
+ (setq sr-right-directory default-directory)
+ (setq sr-right-buffer (current-buffer)))))
+
+(defun sr-bury-panes ()
+ "Send both pane buffers to the end of the `buffer-list'."
+ (mapc (lambda (x)
+ (bury-buffer (symbol-value (sr-symbol x 'buffer))))
+ '(left right)))
+
+(defun sr-save-panes-width ()
+ "Save the width of the panes to use them at the next startup."
+ (unless sr-selected-window-width
+ (if (and (window-live-p sr-left-window)
+ (window-live-p sr-right-window))
+ (setq sr-selected-window-width
+ (window-width
+ (symbol-value (sr-symbol sr-selected-window 'window))))
+ (setq sr-selected-window-width t))))
+
+(defun sr-restore-panes-width ()
+ "Restore the last registered pane width."
+ (when (and (eq sr-window-split-style 'horizontal)
+ (numberp sr-selected-window-width))
+ (enlarge-window-horizontally
+ (min (- sr-selected-window-width (window-width))
+ (- (frame-width) (window-width) window-min-width)))))
+
+(defun sr-resize-panes (&optional reverse)
+ "Enlarge (or shrink, if REVERSE is t) the left pane by 5 columns."
+ (when (and (window-live-p sr-left-window)
+ (window-live-p sr-right-window))
+ (let ((direction (or (and reverse -1) 1)))
+ (save-selected-window
+ (select-window sr-left-window)
+ (enlarge-window-horizontally (* 5 direction))))
+ (setq sr-selected-window-width nil)))
+
+(defun sr-enlarge-left-pane ()
+ "Enlarge the left pane by 5 columns."
+ (interactive)
+ (when (< (1+ window-min-width) (window-width sr-right-window))
+ (sr-resize-panes)
+ (sr-save-panes-width)))
+
+(defun sr-enlarge-right-pane ()
+ "Enlarge the right pane by 5 columns."
+ (interactive)
+ (when (< (1+ window-min-width) (window-width sr-left-window))
+ (sr-resize-panes t)
+ (sr-save-panes-width)))
+
+(defun sr-get-panes-size (&optional size)
+ "Tell what the maximal, minimal and normal pane sizes should be."
+ (let ((frame (frame-height)))
+ (case size
+ (max (max (- frame window-min-height 1) 5))
+ (min (min (1+ window-min-height) 5))
+ (t (/ (* sr-windows-default-ratio (frame-height)) 100)))))
+
+(defun sr-enlarge-panes ()
+ "Enlarge both panes vertically."
+ (interactive)
+ (let ((sr-windows-locked nil)
+ (max (sr-get-panes-size 'max))
+ (ratio 1)
+ delta)
+ (save-selected-window
+ (when (eq sr-window-split-style 'vertical)
+ (select-window sr-right-window)
+ (setq ratio 2)
+ (setq delta (- max (window-height)))
+ (if (> (/ max ratio) (window-height))
+ (shrink-window (if (< 2 delta) -2 -1))))
+ (select-window sr-left-window)
+ (if (> (/ max ratio) (window-height))
+ (shrink-window -1))
+ (setq sr-panes-height (* (window-height) ratio)))))
+
+(defun sr-shrink-panes ()
+ "Shink both panes vertically."
+ (interactive)
+ (let ((sr-windows-locked nil)
+ (min (sr-get-panes-size 'min))
+ (ratio 1)
+ delta)
+ (save-selected-window
+ (when (eq sr-window-split-style 'vertical)
+ (select-window sr-right-window)
+ (setq ratio 2)
+ (setq delta (- (window-height) min))
+ (if (< min (window-height))
+ (shrink-window (if (< 2 delta) 2 1))))
+ (select-window sr-left-window)
+ (if (< min (window-height))
+ (shrink-window 1))
+ (setq sr-panes-height (* (window-height) ratio)))))
+
+(defun sr-lock-panes (&optional height)
+ "Resize and lock the panes at some vertical position.
+The optional argument determines the height to lock the panes at.
+Valid values are `min' and `max'; given any other value, locks
+the panes at normal position."
+ (interactive)
+ (if sr-running
+ (if (not (and (window-live-p sr-left-window)
+ (or (window-live-p sr-right-window)
+ (eq sr-window-split-style 'top))))
+ (sr-setup-windows)
+ (setq sr-panes-height (sr-get-panes-size height))
+ (let ((locked sr-windows-locked))
+ (setq sr-windows-locked t)
+ (if height
+ (shrink-window 1)
+ (setq sr-selected-window-width t)
+ (balance-windows))
+ (unless locked
+ (sit-for 0.1)
+ (setq sr-windows-locked nil))))
+ (sunrise)))
+
+(defun sr-max-lock-panes ()
+ (interactive)
+ (sr-save-panes-width)
+ (sr-lock-panes 'max))
+
+(defun sr-min-lock-panes ()
+ (interactive)
+ (sr-save-panes-width)
+ (sr-lock-panes 'min))
+
+;;; ============================================================================
+;;; File system navigation functions:
+
+(defun sr-advertised-find-file (&optional filename)
+ "Handle accesses to file system objects through the user interface.
+Includes cases when the user presses return, f or clicks on the path line."
+ (interactive)
+ (unless filename
+ (if (eq 1 (line-number-at-pos)) ;; <- Click or Enter on path line.
+ (let* ((path (buffer-substring (point) (point-at-eol)))
+ (levels (1- (length (split-string path "/")))))
+ (if (< 0 levels)
+ (sr-dired-prev-subdir levels)
+ (sr-beginning-of-buffer)))
+ (setq filename (dired-get-filename nil t)
+ filename (and filename (expand-file-name filename)))))
+ (if filename
+ (if (file-exists-p filename)
+ (sr-find-file filename)
+ (error "Sunrise: nonexistent target"))))
+
+(defun sr-advertised-execute-file (&optional prefix)
+ "Execute the currently selected file in a new subprocess."
+ (interactive "P")
+ (let ((path (dired-get-filename nil t)) (label) (args))
+ (if path
+ (setq label (file-name-nondirectory path))
+ (error "Sunrise: no executable file on this line"))
+ (unless (and (not (file-directory-p path)) (file-executable-p path))
+ (error "Sunrise: \"%s\" is not an executable file" label))
+ (when prefix
+ (setq args (read-string (format "arguments for \"%s\": " label))
+ label (format "%s %s" label args)))
+ (message "Sunrise: executing \"%s\" in new process" label)
+ (if args
+ (apply #'start-process (append (list "Sunrise Subprocess" nil path)
+ (split-string args)))
+ (start-process "Sunrise Subprocess" nil path))))
+
+(defun sr-find-file (filename &optional wildcards)
+ "Determine the proper way of handling an object in the file system.
+FILENAME can be either a regular file, a regular directory, a
+Sunrise VIRTUAL directory, or a virtual directory served by
+AVFS."
+ (interactive (find-file-read-args "Find file or directory: " nil))
+ (cond ((file-directory-p filename) (sr-find-regular-directory filename))
+ ((and (sr-avfs-directory-p filename) (sr-avfs-dir filename))
+ (sr-find-regular-directory (sr-avfs-dir filename)))
+ ((sr-virtual-directory-p filename) (sr-find-virtual-directory filename))
+ (t (sr-find-regular-file filename wildcards))))
+
+(defun sr-virtual-directory-p (filename)
+ "Tell whether FILENAME is the path to a Sunrise VIRTUAL directory."
+ (eq 'sr-virtual-mode (assoc-default filename auto-mode-alist 'string-match)))
+
+(defun sr-avfs-directory-p (filename)
+ "Tell whether FILENAME can be seen as the root of an AVFS virtual directory."
+ (let ((mode (assoc-default filename auto-mode-alist 'string-match)))
+ (and sr-avfs-root
+ (or (eq 'archive-mode mode)
+ (eq 'tar-mode mode)
+ (and (listp mode) (eq 'jka-compr (cadr mode)))
+ (not (equal "." (sr-assoc-key filename
+ sr-avfs-handlers-alist
+ 'string-match)))))))
+
+(defun sr-find-regular-directory (directory)
+ "Visit the given regular directory in the active pane."
+ (setq directory (file-name-as-directory directory))
+ (let ((parent (expand-file-name "../")))
+ (if (and (not (sr-equal-dirs parent default-directory))
+ (sr-equal-dirs directory parent))
+ (sr-dired-prev-subdir)
+ (sr-goto-dir directory))))
+
+(defun sr-find-virtual-directory (sr-virtual-dir)
+ "Visit the given Sunrise VIRTUAL directory in the active pane."
+ (sr-save-aspect
+ (sr-alternate-buffer (find-file sr-virtual-dir)))
+ (sr-history-push sr-virtual-dir)
+ (set-visited-file-name nil t)
+ (sr-keep-buffer)
+ (sr-backup-buffer))
+
+(defun sr-find-regular-file (filename &optional wildcards)
+ "Deactivate Sunrise and visit FILENAME as a regular file with WILDCARDS.
+\(See `find-file' for more details on wildcard expansion.)"
+ (condition-case description
+ (let ((buff (find-file-noselect filename nil nil wildcards)))
+ (sr-save-panes-width)
+ (sr-quit)
+ (set-window-configuration sr-prior-window-configuration)
+ (switch-to-buffer buff))
+ (error (message "%s" (cadr description)))))
+
+(defun sr-avfs-dir (filename)
+ "Return the virtual path for accessing FILENAME through AVFS.
+Returns nil if AVFS cannot manage this kind of file."
+ (let* ((handler (assoc-default filename sr-avfs-handlers-alist 'string-match))
+ (vdir (concat filename handler)))
+ (unless (sr-overlapping-paths-p sr-avfs-root vdir)
+ (setq vdir (concat sr-avfs-root vdir)))
+ (if (file-attributes vdir) vdir nil)))
+
+(defun sr-goto-dir (dir)
+ "Change the current directory in the active pane to the given one."
+ (interactive "DChange directory (file or pattern): ")
+ (if sr-goto-dir-function
+ (funcall sr-goto-dir-function dir)
+ (unless (and (eq major-mode 'sr-mode) (sr-equal-dirs dir default-directory))
+ (if (and sr-avfs-root
+ (null (posix-string-match "#" dir)))
+ (setq dir (replace-regexp-in-string
+ (expand-file-name sr-avfs-root) "" dir)))
+ (sr-save-aspect
+ (sr-within dir (sr-alternate-buffer (dired dir))))
+ (sr-history-push default-directory)
+ (sr-beginning-of-buffer))))
+
+(defun sr-dired-prev-subdir (&optional count)
+ "Go to the parent directory, or COUNT subdirectories upwards."
+ (interactive "P")
+ (unless (sr-equal-dirs default-directory "/")
+ (let* ((count (or count 1))
+ (to (replace-regexp-in-string "x" "../" (make-string count ?x)))
+ (from (expand-file-name (substring to 1)))
+ (from (sr-directory-name-proper from))
+ (from (replace-regexp-in-string "\\(?:#.*/?$\\|/$\\)" "" from))
+ (to (replace-regexp-in-string "\\.\\./$" "" (expand-file-name to))))
+ (sr-goto-dir to)
+ (unless (sr-equal-dirs from to)
+ (sr-focus-filename from)))))
+
+(defun sr-follow-file (&optional target-path)
+ "Go to the same directory where the selected file is.
+Very useful inside Sunrise VIRTUAL buffers."
+ (interactive)
+ (if (null target-path)
+ (setq target-path (dired-get-filename nil t)))
+
+ (let ((target-dir (file-name-directory target-path))
+ (target-symlink (file-symlink-p target-path))
+ (target-file))
+
+ ;; if the target is a symlink and there's nothing more interesting to do
+ ;; then follow the symlink:
+ (when (and target-symlink
+ (string= target-dir (dired-current-directory))
+ (not (eq major-mode 'sr-virtual-mode)))
+ (unless (file-exists-p target-symlink)
+ (error "Sunrise: file is a symlink to a nonexistent target"))
+ (setq target-path target-symlink)
+ (setq target-dir (file-name-directory target-symlink)))
+
+ (setq target-file (file-name-nondirectory target-path))
+
+ (when target-dir ;; <-- nil in symlinks to other files in same directory:
+ (setq target-dir (sr-chop ?/ target-dir))
+ (sr-goto-dir target-dir))
+ (sr-focus-filename target-file)))
+
+(defun sr-follow-viewer ()
+ "Go to the directory of the file displayed in the viewer window."
+ (interactive)
+ (when sr-running
+ (let* ((viewer (sr-viewer-window))
+ (viewer-buffer (if viewer (window-buffer viewer)))
+ (target-dir) (target-file))
+ (when viewer-buffer
+ (with-current-buffer viewer-buffer
+ (setq target-dir default-directory
+ target-file (sr-directory-name-proper (buffer-file-name)))))
+ (sr-select-window sr-selected-window)
+ (if target-dir (sr-goto-dir target-dir))
+ (if target-file (sr-focus-filename target-file)))))
+
+(defun sr-project-path ()
+ "Find projections of the active directory over the passive one.
+
+Locates interactively all descendants of the directory in the passive pane that
+have a path similar to the directory in the active pane.
+
+For instance, if the active pane is displaying directory /a/b/c and the passive
+one is displaying /x/y, this command will check for the existence of any of the
+following: /x/y/a/b/c, /x/y/b/c, /x/y/c and /x/y. Each (existing) directory
+located according to this schema will be known hereafter as a 'projection of the
+directory /a/b/c over /x/y'.
+
+If many projections of the active directory over the passive one exist, one can
+rotate among all of them by invoking `sr-project-path' repeatedly : they will be
+visited in order, from longest path to shortest."
+
+ (interactive)
+ (let* ((sr-synchronized nil)
+ (path (sr-chop ?/ (expand-file-name (dired-current-directory))))
+ (pos (if (< 0 (length path)) 1)) (candidate) (next-key))
+ (while pos
+ (setq candidate (concat sr-other-directory (substring path pos))
+ pos (string-match "/" path (1+ pos))
+ pos (if pos (1+ pos)))
+ (when (and (file-directory-p candidate)
+ (not (sr-equal-dirs sr-this-directory candidate)))
+ (sr-goto-dir-other candidate)
+ (setq next-key (read-key-sequence "(press C-M-o again for more)"))
+ (if (eq (lookup-key sr-mode-map next-key) 'sr-project-path)
+ (sr-history-prev-other)
+ (setq unread-command-events (listify-key-sequence next-key)
+ pos nil))))
+ (unless next-key
+ (message "Sunrise: sorry, no suitable projections found"))))
+
+(defun sr-history-push (element)
+ "Push a new path into the history stack of the current pane."
+ (unless (or (null element)
+ (and (featurep 'tramp)
+ (string-match tramp-file-name-regexp element)))
+ (let* ((pane (assoc sr-selected-window sr-history-registry))
+ (hist (cdr pane))
+ (len (length hist)))
+ (if (>= len sr-history-length)
+ (nbutlast hist (- len sr-history-length)))
+ (setq element (abbreviate-file-name (sr-chop ?/ element))
+ hist (delete element hist))
+ (push element hist)
+ (setcdr pane hist))
+ (sr-history-stack-reset)))
+
+(defun sr-history-next ()
+ "Navigate forward in the history of the active pane."
+ (interactive)
+ (let ((side (assoc sr-selected-window sr-history-stack)))
+ (unless (zerop (cadr side))
+ (sr-history-move -1))
+ (when (zerop (cadr side))
+ (sr-history-stack-reset))))
+
+(defun sr-history-prev ()
+ "Navigate backwards in the history of the active pane."
+ (interactive)
+ (let ((history (cdr (assoc sr-selected-window sr-history-registry)))
+ (stack (cdr (assoc sr-selected-window sr-history-stack))))
+ (when (< (abs (cdr stack)) (1- (length history)))
+ (sr-history-move 1))))
+
+(defun sr-history-move (step)
+ "Traverse the history of the active pane in a stack-like fashion.
+This function re-arranges the history list of the current pane so as to make it
+simulate a stack of directories, from which one can 'pop' the current directory
+and 'push' it back, keeping the most recently visited entries always near the
+top of the stack."
+ (let* ((side (assoc sr-selected-window sr-history-stack))
+ (depth (cadr side)) (goal) (target-dir))
+ (when (> 0 (* step depth))
+ (sr-history-stack-reset))
+ (setq goal (1+ (cddr side))
+ depth (* step (+ (abs depth) step))
+ target-dir (sr-history-pick goal))
+ (when target-dir
+ (sr-goto-dir target-dir)
+ (setcdr side (cons depth goal)))))
+
+(defun sr-history-stack-reset ()
+ "Reset the current history stack counter."
+ (let ((side (assoc sr-selected-window sr-history-stack)))
+ (setcdr side '(0 . 0))))
+
+(defun sr-history-pick (position)
+ "Return directory at POSITION in current history.
+If the entry was removed or made inaccessible since our last visit, remove it
+from the history list and check among the previous ones until an accessible
+directory is found, or the list runs out of entries."
+ (let* ((history (cdr (assoc sr-selected-window sr-history-registry)))
+ (target (nth position history)))
+ (while (and target (not (file-accessible-directory-p target)))
+ (delete target history)
+ (setq target (nth position history)))
+ target))
+
+(defun sr-require-checkpoints-extension (&optional noerror)
+ "Bootstrap code for checkpoint support.
+Just tries to require the appropriate checkpoints extension
+depending on the version of bookmark.el being used."
+ (require 'bookmark nil t)
+ (let* ((feature
+ (cond ((fboundp 'bookmark-make-record) 'sunrise-x-checkpoints)
+ (t 'sunrise-x-old-checkpoints)))
+ (name (symbol-name feature)))
+ (or
+ (not (featurep 'sunrise-commander))
+ (require feature nil t)
+ noerror
+ (error "Feature `%s' not found!\
+For checkpoints to work, download http://joseito.republika.pl/%s.el.gz\
+and add it to your `load-path'" name name))))
+
+(defmacro sr-checkpoint-command (function-name)
+ `(defun ,function-name (&optional arg)
+ (interactive)
+ (sr-require-checkpoints-extension)
+ (if (commandp #',function-name)
+ (call-interactively #',function-name)
+ (funcall #',function-name arg))))
+(sr-checkpoint-command sr-checkpoint-save)
+(sr-checkpoint-command sr-checkpoint-restore)
+(sr-checkpoint-command sr-checkpoint-handler)
+;;;###autoload (autoload 'sr-checkpoint-handler "sunrise-commander" "" t)
+
+(defun sr-do-find-marked-files (&optional noselect)
+ "Sunrise replacement for `dired-do-find-marked-files'."
+ (interactive "P")
+ (let* ((files (delq nil (mapcar (lambda (x)
+ (and (file-regular-p x) x))
+ (dired-get-marked-files)))))
+ (unless files
+ (error "Sunrise: no regular files to open"))
+ (unless noselect (sr-quit))
+ (dired-simultaneous-find-file files noselect)))
+
+;;; ============================================================================
+;;; Graphical interface interaction functions:
+
+(defun sr-change-window()
+ "Change to the other Sunrise pane."
+ (interactive)
+ (if (and (window-live-p sr-left-window) (window-live-p sr-right-window))
+ (let ((here sr-this-directory))
+ (setq sr-this-directory sr-other-directory)
+ (setq sr-other-directory here)
+ (sr-select-window (sr-other)))))
+
+(defun sr-mouse-change-window (e)
+ "Change to the Sunrise pane clicked in by the mouse."
+ (interactive "e")
+ (mouse-set-point e)
+ (if (eq (selected-window) (sr-other 'window))
+ (sr-change-window)))
+
+(defun sr-beginning-of-buffer()
+ "Go to the first directory/file in Dired."
+ (interactive)
+ (goto-char (point-min))
+ (when (re-search-forward directory-listing-before-filename-regexp nil t)
+ (dotimes (_times 2)
+ (when (looking-at "\.\.?/?$")
+ (dired-next-line 1)))))
+
+(defun sr-end-of-buffer()
+ "Go to the last directory/file in Dired."
+ (interactive)
+ (goto-char (point-max))
+ (re-search-backward directory-listing-before-filename-regexp)
+ (dired-next-line 0))
+
+(defun sr-focus-filename (filename)
+ "Try to select FILENAME in the current buffer."
+ (if (and dired-omit-mode
+ (string-match (dired-omit-regexp) filename))
+ (dired-omit-mode -1))
+ (let ((sr-inhibit-highlight t)
+ (expr (sr-chop ?/ filename)))
+ (cond ((file-symlink-p filename)
+ (setq expr (concat (regexp-quote expr) " ->")))
+ ((file-directory-p filename)
+ (setq expr (concat (regexp-quote expr) "\\(?:/\\|$\\)")))
+ ((file-regular-p filename)
+ (setq expr (concat (regexp-quote expr) "$"))))
+ (setq expr (concat "[0-9] +" expr))
+ (beginning-of-line)
+ (unless (re-search-forward expr nil t)
+ (re-search-backward expr nil t)))
+ (beginning-of-line)
+ (re-search-forward directory-listing-before-filename-regexp nil t))
+
+(defun sr-split-toggle()
+ "Change Sunrise window layout from horizontal to vertical to top and so on."
+ (interactive)
+ (case sr-window-split-style
+ (horizontal (sr-split-setup 'vertical))
+ (vertical (sr-split-setup 'top))
+ (top (progn
+ (sr-split-setup 'horizontal)
+ (sr-in-other (revert-buffer))))
+ (t (sr-split-setup 'horizontal))))
+
+(defun sr-split-setup(split-type)
+ (setq sr-window-split-style split-type)
+ (when sr-running
+ (when (eq sr-window-split-style 'top)
+ (sr-select-window 'left)
+ (delete-window sr-right-window)
+ (setq sr-panes-height (window-height)))
+ (sr-setup-windows))
+ (message "Sunrise: split style changed to \"%s\"" (symbol-name split-type)))
+
+(defun sr-transpose-panes ()
+ "Change the order of the panes."
+ (interactive)
+ (unless (eq sr-left-buffer sr-right-buffer)
+ (mapc (lambda (x)
+ (let ((left (sr-symbol 'left x)) (right (sr-symbol 'right x)) (tmp))
+ (setq tmp (symbol-value left))
+ (set left (symbol-value right))
+ (set right tmp)))
+ '(directory buffer window))
+ (let ((tmp sr-this-directory))
+ (setq sr-this-directory sr-other-directory
+ sr-other-directory tmp))
+ (select-window sr-right-window)
+ (sr-setup-visible-panes)
+ (sr-select-window sr-selected-window)))
+
+(defun sr-synchronize-panes (&optional reverse)
+ "Change the directory in the other pane to that in the current one.
+If the optional parameter REVERSE is non-nil, performs the
+opposite operation, ie. changes the directory in the current pane
+to that in the other one."
+ (interactive "P")
+ (let ((target (current-buffer)) (sr-inhibit-highlight t))
+ (sr-change-window)
+ (if reverse
+ (setq target (current-buffer))
+ (sr-alternate-buffer (switch-to-buffer target))
+ (sr-history-push default-directory))
+ (sr-change-window)
+ (when reverse
+ (sr-alternate-buffer (switch-to-buffer target))
+ (sr-history-push default-directory)
+ (revert-buffer)))
+ (sr-highlight))
+
+(defun sr-browse-pane ()
+ "Browse the directory in the active pane."
+ (interactive)
+ (if (not (featurep 'browse-url))
+ (error "Sunrise: feature `browse-url' not available!")
+ (let ((url (concat "file://" (expand-file-name default-directory))))
+ (message "Browsing directory %s " default-directory)
+ (if (featurep 'w3m)
+ (eval '(w3m-goto-url url))
+ (browse-url url)))))
+
+(defun sr-browse-file (&optional file)
+ "Display the selected file in the default web browser."
+ (interactive)
+ (unless (featurep 'browse-url)
+ (error "ERROR: Feature browse-url not available!"))
+ (setq file (or file (dired-get-filename)))
+ (save-selected-window
+ (sr-select-viewer-window)
+ (let ((buff (current-buffer)))
+ (browse-url (concat "file://" file))
+ (unless (eq buff (current-buffer))
+ (sr-scrollable-viewer (current-buffer)))))
+ (message "Browsing \"%s\" in web browser" file))
+
+(defun sr-revert-buffer (&optional _ignore-auto _no-confirm)
+ "Revert the current pane using the contents of the backup buffer (if any).
+If the buffer is non-virtual the backup buffer is killed."
+ (interactive)
+ (if (buffer-live-p sr-backup-buffer)
+ (let ((marks (dired-remember-marks (point-min) (point-max)))
+ (focus (dired-get-filename 'verbatim t))
+ (inhibit-read-only t))
+ (erase-buffer)
+ (insert-buffer-substring sr-backup-buffer)
+ (sr-beginning-of-buffer)
+ (dired-mark-remembered marks)
+ (if focus (sr-focus-filename focus))
+ (dired-change-marks ?\t ?*)
+ (if (eq 'sr-mode major-mode) (sr-kill-backup-buffer)))
+ (unless (or (eq major-mode 'sr-virtual-mode)
+ (local-variable-p 'sr-virtual-buffer))
+ (dired-revert)
+ (if (string= "NUMBER" (get sr-selected-window 'sorting-order))
+ (sr-sort-by-number t)
+ (if (get sr-selected-window 'sorting-reverse)
+ (sr-reverse-pane)))))
+ (sr-display-attributes (point-min) (point-max) sr-show-file-attributes)
+ (sr-highlight))
+
+(defun sr-kill-pane-buffer ()
+ "Kill the buffer currently displayed in the active pane, or quit Sunrise.
+Custom variable `sr-kill-unused-buffers' controls whether unused buffers are
+killed automatically by Sunrise when the user navigates away from the directory
+they contain. When this flag is set, all requests to kill the current buffer are
+managed by just calling `sr-quit'."
+ (interactive)
+ (if sr-kill-unused-buffers
+ (sr-quit)
+ (kill-buffer (current-buffer))
+ (let ((_x (pop (cdr (assoc sr-selected-window sr-history-registry)))))
+ (sr-history-stack-reset))))
+
+(defun sr-quick-view (&optional arg)
+ "Quickly view the currently selected item.
+On regular files, opens the file in quick-view mode (see `sr-quick-view-file'
+for more details), on directories, visits the selected directory in the passive
+pane, and on symlinks follows the file the link points to in the passive pane.
+With optional argument kills the last quickly viewed file without opening a new
+buffer."
+ (interactive "P")
+ (if arg
+ (sr-quick-view-kill)
+ (let ((name (dired-get-filename nil t)))
+ (cond ((file-directory-p name) (sr-quick-view-directory name))
+ ((file-symlink-p name) (sr-quick-view-symlink name))
+ (t (sr-quick-view-file))))))
+
+(defun sr-quick-view-kill ()
+ "Kill the last buffer opened using quick view (if any)."
+ (let ((buf other-window-scroll-buffer))
+ (when (and (buffer-live-p buf)
+ (or (not sr-confirm-kill-viewer)
+ (y-or-n-p (format "Kill buffer %s? " (buffer-name buf)))))
+ (setq other-window-scroll-buffer nil)
+ (save-window-excursion (kill-buffer buf)))))
+
+(defun sr-quick-view-directory (name)
+ "Open the directory NAME in the passive pane."
+ (let ((name (expand-file-name name)))
+ (sr-in-other (sr-advertised-find-file name))))
+
+(defun sr-quick-view-symlink (name)
+ "Follow the target of the symlink NAME in the passive pane."
+ (let ((name (expand-file-name (file-symlink-p name))))
+ (if (file-exists-p name)
+ (sr-in-other (sr-follow-file name))
+ (error "Sunrise: file is a symlink to a nonexistent target"))))
+
+(defun sr-quick-view-file ()
+ "Open the selected file on the viewer window without selecting it.
+Kills any other buffer opened previously the same way."
+ (let ((split-width-threshold (* 10 (window-width)))
+ (filename (expand-file-name (dired-get-filename nil t))))
+ (save-selected-window
+ (condition-case description
+ (progn
+ (sr-select-viewer-window)
+ (find-file filename)
+ (if (and (not (eq (current-buffer) other-window-scroll-buffer))
+ (buffer-live-p other-window-scroll-buffer))
+ (kill-buffer other-window-scroll-buffer))
+ (sr-scrollable-viewer (current-buffer)))
+ (error (message "%s" (cadr description)))))))
+
+;; These clean up after a quick view:
+(add-hook 'sr-quit-hook (defun sr-sr-quit-function ()
+ (setq other-window-scroll-buffer nil)))
+(add-hook 'kill-buffer-hook
+ (defun sr-kill-viewer-function ()
+ (if (eq (current-buffer) other-window-scroll-buffer)
+ (setq other-window-scroll-buffer nil))))
+
+(defun sr-mask-attributes (beg end)
+ "Manage the hiding of attributes in region from BEG to END.
+Selective hiding of specific attributes can be controlled by customizing the
+`sr-attributes-display-mask' variable."
+ (let ((cursor beg) props)
+ (labels ((sr-make-display-props
+ (display-function-or-flag)
+ (cond ((functionp display-function-or-flag)
+ `(display
+ ,(apply display-function-or-flag
+ (list (buffer-substring cursor (1- (point)))))))
+ ((null display-function-or-flag) '(invisible t))
+ (t nil))))
+ (if sr-attributes-display-mask
+ (block block
+ (mapc (lambda (do-display)
+ (search-forward-regexp "\\w")
+ (search-forward-regexp "\\s-")
+ (setq props (sr-make-display-props do-display))
+ (when props
+ (add-text-properties cursor (point) props))
+ (setq cursor (point))
+ (if (>= (point) end) (return-from block)))
+ sr-attributes-display-mask))
+ (unless (>= cursor end)
+ (add-text-properties cursor end '(invisible t)))))))
+
+(defun sr-display-attributes (beg end visiblep)
+ "Manage the display of file attributes in the region from BEG to END.
+if VISIBLEP is nil then shows file attributes in region, otherwise hides them."
+ (let ((inhibit-read-only t) (next))
+ (save-excursion
+ (goto-char beg)
+ (forward-line -1)
+ (while (and (null next) (< (point) end))
+ (forward-line 1)
+ (setq next (dired-move-to-filename)))
+ (while (and next (< next end))
+ (beginning-of-line)
+ (forward-char 2)
+ (if (not visiblep)
+ (sr-mask-attributes (point) next)
+ (remove-text-properties (point) next '(invisible t))
+ (remove-text-properties (point) next '(display)))
+ (forward-line 1)
+ (setq next (dired-move-to-filename))))))
+
+(defun sr-toggle-attributes ()
+ "Hide/Show the attributes of all files in the active pane."
+ (interactive)
+ (setq sr-show-file-attributes (not sr-show-file-attributes))
+ (sr-display-attributes (point-min) (point-max) sr-show-file-attributes))
+
+(defun sr-toggle-truncate-lines ()
+ "Enable/Disable truncation of long lines in the active pane."
+ (interactive)
+ (if (sr-truncate-p)
+ (progn
+ (setq truncate-partial-width-windows (sr-truncate-v nil))
+ (message "Sunrise: wrapping long lines"))
+ (progn
+ (setq truncate-partial-width-windows (sr-truncate-v t))
+ (message "Sunrise: truncating long lines")))
+ (sr-silently (dired-do-redisplay)))
+
+(defun sr-truncate-p ()
+ "Return non-nil if `truncate-partial-width-windows' affects the current pane.
+Used by `sr-toggle-truncate-lines'."
+ (if (numberp truncate-partial-width-windows)
+ (< 0 truncate-partial-width-windows)
+ truncate-partial-width-windows))
+
+(defun sr-truncate-v (active)
+ "Return the appropriate value for `truncate-partial-width-widows'.
+Depends on the Emacs version being used. Used by
+`sr-toggle-truncate-lines'."
+ (or (and (version<= "23" emacs-version)
+ (or (and active 3000) 0))
+ active))
+
+(defun sr-sort-order (label option)
+ "Change the sorting order of the active pane.
+Appends additional options to `dired-listing-switches' and
+reverts the buffer."
+ (if (eq major-mode 'sr-virtual-mode)
+ (sr-sort-virtual option)
+ (progn
+ (put sr-selected-window 'sorting-order label)
+ (put sr-selected-window 'sorting-options option)
+ (let ((dired-listing-switches dired-listing-switches))
+ (unless (string-match "^/ftp:" default-directory)
+ (setq dired-listing-switches sr-listing-switches))
+ (dired-sort-other (concat dired-listing-switches option) t))
+ (revert-buffer)))
+ (message "Sunrise: sorting entries by %s" label))
+
+(defmacro sr-defun-sort-by (postfix options)
+ "Helper macro for defining `sr-sort-by-xxx' functions."
+ `(defun ,(intern (format "sr-sort-by-%s" postfix)) ()
+ ,(format "Sorts the contents of the current Sunrise pane by %s." postfix)
+ (interactive)
+ (sr-sort-order ,(upcase postfix) ,options)))
+(sr-defun-sort-by "name" "")
+(sr-defun-sort-by "extension" "X")
+(sr-defun-sort-by "time" "t")
+(sr-defun-sort-by "size" "S")
+
+(defun sr-sort-by-number (&optional inhibit-label)
+ "Sort the contents of the current Sunrise pane numerically.
+Displays entries containing unpadded numbers in a more logical
+order than when sorted alphabetically by name."
+ (interactive)
+ (sr-sort-by-operation 'sr-numerical-sort-op (unless inhibit-label "NUMBER"))
+ (if (get sr-selected-window 'sorting-reverse) (sr-reverse-pane)))
+
+(defun sr-interactive-sort (order)
+ "Prompt for a new sorting order for the active pane and apply it."
+ (interactive "cSort by (n)ame, n(u)mber, (s)ize, (t)ime or e(x)tension? ")
+ (if (>= order 97)
+ (setq order (- order 32)))
+ (case order
+ (?U (sr-sort-by-number))
+ (?T (sr-sort-by-time))
+ (?S (sr-sort-by-size))
+ (?X (sr-sort-by-extension))
+ (t (sr-sort-by-name))))
+
+(defun sr-reverse-pane (&optional interactively)
+ "Reverse the contents of the active pane."
+ (interactive "p")
+ (let ((line (line-number-at-pos))
+ (reverse (get sr-selected-window 'sorting-reverse)))
+ (sr-sort-by-operation 'identity)
+ (when interactively
+ (put sr-selected-window 'sorting-reverse (not reverse))
+ (goto-char (point-min)) (forward-line (1- line))
+ (re-search-forward directory-listing-before-filename-regexp nil t))))
+
+(defun sr-sort-virtual (option)
+ "Manage sorting of buffers in Sunrise VIRTUAL mode."
+ (let ((opt (string-to-char option)) (inhibit-read-only t) (beg) (end))
+ (case opt
+ (?X (sr-end-of-buffer)
+ (setq end (point-at-eol))
+ (sr-beginning-of-buffer)
+ (setq beg (point-at-bol))
+ (sort-regexp-fields nil "^.*$" "[/.][^/.]+$" beg end))
+ (?t (sr-sort-by-operation
+ (lambda (x) (sr-attribute-sort-op 5 t x)) "TIME"))
+ (?S (sr-sort-by-operation
+ (lambda (x) (sr-attribute-sort-op 7 t x)) "SIZE"))
+ (t (sr-sort-by-operation
+ (lambda (x) (sr-attribute-sort-op -1 nil x)) "NAME")))))
+
+(defun sr-sort-by-operation (operation &optional label)
+ "General function for reordering the contents of a Sunrise pane.
+OPERATION is a function that receives a list produced by
+`sr-build-sort-lists', reorders it in some way, transforming it
+into a list that can be passed to `sort-reorder', so the records
+in the current buffer are reordered accordingly. The LABEL is a
+string that will be used to set the sorting order of the current
+pane and then displayed in the minibuffer; if it's not provided
+or its value is nil then the ordering enforced by this function
+is transient and can be undone by reverting the pane, or by
+moving it to a different directory. See `sr-numerical-sort-op'
+and `sr-attribute-sort-op' for examples of OPERATIONs."
+ (interactive)
+ (let ((messages (> (- (point-max) (point-min)) 50000))
+ (focus (dired-get-filename 'verbatim t))
+ (inhibit-read-only t))
+ (if messages (message "Finding sort keys..."))
+ (let* ((sort-lists (sr-build-sort-lists))
+ (old (reverse sort-lists))
+ (beg) (end))
+ (if messages (message "Sorting records..."))
+ (setq sort-lists (apply operation (list sort-lists)))
+ (if messages (message "Reordering buffer..."))
+ (save-excursion
+ (save-restriction
+ (sr-end-of-buffer)
+ (setq end (point-at-eol))
+ (sr-beginning-of-buffer)
+ (setq beg (point-at-bol))
+ (narrow-to-region beg end)
+ (sort-reorder-buffer sort-lists old)))
+ (if messages (message "Reordering buffer... Done")))
+ (sr-highlight)
+ (if focus (sr-focus-filename focus))
+ (when label
+ (put sr-selected-window 'sorting-order label)
+ (message "Sunrise: sorting entries by %s" label)))
+ nil)
+
+(defun sr-numerical-sort-op (sort-lists)
+ "Strategy used to numerically sort contents of a Sunrise pane.
+Used by `sr-sort-by-operation'. See `sr-sort-by-number' for more
+on this kind of sorting."
+ (mapcar
+ 'cddr
+ (sort
+ (sort
+ (mapcar
+ (lambda (x)
+ (let ((key (buffer-substring-no-properties (car x) (cddr x))))
+ (append
+ (list key
+ (string-to-number (replace-regexp-in-string "^[^0-9]*" "" key))
+ (cdr x))
+ (cdr x))))
+ sort-lists)
+ (lambda (a b) (string< (car a) (car b))))
+ (lambda (a b) (< (cadr a) (cadr b))))))
+
+(defun sr-attribute-sort-op (nth-attr as-number sort-lists)
+ "Strategy used to sort contents of a Sunrise pane according to file attributes.
+Used by `sr-sort-by-operation'. See `file-attributes' for a list
+of supported attributes and their positions. Directories are
+forced to remain always on top. NTH-ATTR is the position of the
+attribute to use for sorting, or -1 for the name of the file.
+AS-NUMBER determines whether comparisons will be numeric or
+alphabetical. SORT-LISTS is a list of positions obtained from
+`sr-build-sort-lists'."
+ (let ((attributes (sr-files-attributes))
+ (zero (if as-number 0 "")))
+ (mapcar
+ 'cddr
+ (sort
+ (sort
+ (mapcar
+ (lambda (x)
+ (let* ((key (buffer-substring-no-properties (car x) (cddr x)))
+ (key (sr-chop ?/ (replace-regexp-in-string " -> .*$" "" key)))
+ (attrs (assoc-default key attributes))
+ (index))
+ (when attrs
+ (setq attrs (apply 'cons attrs)
+ index (or (nth (1+ nth-attr) attrs) zero))
+ (append (list (cadr attrs) index (cdr x)) (cdr x)))))
+ sort-lists)
+ (lambda (a b) (sr-compare nth-attr (cadr b) (cadr a))))
+ (lambda (a b)
+ (if (and (car a) (car b))
+ (sr-compare nth-attr (cadr b) (cadr a))
+ (and (car a) (not (stringp (car a))))))))))
+
+(defun sr-build-sort-lists ()
+ "Analyse contents of the current Sunrise pane for `sr-sort-by-operation'.
+Builds a list of dotted lists of the form (a b . c) -- where 'a'
+is the position at the start of the file name in an entry, while
+'b' and 'c' are the start and end positions of the whole entry.
+These lists are used by `sr-sort-by-operation' to sort the
+contents of the pane in arbitrary ways."
+ (delq nil
+ (mapcar
+ (lambda (x) (and (atom (car x)) x))
+ (save-excursion
+ (sr-beginning-of-buffer)
+ (beginning-of-line)
+ (sort-build-lists 'forward-line 'end-of-line 'dired-move-to-filename
+ nil)))))
+
+(defun sr-compare (mode a b)
+ "General comparison function, used to sort files in VIRTUAL buffers.
+MODE must be a number; if it is less than 0, the direction of the
+comparison is inverted: (sr-compare -1 a b) === (sr-compare 1
+b a). Compares numbers using `<', strings case-insensitively
+using `string<' and lists recursively until the first two
+elements that are non-equal are found."
+ (if (< mode 0) (let (tmp) (setq tmp a a b b tmp mode (abs mode))))
+ (cond ((or (null a) (null b)) nil)
+ ((and (listp a) (listp b)) (if (= (car a) (car b))
+ (sr-compare mode (cdr a) (cdr b))
+ (sr-compare mode (car a) (car b))))
+ ((and (stringp a) (stringp b)) (string< (downcase a) (downcase b)))
+ ((and (numberp a) (numberp b)) (< a b))
+ (t nil)))
+
+(defun sr-scroll-up ()
+ "Scroll the current pane or (if active) the viewer pane 1 line up."
+ (interactive)
+ (if (buffer-live-p other-window-scroll-buffer)
+ (save-selected-window
+ (sr-select-viewer-window)
+ (scroll-up 1))
+ (scroll-up 1)))
+
+(defun sr-scroll-down ()
+ "Scroll the current pane or (if active) the viewer pane 1 line down."
+ (interactive)
+ (if (buffer-live-p other-window-scroll-buffer)
+ (save-selected-window
+ (sr-select-viewer-window)
+ (scroll-down 1))
+ (scroll-down 1)))
+
+(defun sr-scroll-quick-view ()
+ "Scroll down the viewer window during a quick view."
+ (interactive)
+ (if other-window-scroll-buffer (scroll-other-window)))
+
+(defun sr-scroll-quick-view-down ()
+ "Scroll down the viewer window during a quick view."
+ (interactive)
+ (if other-window-scroll-buffer (scroll-other-window-down nil)))
+
+(defun sr-undo ()
+ "Restore selection as it was before the last file operation."
+ (interactive)
+ (dired-undo)
+ (sr-highlight))
+
+;;; ============================================================================
+;;; Passive & synchronized navigation functions:
+
+(defun sr-sync ()
+ "Toggle the Sunrise synchronized navigation feature."
+ (interactive)
+ (setq sr-synchronized (not sr-synchronized))
+ (mapc 'sr-mark-sync (list sr-left-buffer sr-right-buffer))
+ (message "Sunrise: sync navigation is now %s" (if sr-synchronized "ON" "OFF"))
+ (run-hooks 'sr-refresh-hook)
+ (sr-in-other (run-hooks 'sr-refresh-hook)))
+
+(defun sr-mark-sync (&optional buffer)
+ "Change `mode-name' depending on whether synchronized navigation is enabled."
+ (save-window-excursion
+ (if buffer
+ (switch-to-buffer buffer))
+ (setq mode-name (concat "Sunrise "
+ (if sr-synchronized "SYNC-NAV" "Commander")))))
+
+;; This advertises synchronized navigation in all new buffers:
+(add-hook 'sr-mode-hook 'sr-mark-sync)
+
+(defun sr-next-line-other ()
+ "Move the cursor down in the passive pane."
+ (interactive)
+ (sr-in-other (dired-next-line 1)))
+
+(defun sr-prev-line-other ()
+ "Move the cursor up in the passive pane."
+ (interactive)
+ (sr-in-other (dired-next-line -1)))
+
+(defun sr-goto-dir-other (dir)
+ "Change the current directory in the passive pane to the given one."
+ (interactive (list (read-directory-name
+ "Change directory in PASSIVE pane (file or pattern): "
+ sr-other-directory)))
+ (sr-in-other (sr-goto-dir dir)))
+
+(defun sr-advertised-find-file-other ()
+ "Open the file/directory selected in the passive pane."
+ (interactive)
+ (if sr-synchronized
+ (let ((target (sr-directory-name-proper (dired-get-filename))))
+ (sr-change-window)
+ (if (file-directory-p target)
+ (sr-goto-dir (expand-file-name target))
+ (if (y-or-n-p "Unable to synchronize. Disable sync navigation? ")
+ (sr-sync)))
+ (sr-change-window)
+ (sr-advertised-find-file))
+ (sr-in-other (sr-advertised-find-file))))
+
+(defun sr-mouse-advertised-find-file (e)
+ "Open the file/directory pointed to by the mouse."
+ (interactive "e")
+ (sr-mouse-change-window e)
+ (sr-advertised-find-file))
+
+(defun sr-prev-subdir-other (&optional count)
+ "Go to the previous subdirectory in the passive pane."
+ (interactive "P")
+ (let ((count (or count 1)))
+ (sr-in-other (sr-dired-prev-subdir count))))
+
+(defun sr-follow-file-other ()
+ "Go to the directory of the selected file, but in the passive pane."
+ (interactive)
+ (let ((filename (dired-get-filename nil t)))
+ (sr-in-other (sr-follow-file filename))))
+
+(defun sr-history-prev-other ()
+ "Change to previous directory (if any) in the passive pane's history list."
+ (interactive)
+ (sr-in-other (sr-history-prev)))
+
+(defun sr-history-next-other ()
+ "Change to the next directory (if any) in the passive pane's history list."
+ (interactive)
+ (sr-in-other (sr-history-next)))
+
+(defun sr-mark-other (arg)
+ "Mark the current (or next ARG) files in the passive pane."
+ (interactive "P")
+ (setq arg (or arg 1))
+ (sr-in-other (dired-mark arg)))
+
+(defun sr-unmark-backward-other (arg)
+ (interactive "p")
+ (sr-in-other (dired-unmark-backward arg)))
+
+(defun sr-unmark-all-marks-other ()
+ "Remove all marks from the passive pane."
+ (interactive)
+ (sr-in-other (dired-unmark-all-marks)))
+
+;;; ============================================================================
+;;; Progress feedback functions:
+
+(defun sr-progress-prompt (op-name)
+ "Build the default progress feedback message."
+ (concat "Sunrise: " op-name "... "))
+
+(defun sr-make-progress-reporter (op-name totalsize)
+ "Make a new Sunrise progress reporter.
+Prepends two integers (accumulator and scale) to a standard
+progress reporter (built using `make-progress-reporter' from
+subr.el): accumulator keeps the current state of the reporter,
+and scale is used when the absolute value of 100% is bigger than
+`most-positive-fixnum'."
+ (let ((accumulator 0) (scale 1) (maxval totalsize))
+ (when (> totalsize most-positive-fixnum)
+ (setq scale (/ totalsize most-positive-fixnum))
+ (setq maxval most-positive-fixnum))
+ (list accumulator scale
+ (make-progress-reporter
+ (sr-progress-prompt op-name) 0 maxval 0 1 0.5))))
+
+(defun sr-progress-reporter-update (reporter size)
+ "Update REPORTER (a Sunrise progress reporter) by adding SIZE to its state."
+ (let ((scale (cadr reporter)))
+ (setcar reporter (+ (truncate (/ size scale)) (car reporter)))
+ (progress-reporter-update (caddr reporter) (car reporter))))
+
+(defun sr-progress-reporter-done (reporter)
+ "Print REPORTER's feedback message followed by \"done\" in echo area."
+ (progress-reporter-done (caddr reporter)))
+
+;;; ============================================================================
+;;; File manipulation functions:
+
+(defun sr-create-files (&optional qty)
+ "Interactively create empty file(s) with the given name or template.
+Optional prefix argument specifies the number of files to create.
+*NEVER* overwrites existing files. A template may contain one
+%-sequence like those used by `format', but the only supported
+specifiers are: d (decimal), x (hex) or o (octal)."
+ (interactive "p")
+ (let* ((qty (or (and (integerp qty) (< 0 qty) qty) 1))
+ (prompt (if (>= 1 qty) "Create file: "
+ (format "Create %d files using template: " qty)))
+ (filename (read-file-name prompt)) (name))
+ (with-temp-buffer
+ (if (>= 1 qty)
+ (unless (file-exists-p filename) (write-file filename))
+ (unless (string-match "%[0-9]*[dox]" filename)
+ (setq filename (concat filename ".%d")))
+ (setq filename (replace-regexp-in-string "%\\([^%]\\)" "%%\\1" filename)
+ filename (replace-regexp-in-string
+ "%%\\([0-9]*[dox]\\)" "%\\1" filename))
+ (dotimes (n qty)
+ (setq name (format filename (1+ n)))
+ (unless (file-exists-p name) (write-file name)))))
+ (sr-revert-buffer)))
+
+(defun sr-editable-pane ()
+ "Put the current pane in File Names Editing mode (`wdired-mode')."
+ (interactive)
+ (sr-graphical-highlight 'sr-editing-path-face)
+ (let* ((was-virtual (eq major-mode 'sr-virtual-mode))
+ (major-mode 'dired-mode))
+ (wdired-change-to-wdired-mode)
+ (if was-virtual
+ (set (make-local-variable 'sr-virtual-buffer) t)))
+ (run-hooks 'sr-refresh-hook))
+
+(defun sr-readonly-pane (as-virtual)
+ "Put the current pane back in Sunrise mode."
+ (when as-virtual
+ (sr-virtual-mode)
+ (sr-force-passive-highlight t))
+ (dired-build-subdir-alist)
+ (sr-revert-buffer))
+
+(defun sr-terminate-wdired (fun)
+ "Restore the current pane's original mode after editing with WDired."
+ (ad-add-advice
+ fun
+ (ad-make-advice
+ (intern (concat "sr-advice-" (symbol-name fun))) nil t
+ `(advice
+ lambda ()
+ (if (not sr-running)
+ ad-do-it
+ (let ((was-virtual (local-variable-p 'sr-virtual-buffer))
+ (saved-point (point)))
+ (sr-save-aspect
+ (setq major-mode 'wdired-mode)
+ (letf (((symbol-function 'yes-or-no-p) (lambda (prompt) (ignore)))
+ ((symbol-function 'revert-buffer)
+ (lambda (&optional ignore-auto noconfirm preserve-modes)
+ (ignore))))
+ ad-do-it)
+ (sr-readonly-pane was-virtual)
+ (goto-char saved-point))
+ (sr-unhighlight 'sr-editing-path-face)))))
+ 'around 'last)
+ (ad-activate fun nil))
+(sr-terminate-wdired 'wdired-finish-edit)
+(sr-terminate-wdired 'wdired-abort-changes)
+
+(defun sr-do-copy ()
+ "Copy selected files and directories recursively to the passive pane."
+ (interactive)
+ (let* ((items (dired-get-marked-files nil))
+ (vtarget (sr-virtual-target))
+ (target (or vtarget sr-other-directory))
+ (progress))
+ (if (and (not vtarget) (sr-equal-dirs default-directory sr-other-directory))
+ (dired-do-copy)
+ (when (sr-ask "Copy" target items #'y-or-n-p)
+ (if vtarget
+ (progn
+ (sr-copy-virtual)
+ (message "Done: %d items(s) copied" (length items)))
+ (progn
+ (setq progress (sr-make-progress-reporter
+ "copying" (sr-files-size items)))
+ (sr-clone items target #'copy-file progress ?C)
+ (sr-progress-reporter-done progress)))
+ (sr-silently (dired-unmark-all-marks))))))
+
+(defun sr-do-symlink ()
+ "Symlink selected files or directories from one pane to the other."
+ (interactive)
+ (if (sr-equal-dirs default-directory sr-other-directory)
+ (dired-do-symlink)
+ (sr-link #'make-symbolic-link "Symlink" dired-keep-marker-symlink)))
+
+(defun sr-do-relsymlink ()
+ "Symlink selected files or directories from one pane to the other relatively.
+See `dired-make-relative-symlink'."
+ (interactive)
+ (if (sr-equal-dirs default-directory sr-other-directory)
+ (dired-do-relsymlink)
+ (sr-link #'dired-make-relative-symlink
+ "RelSymLink"
+ dired-keep-marker-relsymlink)))
+
+(defun sr-do-hardlink ()
+ "Same as `dired-do-hardlink', but refuse to hardlink files to VIRTUAL buffers."
+ (interactive)
+ (if (sr-virtual-target)
+ (error "Cannot hardlink files to a VIRTUAL buffer, try (C)opying instead")
+ (dired-do-hardlink)))
+
+(defun sr-do-rename ()
+ "Move selected files and directories recursively from one pane to the other."
+ (interactive)
+ (when (sr-virtual-target)
+ (error "Cannot move files to a VIRTUAL buffer, try (C)opying instead"))
+ (if (sr-equal-dirs default-directory sr-other-directory)
+ (dired-do-rename)
+ (let ((marked (dired-get-marked-files)))
+ (when (sr-ask "Move" sr-other-directory marked #'y-or-n-p)
+ (let ((names (mapcar #'file-name-nondirectory marked))
+ (progress (sr-make-progress-reporter "renaming" (length marked)))
+ (inhibit-read-only t))
+ (sr-in-other
+ (progn
+ (sr-move-files marked default-directory progress)
+ (revert-buffer)
+ (when (eq major-mode 'sr-mode)
+ (dired-mark-remembered
+ (mapcar (lambda (x) (cons (expand-file-name x) ?R)) names))
+ (sr-focus-filename (car names)))))
+ (sr-progress-reporter-done progress))
+ (sr-silently (revert-buffer))))))
+
+(defun sr-do-delete ()
+ "Remove selected files from the file system."
+ (interactive)
+ (let* ((files (dired-get-marked-files))
+ (mode (sr-ask "Delete" nil files #'sr-y-n-or-a-p))
+ (deletion-mode (cond ((eq mode 'ALWAYS) 'always)
+ (mode 'top)
+ (t (error "(No deletions performed)")))))
+ (mapc (lambda (x)
+ (message "Deleting %s" x)
+ (dired-delete-file x deletion-mode)) files)
+ (if (eq major-mode 'sr-virtual-mode)
+ (dired-do-kill-lines)
+ (revert-buffer))))
+
+(defun sr-do-flagged-delete ()
+ "Remove flagged files from the file system."
+ (interactive)
+ (let* ((dired-marker-char dired-del-marker)
+ (regexp (dired-marker-regexp)) )
+ (if (save-excursion (goto-char (point-min))
+ (re-search-forward regexp nil t))
+ (sr-do-delete)
+ (message "(No deletions requested)"))))
+
+(defun sr-do-clone (&optional mode)
+ "Clone all selected items recursively into the passive pane."
+ (interactive "cClone as: (D)irectories only, (C)opies, (H)ardlinks,\
+ (S)ymlinks or (R)elative symlinks? ")
+
+ (if (sr-virtual-target)
+ (error "Cannot clone into a VIRTUAL buffer, try (C)opying instead"))
+ (if (sr-equal-dirs default-directory sr-other-directory)
+ (error "Cannot clone inside one single directory, please select a\
+ different one in the passive pane"))
+
+ (let ((target sr-other-directory) clone-op items progress)
+ (if (and mode (>= mode 97)) (setq mode (- mode 32)))
+ (setq clone-op
+ (case mode
+ (?D nil)
+ (?C #'copy-file)
+ (?H #'add-name-to-file)
+ (?S #'make-symbolic-link)
+ (?R #'dired-make-relative-symlink)
+ (t (error "Invalid cloning mode: %c" mode))))
+ (setq items (dired-get-marked-files nil))
+ (setq progress (sr-make-progress-reporter
+ "cloning" (sr-files-size items)))
+ (sr-clone items target clone-op progress ?K)
+ (dired-unmark-all-marks)
+ (message "Done: %d items(s) dispatched" (length items))))
+
+(defun sr-fast-backup-files ()
+ "Make backup copies of all marked files inside the same directory.
+The extension to append to each filename can be controlled by
+setting the value of the `sr-fast-backup-extension' custom
+variable. Directories are not copied."
+ (interactive)
+ (let ((extension (if (listp sr-fast-backup-extension)
+ (eval sr-fast-backup-extension)
+ sr-fast-backup-extension)))
+ (dired-do-copy-regexp "$" extension))
+ (revert-buffer))
+
+(defun sr-clone (items target clone-op progress mark-char)
+ "Clone all given items (files and dirs) recursively into the passive pane."
+ (let ((names (mapcar #'file-name-nondirectory items))
+ (inhibit-read-only t))
+ (with-current-buffer (sr-other 'buffer)
+ (sr-clone-files items target clone-op progress))
+ (when (window-live-p (sr-other 'window))
+ (sr-in-other
+ (progn
+ (revert-buffer)
+ (when (memq major-mode '(sr-mode sr-virtual-mode))
+ (dired-mark-remembered
+ (mapcar (lambda (x) (cons (expand-file-name x) mark-char)) names))
+ (sr-focus-filename (car names))))))))
+
+(defun sr-clone-files (file-paths target-dir clone-op progress &optional do-overwrite)
+ "Clone all files in FILE-PATHS to TARGET-DIR using CLONE-OP to clone the files.
+FILE-PATHS should be a list of full paths."
+ (setq target-dir (replace-regexp-in-string "/?$" "/" target-dir))
+ (mapc
+ (function
+ (lambda (f)
+ (sr-progress-reporter-update progress (nth 7 (file-attributes f)))
+ (let* ((name (file-name-nondirectory f))
+ (target-file (concat target-dir name))
+ (symlink-to (file-symlink-p (sr-chop ?/ f)))
+ (clone-args (list f target-file t)))
+ (cond
+ (symlink-to
+ (progn
+ (if (file-exists-p symlink-to)
+ (setq symlink-to (expand-file-name symlink-to)))
+ (make-symbolic-link symlink-to target-file do-overwrite)))
+
+ ((file-directory-p f)
+ (let ((initial-path (file-name-directory f)))
+ (unless (file-symlink-p initial-path)
+ (sr-clone-directory
+ initial-path name target-dir clone-op progress do-overwrite))))
+
+ (clone-op
+ ;; (message "[[Cloning: %s => %s]]" f target-file)
+ (if (eq clone-op 'copy-file)
+ (setq clone-args
+ (append clone-args (list dired-copy-preserve-time))))
+ (if (file-exists-p target-file)
+ (if (or (eq do-overwrite 'ALWAYS)
+ (setq do-overwrite (sr-ask-overwrite target-file)))
+ (apply clone-op clone-args))
+ (apply clone-op clone-args)))))))
+ file-paths))
+
+(defun sr-clone-directory (in-dir d to-dir clone-op progress do-overwrite)
+ "Clone directory IN-DIR/D and all its files recursively to TO-DIR.
+IN-DIR/D => TO-DIR/D using CLONE-OP to clone the files."
+ (setq d (replace-regexp-in-string "/?$" "/" d))
+ (if (string= "" d)
+ (setq to-dir (concat to-dir (sr-directory-name-proper in-dir))))
+ (let* ((files-in-d (sr-list-of-contents (concat in-dir d)))
+ (file-paths-in-d
+ (mapcar (lambda (f) (concat in-dir d f)) files-in-d)))
+ (unless (file-exists-p (concat to-dir d))
+ (make-directory (concat to-dir d)))
+ (sr-clone-files file-paths-in-d (concat to-dir d) clone-op progress do-overwrite)))
+
+(defsubst sr-move-op (file target target-dir progress do-overwrite)
+ "Helper function used by `sr-move-files' to rename files and directories."
+ (condition-case nil
+ (dired-rename-file file target do-overwrite)
+ (error
+ (sr-clone-directory file "" target-dir 'copy-file progress do-overwrite)
+ (dired-delete-file file 'always))))
+
+(defun sr-move-files (file-path-list target-dir progress &optional do-overwrite)
+ "Move all files in FILE-PATH-LIST (list of full paths) to TARGET-DIR."
+ (mapc
+ (function
+ (lambda (f)
+ (if (file-directory-p f)
+ (progn
+ (setq f (replace-regexp-in-string "/?$" "/" f))
+ (sr-progress-reporter-update progress 1)
+ (let* ((target (concat target-dir (sr-directory-name-proper f))))
+ (if (file-exists-p target)
+ (when (or (eq do-overwrite 'ALWAYS)
+ (setq do-overwrite (sr-ask-overwrite target)))
+ (sr-move-op f target target-dir progress do-overwrite))
+ (sr-move-op f target target-dir progress do-overwrite))))
+ (let* ((name (file-name-nondirectory f))
+ (target-file (concat target-dir name)))
+ ;; (message "Renaming: %s => %s" f target-file)
+ (sr-progress-reporter-update progress 1)
+ (if (file-exists-p target-file)
+ (if (or (eq do-overwrite 'ALWAYS)
+ (setq do-overwrite (sr-ask-overwrite target-file)))
+ (dired-rename-file f target-file t))
+ (dired-rename-file f target-file t)) ))))
+ file-path-list))
+
+(defun sr-link (creator action marker)
+ "Helper function for implementing `sr-do-symlink' and `sr-do-relsymlink'."
+ (if (sr-virtual-target)
+ (error "Cannot link files to a VIRTUAL buffer, try (C)opying instead.")
+ (dired-create-files creator action (dired-get-marked-files nil)
+ (lambda (from)
+ (setq from (sr-chop ?/ from))
+ (if (file-directory-p from)
+ (setq from (sr-directory-name-proper from))
+ (setq from (file-name-nondirectory from)))
+ (expand-file-name from sr-other-directory))
+ marker)))
+
+(defun sr-virtual-target ()
+ "If the passive pane is in VIRTUAL mode, return its name as a string.
+Otherwise returns nil."
+ (save-window-excursion
+ (switch-to-buffer (sr-other 'buffer))
+ (if (eq major-mode 'sr-virtual-mode)
+ (or (buffer-file-name) "Sunrise VIRTUAL buffer")
+ nil)))
+
+(defun sr-copy-virtual ()
+ "Manage copying of files or directories to buffers in VIRTUAL mode."
+ (let ((fileset (dired-get-marked-files nil))
+ (inhibit-read-only t) (beg))
+ (sr-change-window)
+ (goto-char (point-max))
+ (setq beg (point))
+ (mapc (lambda (file)
+ (insert-char 32 2)
+ (setq file (dired-make-relative file default-directory)
+ file (sr-chop ?/ file))
+ (insert-directory file sr-virtual-listing-switches))
+ fileset)
+ (sr-display-attributes beg (point-at-eol) sr-show-file-attributes)
+ (unwind-protect
+ (delete-region (point) (line-end-position))
+ (progn
+ (sr-change-window)
+ (dired-unmark-all-marks)))))
+
+(defun sr-ask (prompt target files function)
+ "Use FUNCTION to ask whether to do PROMPT on FILES with TARGET as destination."
+ (if (and files (listp files))
+ (let* ((len (length files))
+ (msg (if (< 1 len)
+ (format "* [%d items]" len)
+ (file-name-nondirectory (car files)))))
+ (if target
+ (setq msg (format "%s to %s" msg target)))
+ (funcall function (format "%s %s? " prompt msg)))))
+
+(defun sr-ask-overwrite (file-name)
+ "Ask whether to overwrite the given FILE-NAME."
+ (sr-y-n-or-a-p (format "File %s exists. OK to overwrite? " file-name)))
+
+(defun sr-y-n-or-a-p (prompt)
+ "Ask the user with PROMPT for an answer y/n/a ('a' stands for 'always').
+Returns t if the answer is y/Y, nil if the answer is n/N or the
+symbol `ALWAYS' if the answer is a/A."
+ (setq prompt (concat prompt "([y]es, [n]o or [a]lways)"))
+ (let ((resp -1))
+ (while (not (memq resp '(?y ?Y ?n ?N ?a ?A)))
+ (setq resp (read-event prompt))
+ (setq prompt "Please answer [y]es, [n]o or [a]lways "))
+ (if (>= resp 97)
+ (setq resp (- resp 32)))
+ (case resp
+ (?Y t)
+ (?A 'ALWAYS)
+ (t nil))))
+
+(defun sr-overlapping-paths-p (dir1 dir2)
+ "Return non-nil if directory DIR2 is located inside directory DIR1."
+ (when (and dir1 dir2)
+ (setq dir1 (expand-file-name (file-name-as-directory dir1))
+ dir2 (expand-file-name dir2))
+ (if (>= (length dir2) (length dir1))
+ (equal (substring dir2 0 (length dir1)) dir1)
+ nil)))
+
+(defun sr-list-of-contents (dir)
+ "Return the list of all files in DIR as a list of strings."
+ (sr-filter (function (lambda (x) (not (string-match "\\.\\.?/?$" x))))
+ (directory-files dir)))
+
+(defun sr-list-of-directories (dir)
+ "Return the list of directories in DIR as a list of strings.
+The list does not include the current directory and the parent directory."
+ (let ((result (sr-filter (function (lambda (x)
+ (file-directory-p (concat dir "/" x))))
+ (sr-list-of-contents dir))))
+ (mapcar (lambda (x) (concat x "/")) result)))
+
+(defun sr-list-of-files (dir)
+ "Return the list of regular files in DIR as a list of strings.
+Broken links are *not* considered regular files."
+ (sr-filter
+ (function (lambda (x) (file-regular-p (concat dir "/" x))))
+ (sr-list-of-contents dir)))
+
+(defun sr-filter (p x)
+ "Return the elements of the list X that satisfy the predicate P."
+ (let ((res-list nil))
+ (while x
+ (if (apply p (list (car x)))
+ (setq res-list (cons (car x) res-list)))
+ (setq x (cdr x)))
+ (reverse res-list)))
+
+(defun sr-directory-name-proper (file-path)
+ "Return the proper name of the directory FILE-PATH, without initial path."
+ (if file-path
+ (let (
+ (file-path-1 (substring file-path 0 (- (length file-path) 1)))
+ (lastchar (substring file-path (- (length file-path) 1)))
+ )
+ (concat (file-name-nondirectory file-path-1) lastchar))))
+
+;;; ============================================================================
+;;; Directory and file comparison functions:
+
+(defun sr-compare-panes ()
+ "Compare the contents of Sunrise panes."
+ (interactive)
+ (let* ((file-alist1 (sr-files-attributes))
+ (other (sr-other 'buffer))
+ (file-alist2 (with-current-buffer other (sr-files-attributes)))
+ (progress
+ (sr-make-progress-reporter
+ "comparing" (+ (length file-alist1) (length file-alist2))))
+ (predicate `(prog1 ,(sr-ask-compare-panes-predicate)
+ (sr-progress-reporter-update ',progress 1)))
+ (file-list1 (mapcar 'cadr (dired-file-set-difference
+ file-alist1 file-alist2 predicate)))
+ (file-list2 (mapcar 'cadr (dired-file-set-difference
+ file-alist2 file-alist1 predicate))))
+ (sr-md5 nil)
+ (dired-mark-if (member (dired-get-filename nil t) file-list1) nil)
+ (with-current-buffer other
+ (dired-mark-if (member (dired-get-filename nil t) file-list2) nil))
+ (message "Marked in pane1: %s files, in pane2: %s files"
+ (length file-list1)
+ (length file-list2))
+ (sit-for 0.2)))
+
+(defun sr-ask-compare-panes-predicate ()
+ "Prompt for the criterion to use for comparing the contents of the panes."
+ (let ((prompt "Compare by (d)ate, (s)ize, date_(a)nd_size, (n)ame \
+or (c)ontents? ")
+ (response -1))
+ (while (not (memq response '(?d ?D ?s ?S ?a ?A ?n ?N ?c ?C)))
+ (setq response (read-event prompt))
+ (setq prompt "Please select: Compare by (d)ate, (s)ize, date_(a)nd_size,\
+ (n)ame or (c)ontents? "))
+ (if (>= response 97)
+ (setq response (- response 32)))
+ (case response
+ (?D `(not (= mtime1 mtime2)))
+ (?S `(not (= size1 size2)))
+ (?N nil)
+ (?C `(not (string= (sr-md5 file1 t) (sr-md5 file2 t))))
+ (t `(or (not (= mtime1 mtime2)) (not (= size1 size2)))))))
+
+(defun sr-files-attributes ()
+ "Return a list of all file names and attributes in the current pane.
+The list has the same form as the one returned by
+`dired-files-attributes', but contains all the files currently
+displayed in VIRTUAL panes."
+ (delq
+ nil
+ (mapcar
+ (lambda (file-name)
+ (unless (member file-name '("." ".."))
+ (let ((full-file-name (expand-file-name file-name default-directory)))
+ (list file-name full-file-name (file-attributes full-file-name)))))
+ (sr-pane-files))))
+
+(defun sr-pane-files ()
+ "Return the list of files in the current pane.
+For VIRTUAL panes, returns the list of all files being currently
+displayed."
+ (delq
+ nil
+ (if (eq major-mode 'sr-virtual-mode)
+ (sr-buffer-files (current-buffer))
+ (directory-files default-directory))))
+
+(defvar sr-md5 '(nil) "Memoization cache for the sr-md5 function.")
+(defun sr-md5 (file-alist &optional memoize)
+ "Build and execute a shell command to calculate the MD5 checksum of a file.
+Second element of FILE-ALIST is the absolute path of the file. If
+MEMOIZE is non-nil, save the result into the `sr-md5' alist so it
+can be reused the next time this function is called with the same
+path. This cache can be cleared later calling `sr-md5' with nil
+as its first argument."
+ (if (null file-alist)
+ (setq sr-md5 '(nil))
+ (let* ((filename (cadr file-alist))
+ (md5-digest (cdr (assoc filename sr-md5)))
+ (md5-command))
+ (unless md5-digest
+ (setq md5-command
+ (replace-regexp-in-string
+ "%f" (format "\"%s\"" filename) sr-md5-shell-command))
+ (setq md5-digest (shell-command-to-string md5-command))
+ (if memoize
+ (push (cons filename md5-digest) sr-md5)))
+ md5-digest)))
+
+(defun sr-diff ()
+ "Run `diff' on the top two marked files in both panes."
+ (interactive)
+ (eval (sr-diff-form 'diff))
+ (sr-scrollable-viewer (get-buffer "*Diff*")))
+
+(defun sr-ediff ()
+ "Run `ediff' on the two top marked files in both panes."
+ (interactive)
+ (eval (sr-diff-form 'ediff)))
+
+(add-hook 'ediff-before-setup-windows-hook
+ (defun sr-ediff-before-setup-windows-function ()
+ (setq sr-ediff-on t)))
+
+(add-hook 'ediff-quit-hook
+ (defun sr-ediff-quit-function ()
+ (setq sr-ediff-on nil)
+ (when sr-running
+ (if (buffer-live-p sr-restore-buffer)
+ (switch-to-buffer sr-restore-buffer))
+ (delete-other-windows)
+ (sr-setup-windows))))
+
+(defun sr-diff-form (fun)
+ "Return the appropriate form to evaluate for comparing files using FUN."
+ (let ((this (sr-pop-mark)) (other nil))
+ (unless this
+ (setq this (car (dired-get-marked-files t))))
+ (if (sr-equal-dirs default-directory sr-other-directory)
+ (setq other (sr-pop-mark))
+ (progn
+ (sr-change-window)
+ (setq other (sr-pop-mark))
+ (sr-change-window)
+ (setq other (or other
+ (if (file-exists-p (concat sr-other-directory this))
+ this
+ (file-name-nondirectory this))))))
+ (setq this (concat default-directory this)
+ other (concat sr-other-directory other))
+ (list fun this other)))
+
+(defun sr-pop-mark ()
+ "Pop the first mark in the current Dired buffer."
+ (let ((result nil))
+ (condition-case description
+ (save-excursion
+ (goto-char (point-min))
+ (dired-next-marked-file 1)
+ (setq result (dired-get-filename t t))
+ (dired-unmark 1))
+ (error (message (cadr description))))
+ result))
+
+;;; ============================================================================
+;;; File search & analysis functions:
+
+(defun sr-process-kill ()
+ "Kill the process running in the current buffer (if any)."
+ (interactive)
+ (let ((proc (get-buffer-process (current-buffer))))
+ (and proc (eq (process-status proc) 'run)
+ (condition-case nil
+ (delete-process proc)
+ (error nil)))))
+
+(defvar sr-process-map (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map sr-virtual-mode-map)
+ (define-key map "\C-c\C-k" 'sr-process-kill)
+ map)
+ "Local map used in Sunrise panes during find and locate operations.")
+
+(defun sr-find-decorate-buffer (find-items)
+ "Provide details on `sr-find' execution in the current buffer.
+If the current find operation is done only in selected files and directories,
+modify the info line of the buffer to reflect this. Additionally, display an
+appropriate message in the minibuffer."
+ (rename-uniquely)
+ (when find-items
+ (let ((items-len (length find-items))
+ (max-items-len (window-width))
+ (inhibit-read-only t))
+ (goto-char (point-min))
+ (forward-line 1)
+ (when (re-search-forward "find \." nil t)
+ (if (> items-len max-items-len)
+ (setq find-items
+ (concat (substring find-items 0 max-items-len) " ...")))
+ (replace-match (format "find %s" find-items)))))
+ (sr-beginning-of-buffer)
+ (sr-highlight)
+ (hl-line-mode 1)
+ (message (propertize "Sunrise find (C-c C-k to kill)"
+ 'face 'minibuffer-prompt)))
+
+(defun sr-find-apply (fun pattern)
+ "Helper function for functions `sr-find', `sr-find-name' and `sr-find-grep'."
+ (let* ((suffix (if (eq 'w32 window-system) " {} ;" " \\{\\} \\;"))
+ (find-ls-option
+ (cons
+ (concat "-exec ls -d " sr-virtual-listing-switches suffix)
+ "ls -ld"))
+ (sr-find-items (sr-quote-marked)) (dir))
+ (when sr-find-items
+ (if (not (y-or-n-p "Find in marked items only? "))
+ (setq sr-find-items nil)
+ (setq dir (directory-file-name (expand-file-name default-directory)))
+ (add-to-list 'file-name-handler-alist (cons dir 'sr-multifind-handler))))
+ (sr-save-aspect
+ (sr-alternate-buffer (apply fun (list default-directory pattern)))
+ (sr-virtual-mode)
+ (use-local-map sr-process-map)
+ (sr-keep-buffer))
+ (run-with-idle-timer 0.01 nil 'sr-find-decorate-buffer sr-find-items)))
+
+(defun sr-find (pattern)
+ "Run `find-dired' passing the current directory as first parameter."
+ (interactive "sRun find (with args): ")
+ (sr-find-apply 'find-dired pattern))
+
+(defun sr-find-name (pattern)
+ "Run `find-name-dired' passing the current directory as first parameter."
+ (interactive "sFind name pattern: ")
+ (sr-find-apply 'find-name-dired pattern))
+
+(defun sr-find-grep (pattern)
+ "Run `find-grep-dired' passing the current directory as first
+parameter. Called with prefix asks for additional grep options."
+ (interactive "sFind files containing pattern: ")
+ (let ((find-grep-options
+ (if current-prefix-arg
+ (concat find-grep-options
+ " "
+ (read-string "Additional Grep Options: "))
+ find-grep-options)))
+ (sr-find-apply 'find-grep-dired pattern)))
+
+(defadvice find-dired-sentinel
+ (after sr-advice-find-dired-sentinel (proc state))
+ "If the current find operation was launched inside the Sunrise
+Commander, create a new backup buffer on operation completion or
+abort."
+ (with-current-buffer (process-buffer proc)
+ (when (eq 'sr-virtual-mode major-mode)
+ (sr-backup-buffer))))
+(ad-activate 'find-dired-sentinel)
+
+(defadvice find-dired-filter
+ (around sr-advice-find-dired-filter (proc string))
+ "Disable the \"non-foolproof\" padding mechanism in `find-dired-filter' that
+breaks Dired when using ls options that omit some columns (like g or G). Defined
+by the Sunrise Commander."
+ (if (and (eq 'sr-virtual-mode major-mode)
+ (or (string-match "g" sr-virtual-listing-switches)
+ (string-match "G" sr-virtual-listing-switches)))
+ (let ((find-ls-option nil)) ad-do-it)
+ ad-do-it))
+(ad-activate 'find-dired-filter)
+
+(defun sr-multifind-handler (operation &rest args)
+ "Magic file name handler for manipulating the command executed by `find-dired'
+when the user requests to perform the find operation on all currently marked
+items (as opposed to the current default directory). Removes itself from the
+`inhibit-file-name-handlers' every time it's executed."
+ (let ((inhibit-file-name-handlers
+ (cons 'sr-multifind-handler
+ (and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation operation))
+ (when (eq operation 'shell-command)
+ (setq file-name-handler-alist
+ (rassq-delete-all 'sr-multifind-handler file-name-handler-alist))
+ (when sr-find-items
+ (setcar args (replace-regexp-in-string
+ "find \." (format "find %s" sr-find-items) (car args)))))
+ (apply operation args)))
+
+(defun sr-flatten-branch (&optional mode)
+ "Display a flat view of the items contained in the current directory and all
+its subdirectories, sub-subdirectories and so on (recursively) in the active
+pane."
+ (interactive "cFlatten branch showing: (E)verything, (D)irectories,\
+ (N)on-directories or (F)iles only?")
+ (if (and mode (>= mode 97)) (setq mode (- mode 32)))
+ (case mode
+ (?E (sr-find-name "*"))
+ (?D (sr-find "-type d"))
+ (?N (sr-find "-not -type d"))
+ (?F (sr-find "-type f"))))
+
+(defun sr-prune-paths (regexp)
+ "Kill all lines (only the lines) in the current pane matching REGEXP."
+ (interactive "sPrune paths matching: ")
+ (save-excursion
+ (sr-beginning-of-buffer)
+ (while (if (string-match regexp (dired-get-filename t))
+ (dired-kill-line)
+ (dired-next-line 1)))))
+
+(defun sr-locate-filter (locate-buffer search-string)
+ "Return a filter function for the background `locate' process."
+ `(lambda (process output)
+ (let ((inhibit-read-only t)
+ (search-regexp ,(regexp-quote search-string))
+ (beg (point-max)))
+ (set-buffer ,locate-buffer)
+ (save-excursion
+ (mapc (lambda (x)
+ (when (and (string-match search-regexp x) (file-exists-p x))
+ (goto-char (point-max))
+ (insert-char 32 2)
+ (insert-directory x sr-virtual-listing-switches nil nil)))
+ (split-string output "[\r\n]" t))
+ (sr-display-attributes beg (point-at-eol) sr-show-file-attributes)))))
+
+(defun sr-locate-sentinel (locate-buffer)
+ "Return a sentinel function for the background locate process.
+Used to notify about the termination status of the process."
+ `(lambda (process status)
+ (let ((inhibit-read-only t))
+ (set-buffer ,locate-buffer)
+ (goto-char (point-max))
+ (insert "\n " locate-command " " status)
+ (forward-char -1)
+ (insert " at " (substring (current-time-string) 0 19))
+ (forward-char 1))
+ (sr-beginning-of-buffer)
+ (sr-highlight)
+ (hl-line-mode 1)))
+
+(defun sr-locate-prompt ()
+ "Display the message that appears when a locate process is launched."
+ (message (propertize "Sunrise locate (C-c C-k to kill)"
+ 'face 'minibuffer-prompt)))
+
+(defvar locate-command)
+(autoload 'locate-prompt-for-search-string "locate")
+(defun sr-locate (search-string &optional _filter _arg)
+ "Run locate asynchronously and display the results in Sunrise virtual mode."
+ (interactive
+ (list (locate-prompt-for-search-string) nil current-prefix-arg))
+ (let ((locate-buffer (create-file-buffer "*Sunrise Locate*"))
+ (process-connection-type nil)
+ (locate-process nil))
+ (sr-save-aspect
+ (sr-alternate-buffer (switch-to-buffer locate-buffer))
+ (cd "/")
+ (insert " " default-directory ":")(newline)
+ (insert " Results of: " locate-command " " search-string)(newline)
+ (sr-virtual-mode)
+ (set-process-filter
+ (setq locate-process
+ (start-process "Async Locate" nil locate-command search-string))
+ (sr-locate-filter locate-buffer search-string))
+ (set-process-sentinel locate-process (sr-locate-sentinel locate-buffer))
+ (set-process-buffer locate-process locate-buffer)
+ (use-local-map sr-process-map)
+ (run-with-idle-timer 0.01 nil 'sr-locate-prompt))))
+
+(defun sr-fuzzy-narrow ()
+ "Interactively narrow contents of the current pane using fuzzy matching:
+ * press Delete or Backspace to revert the buffer to its previous state
+ * press Return, C-n or C-p to exit and accept the current narrowed state
+ * press Esc or C-g to abort the operation and revert the buffer
+ * use ! to prefix characters that should NOT appear beyond a given position.
+ Once narrowed and accepted, you can restore the original contents of the pane
+ by pressing g (`revert-buffer')."
+ (interactive)
+ (when sr-running
+ (sr-beginning-of-buffer)
+ (dired-change-marks ?* ?\t)
+ (let ((stack nil) (filter "") (regex "") (next-char nil) (inhibit-quit t))
+ (labels ((read-next (f) (read-char (concat "Fuzzy narrow: " f))))
+ (setq next-char (read-next filter))
+ (sr-backup-buffer)
+ (while next-char
+ (case next-char
+ ((?\e ?\C-g) (setq next-char nil) (sr-revert-buffer))
+ (?\C-n (setq next-char nil) (sr-beginning-of-buffer))
+ (?\C-p (setq next-char nil) (sr-end-of-buffer))
+ ((?\n ?\r) (setq next-char nil))
+ ((?\b ?\d)
+ (revert-buffer)
+ (setq stack (cdr stack) filter (caar stack) regex (cdar stack))
+ (unless stack (setq next-char nil)))
+ (t
+ (setq filter (concat filter (char-to-string next-char)))
+ (if (not (eq next-char sr-fuzzy-negation-character))
+ (setq next-char (char-to-string next-char)
+ regex (if (string= "" regex) ".*" regex)
+ regex (concat regex (regexp-quote next-char) ".*"))
+ (setq next-char (char-to-string (read-next filter))
+ filter (concat filter next-char)
+ regex (replace-regexp-in-string "\\.\\*\\'" "" regex)
+ regex (concat regex "[^"(regexp-quote next-char)"]*")
+ regex (replace-regexp-in-string "\\]\\*\\[\\^" "" regex)))
+ (setq stack (cons (cons filter regex) stack))))
+ (when next-char
+ (dired-mark-files-regexp (concat "^" regex "$"))
+ (dired-toggle-marks)
+ (dired-do-kill-lines)
+ (setq next-char (read-next filter)))))
+ (dired-change-marks ?\t ?*))))
+
+(defun sr-recent-files ()
+ "Display the history of recent files in Sunrise virtual mode."
+ (interactive)
+ (if (not (featurep 'recentf))
+ (error "ERROR: Feature recentf not available!"))
+
+ (sr-save-aspect
+ (let ((dired-actual-switches dired-listing-switches))
+ (sr-switch-to-clean-buffer "*Recent Files*")
+ (insert "Recently Visited Files: \n")
+ (dolist (file recentf-list)
+ (condition-case nil
+ (insert-directory file sr-virtual-listing-switches nil nil)
+ (error (ignore))))
+ (sr-virtual-mode)
+ (sr-keep-buffer))))
+
+(defun sr-recent-directories ()
+ "Display the history of directories recently visited in the current pane."
+ (interactive)
+ (sr-save-aspect
+ (let ((hist (cdr (assoc sr-selected-window sr-history-registry)))
+ (dired-actual-switches dired-listing-switches)
+ (pane-name (capitalize (symbol-name sr-selected-window)))
+ (switches (concat sr-virtual-listing-switches " -d")))
+ (sr-switch-to-clean-buffer (format "*%s Pane History*" pane-name))
+ (insert (concat "Recent Directories in " pane-name " Pane: \n"))
+ (dolist (dir hist)
+ (condition-case nil
+ (when dir
+ (setq dir (sr-chop ?/ (expand-file-name dir)))
+ (insert-directory dir switches nil nil))
+ (error (ignore))))
+ (sr-virtual-mode))))
+
+(defun sr-switch-to-clean-buffer (name)
+ (sr-alternate-buffer (switch-to-buffer name))
+ (erase-buffer))
+
+(defun sr-pure-virtual (&optional passive)
+ "Create a new empty buffer in Sunrise VIRTUAL mode.
+If the optional argument PASSIVE is non-nil, creates the virtual
+buffer in the passive pane."
+ (interactive "P")
+ (if passive
+ (progn
+ (sr-synchronize-panes)
+ (sr-in-other (sr-pure-virtual nil)))
+ (sr-save-aspect
+ (let* ((dir (directory-file-name (dired-current-directory)))
+ (buff (generate-new-buffer-name (buffer-name (current-buffer)))))
+ (sr-alternate-buffer (switch-to-buffer buff))
+ (goto-char (point-min))
+ (insert " " dir ":")(newline)
+ (insert " Pure VIRTUAL buffer: ")(newline)
+ (sr-virtual-mode)
+ (sr-keep-buffer)))))
+
+(defun sr-dired-do-apply (dired-fun)
+ "Helper function for implementing `sr-do-query-replace-regexp' and Co."
+ (let ((buff (current-buffer)) (orig sr-restore-buffer))
+ (condition-case nil
+ (progn
+ (sr-quit)
+ (switch-to-buffer buff)
+ (call-interactively dired-fun)
+ (replace-buffer-in-windows buff)
+ (sr-bury-panes))
+ (quit
+ (when orig (switch-to-buffer orig))
+ (sunrise)))))
+
+(defun sr-do-query-replace-regexp ()
+ "Force Sunrise to quit before executing `dired-do-query-replace-regexp'."
+ (interactive)
+ (sr-dired-do-apply 'dired-do-query-replace-regexp))
+
+(defun sr-do-search ()
+ "Force Sunrise to quit before executing `dired-do-search'."
+ (interactive)
+ (sr-dired-do-apply 'dired-do-search))
+
+(defun sr-sticky-isearch-prompt ()
+ "Display the message that appears when a sticky search is launched."
+ (message (propertize "Sunrise sticky I-search (C-g to exit): "
+ 'face 'minibuffer-prompt)))
+
+(defvar sr-sticky-isearch-commands
+ '(nil
+ ("\C-o" . dired-omit-mode)
+ ("\M-a" . sr-beginning-of-buffer)
+ ("\M-e" . sr-end-of-buffer)
+ ("\C-v" . scroll-up-command)
+ ("\M-v" . (lambda () (interactive) (scroll-up-command '-)))
+ ) "Keybindings installed in `isearch-mode' during a sticky search.")
+
+(defun sr-sticky-isearch-remap-commands (&optional restore)
+ "Remap `isearch-mode-map' commands using `sr-sticky-isearch-commands'.
+Replace the bindings in our table with the previous ones from `isearch-mode-map'
+so we can restore them when the current sticky search operation finishes."
+ (when (eq restore (car sr-sticky-isearch-commands))
+ (setcar sr-sticky-isearch-commands (not restore))
+ (mapc (lambda (entry)
+ (let* ((binding (car entry))
+ (old-command (lookup-key isearch-mode-map binding))
+ (new-command (cdr entry)))
+ (define-key isearch-mode-map binding new-command)
+ (setcdr entry old-command)))
+ (cdr sr-sticky-isearch-commands))))
+
+(defun sr-sticky-isearch (&optional backward)
+ "Concatenate Isearch operations to allow fast file system navigation.
+Search continues until C-g is pressed (to abort) or Return is
+pressed on a regular file (to end the operation and visit that
+file)."
+ (set (make-local-variable 'search-nonincremental-instead) nil)
+ (add-hook 'isearch-mode-end-hook 'sr-sticky-post-isearch)
+ (sr-sticky-isearch-remap-commands)
+ (if backward
+ (isearch-backward nil t)
+ (isearch-forward nil t))
+ (run-hooks 'sr-refresh-hook)
+ (run-with-idle-timer 0.01 nil 'sr-sticky-isearch-prompt))
+
+(defun sr-sticky-isearch-forward ()
+ "Start a sticky forward search in the current pane."
+ (interactive)
+ (sr-sticky-isearch))
+
+(defun sr-sticky-isearch-backward ()
+ "Start a sticky backward search in the current pane."
+ (interactive)
+ (sr-sticky-isearch t))
+
+(defun sr-sticky-post-isearch ()
+ "`isearch-mode-end-hook' function for Sunrise sticky Isearch operations."
+ (and
+ (dired-get-filename nil t)
+ (let* ((filename (expand-file-name (dired-get-filename nil t)))
+ (is-dir (or (file-directory-p filename)
+ (sr-avfs-dir filename)
+ (sr-virtual-directory-p filename))))
+ (cond ((or isearch-mode-end-hook-quit (not is-dir))
+ (progn
+ (remove-hook 'isearch-mode-end-hook 'sr-sticky-post-isearch)
+ (kill-local-variable 'search-nonincremental-instead)
+ (sr-sticky-isearch-remap-commands t)
+ (isearch-done)
+ (if isearch-mode-end-hook-quit
+ (run-hooks 'sr-refresh-hook)
+ (sr-find-file filename))))
+ (t
+ (progn
+ (sr-find-file filename)
+ (set (make-local-variable 'search-nonincremental-instead) nil)
+ (isearch-forward nil t)
+ (run-with-idle-timer 0.01 nil 'sr-sticky-isearch-prompt)))))))
+
+(defun sr-show-files-info (&optional deref-symlinks)
+ "Enhanced version of `dired-show-file-type' from dired‐aux.
+If at most one item is marked, print the filetype of the current
+item according to the \"file\" command, including its size in bytes.
+If more than one item is marked, print the total size in
+bytes (calculated recursively) of all marked items."
+ (interactive "P")
+ (message "Calculating total size of selection... (C-g to abort)")
+ (let* ((selection (dired-get-marked-files t))
+ (size (sr-size-format (sr-files-size selection)))
+ (items (length selection)) (label) (regex))
+ (if (>= 1 items)
+ (progn
+ (setq selection (car selection)
+ label (file-name-nondirectory selection)
+ regex (concat "^.*" label "[:;]")
+ label (concat label ":"))
+ (dired-show-file-type selection deref-symlinks)
+ (message
+ "%s (%s bytes)"
+ (replace-regexp-in-string regex label (current-message)) size))
+ (message "%s bytes in %d selected items" size items))
+ (sit-for 0.5)))
+
+(eval-when-compile
+ (defsubst sr-size-attr (file)
+ "Helper function for `sr-files-size'."
+ (float (or (nth 7 (file-attributes file)) 0))))
+
+(defun sr-files-size (files)
+ "Recursively calculate the total size of all FILES.
+FILES should be a list of paths."
+ (let ((result 0))
+ (mapc
+ (lambda (x) (setq result (+ x result)))
+ (mapcar (lambda (f) (cond ((string-match "\\.\\./?$" f) 0)
+ ((string-match "\\./?$" f) (sr-size-attr f))
+ ((file-symlink-p f) (sr-size-attr f))
+ ((file-directory-p f) (sr-directory-size f))
+ (t (float (sr-size-attr f)))))
+ files))
+ result))
+
+(defun sr-directory-size (directory)
+ "Recursively calculate the total size of the given DIRECTORY."
+ (sr-files-size (directory-files directory t nil t)))
+
+(defun sr-size-format (size)
+ "Return integer representation of SIZE (a float) as a string.
+Uses comma as the thousands separator."
+ (let* ((num (replace-regexp-in-string "\\..*$" "" (number-to-string size)))
+ (digits (reverse (split-string num "" t)))
+ result)
+ (dotimes (n (length digits))
+ (when (and (< 0 n) (zerop (% n 3)))
+ (setq result (concat "," result)))
+ (setq result (concat (pop digits) result)))
+ result))
+
+;;; ============================================================================
+;;; TI (Terminal Integration) and CLEX (Command Line EXpansion) functions:
+
+;;;###autoload
+(defun sr-term (&optional cd newterm program)
+ "Run terminal in a new buffer or switch to an existing one.
+If the optional argument CD is non-nil, directory is changed to
+the current one in the active pane. A non-nil NEWTERM argument
+forces the creation of a new terminal. If PROGRAM is provided
+and exists in `exec-path', then it will be used instead of the
+default `sr-terminal-program'."
+ (interactive)
+ (let ((aterm (car sr-ti-openterms)))
+ (if (and (null program)
+ (or (eq major-mode 'eshell-mode)
+ (and (buffer-live-p aterm)
+ (with-current-buffer aterm
+ (eq major-mode 'eshell-mode)))))
+ (setq program "eshell")
+ (setq program (or program sr-terminal-program))))
+ (if (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
+ (hl-line-mode 1))
+ (if (string= program "eshell")
+ (sr-term-eshell cd newterm)
+ (sr-term-extern cd newterm program)))
+
+;;;###autoload
+(defun sr-term-cd ()
+ "Run terminal in a new buffer or switch to an existing one.
+cd's to the current directory of the active pane."
+ (interactive)
+ (sr-term t))
+
+;;;###autoload
+(defun sr-term-cd-newterm ()
+ "Open a NEW terminal (don't switch to an existing one).
+cd's to the current directory of the active pane."
+ (interactive)
+ (sr-term t t))
+
+;;;###autoload
+(defun sr-term-cd-program (&optional program)
+ "Open a NEW terminal using PROGRAM as the shell."
+ (interactive "sShell program to use: ")
+ (sr-term t t program))
+
+(defmacro sr-term-excursion (newterm form &optional is-external)
+ "Take care of the common mechanics of launching or switching to a terminal.
+Helper macro."
+ `(let* ((start-buffer (current-buffer))
+ (new-term (or (null sr-ti-openterms) ,newterm))
+ (next-buffer (or (cadr (memq start-buffer sr-ti-openterms))
+ (car sr-ti-openterms)))
+ (new-name) (is-line-mode))
+ (sr-select-viewer-window t)
+ (if (not new-term)
+ (switch-to-buffer next-buffer)
+ (when next-buffer
+ (with-current-buffer next-buffer
+ (setq is-line-mode (and (boundp 'sr-term-line-minor-mode)
+ (symbol-value 'sr-term-line-minor-mode)))))
+ ,form
+ (if ,is-external (sr-term-char-mode))
+ (if is-line-mode (sr-term-line-mode))
+ (when (memq (current-buffer) sr-ti-openterms)
+ (rename-uniquely)
+ (setq new-name (buffer-name))
+ ,form)
+ (when new-name
+ (message "Sunrise: previous terminal renamed to %s" new-name))
+ (push (current-buffer) sr-ti-openterms))))
+
+(defun sr-term-line-mode ()
+ "Switch the current terminal to line mode.
+Apply additional Sunrise keybindings for terminal integration."
+ (interactive)
+ (term-line-mode)
+ (sr-term-line-minor-mode 1))
+
+(defun sr-term-char-mode ()
+ "Switch the current terminal to character mode.
+Bind C-j and C-k to Sunrise terminal integration commands."
+ (interactive)
+ (term-char-mode)
+ (sr-term-line-minor-mode 0)
+ (sr-term-char-minor-mode 1))
+
+(defun sr-term-extern (&optional cd newterm program)
+ "Implementation of `sr-term' for external terminal programs.
+See `sr-term' for a description of the arguments."
+ (let* ((program (if program (executable-find program)))
+ (program (or program sr-terminal-program))
+ (dir (expand-file-name (sr-choose-cd-target)))
+ (aterm (car sr-ti-openterms))
+ (cd (or cd (null sr-ti-openterms)))
+ (line-mode (if (buffer-live-p aterm)
+ (with-current-buffer aterm (term-in-line-mode)))))
+ (sr-term-excursion newterm (term program) t)
+ (sr-term-char-mode)
+ (when (or line-mode (term-in-line-mode))
+ (sr-term-line-mode))
+ (when cd
+ (term-send-raw-string
+ (concat "cd " (shell-quote-wildcard-pattern dir) "
+")))))
+
+(defun sr-term-eshell (&optional cd newterm)
+ "Implementation of `sr-term' when using `eshell'."
+ (let ((dir (expand-file-name (sr-choose-cd-target)))
+ (cd (or cd (null sr-ti-openterms))))
+ (sr-term-excursion newterm (eshell))
+ (when cd
+ (insert (concat "cd " (shell-quote-wildcard-pattern dir)))
+ (eshell-send-input))
+ (sr-term-line-mode)))
+
+(defmacro sr-ti (form)
+ "Evaluate FORM in the context of the selected pane.
+Helper macro for implementing terminal integration in Sunrise."
+ `(if sr-running
+ (progn
+ (sr-select-window sr-selected-window)
+ (hl-line-unhighlight)
+ (unwind-protect
+ ,form
+ (when sr-running
+ (sr-select-viewer-window))))))
+
+(defun sr-ti-previous-line ()
+ "Move one line backward on active pane from the terminal window."
+ (interactive)
+ (sr-ti (forward-line -1)))
+
+(defun sr-ti-next-line ()
+ "Move one line forward on active pane from the terminal window."
+ (interactive)
+ (sr-ti (forward-line 1)))
+
+(defun sr-ti-select ()
+ "Run `dired-advertised-find-file' on active pane from the terminal window."
+ (interactive)
+ (sr-ti (sr-advertised-find-file)))
+
+(defun sr-ti-mark ()
+ "Run `dired-mark' on active pane from the terminal window."
+ (interactive)
+ (sr-ti (dired-mark 1)))
+
+(defun sr-ti-unmark ()
+ "Run `dired-unmark-backward' on active pane from the terminal window."
+ (interactive)
+ (sr-ti (dired-unmark-backward 1)))
+
+(defun sr-ti-prev-subdir (&optional count)
+ "Run `dired-prev-subdir' on active pane from the terminal window."
+ (interactive "P")
+ (let ((count (or count 1)))
+ (sr-ti (sr-dired-prev-subdir count))))
+
+(defun sr-ti-unmark-all-marks ()
+ "Remove all marks on active pane from the terminal window."
+ (interactive)
+ (sr-ti (dired-unmark-all-marks)))
+
+(defun sr-ti-change-window ()
+ "Switch focus to the currently active pane."
+ (interactive)
+ (sr-select-window sr-selected-window))
+
+(defun sr-ti-change-pane ()
+ "Change selection of active pane to passive one."
+ (interactive)
+ (sr-ti (sr-change-window)))
+
+(add-hook
+ 'kill-buffer-hook
+ (defun sr-ti-cleanup-openterms ()
+ "Remove the current buffer from the list of open terminals."
+ (setq sr-ti-openterms (delete (current-buffer) sr-ti-openterms))))
+
+(defun sr-ti-revert-buffer ()
+ "Refresh the currently active pane."
+ (interactive)
+ (let ((dir default-directory))
+ (if (not (sr-equal-dirs dir sr-this-directory))
+ (sr-ti (sr-goto-dir dir))
+ (sr-ti (sr-revert-buffer)))))
+
+(defun sr-ti-lock-panes ()
+ "Resize and lock the panes at standard position from the command line."
+ (interactive)
+ (sr-ti (sr-lock-panes)))
+
+(defun sr-ti-min-lock-panes ()
+ "Minimize the panes from the command line."
+ (interactive)
+ (sr-ti (sr-min-lock-panes)))
+
+(defun sr-ti-max-lock-panes ()
+ "Maximize the panes from the command line."
+ (interactive)
+ (sr-ti (sr-max-lock-panes)))
+
+(defmacro sr-clex (pane form)
+ "Evaluate FORM in the context of PANE.
+Helper macro for implementing command line expansion in Sunrise."
+ `(save-window-excursion
+ (setq pane (if (atom pane) pane (eval pane)))
+ (select-window (symbol-value (sr-symbol ,pane 'window)))
+ ,form))
+
+(defun sr-clex-marked (pane)
+ "Return a string containing the list of marked files in PANE."
+ (sr-clex
+ pane
+ (mapconcat 'shell-quote-wildcard-pattern (dired-get-marked-files) " ")))
+
+(defun sr-clex-file (pane)
+ "Return the file currently selected in PANE."
+ (sr-clex
+ pane
+ (concat (shell-quote-wildcard-pattern (dired-get-filename)) " ")))
+
+(defun sr-clex-marked-nodir (pane)
+ "Return a list of basenames of all the files currently marked in PANE."
+ (sr-clex
+ pane
+ (mapconcat 'shell-quote-wildcard-pattern
+ (dired-get-marked-files 'no-dir) " ")))
+
+(defun sr-clex-dir (pane)
+ "Return the current directory of the given pane."
+ (sr-clex
+ pane
+ (concat (shell-quote-wildcard-pattern default-directory) " ")))
+
+(defun sr-clex-start ()
+ "Start a new CLEX operation.
+Puts `sr-clex-commit' into local `after-change-functions'."
+ (interactive)
+ (if sr-clex-on
+ (progn
+ (setq sr-clex-on nil)
+ (delete-overlay sr-clex-hotchar-overlay))
+ (progn
+ (insert-char ?% 1)
+ (if sr-running
+ (progn
+ (add-hook 'after-change-functions 'sr-clex-commit nil t)
+ (setq sr-clex-on t)
+ (setq sr-clex-hotchar-overlay (make-overlay (point) (1- (point))))
+ (overlay-put sr-clex-hotchar-overlay 'face 'sr-clex-hotchar-face)
+ (message
+ "Sunrise: CLEX is now ON for keys: m f n d a p M F N D A P %%"))))))
+
+(defun sr-clex-commit (&optional _beg _end _range)
+ "Commit the current CLEX operation (if any).
+This function is added to the local `after-change-functions' list
+by `sr-clex-start'."
+ (interactive)
+ (if sr-clex-on
+ (progn
+ (setq sr-clex-on nil)
+ (delete-overlay sr-clex-hotchar-overlay)
+ (let* ((xchar (char-before))
+ (expansion (case xchar
+ (?m (sr-clex-marked 'left))
+ (?f (sr-clex-file 'left))
+ (?n (sr-clex-marked-nodir 'left))
+ (?d (sr-clex-dir 'left))
+ (?M (sr-clex-marked 'right))
+ (?F (sr-clex-file 'right))
+ (?N (sr-clex-marked-nodir 'right))
+ (?D (sr-clex-dir 'right))
+ (?a (sr-clex-marked '(sr-this)))
+ (?A (sr-clex-dir '(sr-this)))
+ (?p (sr-clex-marked '(sr-other)))
+ (?P (sr-clex-dir '(sr-other)))
+ (t nil))))
+ (if expansion
+ (progn
+ (delete-char -2)
+ (insert expansion)))))))
+
+(define-minor-mode sr-term-char-minor-mode
+ "Sunrise Commander terminal add-on for character (raw) mode."
+ nil nil
+ '(("\C-c\C-j" . sr-term-line-mode)
+ ("\C-c\C-k" . sr-term-char-mode)
+ ("\C-c\t" . sr-ti-change-window)
+ ("\C-ct" . sr-term)
+ ("\C-cT" . sr-term-cd)
+ ("\C-c\C-t" . sr-term-cd-newterm)
+ ("\C-c\M-t" . sr-term-cd-program)
+ ("\C-c;" . sr-follow-viewer)
+ ("\C-c\\" . sr-ti-lock-panes)
+ ("\C-c{" . sr-ti-min-lock-panes)
+ ("\C-c}" . sr-ti-max-lock-panes)))
+
+(define-minor-mode sr-term-line-minor-mode
+ "Sunrise Commander terminal add-on for line (cooked) mode."
+ nil nil
+ '(([M-up] . sr-ti-previous-line)
+ ([A-up] . sr-ti-previous-line)
+ ("\M-P" . sr-ti-previous-line)
+ ([M-down] . sr-ti-next-line)
+ ([A-down] . sr-ti-next-line)
+ ("\M-N" . sr-ti-next-line)
+ ("\M-\C-m" . sr-ti-select)
+ ("\C-\M-j" . sr-ti-select)
+ ([M-return] . sr-ti-select)
+ ([S-M-return] . sr-ti-select)
+ ("\M-M" . sr-ti-mark)
+ ([M-backspace] . sr-ti-unmark)
+ ("\M-\d" . sr-ti-unmark)
+ ("\M-J" . sr-ti-prev-subdir)
+ ("\M-U" . sr-ti-unmark-all-marks)
+ ([C-tab] . sr-ti-change-window)
+ ([M-tab] . sr-ti-change-pane)
+ ("\C-c\t" . sr-ti-change-window)
+ ("\C-ct" . sr-term)
+ ("\C-cT" . sr-term-cd)
+ ("\C-c\C-t" . sr-term-cd-newterm)
+ ("\C-c\M-t" . sr-term-cd-program)
+ ("\C-c;" . sr-follow-viewer)
+ ("\M-\S-g" . sr-ti-revert-buffer)
+ ("%" . sr-clex-start)
+ ("\t" . term-dynamic-complete)
+ ("\C-c\\" . sr-ti-lock-panes)
+ ("\C-c{" . sr-ti-min-lock-panes)
+ ("\C-c}" . sr-ti-max-lock-panes))
+ :group 'sunrise)
+
+(defadvice term-sentinel (around sr-advice-term-sentinel (proc msg) activate)
+ "Take care of killing Sunrise Commander terminal buffers on exit."
+ (if (and (or sr-term-char-minor-mode sr-term-line-minor-mode)
+ sr-terminal-kill-buffer-on-exit
+ (memq (process-status proc) '(signal exit)))
+ (let ((buffer (process-buffer proc)))
+ ad-do-it
+ (bury-buffer buffer)
+ (kill-buffer buffer))
+ ad-do-it))
+
+;;; ============================================================================
+;;; Desktop support:
+
+(defun sr-pure-virtual-p (&optional buffer)
+ "Return t if BUFFER (or the current buffer if nil) is purely virtual.
+Purely virtual means it is not attached to any directory or any
+file in the file system."
+ (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
+ (not (or (eq 'sr-mode major-mode)
+ (and (eq 'sr-virtual-mode major-mode)
+ buffer-file-truename
+ (file-exists-p buffer-file-truename))))))
+
+(defun sr-desktop-save-buffer (desktop-dir)
+ "Return the additional data for saving a Sunrise buffer to a desktop file."
+ (unless (sr-pure-virtual-p)
+ (apply
+ 'append
+ (delq nil
+ (list
+ (if (eq major-mode 'sr-virtual-mode)
+ (list 'dirs buffer-file-truename)
+ (cons 'dirs (dired-desktop-buffer-misc-data desktop-dir)))
+ (if (eq (current-buffer) sr-left-buffer) (cons 'left t))
+ (if (eq (current-buffer) sr-right-buffer) (cons 'right t))
+ (if (eq major-mode 'sr-virtual-mode) (cons 'virtual t))))
+ (mapcar (lambda (fun)
+ (funcall fun desktop-dir))
+ sr-desktop-save-handlers))))
+
+(defun sr-desktop-restore-buffer (desktop-buffer-file-name
+ desktop-buffer-name
+ desktop-buffer-misc)
+ "Restore a Sunrise (normal or VIRTUAL) buffer from its desktop file data."
+ (let* ((sr-running t)
+ (misc-data (cdr (assoc 'dirs desktop-buffer-misc)))
+ (is-virtual (assoc 'virtual desktop-buffer-misc))
+ (buffer
+ (if (not is-virtual)
+ (with-current-buffer
+ (dired-restore-desktop-buffer desktop-buffer-file-name
+ desktop-buffer-name
+ misc-data)
+ (sr-mode)
+ (current-buffer))
+ (desktop-restore-file-buffer (car misc-data)
+ desktop-buffer-name
+ misc-data))))
+ (with-current-buffer buffer
+ (when is-virtual (set-visited-file-name nil t))
+ (mapc (lambda (side)
+ (when (cdr (assq side desktop-buffer-misc))
+ (set (sr-symbol side 'buffer) buffer)
+ (set (sr-symbol side 'directory) default-directory)))
+ '(left right))
+ (mapc (lambda (fun)
+ (funcall fun
+ desktop-buffer-file-name
+ desktop-buffer-name
+ desktop-buffer-misc))
+ sr-desktop-restore-handlers))
+ buffer))
+
+(defun sr-reset-state ()
+ "Reset some environment variables that control the Sunrise behavior.
+Used for desktop support."
+ (setq sr-left-directory "~/" sr-right-directory "~/"
+ sr-this-directory "~/" sr-other-directory "~/")
+ (if sr-running (sr-quit))
+ nil)
+
+;; These register the previous functions in the desktop framework:
+(add-to-list 'desktop-buffer-mode-handlers
+ '(sr-mode . sr-desktop-restore-buffer))
+(add-to-list 'desktop-buffer-mode-handlers
+ '(sr-virtual-mode . sr-desktop-restore-buffer))
+
+;; This initializes (and sometimes starts) Sunrise after desktop restoration:
+(add-hook 'desktop-after-read-hook
+ (defun sr-desktop-after-read-function ()
+ (unless (assoc 'sr-running desktop-globals-to-clear)
+ (add-to-list 'desktop-globals-to-clear
+ '(sr-running . (sr-reset-state))))
+ (if (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
+ (sunrise))))
+
+;;; ============================================================================
+;;; Miscellaneous functions:
+
+(defun sr-buffer-files (buffer-or-name)
+ "Return the list of all file names currently displayed in the given buffer."
+ (with-current-buffer buffer-or-name
+ (save-excursion
+ (let ((result nil))
+ (sr-beginning-of-buffer)
+ (while (not (eobp))
+ (setq result (cons (dired-get-filename t t) result))
+ (forward-line 1))
+ (reverse result)))))
+
+(defun sr-keep-buffer (&optional side)
+ "Keep the currently displayed buffer in SIDE (left or right) window.
+Keeps it there even if it does not belong to the panel's history
+ring. If SIDE is nil, use the value of `sr-selected-window'
+instead. Useful for maintaining the contents of the pane during
+layout switching."
+ (let* ((side (or side sr-selected-window))
+ (window (symbol-value (sr-symbol side 'window))))
+ (set (sr-symbol side 'buffer) (window-buffer window))))
+
+(defun sr-scrollable-viewer (buffer)
+ "Set the `other-window-scroll-buffer' variable to BUFFER.
+Doing so allows to scroll the given buffer directly from the active pane."
+ (setq other-window-scroll-buffer buffer)
+ (if buffer
+ (message "QUICK VIEW: Press C-e/C-y to scroll, Space/M-Space to page, and C-u v (or C-u o) to dismiss")))
+
+(defun sr-describe-mode ()
+ "Call `describe-mode' and make the resulting buffer C-M-v scrollable."
+ (interactive)
+ (describe-mode)
+ (sr-scrollable-viewer (get-buffer "*Help*"))
+ (sr-select-window sr-selected-window))
+
+(defun sr-equal-dirs (dir1 dir2)
+ "Return non-nil if the two paths DIR1 and DIR2 represent the same directory."
+ (string= (expand-file-name (concat (directory-file-name dir1) "/"))
+ (expand-file-name (concat (directory-file-name dir2) "/"))))
+
+(defun sr-summary ()
+ "Summarize basic Sunrise commands and show recent Dired errors."
+ (interactive)
+ (dired-why)
+ (message "C-opy, R-ename, K-lone, D-elete, v-iew, e-X-ecute, Ff-ollow, \
+Jj-ump, q-uit, m-ark, u-nmark, h-elp"))
+
+(defun sr-restore-point-if-same-buffer ()
+ "Synchronize point position if the same buffer is displayed in both panes."
+ (let ((this-win)(other-win)(point))
+ (when (and (eq sr-left-buffer sr-right-buffer)
+ (window-live-p (setq other-win (sr-other 'window))))
+ (setq this-win (selected-window))
+ (setq point (point))
+ (select-window other-win)
+ (goto-char point)
+ (select-window this-win))))
+
+(defun sr-mark-toggle ()
+ "Toggle the mark on the current file or directory."
+ (interactive)
+ (when (dired-get-filename t t)
+ (if (eq ? (char-after (line-beginning-position)))
+ (dired-mark 1)
+ (dired-unmark 1))))
+
+(defun sr-assoc-key (name alist test)
+ "Return the key in ALIST matched by NAME according to TEST."
+ (let (head (tail alist) found)
+ (while (and tail (not found))
+ (setq head (caar tail)
+ found (and (apply test (list head name)) head)
+ tail (cdr tail)))
+ found))
+
+(defun sr-quote-marked ()
+ "Return current pane's selected entries quoted and space-separated as a string."
+ (let ((marked (dired-get-marked-files t nil nil t)))
+ (if (< (length marked) 2)
+ (setq marked nil)
+ (if (eq t (car marked)) (setq marked (cdr marked)))
+ (format "\"%s\"" (mapconcat 'identity marked "\" \"")))))
+
+(defun sr-fix-listing-switches()
+ "Work around a bug in Dired that makes `dired-move-to-filename' misbehave
+when any of the options -p or -F is used with ls."
+ (mapc (lambda (sym)
+ (let ((val (replace-regexp-in-string "\\(?:^\\| \\)-[pF]*\\(?: \\|$\\)" " " (symbol-value sym))))
+ (while (string-match "\\(?:^\\| \\)-[^- ]*[pF]" val)
+ (setq val (replace-regexp-in-string "\\(\\(?:^\\| \\)-[^- ]*\\)[pF]\\([^ ]*\\)" "\\1\\2" val)))
+ (set sym val)))
+ '(sr-listing-switches sr-virtual-listing-switches))
+ (remove-hook 'sr-init-hook 'sr-fix-listing-switches))
+(add-hook 'sr-init-hook 'sr-fix-listing-switches)
+
+(defun sr-chop (char path)
+ "Remove all trailing instances of character CHAR from the string PATH."
+ (while (and (< 1 (length path))
+ (eq (string-to-char (substring path -1)) char))
+ (setq path (substring path 0 -1)))
+ path)
+
+;;; ============================================================================
+;;; Advice
+
+(defun sr-ad-enable (regexp &optional function)
+ "Put all or FUNCTION-specific advice matching REGEXP into effect.
+If provided, only update FUNCTION itself, otherwise all functions
+with advice matching REGEXP."
+ (if function
+ (progn (ad-enable-advice function 'any regexp)
+ (ad-activate function))
+ (ad-enable-regexp regexp)
+ (ad-activate-regexp regexp)))
+
+(defun sr-ad-disable (regexp &optional function)
+ "Stop all FUNCTION-specific advice matching REGEXP from taking effect.
+If provided, only update FUNCTION itself, otherwise all functions
+with advice matching REGEXP."
+ (if function
+ (progn (ad-disable-advice function 'any regexp)
+ (ad-update function))
+ (ad-disable-regexp regexp)
+ (ad-update-regexp regexp)))
+
+(defun sunrise-commander-unload-function ()
+ (sr-ad-disable "^sr-advice-"))
+
+;;; ============================================================================
+;;; Font-Lock colors & styles:
+
+(defmacro sr-rainbow (symbol spec regexp)
+ `(progn
+ (defface ,symbol '((t ,spec)) "Sunrise rainbow face" :group 'sunrise)
+ ,@(mapcar (lambda (m)
+ `(font-lock-add-keywords ',m '((,regexp 1 ',symbol))))
+ '(sr-mode sr-virtual-mode))))
+
+(sr-rainbow sr-html-face (:foreground "DarkOliveGreen") "\\(^[^!].[^d].*\\.x?html?$\\)")
+(sr-rainbow sr-xml-face (:foreground "DarkGreen") "\\(^[^!].[^d].*\\.\\(xml\\|xsd\\|xslt?\\|wsdl\\)$\\)")
+(sr-rainbow sr-log-face (:foreground "brown") "\\(^[^!].[^d].*\\.log$\\)")
+(sr-rainbow sr-compressed-face (:foreground "magenta") "\\(^[^!].[^d].*\\.\\(zip\\|bz2\\|t?[gx]z\\|[zZ]\\|[jwers]?ar\\|xpi\\|apk\\|xz\\)$\\)")
+(sr-rainbow sr-packaged-face (:foreground "DarkMagenta") "\\(^[^!].[^d].*\\.\\(deb\\|rpm\\)$\\)")
+(sr-rainbow sr-encrypted-face (:foreground "DarkOrange1") "\\(^[^!].[^d].*\\.\\(gpg\\|pgp\\)$\\)")
+
+(sr-rainbow sr-directory-face (:inherit dired-directory :bold t) "\\(^[^!].d.*\\)")
+(sr-rainbow sr-symlink-face (:inherit dired-symlink :italic t) "\\(^[^!].l.*[^/]$\\)")
+(sr-rainbow sr-symlink-directory-face (:inherit dired-directory :italic t) "\\(^[^!].l.*/$\\)")
+(sr-rainbow sr-alt-marked-dir-face (:foreground "DeepPink" :bold t) "\\(^[^ *!D].d.*$\\)")
+(sr-rainbow sr-alt-marked-file-face (:foreground "DeepPink") "\\(^[^ *!D].[^d].*$\\)")
+(sr-rainbow sr-marked-dir-face (:inherit dired-marked) "\\(^[*!D].d.*$\\)")
+(sr-rainbow sr-marked-file-face (:inherit dired-marked :bold nil) "\\(^[*!D].[^d].*$\\)")
+(sr-rainbow sr-broken-link-face (:inherit dired-warning :italic t) "\\(^[!].l.*$\\)")
+
+(provide 'sunrise-commander)
+
+;;; sunrise-commander.el ends here
--- /dev/null
+Subproject commit ab64c73b393e7ed1a28ca2bf15e13958996a52df
--- /dev/null
+;; verilog-mode.el --- major mode for editing verilog source in Emacs
+;;
+;; $Id: verilog-mode.el 344 2007-07-10 15:49:18Z wsnyder $
+
+;; Copyright (C) 1996-2007 Free Software Foundation, Inc.
+
+;; Author: Michael McNamara (mac@verilog.com)
+;; http://www.verilog.com
+;;
+;; AUTO features, signal, modsig; by: Wilson Snyder
+;; (wsnyder@wsnyder.org)
+;; http://www.veripool.com
+;; Keywords: languages
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; This mode borrows heavily from the Pascal-mode and the cc-mode of emacs
+
+;; USAGE
+;; =====
+
+;; A major mode for editing Verilog HDL source code. When you have
+;; entered Verilog mode, you may get more info by pressing C-h m. You
+;; may also get online help describing various functions by: C-h f
+;; <Name of function you want described>
+
+;; You can get step by step help in installing this file by going to
+;; <http://www.verilog.com/emacs_install.html>
+
+;; The short list of installation instructions are: To set up
+;; automatic verilog mode, put this file in your load path, and put
+;; the following in code (please un comment it first!) in your
+;; .emacs, or in your site's site-load.el
+
+; (autoload 'verilog-mode "verilog-mode" "Verilog mode" t )
+; (setq auto-mode-alist (cons '("\\.v\\'" . verilog-mode) auto-mode-alist))
+; (setq auto-mode-alist (cons '("\\.dv\\'" . verilog-mode) auto-mode-alist))
+
+;; If you want to customize Verilog mode to fit your needs better,
+;; you may add these lines (the values of the variables presented
+;; here are the defaults). Note also that if you use an emacs that
+;; supports custom, it's probably better to use the custom menu to
+;; edit these.
+;;
+;; Be sure to examine at the help for verilog-auto, and the other
+;; verilog-auto-* functions for some major coding time savers.
+;;
+; ;; User customization for Verilog mode
+; (setq verilog-indent-level 3
+; verilog-indent-level-module 3
+; verilog-indent-level-declaration 3
+; verilog-indent-level-behavioral 3
+; verilog-indent-level-directive 1
+; verilog-case-indent 2
+; verilog-auto-newline t
+; verilog-auto-indent-on-newline t
+; verilog-tab-always-indent t
+; verilog-auto-endcomments t
+; verilog-minimum-comment-distance 40
+; verilog-indent-begin-after-if t
+; verilog-auto-lineup '(all)
+; verilog-linter "my_lint_shell_command"
+; )
+
+;; KNOWN BUGS / BUG REPORTS
+;; =======================
+;; This is beta code, and likely has bugs. Please report any and all
+;; bugs to me at mac@verilog.com. Use
+;; verilog-submit-bug-report to submit a report.
+;; \f
+
+;;; History:
+;;
+;; \f
+;;; Code:
+
+(provide 'verilog-mode)
+
+;; This variable will always hold the version number of the mode
+(defconst verilog-mode-version (substring "$$Revision: 344 $$" 12 -3)
+ "Version of this verilog mode.")
+(defconst verilog-mode-release-date (substring "$$Date: 2007-07-10 08:49:18 -0700 (Tue, 10 Jul 2007) $$" 8 -3)
+ "Version of this verilog mode.")
+
+(defconst verilog-running-on-xemacs (string-match "XEmacs" emacs-version))
+(defun verilog-version ()
+ "Inform caller of the version of this file."
+ (interactive)
+ (message (concat "Using verilog-mode version " verilog-mode-version) ))
+
+;; Insure we have certain packages, and deal with it if we don't
+(if (fboundp 'eval-when-compile)
+ (eval-when-compile
+ (require 'verilog-mode)
+ (condition-case nil
+ (require 'imenu)
+ (error nil))
+ (condition-case nil
+ (require 'reporter)
+ (error nil))
+ (condition-case nil
+ (require 'easymenu)
+ (error nil))
+ (condition-case nil
+ (require 'regexp-opt)
+ (error nil))
+ (condition-case nil
+ (load "skeleton") ;; bug in 19.28 through 19.30 skeleton.el, not provided.
+ (error nil))
+ (condition-case nil
+ (require 'vc)
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'when)
+ nil ;; fab
+ (defmacro when (var &rest body)
+ (` (cond ( (, var) (,@ body))))))
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'unless)
+ nil ;; fab
+ (defmacro unless (var &rest body)
+ (` (if (, var) nil (,@ body)))))
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'store-match-data)
+ nil ;; fab
+ (defmacro store-match-data (&rest args) nil))
+ (error nil))
+ (condition-case nil
+ (if (boundp 'current-menubar)
+ nil ;; great
+ (progn
+ (defmacro set-buffer-menubar (&rest args) nil)
+ (defmacro add-submenu (&rest args) nil))
+ )
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'zmacs-activate-region)
+ nil ;; great
+ (defmacro zmacs-activate-region (&rest args) nil))
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'char-before)
+ nil ;; great
+ (defmacro char-before (&rest body)
+ (` (char-after (1- (point))))))
+ (error nil))
+ ;; Requires to define variables that would be "free" warnings
+ (condition-case nil
+ (require 'font-lock)
+ (error nil))
+ (condition-case nil
+ (require 'compile)
+ (error nil))
+ (condition-case nil
+ (require 'custom)
+ (error nil))
+ (condition-case nil
+ (require 'dinotrace)
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'dinotrace-unannotate-all)
+ nil ;; great
+ (defun dinotrace-unannotate-all (&rest args) nil))
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'customize-apropos)
+ nil ;; great
+ (defun customize-apropos (&rest args) nil))
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'match-string-no-properties)
+ nil ;; great
+ (defsubst match-string-no-properties (num &optional string)
+ "Return string of text matched by last search, without text properties.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING."
+ (if (match-beginning num)
+ (if string
+ (let ((result
+ (substring string (match-beginning num) (match-end num))))
+ (set-text-properties 0 (length result) nil result)
+ result)
+ (buffer-substring-no-properties (match-beginning num)
+ (match-end num)
+ (current-buffer)
+ )))))
+ (error nil))
+ (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ nil ;; We've got what we needed
+ ;; We have the old custom-library, hack around it!
+ (defmacro defgroup (&rest args) nil)
+ (defmacro customize (&rest args)
+ (message "Sorry, Customize is not available with this version of emacs"))
+ (defmacro defcustom (var value doc &rest args)
+ (` (defvar (, var) (, value) (, doc))))
+ )
+ (if (fboundp 'defface)
+ nil ; great!
+ (defmacro defface (var value doc &rest args)
+ (` (make-face (, var))))
+ )
+
+ (if (and (featurep 'custom) (fboundp 'customize-group))
+ nil ;; We've got what we needed
+ ;; We have an intermediate custom-library, hack around it!
+ (defmacro customize-group (var &rest args)
+ (`(customize (, var) )))
+ )
+
+ ))
+;; Provide a regular expression optimization routine, using regexp-opt
+;; if provided by the user's elisp libraries
+(eval-and-compile
+ (if (fboundp 'regexp-opt)
+ ;; regexp-opt is defined, does it take 3 or 2 arguments?
+ (if (fboundp 'function-max-args)
+ (case (function-max-args `regexp-opt)
+ ( 3 ;; It takes 3
+ (condition-case nil ; Hide this defun from emacses
+ ;with just a two input regexp
+ (defun verilog-regexp-opt (a b)
+ "Deal with differing number of required arguments for `regexp-opt'.
+ Call 'regexp-opt' on A and B."
+ (regexp-opt a b 't)
+ )
+ (error nil))
+ )
+ ( 2 ;; It takes 2
+ (defun verilog-regexp-opt (a b)
+ "Call 'regexp-opt' on A and B."
+ (regexp-opt a b))
+ )
+ ( t nil))
+ ;; We can't tell; assume it takes 2
+ (defun verilog-regexp-opt (a b)
+ "Call 'regexp-opt' on A and B."
+ (regexp-opt a b))
+ )
+ ;; There is no regexp-opt, provide our own
+ (defun verilog-regexp-opt (strings &optional paren shy)
+ (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
+ (concat open (mapconcat 'regexp-quote strings "\\|") close)))
+ ))
+
+(eval-when-compile
+ (defun verilog-regexp-words (a)
+ "Call 'regexp-opt' with word delimiters."
+ (concat "\\<" (verilog-regexp-opt a t) "\\>")))
+
+(defun verilog-regexp-words (a)
+ "Call 'regexp-opt' with word delimiters for the words A."
+ (concat "\\<" (verilog-regexp-opt a t) "\\>"))
+
+(defun verilog-customize ()
+ "Link to customize screen for Verilog."
+ (interactive)
+ (customize-group 'verilog-mode))
+
+(defun verilog-font-customize ()
+ "Link to customize fonts used for Verilog."
+ (interactive)
+ (customize-apropos "font-lock-*" 'faces))
+
+(defgroup verilog-mode nil
+ "Facilitates easy editing of Verilog source text"
+ :group 'languages)
+
+; (defgroup verilog-mode-fonts nil
+; "Facilitates easy customization fonts used in Verilog source text"
+; :link '(customize-apropos "font-lock-*" 'faces)
+; :group 'verilog-mode)
+
+(defgroup verilog-mode-indent nil
+ "Customize indentation and highlighting of verilog source text"
+ :group 'verilog-mode)
+
+(defgroup verilog-mode-actions nil
+ "Customize actions on verilog source text"
+ :group 'verilog-mode)
+
+(defgroup verilog-mode-auto nil
+ "Customize AUTO actions when expanding verilog source text"
+ :group 'verilog-mode)
+
+(defcustom verilog-linter
+ "echo 'No verilog-linter set, see \"M-x describe-variable verilog-linter\"'"
+ "*Unix program and arguments to call to run a lint checker on verilog source.
+Depending on the `verilog-set-compile-command', this may be invoked when
+you type \\[compile]. When the compile completes, \\[next-error] will take
+you to the next lint error."
+ :type 'string
+ :group 'verilog-mode-actions)
+
+(defcustom verilog-coverage
+ "echo 'No verilog-coverage set, see \"M-x describe-variable verilog-coverage\"'"
+ "*Program and arguments to use to annotate for coverage verilog source.
+Depending on the `verilog-set-compile-command', this may be invoked when
+you type \\[compile]. When the compile completes, \\[next-error] will take
+you to the next lint error."
+ :type 'string
+ :group 'verilog-mode-actions)
+
+(defcustom verilog-simulator
+ "echo 'No verilog-simulator set, see \"M-x describe-variable verilog-simulator\"'"
+ "*Program and arguments to use to interpret verilog source.
+Depending on the `verilog-set-compile-command', this may be invoked when
+you type \\[compile]. When the compile completes, \\[next-error] will take
+you to the next lint error."
+ :type 'string
+ :group 'verilog-mode-actions)
+
+(defcustom verilog-compiler
+ "echo 'No verilog-compiler set, see \"M-x describe-variable verilog-compiler\"'"
+ "*Program and arguments to use to compile verilog source.
+Depending on the `verilog-set-compile-command', this may be invoked when
+you type \\[compile]. When the compile completes, \\[next-error] will take
+you to the next lint error."
+ :type 'string
+ :group 'verilog-mode-actions)
+
+(defvar verilog-tool 'verilog-linter
+ "Which tool to use for building compiler-command.
+Either nil, `verilog-linter, `verilog-coverage, `verilog-simulator, or
+`verilog-compiler. Alternatively use the \"Choose Compilation Action\"
+menu. See `verilog-set-compile-command' for more information.")
+
+(defcustom verilog-highlight-translate-off nil
+ "*Non-nil means background-highlight code excluded from translation.
+That is, all code between \"// synopsys translate_off\" and
+\"// synopsys translate_on\" is highlighted using a different background color
+\(face `verilog-font-lock-translate-off-face').
+
+Note: This will slow down on-the-fly fontification (and thus editing).
+
+Note: Activate the new setting in a Verilog buffer by re-fontifying it (menu
+entry \"Fontify Buffer\"). XEmacs: turn off and on font locking."
+ :type 'boolean
+ :group 'verilog-mode-indent)
+
+(defcustom verilog-indent-level 3
+ "*Indentation of Verilog statements with respect to containing block."
+ :group 'verilog-mode-indent
+ :type 'integer)
+
+(defcustom verilog-indent-level-module 3
+ "*Indentation of Module level Verilog statements. (eg always, initial)
+Set to 0 to get initial and always statements lined up on the left side of
+your screen."
+ :group 'verilog-mode-indent
+ :type 'integer)
+
+(defcustom verilog-indent-level-declaration 3
+ "*Indentation of declarations with respect to containing block.
+Set to 0 to get them list right under containing block."
+ :group 'verilog-mode-indent
+ :type 'integer)
+
+(defcustom verilog-indent-declaration-macros nil
+ "*How to treat macro expansions in a declaration.
+If nil, indent as:
+ input [31:0] a;
+ input `CP;
+ output c;
+If non nil, treat as:
+ input [31:0] a;
+ input `CP ;
+ output c;"
+ :group 'verilog-mode-indent
+ :type 'boolean)
+
+(defcustom verilog-indent-lists t
+ "*How to treat indenting items in a list.
+If t (the default), indent as:
+ always @( posedge a or
+ reset ) begin
+
+If nil, treat as:
+ always @( posedge a or
+ reset ) begin"
+ :group 'verilog-mode-indent
+ :type 'boolean)
+
+(defcustom verilog-indent-level-behavioral 3
+ "*Absolute indentation of first begin in a task or function block.
+Set to 0 to get such code to start at the left side of the screen."
+ :group 'verilog-mode-indent
+ :type 'integer)
+
+(defcustom verilog-indent-level-directive 1
+ "*Indentation to add to each level of `ifdef declarations.
+Set to 0 to have all directives start at the left side of the screen."
+ :group 'verilog-mode-indent
+ :type 'integer)
+
+(defcustom verilog-cexp-indent 2
+ "*Indentation of Verilog statements split across lines."
+ :group 'verilog-mode-indent
+ :type 'integer)
+
+(defcustom verilog-case-indent 2
+ "*Indentation for case statements."
+ :group 'verilog-mode-indent
+ :type 'integer)
+
+(defcustom verilog-auto-newline t
+ "*True means automatically newline after semicolons."
+ :group 'verilog-mode-indent
+ :type 'boolean)
+
+(defcustom verilog-auto-indent-on-newline t
+ "*True means automatically indent line after newline."
+ :group 'verilog-mode-indent
+ :type 'boolean)
+
+(defcustom verilog-tab-always-indent t
+ "*True means TAB should always re-indent the current line.
+Nil means TAB will only reindent when at the beginning of the line."
+ :group 'verilog-mode-indent
+ :type 'boolean)
+
+(defcustom verilog-tab-to-comment nil
+ "*True means TAB moves to the right hand column in preparation for a comment."
+ :group 'verilog-mode-actions
+ :type 'boolean)
+
+(defcustom verilog-indent-begin-after-if t
+ "*If true, indent begin statements following if, else, while, for and repeat.
+Otherwise, line them up."
+ :group 'verilog-mode-indent
+ :type 'boolean )
+
+
+(defcustom verilog-align-ifelse nil
+ "*If true, align `else' under matching `if'.
+Otherwise else is lined up with first character on line holding matching if."
+ :group 'verilog-mode-indent
+ :type 'boolean )
+
+(defcustom verilog-minimum-comment-distance 10
+ "*Minimum distance (in lines) between begin and end required before a comment.
+Setting this variable to zero results in every end acquiring a comment; the
+default avoids too many redundant comments in tight quarters"
+ :group 'verilog-mode-indent
+ :type 'integer)
+
+(defcustom verilog-auto-lineup '(declaration)
+ "*Algorithm for lining up statements on multiple lines.
+
+If this list contains the symbol 'all', then all line ups described below
+are done.
+
+If this list contains the symbol 'declaration', then declarations are lined up
+with any preceding declarations, taking into account widths and the like, so
+for example the code:
+ reg [31:0] a;
+ reg b;
+would become
+ reg [31:0] a;
+ reg b;
+
+If this list contains the symbol 'assignment', then assignments are lined up
+with any preceding assignments, so for example the code
+ a_long_variable = b + c;
+ d = e + f;
+would become
+ a_long_variable = b + c;
+ d = e + f;"
+
+;; The following is not implemented:
+;If this list contains the symbol 'case', then case items are lined up
+;with any preceding case items, so for example the code
+; case (a) begin
+; a_long_state : a = 3;
+; b: a = 4;
+; endcase
+;would become
+; case (a) begin
+; a_long_state : a = 3;
+; b : a = 4;
+; endcase
+;
+
+ :group 'verilog-mode-indent
+ :type 'list )
+
+(defcustom verilog-auto-endcomments t
+ "*True means insert a comment /* ... */ after 'end's.
+The name of the function or case will be set between the braces."
+ :group 'verilog-mode-actions
+ :type 'boolean )
+
+(defcustom verilog-auto-read-includes nil
+ "*True means to automatically read includes before AUTOs.
+This will do a `verilog-read-defines' and `verilog-read-includes' before
+each AUTO expansion. This makes it easier to embed defines and includes,
+but can result in very slow reading times if there are many or large
+include files."
+ :group 'verilog-mode-actions
+ :type 'boolean )
+
+(defcustom verilog-auto-save-policy nil
+ "*Non-nil indicates action to take when saving a Verilog buffer with AUTOs.
+A value of `force' will always do a \\[verilog-auto] automatically if
+needed on every save. A value of `detect' will do \\[verilog-auto]
+automatically when it thinks necessary. A value of `ask' will query the
+user when it thinks updating is needed.
+
+You should not rely on the 'ask or 'detect policies, they are safeguards
+only. They do not detect when AUTOINSTs need to be updated because a
+sub-module's port list has changed."
+ :group 'verilog-mode-actions
+ :type '(choice (const nil) (const ask) (const detect) (const force)))
+
+(defcustom verilog-auto-star-expand t
+ "*Non-nil indicates to expand a SystemVerilog .* instance ports.
+They will be expanded in the same way as if there was a AUTOINST in the
+instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'."
+ :group 'verilog-mode-actions
+ :type 'boolean)
+
+(defcustom verilog-auto-star-save nil
+ "*Non-nil indicates to save to disk SystemVerilog .* instance expansions.
+Nil indicates direct connections will be removed before saving. Only
+meaningful to those created due to `verilog-auto-star-expand' being set.
+
+Instead of setting this, you may want to use /*AUTOINST*/, which will
+always be saved."
+ :group 'verilog-mode-actions
+ :type 'boolean)
+
+(defvar verilog-auto-update-tick nil
+ "Modification tick at which autos were last performed.")
+
+(defvar verilog-auto-last-file-locals nil
+ "Text from file-local-variables during last evaluation.")
+
+(defvar verilog-error-regexp-add-didit nil)
+(defvar verilog-error-regexp nil)
+(setq verilog-error-regexp-add-didit nil
+ verilog-error-regexp
+ '(
+ ; SureLint
+;; ("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 1 2)
+ ; Most SureFire tools
+ ("\\(WARNING\\|ERROR\\|INFO\\)[^:]*: \\([^,]+\\), \\(line \\|\\)\\([0-9]+\\):" 2 4 )
+ ("\
+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
+:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5)
+ ; xsim
+ ; Error! in file /homes/mac/Axis/Xsim/test.v at line 13 [OBJ_NOT_DECLARED]
+ ("\\(Error\\|Warning\\).*in file (\\([^ \t]+\\) at line *\\([0-9]+\\))" 2 3)
+ ; vcs
+ ("\\(Error\\|Warning\\):[^(]*(\\([^ \t]+\\) line *\\([0-9]+\\))" 2 3)
+ ("Warning:.*(port.*(\\([^ \t]+\\) line \\([0-9]+\\))" 1 2)
+ ("\\(Error\\|Warning\\):[\n.]*\\([^ \t]+\\) *\\([0-9]+\\):" 2 3)
+ ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 2)
+ ; Verilator
+ ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 4)
+ ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 4)
+ ; vxl
+ ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 3)
+ ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\([0-9]+\\):.*$" 1 2) ; vxl
+ ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+line[ \t]+\\([0-9]+\\):.*$" 1 2)
+ ; nc-verilog
+ (".*\\*[WE],[0-9A-Z]+ (\\([^ \t,]+\\),\\([0-9]+\\)|" 1 2)
+ ; Leda
+ ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 2)
+ )
+; "*List of regexps for verilog compilers, like verilint. See compilation-error-regexp-alist for the formatting."
+)
+
+(defvar verilog-error-font-lock-keywords
+ '(
+ ("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 1 bold t)
+ ("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 2 bold t)
+
+ ("\\(WARNING\\|ERROR\\|INFO\\): \\([^,]+\\), line \\([0-9]+\\):" 2 bold t)
+ ("\\(WARNING\\|ERROR\\|INFO\\): \\([^,]+\\), line \\([0-9]+\\):" 3 bold t)
+
+ ("\
+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
+:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 bold t)
+ ("\
+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
+:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 bold t)
+
+ ("\\(Error\\|Warning\\):[^(]*(\\([^ \t]+\\) line *\\([0-9]+\\))" 2 bold t)
+ ("\\(Error\\|Warning\\):[^(]*(\\([^ \t]+\\) line *\\([0-9]+\\))" 3 bold t)
+
+ ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t)
+ ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t)
+
+ ("Warning:.*(port.*(\\([^ \t]+\\) line \\([0-9]+\\))" 1 bold t)
+ ("Warning:.*(port.*(\\([^ \t]+\\) line \\([0-9]+\\))" 1 bold t)
+
+ ("\\(Error\\|Warning\\):[\n.]*\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t)
+ ("\\(Error\\|Warning\\):[\n.]*\\([^ \t]+\\) *\\([0-9]+\\):" 3 bold t)
+
+ ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 bold t)
+ ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t)
+ ; vxl
+ ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 bold t)
+ ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 bold t)
+
+ ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\([0-9]+\\):.*$" 1 bold t)
+ ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\([0-9]+\\):.*$" 2 bold t)
+
+ ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+line[ \t]+\\([0-9]+\\):.*$" 1 bold t)
+ ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+line[ \t]+\\([0-9]+\\):.*$" 2 bold t)
+ ; nc-verilog
+ (".*[WE],[0-9A-Z]+ (\\([^ \t,]+\\),\\([0-9]+\\)|" 1 bold t)
+ (".*[WE],[0-9A-Z]+ (\\([^ \t,]+\\),\\([0-9]+\\)|" 2 bold t)
+ ; Leda
+ ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 bold t)
+ ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 2 bold t)
+ )
+ "*Keywords to also highlight in Verilog *compilation* buffers."
+ )
+
+(defcustom verilog-library-flags '("")
+ "*List of standard Verilog arguments to use for /*AUTOINST*/.
+These arguments are used to find files for `verilog-auto', and match
+the flags accepted by a standard Verilog-XL simulator.
+
+ -f filename Reads more `verilog-library-flags' from the filename.
+ +incdir+dir Adds the directory to `verilog-library-directories'.
+ -Idir Adds the directory to `verilog-library-directories'.
+ -y dir Adds the directory to `verilog-library-directories'.
+ +libext+.v Adds the extensions to `verilog-library-extensions'.
+ -v filename Adds the filename to `verilog-library-files'.
+
+ filename Adds the filename to `verilog-library-files'.
+ This is not recommended, -v is a better choice.
+
+You might want these defined in each file; put at the *END* of your file
+something like:
+
+ // Local Variables:
+ // verilog-library-flags:(\"-y dir -y otherdir\")
+ // End:
+
+Verilog-mode attempts to detect changes to this local variable, but they
+are only insured to be correct when the file is first visited. Thus if you
+have problems, use \\[find-alternate-file] RET to have these take effect.
+
+See also the variables mentioned above."
+ :group 'verilog-mode-auto
+ :type '(repeat string))
+
+(defcustom verilog-library-directories '(".")
+ "*List of directories when looking for files for /*AUTOINST*/.
+The directory may be relative to the current file, or absolute.
+Environment variables are also expanded in the directory names.
+Having at least the current directory is a good idea.
+
+You might want these defined in each file; put at the *END* of your file
+something like:
+
+ // Local Variables:
+ // verilog-library-directories:(\".\" \"subdir\" \"subdir2\")
+ // End:
+
+Verilog-mode attempts to detect changes to this local variable, but they
+are only insured to be correct when the file is first visited. Thus if you
+have problems, use \\[find-alternate-file] RET to have these take effect.
+
+See also `verilog-library-flags', `verilog-library-files'
+and `verilog-library-extensions'."
+ :group 'verilog-mode-auto
+ :type '(repeat file))
+
+(defcustom verilog-library-files '()
+ "*List of files to search for modules when looking for AUTOINST files.
+This is a complete path, usually to a technology file with many standard
+cells defined in it.
+
+You might want these defined in each file; put at the *END* of your file
+something like:
+
+ // Local Variables:
+ // verilog-library-files:(\"/some/path/technology.v\" \"/some/path/tech2.v\")
+ // End:
+
+Verilog-mode attempts to detect changes to this local variable, but they
+are only insured to be correct when the file is first visited. Thus if you
+have problems, use \\[find-alternate-file] RET to have these take effect.
+
+See also `verilog-library-flags', `verilog-library-directories'."
+ :group 'verilog-mode-auto
+ :type '(repeat directory))
+
+(defcustom verilog-library-extensions '(".v")
+ "*List of extensions to use when looking for files for /*AUTOINST*/.
+See also `verilog-library-flags', `verilog-library-directories'."
+ :type '(repeat string)
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-active-low-regexp nil
+ "*If set, treat signals matching this regexp as active low.
+This is used for AUTORESET and AUTOTIEOFF. For proper behavior,
+you will probably also need `verilog-auto-reset-widths' set."
+ :group 'verilog-mode-auto
+ :type 'string)
+
+(defcustom verilog-auto-sense-include-inputs nil
+ "*If true, AUTOSENSE should include all inputs.
+If nil, only inputs that are NOT output signals in the same block are
+included."
+ :type 'boolean
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-auto-sense-defines-constant nil
+ "*If true, AUTOSENSE should assume all defines represent constants.
+When true, the defines will not be included in sensitivity lists. To
+maintain compatibility with other sites, this should be set at the bottom
+of each verilog file that requires it, rather then being set globally."
+ :type 'boolean
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-auto-reset-widths t
+ "*If true, AUTORESET should determine the width of signals.
+This is then used to set the width of the zero (32'h0 for example). This
+is required by some lint tools that aren't smart enough to ignore widths of
+the constant zero. This may result in ugly code when parameters determine
+the MSB or LSB of a signal inside a AUTORESET."
+ :type 'boolean
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-assignment-delay ""
+ "*Text used for delays in delayed assignments. Add a trailing space if set."
+ :type 'string
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-auto-inst-vector t
+ "*If true, when creating default ports with AUTOINST, use bus subscripts.
+If nil, skip the subscript when it matches the entire bus as declared in
+the module (AUTOWIRE signals always are subscripted, you must manually
+declare the wire to have the subscripts removed.) Nil may speed up some
+simulators, but is less general and harder to read, so avoid."
+ :group 'verilog-mode-auto
+ :type 'boolean )
+
+(defcustom verilog-auto-inst-template-numbers nil
+ "*If true, when creating templated ports with AUTOINST, add a comment.
+The comment will add the line number of the template that was used for that
+port declaration. Setting this aids in debugging, but nil is suggested for
+regular use to prevent large numbers of merge conflicts."
+ :group 'verilog-mode-auto
+ :type 'boolean )
+
+(defvar verilog-auto-inst-column 40
+ "Column number for first part of auto-inst.")
+
+(defcustom verilog-auto-input-ignore-regexp nil
+ "*If set, when creating AUTOINPUT list, ignore signals matching this regexp.
+See the \\[verilog-faq] for examples on using this."
+ :group 'verilog-mode-auto
+ :type 'string )
+
+(defcustom verilog-auto-inout-ignore-regexp nil
+ "*If set, when creating AUTOINOUT list, ignore signals matching this regexp.
+See the \\[verilog-faq] for examples on using this."
+ :group 'verilog-mode-auto
+ :type 'string )
+
+(defcustom verilog-auto-output-ignore-regexp nil
+ "*If set, when creating AUTOOUTPUT list, ignore signals matching this regexp.
+See the \\[verilog-faq] for examples on using this."
+ :group 'verilog-mode-auto
+ :type 'string )
+
+(defcustom verilog-auto-unused-ignore-regexp nil
+ "*If set, when creating AUTOUNUSED list, ignore signals matching this regexp.
+See the \\[verilog-faq] for examples on using this."
+ :group 'verilog-mode-auto
+ :type 'string )
+
+(defcustom verilog-typedef-regexp nil
+ "*If non-nil, regular expression that matches Verilog-2001 typedef names.
+For example, \"_t$\" matches typedefs named with _t, as in the C language."
+ :group 'verilog-mode-auto
+ :type 'string )
+
+(defcustom verilog-mode-hook 'verilog-set-compile-command
+ "*Hook (List of functions) run after verilog mode is loaded."
+ :type 'hook
+ :group 'verilog-mode)
+
+(defcustom verilog-auto-hook nil
+ "*Hook run after `verilog-mode' updates AUTOs."
+ :type 'hook
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-before-auto-hook nil
+ "*Hook run before `verilog-mode' updates AUTOs."
+ :type 'hook
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-delete-auto-hook nil
+ "*Hook run after `verilog-mode' deletes AUTOs."
+ :type 'hook
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-before-delete-auto-hook nil
+ "*Hook run before `verilog-mode' deletes AUTOs."
+ :type 'hook
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-getopt-flags-hook nil
+ "*Hook run after `verilog-getopt-flags' determines the Verilog option lists."
+ :type 'hook
+ :group 'verilog-mode-auto)
+
+(defcustom verilog-before-getopt-flags-hook nil
+ "*Hook run before `verilog-getopt-flags' determines the Verilog option lists."
+ :type 'hook
+ :group 'verilog-mode-auto)
+
+(defvar verilog-imenu-generic-expression
+ '((nil "^\\s-*\\(\\(m\\(odule\\|acromodule\\)\\)\\|primitive\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 4)
+ ("*Vars*" "^\\s-*\\(reg\\|wire\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3))
+ "Imenu expression for Verilog-mode. See `imenu-generic-expression'.")
+
+;;
+;; provide a verilog-header function.
+;; Customization variables:
+;;
+(defvar verilog-date-scientific-format nil
+ "*If non-nil, dates are written in scientific format (e.g. 1997/09/17).
+If nil, in European format (e.g. 17.09.1997). The brain-dead American
+format (e.g. 09/17/1997) is not supported.")
+
+(defvar verilog-company nil
+ "*Default name of Company for verilog header.
+If set will become buffer local.")
+
+(defvar verilog-project nil
+ "*Default name of Project for verilog header.
+If set will become buffer local.")
+
+(define-abbrev-table 'verilog-mode-abbrev-table ())
+
+(defvar verilog-mode-map ()
+ "Keymap used in Verilog mode.")
+(if verilog-mode-map
+ ()
+ (setq verilog-mode-map (make-sparse-keymap))
+ (define-key verilog-mode-map ";" 'electric-verilog-semi)
+ (define-key verilog-mode-map [(control 59)] 'electric-verilog-semi-with-comment)
+ (define-key verilog-mode-map ":" 'electric-verilog-colon)
+ ;;(define-key verilog-mode-map "=" 'electric-verilog-equal)
+ (define-key verilog-mode-map "\`" 'electric-verilog-tick)
+ (define-key verilog-mode-map "\t" 'electric-verilog-tab)
+ (define-key verilog-mode-map "\r" 'electric-verilog-terminate-line)
+ ;; backspace/delete key bindings
+ (define-key verilog-mode-map [backspace] 'backward-delete-char-untabify)
+ (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable
+ (define-key verilog-mode-map [delete] 'delete-char)
+ (define-key verilog-mode-map [(meta delete)] 'kill-word))
+ (define-key verilog-mode-map "\M-\C-b" 'electric-verilog-backward-sexp)
+ (define-key verilog-mode-map "\M-\C-f" 'electric-verilog-forward-sexp)
+ (define-key verilog-mode-map "\M-\r" `electric-verilog-terminate-and-indent)
+ (define-key verilog-mode-map "\M-\t" 'verilog-complete-word)
+ (define-key verilog-mode-map "\M-?" 'verilog-show-completions)
+ (define-key verilog-mode-map [(meta control h)] 'verilog-mark-defun)
+ (define-key verilog-mode-map "\C-c\`" 'verilog-lint-off)
+ (define-key verilog-mode-map "\C-c\*" 'verilog-delete-auto-star-implicit)
+ (define-key verilog-mode-map "\C-c\C-r" 'verilog-label-be)
+ (define-key verilog-mode-map "\C-c\C-i" 'verilog-pretty-declarations)
+ (define-key verilog-mode-map "\C-c=" 'verilog-pretty-expr)
+ (define-key verilog-mode-map "\C-c\C-b" 'verilog-submit-bug-report)
+ (define-key verilog-mode-map "\M-*" 'verilog-star-comment)
+ (define-key verilog-mode-map "\C-c\C-c" 'verilog-comment-region)
+ (define-key verilog-mode-map "\C-c\C-u" 'verilog-uncomment-region)
+ (define-key verilog-mode-map "\M-\C-a" 'verilog-beg-of-defun)
+ (define-key verilog-mode-map "\M-\C-e" 'verilog-end-of-defun)
+ (define-key verilog-mode-map "\C-c\C-d" 'verilog-goto-defun)
+ (define-key verilog-mode-map "\C-c\C-k" 'verilog-delete-auto)
+ (define-key verilog-mode-map "\C-c\C-a" 'verilog-auto)
+ (define-key verilog-mode-map "\C-c\C-s" 'verilog-auto-save-compile)
+ (define-key verilog-mode-map "\C-c\C-z" 'verilog-inject-auto)
+ (define-key verilog-mode-map "\C-c\C-e" 'verilog-expand-vector)
+ (define-key verilog-mode-map "\C-c\C-h" 'verilog-header)
+ )
+
+;; menus
+(defvar verilog-xemacs-menu
+ '("Verilog"
+ ("Choose Compilation Action"
+ ["None"
+ (progn
+ (setq verilog-tool nil)
+ (verilog-set-compile-command))
+ :style radio
+ :selected (equal verilog-tool nil)]
+ ["Lint"
+ (progn
+ (setq verilog-tool 'verilog-linter)
+ (verilog-set-compile-command))
+ :style radio
+ :selected (equal verilog-tool `verilog-linter)]
+ ["Coverage"
+ (progn
+ (setq verilog-tool 'verilog-coverage)
+ (verilog-set-compile-command))
+ :style radio
+ :selected (equal verilog-tool `verilog-coverage)]
+ ["Simulator"
+ (progn
+ (setq verilog-tool 'verilog-simulator)
+ (verilog-set-compile-command))
+ :style radio
+ :selected (equal verilog-tool `verilog-simulator)]
+ ["Compiler"
+ (progn
+ (setq verilog-tool 'verilog-compiler)
+ (verilog-set-compile-command))
+ :style radio
+ :selected (equal verilog-tool `verilog-compiler)]
+ )
+ ("Move"
+ ["Beginning of function" verilog-beg-of-defun t]
+ ["End of function" verilog-end-of-defun t]
+ ["Mark function" verilog-mark-defun t]
+ ["Goto function/module" verilog-goto-defun t]
+ ["Move to beginning of block" electric-verilog-backward-sexp t]
+ ["Move to end of block" electric-verilog-forward-sexp t]
+ )
+ ("Comments"
+ ["Comment Region" verilog-comment-region t]
+ ["UnComment Region" verilog-uncomment-region t]
+ ["Multi-line comment insert" verilog-star-comment t]
+ ["Lint error to comment" verilog-lint-off t]
+ )
+ "----"
+ ["Compile" compile t]
+ ["AUTO, Save, Compile" verilog-auto-save-compile t]
+ ["Next Compile Error" next-error t]
+ ["Ignore Lint Warning at point" verilog-lint-off t]
+ "----"
+ ["Line up declarations around point" verilog-pretty-declarations t]
+ ["Line up equations around point" verilog-pretty-expr t]
+ ["Redo/insert comments on every end" verilog-label-be t]
+ ["Expand [x:y] vector line" verilog-expand-vector t]
+ ["Insert begin-end block" verilog-insert-block t]
+ ["Complete word" verilog-complete-word t]
+ "----"
+ ["Recompute AUTOs" verilog-auto t]
+ ["Kill AUTOs" verilog-delete-auto t]
+ ["Inject AUTOs" verilog-inject-auto t]
+ ("AUTO Help..."
+ ["AUTO General" (describe-function 'verilog-auto) t]
+ ["AUTO Library Flags" (describe-variable 'verilog-library-flags) t]
+ ["AUTO Library Path" (describe-variable 'verilog-library-directories) t]
+ ["AUTO Library Files" (describe-variable 'verilog-library-files) t]
+ ["AUTO Library Extensions" (describe-variable 'verilog-library-extensions) t]
+ ["AUTO `define Reading" (describe-function 'verilog-read-defines) t]
+ ["AUTO `include Reading" (describe-function 'verilog-read-includes) t]
+ ["AUTOARG" (describe-function 'verilog-auto-arg) t]
+ ["AUTOASCIIENUM" (describe-function 'verilog-auto-ascii-enum) t]
+ ["AUTOINOUTMODULE" (describe-function 'verilog-auto-inout-module) t]
+ ["AUTOINOUT" (describe-function 'verilog-auto-inout) t]
+ ["AUTOINPUT" (describe-function 'verilog-auto-input) t]
+ ["AUTOINST" (describe-function 'verilog-auto-inst) t]
+ ["AUTOINST (.*)" (describe-function 'verilog-auto-star) t]
+ ["AUTOINSTPARAM" (describe-function 'verilog-auto-inst-param) t]
+ ["AUTOOUTPUT" (describe-function 'verilog-auto-output) t]
+ ["AUTOOUTPUTEVERY" (describe-function 'verilog-auto-output-every) t]
+ ["AUTOREG" (describe-function 'verilog-auto-reg) t]
+ ["AUTOREGINPUT" (describe-function 'verilog-auto-reg-input) t]
+ ["AUTORESET" (describe-function 'verilog-auto-reset) t]
+ ["AUTOSENSE" (describe-function 'verilog-auto-sense) t]
+ ["AUTOTIEOFF" (describe-function 'verilog-auto-tieoff) t]
+ ["AUTOUNUSED" (describe-function 'verilog-auto-unused) t]
+ ["AUTOWIRE" (describe-function 'verilog-auto-wire) t]
+ )
+ "----"
+ ["Submit bug report" verilog-submit-bug-report t]
+ ["Version and FAQ" verilog-faq t]
+ ["Customize Verilog Mode..." verilog-customize t]
+ ["Customize Verilog Fonts & Colors" verilog-font-customize t]
+ )
+ "Emacs menu for VERILOG mode."
+ )
+(defvar verilog-statement-menu
+ '("Statements"
+ ["Header" verilog-sk-header t]
+ ["Comment" verilog-sk-comment t]
+ "----"
+ ["Module" verilog-sk-module t]
+ ["Primitive" verilog-sk-primitive t]
+ "----"
+ ["Input" verilog-sk-input t]
+ ["Output" verilog-sk-output t]
+ ["Inout" verilog-sk-inout t]
+ ["Wire" verilog-sk-wire t]
+ ["Reg" verilog-sk-reg t]
+ ["Define thing under point as a register" verilog-sk-define-signal t]
+ "----"
+ ["Initial" verilog-sk-initial t]
+ ["Always" verilog-sk-always t]
+ ["Function" verilog-sk-function t]
+ ["Task" verilog-sk-task t]
+ ["Specify" verilog-sk-specify t]
+ ["Generate" verilog-sk-generate t]
+ "----"
+ ["Begin" verilog-sk-begin t]
+ ["If" verilog-sk-if t]
+ ["(if) else" verilog-sk-else-if t]
+ ["For" verilog-sk-for t]
+ ["While" verilog-sk-while t]
+ ["Fork" verilog-sk-fork t]
+ ["Repeat" verilog-sk-repeat t]
+ ["Case" verilog-sk-case t]
+ ["Casex" verilog-sk-casex t]
+ ["Casez" verilog-sk-casez t]
+ )
+ "Menu for statement templates in Verilog."
+ )
+
+(easy-menu-define verilog-menu verilog-mode-map "Menu for Verilog mode"
+ verilog-xemacs-menu)
+(easy-menu-define verilog-stmt-menu verilog-mode-map "Menu for statement templates in Verilog."
+ verilog-statement-menu)
+
+(defvar verilog-mode-abbrev-table nil
+ "Abbrev table in use in Verilog-mode buffers.")
+
+(define-abbrev-table 'verilog-mode-abbrev-table ())
+
+;; compilation program
+(defun verilog-set-compile-command ()
+ "Function to compute shell command to compile verilog.
+
+This reads `verilog-tool' and sets `compile-command'. This specifies the
+program that executes when you type \\[compile] or
+\\[verilog-auto-save-compile].
+
+By default `verilog-tool' uses a Makefile if one exists in the current
+directory. If not, it is set to the `verilog-linter', `verilog-coverage',
+`verilog-simulator', or `verilog-compiler' variables, as selected with the
+Verilog -> \"Choose Compilation Action\" menu.
+
+You should set `verilog-tool' or the other variables to the path and
+arguments for your Verilog simulator. For example:
+ \"vcs -p123 -O\"
+or a string like:
+ \"(cd /tmp; surecov %s)\".
+
+In the former case, the path to the current buffer is concat'ed to the
+value of `verilog-tool'; in the later, the path to the current buffer is
+substituted for the %s.
+
+Where __FILE__ appears in the string, the buffer-file-name of the current
+buffer, without the directory portion, will be substituted."
+ (interactive)
+ (cond
+ ((or (file-exists-p "makefile") ;If there is a makefile, use it
+ (file-exists-p "Makefile"))
+ (make-local-variable 'compile-command)
+ (setq compile-command "make "))
+ (t
+ (make-local-variable 'compile-command)
+ (setq compile-command
+ (if verilog-tool
+ (if (string-match "%s" (eval verilog-tool))
+ (format (eval verilog-tool) (or buffer-file-name ""))
+ (concat (eval verilog-tool) " " (or buffer-file-name "")))
+ ""))))
+ (verilog-modify-compile-command))
+
+(defun verilog-modify-compile-command ()
+ "Replace meta-information in `compile-command'.
+Where __FILE__ appears in the string, the current buffer's file-name,
+without the directory portion, will be substituted."
+ (when (string-match "\\b__FILE__\\b" compile-command)
+ (make-local-variable 'compile-command)
+ (setq compile-command
+ (verilog-string-replace-matches
+ "\\b__FILE__\\b" (file-name-nondirectory (buffer-file-name))
+ t t compile-command))))
+
+(defun verilog-error-regexp-add ()
+ "Add the messages to the `compilation-error-regexp-alist'.
+Called by `compilation-mode-hook'. This allows \\[next-error] to find the errors."
+ (if (not verilog-error-regexp-add-didit)
+ (progn
+ (setq verilog-error-regexp-add-didit t)
+ (setq-default compilation-error-regexp-alist
+ (append verilog-error-regexp
+ (default-value 'compilation-error-regexp-alist)))
+ ;; Could be buffer local at this point; maybe also in let; change all three
+ (setq compilation-error-regexp-alist (default-value 'compilation-error-regexp-alist))
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ (default-value 'compilation-error-regexp-alist))
+ )))
+
+(add-hook 'compilation-mode-hook 'verilog-error-regexp-add)
+
+(defconst verilog-directive-re
+ ;; "`case" "`default" "`define" "`define" "`else" "`endfor" "`endif"
+ ;; "`endprotect" "`endswitch" "`endwhile" "`for" "`format" "`if" "`ifdef"
+ ;; "`ifndef" "`include" "`let" "`protect" "`switch" "`timescale"
+ ;; "`time_scale" "`undef" "`while"
+ "\\<`\\(case\\|def\\(ault\\|ine\\(\\)?\\)\\|e\\(lse\\|nd\\(for\\|if\\|protect\\|switch\\|while\\)\\)\\|for\\(mat\\)?\\|i\\(f\\(def\\|ndef\\)?\\|nclude\\)\\|let\\|protect\\|switch\\|time\\(_scale\\|scale\\)\\|undef\\|while\\)\\>")
+
+(defconst verilog-directive-begin
+ "\\<`\\(for\\|i\\(f\\|fdef\\|fndef\\)\\|switch\\|while\\)\\>")
+
+(defconst verilog-directive-middle
+ "\\<`\\(else\\|default\\|case\\)\\>")
+
+(defconst verilog-directive-end
+ "`\\(endfor\\|endif\\|endswitch\\|endwhile\\)\\>")
+
+(defconst verilog-directive-re-1
+ (concat "[ \t]*" verilog-directive-re))
+
+;;
+;; Regular expressions used to calculate indent, etc.
+;;
+(defconst verilog-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
+(defconst verilog-case-re "\\(\\<case[xz]?\\>\\|\\<randcase\\>\\)")
+;; Want to match
+;; aa :
+;; aa,bb :
+;; a[34:32] :
+;; a,
+;; b :
+
+(defconst verilog-no-indent-begin-re
+ "\\<\\(if\\|else\\|while\\|for\\|repeat\\|always\\|always_comb\\|always_ff\\|always_latch\\)\\>")
+
+(defconst verilog-ends-re
+ ;; Parenthesis indicate type of keyword found
+ (concat
+ "\\(\\<else\\>\\)\\|" ; 1
+ "\\(\\<if\\>\\)\\|" ; 2
+ "\\(\\<end\\>\\)\\|" ; 3
+ "\\(\\<endcase\\>\\)\\|" ; 4
+ "\\(\\<endfunction\\>\\)\\|" ; 5
+ "\\(\\<endtask\\>\\)\\|" ; 6
+ "\\(\\<endspecify\\>\\)\\|" ; 7
+ "\\(\\<endtable\\>\\)\\|" ; 8
+ "\\(\\<endgenerate\\>\\)\\|" ; 9
+ "\\(\\<join\\(_any\\|_none\\)?\\>\\)\\|" ; 10
+ "\\(\\<endclass\\>\\)\\|" ; 11
+ "\\(\\<endgroup\\>\\)" ; 12
+ ))
+
+(defconst verilog-auto-end-comment-lines-re
+ ;; Matches to names in this list cause auto-end-commentation
+ ;;
+ ;; "macromodule" "module" "primitive" "interface" "end" "endcase" "endfunction"
+ ;; "endtask" "endmodule" "endprimitive" "endinterface" "endspecify" "endtable" "join"
+ ;; "begin" "else" `{directives}
+ (concat "\\("
+ verilog-directive-re "\\)\\|\\("
+ (eval-when-compile
+ (verilog-regexp-words
+ `( "begin"
+ "else"
+ "end"
+ "endcase"
+ "endclass"
+ "endgroup"
+ "endfunction"
+ "endmodule"
+ "endprogram"
+ "endprimitive"
+ "endinterface"
+ "endpackage"
+ "endsequence"
+ "endspecify"
+ "endtable"
+ "endtask"
+ "join"
+ "join_any"
+ "join_none"
+ "module"
+ "macromodule"
+ "primitive"
+ "interface"
+ "package")))
+ "\\)"))
+
+;;; NOTE: verilog-leap-to-head expects that verilog-end-block-re and
+;;; verilog-end-block-ordered-re matches exactly the same strings.
+(defconst verilog-end-block-ordered-re
+ ;; Parenthesis indicate type of keyword found
+ (concat "\\(\\<endcase\\>\\)\\|" ; 1
+ "\\(\\<end\\>\\)\\|" ; 2
+ "\\(\\<end" ; 3, but not used
+ "\\(" ; 4, but not used
+ "\\(function\\)\\|" ; 5
+ "\\(task\\)\\|" ; 6
+ "\\(module\\)\\|" ; 7
+ "\\(primitive\\)\\|" ; 8
+ "\\(interface\\)\\|" ; 9
+ "\\(package\\)\\|" ; 10
+ "\\(class\\)\\|" ; 11
+ "\\(group\\)\\|" ; 12
+ "\\(program\\)\\|" ; 13
+ "\\(sequence\\)\\|" ; 14
+ "\\)\\>\\)"))
+(defconst verilog-end-block-re
+ (eval-when-compile
+ (verilog-regexp-words
+
+ `("end" ;; closes begin
+ "endcase" ;; closes any of case, casex casez or randcase
+ "join" "join_any" "join_none" ;; closes fork
+ "endclass"
+ "endtable"
+ "endspecify"
+ "endfunction"
+ "endgenerate"
+ "endtask"
+ "endgroup"
+ "endproperty"
+ "endinterface"
+ "endpackage"
+ "endprogram"
+ "endsequence"
+ )
+ )))
+
+
+(defconst verilog-endcomment-reason-re
+ ;; Parenthesis indicate type of keyword found
+ (concat
+ "\\(\\<fork\\>\\)\\|"
+ "\\(\\<begin\\>\\)\\|"
+ "\\(\\<if\\>\\)\\|"
+ "\\(\\<else\\>\\)\\|"
+ "\\(\\<end\\>.*\\<else\\>\\)\\|"
+ "\\(\\<task\\>\\)\\|"
+ "\\(\\<function\\>\\)\\|"
+ "\\(\\<initial\\>\\)\\|"
+ "\\(\\<interface\\>\\)\\|"
+ "\\(\\<package\\>\\)\\|"
+ "\\(\\<final\\>\\)\\|"
+ "\\(\\<always\\>\\(\[ \t\]*@\\)?\\)\\|"
+ "\\(\\<always_comb\\>\\(\[ \t\]*@\\)?\\)\\|"
+ "\\(\\<always_ff\\>\\(\[ \t\]*@\\)?\\)\\|"
+ "\\(\\<always_latch\\>\\(\[ \t\]*@\\)?\\)\\|"
+ "\\(@\\)\\|"
+ "\\(\\<while\\>\\)\\|"
+ "\\(\\<for\\(ever\\)?\\>\\)\\|"
+ "\\(\\<repeat\\>\\)\\|\\(\\<wait\\>\\)\\|"
+ "#"))
+
+(defconst verilog-named-block-re "begin[ \t]*:")
+
+;; These words begin a block which can occur inside a module which should be indented,
+;; and closed with the respective word from the end-block list
+
+(defconst verilog-beg-block-re
+ (eval-when-compile
+ (verilog-regexp-words
+ `("begin"
+ "case" "casex" "casez" "randcase"
+ "generate"
+ "fork"
+ "function"
+ "property"
+ "specify"
+ "table"
+ "task"
+ ))))
+;; These are the same words, in a specific order in the regular
+;; expression so that matching will work nicely for
+;; verilog-forward-sexp and verilog-calc-indent
+
+(defconst verilog-beg-block-re-ordered
+ ( concat "\\<"
+ "\\(begin\\)\\|" ;1
+ "\\(randcase\\|case[xz]?\\)\\|" ; 2
+ "\\(fork\\)\\|" ;3
+ "\\(class\\)\\|" ;4
+ "\\(table\\)\\|" ;5
+ "\\(specify\\)\\|" ;6
+ "\\(function\\)\\|" ;7
+ "\\(task\\)\\|" ;8
+ "\\(generate\\)\\|" ;9
+ "\\(covergroup\\)\\|" ;10
+ "\\(property\\)\\|" ;11
+ "\\(\\(rand\\)?sequence\\)" ;12
+ "\\>"))
+
+(defconst verilog-end-block-ordered-rry
+ [ "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<endcase\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)"
+ "\\(\\<randcase\\>\\|\\<case[xz]?\\>\\)\\|\\(\\<endcase\\>\\)"
+ "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)"
+ "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)"
+ "\\(\\<table\\>\\)\\|\\(\\<endtable\\>\\)"
+ "\\(\\<specify\\>\\)\\|\\(\\<endspecify\\>\\)"
+ "\\(\\<function\\>\\)\\|\\(\\<endfunction\\>\\)"
+ "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)"
+ "\\(\\<task\\>\\)\\|\\(\\<endtask\\>\\)"
+ "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)"
+ "\\(\\<property\\>\\)\\|\\(\\<endproperty\\>\\)"
+ "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)"
+ ] )
+
+(defconst verilog-nameable-item-re
+ (eval-when-compile
+ (verilog-regexp-words
+ `("begin"
+ "fork"
+ "join" "join_any" "join_none"
+ "end"
+ "endcase"
+ "endconfig"
+ "endclass"
+ "endfunction"
+ "endgenerate"
+ "endmodule"
+ "endprimative"
+ "endinterface"
+ "endpackage"
+ "endspecify"
+ "endtable"
+ "endtask" )
+ )))
+
+(defconst verilog-declaration-opener
+ (eval-when-compile
+ (verilog-regexp-words
+ `("module" "begin" "task" "function"))))
+
+(defconst verilog-declaration-re
+ (eval-when-compile
+ (verilog-regexp-words
+ `("assign" "defparam" "event" "inout" "input" "integer" "localparam" "output"
+ "parameter" "real" "realtime" "reg" "supply" "supply0" "supply1" "time"
+ "tri" "tri0" "tri1" "triand" "trior" "trireg" "wand" "wire" "typedef"
+ "struct" "logic" "bit" "genvar" "wor"))))
+(defconst verilog-range-re "\\(\\[[^]]*\\]\\s-*\\)+")
+(defconst verilog-optional-signed-re "\\s-*\\(signed\\)?")
+(defconst verilog-optional-signed-range-re
+ (concat
+ "\\s-*\\(\\<\\(reg\\|wire\\)\\>\\s-*\\)?\\(\\<signed\\>\\s-*\\)?\\(" verilog-range-re "\\)?"))
+(defconst verilog-macroexp-re "`\\sw+")
+
+(defconst verilog-delay-re "#\\s-*\\(\\([0-9_]+\\('s?[hdxbo][0-9a-fA-F_xz]+\\)?\\)\\|\\(([^()]*)\\)\\|\\(\\sw+\\)\\)")
+(defconst verilog-declaration-re-2-no-macro
+ (concat "\\s-*" verilog-declaration-re
+ "\\s-*\\(\\(" verilog-optional-signed-range-re "\\)\\|\\(" verilog-delay-re "\\)"
+; "\\|\\(" verilog-macroexp-re "\\)"
+ "\\)?"))
+(defconst verilog-declaration-re-2-macro
+ (concat "\\s-*" verilog-declaration-re
+ "\\s-*\\(\\(" verilog-optional-signed-range-re "\\)\\|\\(" verilog-delay-re "\\)"
+ "\\|\\(" verilog-macroexp-re "\\)"
+ "\\)?"))
+(defconst verilog-declaration-re-1-macro
+ (concat "^" verilog-declaration-re-2-macro))
+; (concat
+; "^\\s-*\\<\\(in\\(?:out\\|put\\|teger\\)\\|output\\|re\\(?:al\\(?:time\\)?\\|g\\)\\|t\\(?:ime\\|ri\\(?:and\\|or\\|reg\\|[01]\\)?\\|ypedef\\)\\|w\\(?:and\\|ire\\|or\\)\\)\\>"
+; "\\s-*"
+; "\\("
+; "\\("
+; "\\(\\<\\(reg\\|wire\\)\\>\\s-*\\)?"
+; "\\(\\<signed\\>\\s-*\\)?"
+; "\\(\\(\\[[^]]*\\]\\)+\\)?"
+; "\\)"
+; "\\|"
+; "\\(#\\s-*\\("
+; "\\([0-9_]+\\('s?[hdxbo][0-9a-fA-F_xz]+\\)?\\)"
+; "\\|\\(([^()]*)\\)"
+; "\\|\\(\\sw+\\)"
+; "\\)"
+; "\\)"
+; "\\|\\(`\\sw+\\)\\)?"
+; ))
+
+(defconst verilog-declaration-re-1-no-macro (concat "^" verilog-declaration-re-2-no-macro))
+(defconst verilog-defun-re
+ (eval-when-compile (verilog-regexp-words `("macromodule" "module" "class" "program" "interface" "package" "primitive" "config"))))
+(defconst verilog-end-defun-re
+ (eval-when-compile (verilog-regexp-words `("endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig"))))
+(defconst verilog-zero-indent-re
+ (concat verilog-defun-re "\\|" verilog-end-defun-re))
+
+(defconst verilog-behavioral-block-beg-re
+ (concat "\\(\\<initial\\>\\|\\<final\\>\\|\\<always\\>\\|\\<always_comb\\>\\|\\<always_ff\\>\\|"
+ "\\<always_latch\\>\\|\\<function\\>\\|\\<task\\>\\)"))
+
+(defconst verilog-indent-re
+ (eval-when-compile
+ (verilog-regexp-words
+ `(
+ "always" "always_latch" "always_ff" "always_comb"
+ "begin" "end"
+ "case" "casex" "casez" "randcase" "endcase"
+ "class" "endclass"
+ "config" "endconfig"
+ "covergroup" "endgroup"
+ "fork" "join" "join_any" "join_none"
+ "function" "endfunction"
+ "final"
+ "generate" "endgenerate"
+ "initial"
+ "interface" "endinterface"
+ "module" "macromodule" "endmodule"
+ "package" "endpackage"
+ "primitive" "endprimative"
+ "program" "endprogram"
+ "property" "endproperty"
+ "sequence" "randsequence" "endsequence"
+ "specify" "endspecify"
+ "table" "endtable"
+ "task" "endtask"
+ "`case"
+ "`default"
+ "`define" "`undef"
+ "`if" "`ifdef" "`ifndef" "`else" "`endif"
+ "`while" "`endwhile"
+ "`for" "`endfor"
+ "`format"
+ "`include"
+ "`let"
+ "`protect" "`endprotect"
+ "`switch" "`endswitch"
+ "`timescale"
+ "`time_scale"
+ ))))
+
+(defconst verilog-defun-level-re
+ (eval-when-compile
+ (verilog-regexp-words
+ `(
+ "module" "macromodule" "primitive" "class" "program" "initial" "final" "always" "always_comb"
+ "always_ff" "always_latch" "endtask" "endfunction" "interface" "package"
+ "config"))))
+
+(defconst verilog-defun-level-not-generate-re
+ (eval-when-compile
+ (verilog-regexp-words
+ `(
+ "module" "macromodule" "primitive" "class" "program" "interface" "package" "config"))))
+
+(defconst verilog-cpp-level-re
+ (eval-when-compile
+ (verilog-regexp-words
+ `(
+ "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass"
+ ))))
+
+(defconst verilog-complete-reg
+ (concat
+ "\\(extern\\s-+\\|virtual\\s-+\\|protected\\s-+\\)*\\(function\\|task\\)\\|"
+ "\\(typedef\\s-+\\)*\\(struct\\|union\\|class\\)\\|"
+ (eval-when-compile
+ (verilog-regexp-words
+ `(
+ "always" "assign" "always_latch" "always_ff" "always_comb" "constraint"
+ "import" "initial" "final" "repeat" "case" "casex" "casez" "randcase" "while"
+ "if" "for" "forever" "else" "parameter" "do" "foreach"
+ )))))
+
+(defconst verilog-end-statement-re
+ (concat "\\(" verilog-beg-block-re "\\)\\|\\("
+ verilog-end-block-re "\\)"))
+
+(defconst verilog-endcase-re
+ (concat verilog-case-re "\\|"
+ "\\(endcase\\)\\|"
+ verilog-defun-re
+ ))
+
+(defconst verilog-exclude-str-start "/* -----\\/----- EXCLUDED -----\\/-----"
+ "String used to mark beginning of excluded text.")
+(defconst verilog-exclude-str-end " -----/\\----- EXCLUDED -----/\\----- */"
+ "String used to mark end of excluded text.")
+
+(defconst verilog-keywords
+ '( "`case" "`default" "`define" "`else" "`endfor" "`endif"
+ "`endprotect" "`endswitch" "`endwhile" "`for" "`format" "`if" "`ifdef"
+ "`ifndef" "`include" "`let" "`protect" "`switch" "`timescale"
+ "`time_scale" "`undef" "`while"
+
+ "alias" "always" "always_comb" "always_ff" "always_latch" "and"
+ "assert" "assign" "assume" "automatic" "before" "begin" "bind"
+ "bins" "binsof" "bit" "break" "buf" "bufif0" "bufif1" "byte"
+ "case" "casex" "casez" "cell" "chandle" "class" "clocking" "cmos"
+ "config" "const" "constraint" "context" "continue" "cover"
+ "covergroup" "coverpoint" "cross" "deassign" "default" "defparam"
+ "design" "disable" "dist" "do" "edge" "else" "end" "endcase"
+ "endclass" "endclocking" "endconfig" "endfunction" "endgenerate"
+ "endgroup" "endinterface" "endmodule" "endpackage" "endprimitive"
+ "endprogram" "endproperty" "endspecify" "endsequence" "endtable"
+ "endtask" "enum" "event" "expect" "export" "extends" "extern"
+ "final" "first_match" "for" "force" "foreach" "forever" "fork"
+ "forkjoin" "function" "generate" "genvar" "highz0" "highz1" "if"
+ "iff" "ifnone" "ignore_bins" "illegal_bins" "import" "incdir"
+ "include" "initial" "inout" "input" "inside" "instance" "int"
+ "integer" "interface" "intersect" "join" "join_any" "join_none"
+ "large" "liblist" "library" "local" "localparam" "logic"
+ "longint" "macromodule" "matches" "medium" "modport" "module"
+ "nand" "negedge" "new" "nmos" "nor" "noshowcancelled" "not"
+ "notif0" "notif1" "null" "or" "output" "package" "packed"
+ "parameter" "pmos" "posedge" "primitive" "priority" "program"
+ "property" "protected" "pull0" "pull1" "pulldown" "pullup"
+ "pulsestyle_onevent" "pulsestyle_ondetect" "pure" "rand" "randc"
+ "randcase" "randsequence" "rcmos" "real" "realtime" "ref" "reg"
+ "release" "repeat" "return" "rnmos" "rpmos" "rtran" "rtranif0"
+ "rtranif1" "scalared" "sequence" "shortint" "shortreal"
+ "showcancelled" "signed" "small" "solve" "specify" "specparam"
+ "static" "string" "strong0" "strong1" "struct" "super" "supply0"
+ "supply1" "table" "tagged" "task" "this" "throughout" "time"
+ "timeprecision" "timeunit" "tran" "tranif0" "tranif1" "tri"
+ "tri0" "tri1" "triand" "trior" "trireg" "type" "typedef" "union"
+ "unique" "unsigned" "use" "var" "vectored" "virtual" "void"
+ "wait" "wait_order" "wand" "weak0" "weak1" "while" "wildcard"
+ "wire" "with" "within" "wor" "xnor" "xor"
+ )
+ "List of Verilog keywords.")
+
+
+(defconst verilog-emacs-features
+ ;; Documentation at the bottom
+ (let ((major (and (boundp 'emacs-major-version)
+ emacs-major-version))
+ (minor (and (boundp 'emacs-minor-version)
+ emacs-minor-version))
+ flavor comments flock-syntax)
+ ;; figure out version numbers if not already discovered
+ (and (or (not major) (not minor))
+ (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
+ (setq major (string-to-int (substring emacs-version
+ (match-beginning 1)
+ (match-end 1)))
+ minor (string-to-int (substring emacs-version
+ (match-beginning 2)
+ (match-end 2)))))
+ (if (not (and major minor))
+ (error "Cannot figure out the major and minor version numbers"))
+ ;; calculate the major version
+ (cond
+ ((= major 4) (setq major 'v18)) ;Epoch 4
+ ((= major 18) (setq major 'v18)) ;Emacs 18
+ ((= major 19) (setq major 'v19 ;Emacs 19
+ flavor (if (or (string-match "Lucid" emacs-version)
+ (string-match "XEmacs" emacs-version))
+ 'XEmacs 'FSF)))
+ ((> major 19) (setq major 'v20
+ flavor (if (or (string-match "Lucid" emacs-version)
+ (string-match "XEmacs" emacs-version))
+ 'XEmacs 'FSF)))
+ ;; I don't know
+ (t (error "Cannot recognize major version number: %s" major)))
+ ;; XEmacs 19 uses 8-bit modify-syntax-entry flags, as do all
+ ;; patched Emacs 19, Emacs 18, Epoch 4's. Only Emacs 19 uses a
+ ;; 1-bit flag. Let's be as smart as we can about figuring this
+ ;; out.
+ (if (or (eq major 'v20) (eq major 'v19))
+ (let ((table (copy-syntax-table)))
+ (modify-syntax-entry ?a ". 12345678" table)
+ (cond
+ ;; XEmacs pre 20 and Emacs pre 19.30 use vectors for syntax tables.
+ ((vectorp table)
+ (if (= (logand (lsh (aref table ?a) -16) 255) 255)
+ (setq comments '8-bit)
+ (setq comments '1-bit)))
+ ;; XEmacs 20 is known to be 8-bit
+ ((eq flavor 'XEmacs) (setq comments '8-bit))
+ ;; Emacs 19.30 and beyond are known to be 1-bit
+ ((eq flavor 'FSF) (setq comments '1-bit))
+ ;; Don't know what this is
+ (t (error "Couldn't figure out syntax table format"))
+ ))
+ ;; Emacs 18 has no support for dual comments
+ (setq comments 'no-dual-comments))
+ ;; determine whether to use old or new font lock syntax
+ ;; We can assume 8-bit syntax table emacsen support new syntax, otherwise
+ ;; look for version > 19.30
+ (setq flock-syntax
+ (if (or (equal comments '8-bit)
+ (equal major 'v20)
+ (and (equal major 'v19) (> minor 30)))
+ 'flock-syntax-after-1930
+ 'flock-syntax-before-1930))
+ ;; lets do some minimal sanity checking.
+ (if (or
+ ;; Emacs before 19.6 had bugs
+ (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6))
+ ;; Emacs 19 before 19.21 has known bugs
+ (and (eq major 'v19) (eq flavor 'FSF) (< minor 21))
+ )
+ (with-output-to-temp-buffer "*verilog-mode warnings*"
+ (print (format
+ "The version of Emacs that you are running, %s,
+has known bugs in its syntax parsing routines which will affect the
+performance of verilog-mode. You should strongly consider upgrading to the
+latest available version. verilog-mode may continue to work, after a
+fashion, but strange indentation errors could be encountered."
+ emacs-version))))
+ ;; Emacs 18, with no patch is not too good
+ (if (and (eq major 'v18) (eq comments 'no-dual-comments))
+ (with-output-to-temp-buffer "*verilog-mode warnings*"
+ (print (format
+ "The version of Emacs 18 you are running, %s,
+has known deficiencies in its ability to handle the dual verilog
+(and C++) comments, (e.g. the // and /* */ comments). This will
+not be much of a problem for you if you only use the /* */ comments,
+but you really should strongly consider upgrading to one of the latest
+Emacs 19's. In Emacs 18, you may also experience performance degradations.
+Emacs 19 has some new built-in routines which will speed things up for you.
+Because of these inherent problems, verilog-mode is not supported
+on emacs-18."
+ emacs-version))))
+ ;; Emacs 18 with the syntax patches are no longer supported
+ (if (and (eq major 'v18) (not (eq comments 'no-dual-comments)))
+ (with-output-to-temp-buffer "*verilog-mode warnings*"
+ (print (format
+ "You are running a syntax patched Emacs 18 variant. While this should
+work for you, you may want to consider upgrading to Emacs 19.
+The syntax patches are no longer supported either for verilog-mode."))))
+ (list major comments flock-syntax))
+ "A list of features extant in the Emacs you are using.
+There are many flavors of Emacs out there, each with different
+features supporting those needed by `verilog-mode'. Here's the current
+supported list, along with the values for this variable:
+
+ Vanilla Emacs 18/Epoch 4: (v18 no-dual-comments flock-syntax-before-1930)
+ Emacs 18/Epoch 4 (patch2): (v18 8-bit flock-syntax-after-1930)
+ XEmacs (formerly Lucid) 19: (v19 8-bit flock-syntax-after-1930)
+ XEmacs 20: (v20 8-bit flock-syntax-after-1930)
+ Emacs 19.1-19.30: (v19 8-bit flock-syntax-before-1930)
+ Emacs 19.31-19.xx: (v19 8-bit flock-syntax-after-1930)
+ Emacs20 : (v20 1-bit flock-syntax-after-1930).")
+
+(defconst verilog-comment-start-regexp "//\\|/\\*"
+ "Dual comment value for `comment-start-regexp'.")
+
+(defun verilog-populate-syntax-table (table)
+ "Populate the syntax TABLE."
+ (modify-syntax-entry ?\\ "\\" table)
+ (modify-syntax-entry ?+ "." table)
+ (modify-syntax-entry ?- "." table)
+ (modify-syntax-entry ?= "." table)
+ (modify-syntax-entry ?% "." table)
+ (modify-syntax-entry ?< "." table)
+ (modify-syntax-entry ?> "." table)
+ (modify-syntax-entry ?& "." table)
+ (modify-syntax-entry ?| "." table)
+ (modify-syntax-entry ?` "w" table)
+ (modify-syntax-entry ?_ "w" table)
+ (modify-syntax-entry ?\' "." table)
+)
+
+(defun verilog-setup-dual-comments (table)
+ "Set up TABLE to handle block and line style comments."
+ (cond
+ ((memq '8-bit verilog-emacs-features)
+ ;; XEmacs (formerly Lucid) has the best implementation
+ (modify-syntax-entry ?/ ". 1456" table)
+ (modify-syntax-entry ?* ". 23" table)
+ (modify-syntax-entry ?\n "> b" table)
+ )
+ ((memq '1-bit verilog-emacs-features)
+ ;; Emacs 19 does things differently, but we can work with it
+ (modify-syntax-entry ?/ ". 124b" table)
+ (modify-syntax-entry ?* ". 23" table)
+ (modify-syntax-entry ?\n "> b" table)
+ )
+ ))
+
+(defvar verilog-mode-syntax-table nil
+ "Syntax table used in `verilog-mode' buffers.")
+
+(defconst verilog-font-lock-keywords nil
+ "Default highlighting for Verilog mode.")
+
+(defconst verilog-font-lock-keywords-1 nil
+ "Subdued level highlighting for Verilog mode.")
+
+(defconst verilog-font-lock-keywords-2 nil
+ "Medium level highlighting for Verilog mode.
+See also `verilog-font-lock-extra-types'.")
+
+(defconst verilog-font-lock-keywords-3 nil
+ "Gaudy level highlighting for Verilog mode.
+See also `verilog-font-lock-extra-types'.")
+(defvar verilog-font-lock-translate-off-face
+ 'verilog-font-lock-translate-off-face
+ "Font to use for translated off regions.")
+(defface verilog-font-lock-translate-off-face
+ '((((class color)
+ (background light))
+ (:background "gray90" :italic t ))
+ (((class color)
+ (background dark))
+ (:background "gray10" :italic t ))
+ (((class grayscale) (background light))
+ (:foreground "DimGray" :italic t))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" :italic t))
+ (t (:italis t)))
+ "Font lock mode face used to background highlight translate-off regions."
+ :group 'font-lock-highlighting-faces)
+
+(defvar verilog-font-lock-p1800-face
+ 'verilog-font-lock-p1800-face
+ "Font to use for p1800 keywords.")
+(defface verilog-font-lock-p1800-face
+ '((((class color)
+ (background light))
+ (:foreground "DarkOrange3" :bold t ))
+ (((class color)
+ (background dark))
+ (:foreground "orange1" :bold t ))
+ (t (:italic t)))
+ "Font lock mode face used to highlight P1800 keywords."
+ :group 'font-lock-highlighting-faces)
+
+(defvar verilog-font-lock-ams-face
+ 'verilog-font-lock-ams-face
+ "Font to use for Analog/Mixed Signal keywords.")
+(defface verilog-font-lock-ams-face
+ '((((class color)
+ (background light))
+ (:foreground "Purple" :bold t ))
+ (((class color)
+ (background dark))
+ (:foreground "orange1" :bold t ))
+ (t (:italic t)))
+ "Font lock mode face used to highlight P1800 keywords."
+ :group 'font-lock-highlighting-faces)
+
+(let* ((verilog-type-font-keywords
+ (eval-when-compile
+ (verilog-regexp-opt
+ '(
+ "and" "bit" "buf" "bufif0" "bufif1" "cmos" "defparam"
+ "event" "genvar" "inout" "input" "integer" "localparam"
+ "logic" "nand" "nmos" "not" "notif0" "notif1" "or"
+ "output" "parameter" "pmos" "pull0" "pull1" "pullup"
+ "rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran"
+ "rtranif0" "rtranif1" "signed" "struct" "supply"
+ "supply0" "supply1" "time" "tran" "tranif0" "tranif1"
+ "tri" "tri0" "tri1" "triand" "trior" "trireg" "typedef"
+ "vectored" "wand" "wire" "wor" "xnor" "xor"
+ ) nil )))
+
+ (verilog-pragma-keywords
+ (eval-when-compile
+ (verilog-regexp-opt
+ '("surefire" "synopsys" "rtl_synthesis" "verilint" ) nil
+ )))
+
+ (verilog-p1800-keywords
+ (eval-when-compile
+ (verilog-regexp-opt
+ '("alias" "assert" "assume" "automatic" "before" "bind"
+ "bins" "binsof" "break" "byte" "cell" "chandle" "class"
+ "clocking" "config" "const" "constraint" "context" "continue"
+ "cover" "covergroup" "coverpoint" "cross" "deassign" "design"
+ "dist" "do" "edge" "endclass" "endclocking" "endconfig"
+ "endgroup" "endprogram" "endproperty" "endsequence" "enum"
+ "expect" "export" "extends" "extern" "first_match" "foreach"
+ "forkjoin" "genvar" "highz0" "highz1" "ifnone" "ignore_bins"
+ "illegal_bins" "import" "incdir" "include" "inside" "instance"
+ "int" "intersect" "large" "liblist" "library" "local" "longint"
+ "matches" "medium" "modport" "new" "noshowcancelled" "null"
+ "packed" "program" "property" "protected" "pull0" "pull1"
+ "pulsestyle_onevent" "pulsestyle_ondetect" "pure" "rand" "randc"
+ "randcase" "randsequence" "ref" "release" "return" "scalared"
+ "sequence" "shortint" "shortreal" "showcancelled" "small" "solve"
+ "specparam" "static" "string" "strong0" "strong1" "struct"
+ "super" "tagged" "this" "throughout" "timeprecision" "timeunit"
+ "type" "union" "unsigned" "use" "var" "virtual" "void"
+ "wait_order" "weak0" "weak1" "wildcard" "with" "within"
+ ) nil )))
+
+ (verilog-ams-keywords
+ (eval-when-compile
+ (verilog-regexp-opt
+ '("above" "abs" "absdelay" "acos" "acosh" "ac_stim"
+ "aliasparam" "analog" "analysis" "asin" "asinh" "atan" "atan2" "atanh"
+ "branch" "ceil" "connectmodule" "connectrules" "cos" "cosh" "ddt"
+ "ddx" "discipline" "driver_update" "enddiscipline" "endconnectrules"
+ "endnature" "endparamset" "exclude" "exp" "final_step" "flicker_noise"
+ "floor" "flow" "from" "ground" "hypot" "idt" "idtmod" "inf"
+ "initial_step" "laplace_nd" "laplace_np" "laplace_zd" "laplace_zp"
+ "last_crossing" "limexp" "ln" "log" "max" "min" "nature"
+ "net_resolution" "noise_table" "paramset" "potential" "pow" "sin"
+ "sinh" "slew" "sqrt" "tan" "tanh" "timer" "transition" "white_noise"
+ "wreal" "zi_nd" "zi_np" "zi_zd" ) nil )))
+
+ (verilog-font-keywords
+ (eval-when-compile
+ (verilog-regexp-opt
+ '(
+ "assign" "begin" "case" "casex" "casez" "randcase" "deassign"
+ "default" "disable" "else" "end" "endcase" "endfunction"
+ "endgenerate" "endinterface" "endmodule" "endprimitive"
+ "endspecify" "endtable" "endtask" "final" "for" "force" "return" "break"
+ "continue" "forever" "fork" "function" "generate" "if" "iff" "initial"
+ "interface" "join" "join_any" "join_none" "macromodule" "module" "negedge"
+ "package" "endpackage" "always" "always_comb" "always_ff"
+ "always_latch" "posedge" "primitive" "priority" "release"
+ "repeat" "specify" "table" "task" "unique" "wait" "while"
+ "class" "program" "endclass" "endprogram"
+ ) nil ))))
+
+ (setq verilog-font-lock-keywords
+ (list
+ ;; Fontify all builtin keywords
+ (concat "\\<\\(" verilog-font-keywords "\\|"
+ ;; And user/system tasks and functions
+ "\\$[a-zA-Z][a-zA-Z0-9_\\$]*"
+ "\\)\\>")
+ ;; Fontify all types
+ (cons (concat "\\<\\(" verilog-type-font-keywords "\\)\\>")
+ 'font-lock-type-face)
+ ;; Fontify IEEE-P1800 keywords
+ (cons (concat "\\<\\(" verilog-p1800-keywords "\\)\\>")
+ 'verilog-font-lock-p1800-face)
+ ;; Fontify Verilog-AMS keywords
+ (cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>")
+ 'verilog-font-lock-ams-face)
+
+ ))
+
+ (setq verilog-font-lock-keywords-1
+ (append verilog-font-lock-keywords
+ (list
+ ;; Fontify module definitions
+ (list
+ "\\<\\(\\(macro\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)"
+ '(1 font-lock-keyword-face)
+ '(3 font-lock-function-name-face 'prepend))
+ ;; Fontify function definitions
+ (list
+ (concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" )
+ '(1 font-lock-keyword-face)
+ '(3 font-lock-reference-face prepend)
+ )
+ '("\\<function\\>\\s-+\\(\\[[^]]+\\]\\)\\s-+\\(\\sw+\\)"
+ (1 font-lock-keyword-face)
+ (2 font-lock-reference-face append)
+ )
+ '("\\<function\\>\\s-+\\(\\sw+\\)"
+ 1 'font-lock-reference-face append)
+ )))
+
+ (setq verilog-font-lock-keywords-2
+ (append verilog-font-lock-keywords-1
+ (list
+ ;; Fontify pragmas
+ (concat "\\(//\\s-*" verilog-pragma-keywords "\\s-.*\\)")
+ ;; Fontify escaped names
+ '("\\(\\\\\\S-*\\s-\\)" 0 font-lock-function-name-face)
+ ;; Fontify macro definitions/ uses
+ '("`\\s-*[A-Za-z][A-Za-z0-9_]*" 0 font-lock-preprocessor-face)
+ ;; Fontify delays/numbers
+ '("\\(@\\)\\|\\(#\\s-*\\(\\(\[0-9_.\]+\\('s?[hdxbo][0-9a-fA-F_xz]*\\)?\\)\\|\\(([^()]+)\\|\\sw+\\)\\)\\)"
+ 0 font-lock-type-face append)
+ ;; Fontify instantiation names
+ '("\\([A-Za-z][A-Za-z0-9_]+\\)\\s-*(" 1 font-lock-function-name-face)
+
+ )))
+
+ (setq verilog-font-lock-keywords-3
+ (append verilog-font-lock-keywords-2
+ (when verilog-highlight-translate-off
+ (list
+ ;; Fontify things in translate off regions
+ '(verilog-match-translate-off (0 'verilog-font-lock-translate-off-face prepend))
+ )))
+ )
+ )
+
+
+
+(defun verilog-inside-comment-p ()
+ "Check if point inside a nested comment."
+ (save-excursion
+ (let ((st-point (point)) hitbeg)
+ (or (search-backward "//" (verilog-get-beg-of-line) t)
+ (if (progn
+ ;; This is for tricky case //*, we keep searching if /* is proceeded by // on same line
+ (while (and (setq hitbeg (search-backward "/*" nil t))
+ (progn (forward-char 1) (search-backward "//" (verilog-get-beg-of-line) t))))
+ hitbeg)
+ (not (search-forward "*/" st-point t)))))))
+
+(defun verilog-declaration-end ()
+ (search-forward ";"))
+
+(defun verilog-point-text (&optional pointnum)
+ "Return text describing where POINTNUM or current point is (for errors).
+Use filename, if current buffer being edited shorten to just buffer name."
+ (concat (or (and (equal (window-buffer (selected-window)) (current-buffer))
+ (buffer-name))
+ buffer-file-name
+ (buffer-name))
+ ":" (int-to-string (count-lines (point-min) (or pointnum (point))))))
+
+(defun electric-verilog-backward-sexp ()
+ "Move backward over a sexp."
+ (interactive)
+ ;; before that see if we are in a comment
+ (verilog-backward-sexp)
+)
+(defun electric-verilog-forward-sexp ()
+ "Move backward over a sexp."
+ (interactive)
+ ;; before that see if we are in a comment
+ (verilog-forward-sexp)
+)
+;;;used by hs-minor-mode
+(defun verilog-forward-sexp-function (arg)
+ (if (< arg 0)
+ (verilog-backward-sexp)
+ (verilog-forward-sexp)))
+
+
+(defun verilog-backward-sexp ()
+ (let ((reg)
+ (elsec 1)
+ (found nil)
+ (st (point))
+ )
+ (if (not (looking-at "\\<"))
+ (forward-word -1))
+ (cond
+ ((verilog-skip-backward-comment-or-string)
+ )
+ ((looking-at "\\<else\\>")
+ (setq reg (concat
+ verilog-end-block-re
+ "\\|\\(\\<else\\>\\)"
+ "\\|\\(\\<if\\>\\)"
+ ))
+ (while (and (not found)
+ (verilog-re-search-backward reg nil 'move))
+ (cond
+ ((match-end 1) ; matched verilog-end-block-re
+ ; try to leap back to matching outward block by striding across
+ ; indent level changing tokens then immediately
+ ; previous line governs indentation.
+ (verilog-leap-to-head))
+ ((match-end 2) ; else, we're in deep
+ (setq elsec (1+ elsec)))
+ ((match-end 3) ; found it
+ (setq elsec (1- elsec))
+ (if (= 0 elsec)
+ ;; Now previous line describes syntax
+ (setq found 't)
+ ))
+ )
+ )
+ )
+ ((looking-at verilog-end-block-re)
+ (verilog-leap-to-head))
+ ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)")
+ (cond
+ ((match-end 1)
+ (verilog-re-search-backward "\\<\\(macro\\)?module\\>" nil 'move))
+ ((match-end 2)
+ (verilog-re-search-backward "\\<primitive\\>" nil 'move))
+ ((match-end 3)
+ (verilog-re-search-backward "\\<class\\>" nil 'move))
+ ((match-end 4)
+ (verilog-re-search-backward "\\<program\\>" nil 'move))
+ ((match-end 5)
+ (verilog-re-search-backward "\\<interface\\>" nil 'move))
+ ((match-end 6)
+ (verilog-re-search-backward "\\<package\\>" nil 'move))
+ (t
+ (goto-char st)
+ (backward-sexp 1))))
+ (t
+ (goto-char st)
+ (backward-sexp))
+ ) ;; cond
+ ))
+
+(defun verilog-forward-sexp ()
+ (let ((reg)
+ (md 2)
+ (st (point)))
+ (if (not (looking-at "\\<"))
+ (forward-word -1))
+ (cond
+ ((verilog-skip-forward-comment-or-string)
+ (verilog-forward-syntactic-ws)
+ )
+ ((looking-at verilog-beg-block-re-ordered);; begin|case|fork|class|table|specify|function|task|generate|covergroup|property|sequence
+ (cond
+ ((match-end 1) ; end
+ ;; Search forward for matching begin
+ (setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" ))
+ ((match-end 2) ; endcase
+ ;; Search forward for matching case
+ (setq reg "\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" )
+ )
+ ((match-end 3) ; join
+ ;; Search forward for matching fork
+ (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" ))
+ ((match-end 4) ; endclass
+ ;; Search forward for matching class
+ (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" ))
+ ((match-end 5) ; endtable
+ ;; Search forward for matching table
+ (setq reg "\\(\\<table\\>\\)\\|\\(\\<endtable\\>\\)" ))
+ ((match-end 6) ; endspecify
+ ;; Search forward for matching specify
+ (setq reg "\\(\\<specify\\>\\)\\|\\(\\<endspecify\\>\\)" ))
+ ((match-end 7) ; endfunction
+ ;; Search forward for matching function
+ (setq reg "\\(\\<function\\>\\)\\|\\(\\<endfunction\\>\\)" ))
+ ((match-end 8) ; endtask
+ ;; Search forward for matching task
+ (setq reg "\\(\\<task\\>\\)\\|\\(\\<endtask\\>\\)" ))
+ ((match-end 9) ; endgenerate
+ ;; Search forward for matching generate
+ (setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" ))
+ ((match-end 10) ; endgroup
+ ;; Search forward for matching covergroup
+ (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" ))
+ ((match-end 11) ; endproperty
+ ;; Search forward for matching property
+ (setq reg "\\(\\<property\\>\\)\\|\\(\\<endproperty\\>\\)" ))
+ ((match-end 12) ; endsequence
+ ;; Search forward for matching sequence
+ (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" )
+ (setq md 3) ; 3 to get to endsequence in the reg above
+ )
+
+ )
+ (if (forward-word 1)
+ (catch 'skip
+ (let ((nest 1))
+ (while (verilog-re-search-forward reg nil 'move)
+ (cond
+ ((match-end md) ; the closer in reg
+ (setq nest (1- nest))
+ (if (= 0 nest)
+ (throw 'skip 1)))
+ ((match-end 1) ; begin
+ (setq nest (1+ nest)))))
+ )))
+ )
+ ((looking-at (concat
+ "\\(\\<\\(macro\\)?module\\>\\)\\|"
+ "\\(\\<primitive\\>\\)\\|"
+ "\\(\\<class\\>\\)\\|"
+ "\\(\\<program\\>\\)\\|"
+ "\\(\\<interface\\>\\)\\|"
+ "\\(\\<package\\>\\)"))
+ (cond
+ ((match-end 1)
+ (verilog-re-search-forward "\\<endmodule\\>" nil 'move))
+ ((match-end 2)
+ (verilog-re-search-forward "\\<endprimitive\\>" nil 'move))
+ ((match-end 3)
+ (verilog-re-search-forward "\\<endclass\\>" nil 'move))
+ ((match-end 4)
+ (verilog-re-search-forward "\\<endprogram\\>" nil 'move))
+ ((match-end 5)
+ (verilog-re-search-forward "\\<endinterface\\>" nil 'move))
+ ((match-end 6)
+ (verilog-re-search-forward "\\<endpackage\\>" nil 'move))
+ (t
+ (goto-char st)
+ (if (= (following-char) ?\) )
+ (forward-char 1)
+ (forward-sexp 1)))))
+ (t
+ (goto-char st)
+ (if (= (following-char) ?\) )
+ (forward-char 1)
+ (forward-sexp 1)))
+ ) ;; cond
+ ))
+
+(defun verilog-declaration-beg ()
+ (verilog-re-search-backward verilog-declaration-re (bobp) t))
+
+;;
+;; Macros
+;;
+
+(defsubst verilog-string-replace-matches (from-string to-string fixedcase literal string)
+ "Replace occurrences of FROM-STRING with TO-STRING.
+FIXEDCASE and LITERAL as in `replace-match`. STRING is what to replace.
+The case (verilog-string-replace-matches \"o\" \"oo\" nil nil \"foobar\")
+will break, as the o's continuously replace. xa -> x works ok though."
+ ;; Hopefully soon to a emacs built-in
+ (let ((start 0))
+ (while (string-match from-string string start)
+ (setq string (replace-match to-string fixedcase literal string)
+ start (min (length string) (match-end 0))))
+ string))
+
+(defsubst verilog-string-remove-spaces (string)
+ "Remove spaces surrounding STRING."
+ (save-match-data
+ (setq string (verilog-string-replace-matches "^\\s-+" "" nil nil string))
+ (setq string (verilog-string-replace-matches "\\s-+$" "" nil nil string))
+ string))
+
+(defsubst verilog-re-search-forward (REGEXP BOUND NOERROR)
+ ; checkdoc-params: (REGEXP BOUND NOERROR)
+ "Like `re-search-forward', but skips over match in comments or strings."
+ (store-match-data '(nil nil))
+ (while (and
+ (re-search-forward REGEXP BOUND NOERROR)
+ (and (verilog-skip-forward-comment-or-string)
+ (progn
+ (store-match-data '(nil nil))
+ (if BOUND
+ (< (point) BOUND)
+ t)
+ ))))
+ (match-end 0))
+
+(defsubst verilog-re-search-backward (REGEXP BOUND NOERROR)
+ ; checkdoc-params: (REGEXP BOUND NOERROR)
+ "Like `re-search-backward', but skips over match in comments or strings."
+ (store-match-data '(nil nil))
+ (while (and
+ (re-search-backward REGEXP BOUND NOERROR)
+ (and (verilog-skip-backward-comment-or-string)
+ (progn
+ (store-match-data '(nil nil))
+ (if BOUND
+ (> (point) BOUND)
+ t)
+ ))))
+ (match-end 0))
+
+(defsubst verilog-re-search-forward-quick (regexp bound noerror)
+ "Like `verilog-re-search-forward', including use of REGEXP BOUND and NOERROR,
+but trashes match data and is faster for REGEXP that doesn't match often.
+This may at some point use text properties to ignore comments,
+so there may be a large up front penalty for the first search."
+ (let (pt)
+ (while (and (not pt)
+ (re-search-forward regexp bound noerror))
+ (if (not (verilog-inside-comment-p))
+ (setq pt (match-end 0))))
+ pt))
+
+(defsubst verilog-re-search-backward-quick (regexp bound noerror)
+ ; checkdoc-params: (REGEXP BOUND NOERROR)
+ "Like `verilog-re-search-backward', including use of REGEXP BOUND and NOERROR,
+but trashes match data and is faster for REGEXP that doesn't match often.
+This may at some point use text properties to ignore comments,
+so there may be a large up front penalty for the first search."
+ (let (pt)
+ (while (and (not pt)
+ (re-search-backward regexp bound noerror))
+ (if (not (verilog-inside-comment-p))
+ (setq pt (match-end 0))))
+ pt))
+
+(defsubst verilog-get-beg-of-line (&optional arg)
+ (save-excursion
+ (beginning-of-line arg)
+ (point)))
+
+(defsubst verilog-get-end-of-line (&optional arg)
+ (save-excursion
+ (end-of-line arg)
+ (point)))
+
+(defsubst verilog-within-string ()
+ (save-excursion
+ (nth 3 (parse-partial-sexp (verilog-get-beg-of-line) (point)))))
+
+(require 'font-lock)
+(defvar verilog-need-fld 1)
+(defvar font-lock-defaults-alist nil) ;In case we are XEmacs
+
+(defun verilog-font-lock-init ()
+ "Initialize fontification."
+ ;; highlight keywords and standardized types, attributes, enumeration
+ ;; values, and subprograms
+ (setq verilog-font-lock-keywords-3
+ (append verilog-font-lock-keywords-2
+ (when verilog-highlight-translate-off
+ (list
+ ;; Fontify things in translate off regions
+ '(verilog-match-translate-off (0 'verilog-font-lock-translate-off-face prepend))
+ ))
+ )
+ )
+ (put 'verilog-mode 'font-lock-defaults
+ '((verilog-font-lock-keywords
+ verilog-font-lock-keywords-1
+ verilog-font-lock-keywords-2
+ verilog-font-lock-keywords-3
+ )
+ nil ;; nil means highlight strings & comments as well as keywords
+ nil ;; nil means keywords must match case
+ nil ;; syntax table handled elsewhere
+ verilog-beg-of-defun ;; function to move to beginning of reasonable region to highlight
+ ))
+ (if verilog-need-fld
+ (let ((verilog-mode-defaults
+ '((verilog-font-lock-keywords
+ verilog-font-lock-keywords-1
+ verilog-font-lock-keywords-2
+ verilog-font-lock-keywords-3
+ )
+ nil ;; nil means highlight strings & comments as well as keywords
+ nil ;; nil means keywords must match case
+ nil ;; syntax table handled elsewhere
+ verilog-beg-of-defun ;; function to move to beginning of reasonable region to highlight
+ )))
+ (setq font-lock-defaults-alist
+ (append
+ font-lock-defaults-alist
+ (list (cons 'verilog-mode verilog-mode-defaults))))
+ (setq verilog-need-fld 0))))
+
+;; initialize fontification for Verilog Mode
+(verilog-font-lock-init)
+;; start up message
+(defconst verilog-startup-message-lines
+ '("Please use \\[verilog-submit-bug-report] to report bugs."
+ "Visit http://www.verilog.com to check for updates"
+ ))
+(defconst verilog-startup-message-displayed t)
+(defun verilog-display-startup-message ()
+ (if (not verilog-startup-message-displayed)
+ (if (sit-for 5)
+ (let ((lines verilog-startup-message-lines))
+ (message "verilog-mode version %s, released %s; type \\[describe-mode] for help"
+ verilog-mode-version verilog-mode-release-date)
+ (setq verilog-startup-message-displayed t)
+ (while (and (sit-for 4) lines)
+ (message (substitute-command-keys (car lines)))
+ (setq lines (cdr lines)))))
+ (message "")))
+;;
+;;
+;; Mode
+;;
+
+;;###autoload
+(defun verilog-mode ()
+ "Major mode for editing Verilog code.
+\\<verilog-mode-map>
+See \\[describe-function] verilog-auto (\\[verilog-auto]) for details on how
+AUTOs can improve coding efficiency.
+
+Use \\[verilog-faq] for a pointer to frequently asked questions.
+
+NEWLINE, TAB indents for Verilog code.
+Delete converts tabs to spaces as it moves back.
+
+Supports highlighting.
+
+Turning on Verilog mode calls the value of the variable `verilog-mode-hook'
+with no args, if that value is non-nil.
+
+Variables controlling indentation/edit style:
+
+ variable `verilog-indent-level' (default 3)
+ Indentation of Verilog statements with respect to containing block.
+ `verilog-indent-level-module' (default 3)
+ Absolute indentation of Module level Verilog statements.
+ Set to 0 to get initial and always statements lined up
+ on the left side of your screen.
+ `verilog-indent-level-declaration' (default 3)
+ Indentation of declarations with respect to containing block.
+ Set to 0 to get them list right under containing block.
+ `verilog-indent-level-behavioral' (default 3)
+ Indentation of first begin in a task or function block
+ Set to 0 to get such code to lined up underneath the task or function keyword
+ `verilog-indent-level-directive' (default 1)
+ Indentation of `ifdef/`endif blocks
+ `verilog-cexp-indent' (default 1)
+ Indentation of Verilog statements broken across lines i.e.:
+ if (a)
+ begin
+ `verilog-case-indent' (default 2)
+ Indentation for case statements.
+ `verilog-auto-newline' (default nil)
+ Non-nil means automatically newline after semicolons and the punctuation
+ mark after an end.
+ `verilog-auto-indent-on-newline' (default t)
+ Non-nil means automatically indent line after newline
+ `verilog-tab-always-indent' (default t)
+ Non-nil means TAB in Verilog mode should always reindent the current line,
+ regardless of where in the line point is when the TAB command is used.
+ `verilog-indent-begin-after-if' (default t)
+ Non-nil means to indent begin statements following a preceding
+ if, else, while, for and repeat statements, if any. otherwise,
+ the begin is lined up with the preceding token. If t, you get:
+ if (a)
+ begin // amount of indent based on `verilog-cexp-indent'
+ otherwise you get:
+ if (a)
+ begin
+ `verilog-auto-endcomments' (default t)
+ Non-nil means a comment /* ... */ is set after the ends which ends
+ cases, tasks, functions and modules.
+ The type and name of the object will be set between the braces.
+ `verilog-minimum-comment-distance' (default 10)
+ Minimum distance (in lines) between begin and end required before a comment
+ will be inserted. Setting this variable to zero results in every
+ end acquiring a comment; the default avoids too many redundant
+ comments in tight quarters.
+ `verilog-auto-lineup' (default `(all))
+ List of contexts where auto lineup of code should be done.
+
+Variables controlling other actions:
+
+ `verilog-linter' (default surelint)
+ Unix program to call to run the lint checker. This is the default
+ command for \\[compile-command] and \\[verilog-auto-save-compile].
+
+See \\[customize] for the complete list of variables.
+
+AUTO expansion functions are, in part:
+
+ \\[verilog-auto] Expand AUTO statements.
+ \\[verilog-delete-auto] Remove the AUTOs.
+ \\[verilog-inject-auto] Insert AUTOs for the first time.
+
+Some other functions are:
+
+ \\[verilog-complete-word] Complete word with appropriate possibilities.
+ \\[verilog-mark-defun] Mark function.
+ \\[verilog-beg-of-defun] Move to beginning of current function.
+ \\[verilog-end-of-defun] Move to end of current function.
+ \\[verilog-label-be] Label matching begin ... end, fork ... join, etc statements.
+
+ \\[verilog-comment-region] Put marked area in a comment.
+ \\[verilog-uncomment-region] Uncomment an area commented with \\[verilog-comment-region].
+ \\[verilog-insert-block] Insert begin ... end;.
+ \\[verilog-star-comment] Insert /* ... */.
+
+ \\[verilog-sk-always] Insert a always @(AS) begin .. end block.
+ \\[verilog-sk-begin] Insert a begin .. end block.
+ \\[verilog-sk-case] Insert a case block, prompting for details.
+ \\[verilog-sk-for] Insert a for (...) begin .. end block, prompting for details.
+ \\[verilog-sk-generate] Insert a generate .. endgenerate block.
+ \\[verilog-sk-header] Insert a nice header block at the top of file.
+ \\[verilog-sk-initial] Insert an initial begin .. end block.
+ \\[verilog-sk-fork] Insert a fork begin .. end .. join block.
+ \\[verilog-sk-module] Insert a module .. (/*AUTOARG*/);.. endmodule block.
+ \\[verilog-sk-primitive] Insert a primitive .. (.. );.. endprimitive block.
+ \\[verilog-sk-repeat] Insert a repeat (..) begin .. end block.
+ \\[verilog-sk-specify] Insert a specify .. endspecify block.
+ \\[verilog-sk-task] Insert a task .. begin .. end endtask block.
+ \\[verilog-sk-while] Insert a while (...) begin .. end block, prompting for details.
+ \\[verilog-sk-casex] Insert a casex (...) item: begin.. end endcase block, prompting for details.
+ \\[verilog-sk-casez] Insert a casez (...) item: begin.. end endcase block, prompting for details.
+ \\[verilog-sk-if] Insert an if (..) begin .. end block.
+ \\[verilog-sk-else-if] Insert an else if (..) begin .. end block.
+ \\[verilog-sk-comment] Insert a comment block.
+ \\[verilog-sk-assign] Insert an assign .. = ..; statement.
+ \\[verilog-sk-function] Insert a function .. begin .. end endfunction block.
+ \\[verilog-sk-input] Insert an input declaration, prompting for details.
+ \\[verilog-sk-output] Insert an output declaration, prompting for details.
+ \\[verilog-sk-state-machine] Insert a state machine definition, prompting for details.
+ \\[verilog-sk-inout] Insert an inout declaration, prompting for details.
+ \\[verilog-sk-wire] Insert a wire declaration, prompting for details.
+ \\[verilog-sk-reg] Insert a register declaration, prompting for details.
+ \\[verilog-sk-define-signal] Define signal under point as a register at the top of the module.
+
+All key bindings can be seen in a Verilog-buffer with \\[describe-bindings].
+Key bindings specific to `verilog-mode-map' are:
+
+\\{verilog-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map verilog-mode-map)
+ (setq major-mode 'verilog-mode)
+ (setq mode-name "Verilog")
+ (setq local-abbrev-table verilog-mode-abbrev-table)
+ (setq verilog-mode-syntax-table (make-syntax-table))
+ (verilog-populate-syntax-table verilog-mode-syntax-table)
+ ;; add extra comment syntax
+ (verilog-setup-dual-comments verilog-mode-syntax-table)
+ (set-syntax-table verilog-mode-syntax-table)
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'verilog-indent-line-relative)
+ (setq comment-indent-function 'verilog-comment-indent)
+ (make-local-variable 'parse-sexp-ignore-comments)
+ (setq parse-sexp-ignore-comments nil)
+ (make-local-variable 'comment-start)
+ (make-local-variable 'comment-end)
+ (make-local-variable 'comment-multi-line)
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start "// "
+ comment-end ""
+ comment-start-skip "/\\*+ *\\|// *"
+ comment-multi-line nil)
+ ;; Set up for compilation
+ (setq verilog-which-tool 1)
+ (setq verilog-tool 'verilog-linter)
+ (verilog-set-compile-command)
+ (when (boundp 'hack-local-variables-hook) ;; Also modify any file-local-variables
+ (add-hook 'hack-local-variables-hook 'verilog-modify-compile-command t))
+
+ ;; Setting up things for font-lock
+ (if verilog-running-on-xemacs
+ (progn
+ (if (and current-menubar
+ (not (assoc "Verilog" current-menubar)))
+ (progn
+ ;; (set-buffer-menubar (copy-sequence current-menubar))
+ (add-submenu nil verilog-xemacs-menu)
+ (add-submenu nil verilog-stmt-menu)
+ )
+ )
+ ))
+ ;; Stuff for GNU emacs
+ (make-local-variable 'font-lock-defaults)
+ ;;------------------------------------------------------------
+ ;; now hook in 'verilog-colorize-include-files (eldo-mode.el&spice-mode.el)
+ ;; all buffer local:
+ (make-local-hook 'font-lock-mode-hook)
+ (make-local-hook 'font-lock-after-fontify-buffer-hook); doesn't exist in emacs 20
+ (add-hook 'font-lock-mode-hook 'verilog-colorize-include-files-buffer t t)
+ (add-hook 'font-lock-after-fontify-buffer-hook 'verilog-colorize-include-files-buffer t t) ; not in emacs 20
+ (make-local-hook 'after-change-functions)
+ (add-hook 'after-change-functions 'verilog-colorize-include-files t t)
+
+ ;; Tell imenu how to handle verilog.
+ (make-local-variable 'imenu-generic-expression)
+ (setq imenu-generic-expression verilog-imenu-generic-expression)
+ ;; hideshow support
+ (unless (assq 'verilog-mode hs-special-modes-alist)
+ (setq hs-special-modes-alist
+ (cons '(verilog-mode-mode "\\<begin\\>" "\\<end\\>" nil
+ verilog-forward-sexp-function)
+ hs-special-modes-alist)))
+ ;; Display version splash information.
+ (verilog-display-startup-message)
+
+ ;; Stuff for autos
+ (add-hook 'write-contents-hooks 'verilog-auto-save-check) ; already local
+;; (verilog-auto-reeval-locals t) ; Save locals in case user changes them
+;; (verilog-getopt-flags)
+ (run-hooks 'verilog-mode-hook))
+\f
+
+;;
+;; Electric functions
+;;
+(defun electric-verilog-terminate-line (&optional arg)
+ "Terminate line and indent next line.
+With optional ARG, remove existing end of line comments."
+ (interactive)
+ ;; before that see if we are in a comment
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (cond
+ ((nth 7 state) ; Inside // comment
+ (if (eolp)
+ (progn
+ (delete-horizontal-space)
+ (newline))
+ (progn
+ (newline)
+ (insert-string "// ")
+ (beginning-of-line)))
+ (verilog-indent-line))
+ ((nth 4 state) ; Inside any comment (hence /**/)
+ (newline)
+ (verilog-more-comment))
+ ((eolp)
+ ;; First, check if current line should be indented
+ (if (save-excursion
+ (delete-horizontal-space)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (if (looking-at verilog-auto-end-comment-lines-re)
+ (let ((indent-str (verilog-indent-line)))
+ ;; Maybe we should set some endcomments
+ (if verilog-auto-endcomments
+ (verilog-set-auto-endcomments indent-str arg))
+ (end-of-line)
+ (delete-horizontal-space)
+ (if arg
+ ()
+ (newline))
+ nil)
+ (progn
+ (end-of-line)
+ (delete-horizontal-space)
+ 't
+ )
+ )
+ )
+ ;; see if we should line up assignments
+ (progn
+ (if (or (memq 'all verilog-auto-lineup)
+ (memq 'assignments verilog-auto-lineup))
+ (verilog-pretty-expr)
+ )
+ (newline)
+ )
+ (forward-line 1)
+ )
+ ;; Indent next line
+ (if verilog-auto-indent-on-newline
+ (verilog-indent-line))
+ )
+ (t
+ (newline))
+ )))
+
+(defun electric-verilog-terminate-and-indent ()
+ "Insert a newline and indent for the next statement."
+ (interactive)
+ (electric-verilog-terminate-line 1))
+
+(defun electric-verilog-semi ()
+ "Insert `;' character and reindent the line."
+ (interactive)
+ (insert last-command-char)
+
+ (if (or (verilog-in-comment-or-string-p)
+ (verilog-in-escaped-name-p))
+ ()
+ (save-excursion
+ (beginning-of-line)
+ (verilog-forward-ws&directives)
+ (verilog-indent-line)
+ )
+ (if (and verilog-auto-newline
+ (not (verilog-parenthesis-depth)))
+ (electric-verilog-terminate-line))))
+
+(defun electric-verilog-semi-with-comment ()
+ "Insert `;' character, reindent the line and indent for comment."
+ (interactive)
+ (insert "\;")
+ (save-excursion
+ (beginning-of-line)
+ (verilog-indent-line))
+ (indent-for-comment))
+
+(defun electric-verilog-colon ()
+ "Insert `:' and do all indentations except line indent on this line."
+ (interactive)
+ (insert last-command-char)
+ ;; Do nothing if within string.
+ (if (or
+ (verilog-within-string)
+ (not (verilog-in-case-region-p)))
+ ()
+ (save-excursion
+ (let ((p (point))
+ (lim (progn (verilog-beg-of-statement) (point))))
+ (goto-char p)
+ (verilog-backward-case-item lim)
+ (verilog-indent-line)))
+;; (let ((verilog-tab-always-indent nil))
+;; (verilog-indent-line))
+ ))
+
+;;(defun electric-verilog-equal ()
+;; "Insert `=', and do indentation if within block."
+;; (interactive)
+;; (insert last-command-char)
+;; Could auto line up expressions, but not yet
+;; (if (eq (car (verilog-calculate-indent)) 'block)
+;; (let ((verilog-tab-always-indent nil))
+;; (verilog-indent-command)))
+;; )
+
+(defun electric-verilog-tick ()
+ "Insert back-tick, and indent to column 0 if this is a CPP directive."
+ (interactive)
+ (insert last-command-char)
+ (save-excursion
+ (if (progn
+ (beginning-of-line)
+ (looking-at verilog-directive-re-1))
+ (verilog-indent-line))))
+
+(defun electric-verilog-tab ()
+ "Function called when TAB is pressed in Verilog mode."
+ (interactive)
+ ;; If verilog-tab-always-indent, indent the beginning of the line.
+ (if (or verilog-tab-always-indent
+ (save-excursion
+ (skip-chars-backward " \t")
+ (bolp)))
+ (let* ((oldpnt (point))
+ (boi-point
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (verilog-indent-line)
+ (back-to-indentation)
+ (point))))
+ (if (< (point) boi-point)
+ (back-to-indentation)
+ (cond ((not verilog-tab-to-comment))
+ ((not (eolp))
+ (end-of-line))
+ (t
+ (indent-for-comment)
+ (when (and (eolp) (= oldpnt (point)))
+ ; kill existing comment
+ (beginning-of-line)
+ (re-search-forward comment-start-skip oldpnt 'move)
+ (goto-char (match-beginning 0))
+ (skip-chars-backward " \t")
+ (kill-region (point) oldpnt)
+ ))))
+ )
+ (progn (insert "\t"))))
+
+\f
+
+;;
+;; Interactive functions
+;;
+
+(defun verilog-indent-buffer ()
+ "Indent-region the entire buffer as Verilog code.
+To call this from the command line, see \\[verilog-batch-indent]."
+ (interactive)
+ (verilog-mode)
+ (indent-region (point-min) (point-max) nil))
+
+(defun verilog-insert-block ()
+ "Insert Verilog begin ... end; block in the code with right indentation."
+ (interactive)
+ (verilog-indent-line)
+ (insert "begin")
+ (electric-verilog-terminate-line)
+ (save-excursion
+ (electric-verilog-terminate-line)
+ (insert "end")
+ (beginning-of-line)
+ (verilog-indent-line)))
+
+(defun verilog-star-comment ()
+ "Insert Verilog star comment at point."
+ (interactive)
+ (verilog-indent-line)
+ (insert "/*")
+ (save-excursion
+ (newline)
+ (insert " */"))
+ (newline)
+ (insert " * "))
+
+(defun verilog-insert-indices (MAX)
+ "Insert a set of indices at into the rectangle.
+The upper left corner is defined by the current point. Indices always
+begin with 0 and extend to the MAX - 1. If no prefix arg is given, the
+user is prompted for a value. The indices are surrounded by square brackets
+[]. For example, the following code with the point located after the first
+'a' gives:
+
+ a = b a[ 0] = b
+ a = b a[ 1] = b
+ a = b a[ 2] = b
+ a = b a[ 3] = b
+ a = b ==> insert-indices ==> a[ 4] = b
+ a = b a[ 5] = b
+ a = b a[ 6] = b
+ a = b a[ 7] = b
+ a = b a[ 8] = b"
+
+ (interactive "NMAX?")
+ (save-excursion
+ (let ((n 0))
+ (while (< n MAX)
+ (save-excursion
+ (insert (format "[%3d]" n)))
+ (next-line 1)
+ (setq n (1+ n))))))
+
+
+(defun verilog-generate-numbers (MAX)
+ "Insert a set of generated numbers into a rectangle.
+The upper left corner is defined by point. The numbers are padded to three
+digits, starting with 000 and extending to (MAX - 1). If no prefix argument
+is supplied, then the user is prompted for the MAX number. consider the
+following code fragment:
+
+ buf buf buf buf000
+ buf buf buf buf001
+ buf buf buf buf002
+ buf buf buf buf003
+ buf buf ==> insert-indices ==> buf buf004
+ buf buf buf buf005
+ buf buf buf buf006
+ buf buf buf buf007
+ buf buf buf buf008"
+
+ (interactive "NMAX?")
+ (save-excursion
+ (let ((n 0))
+ (while (< n MAX)
+ (save-excursion
+ (insert (format "%3.3d" n)))
+ (next-line 1)
+ (setq n (1+ n))))))
+
+(defun verilog-mark-defun ()
+ "Mark the current verilog function (or procedure).
+This puts the mark at the end, and point at the beginning."
+ (interactive)
+ (push-mark (point))
+ (verilog-end-of-defun)
+ (push-mark (point))
+ (verilog-beg-of-defun)
+ (zmacs-activate-region))
+
+(defun verilog-comment-region (start end)
+ ; checkdoc-params: (start end)
+ "Put the region into a Verilog comment.
+The comments that are in this area are \"deformed\":
+`*)' becomes `!(*' and `}' becomes `!{'.
+These deformed comments are returned to normal if you use
+\\[verilog-uncomment-region] to undo the commenting.
+
+The commented area starts with `verilog-exclude-str-start', and ends with
+`verilog-exclude-str-end'. But if you change these variables,
+\\[verilog-uncomment-region] won't recognize the comments."
+ (interactive "r")
+ (save-excursion
+ ;; Insert start and endcomments
+ (goto-char end)
+ (if (and (save-excursion (skip-chars-forward " \t") (eolp))
+ (not (save-excursion (skip-chars-backward " \t") (bolp))))
+ (forward-line 1)
+ (beginning-of-line))
+ (insert verilog-exclude-str-end)
+ (setq end (point))
+ (newline)
+ (goto-char start)
+ (beginning-of-line)
+ (insert verilog-exclude-str-start)
+ (newline)
+ ;; Replace end-comments within commented area
+ (goto-char end)
+ (save-excursion
+ (while (re-search-backward "\\*/" start t)
+ (replace-match "*-/" t t)))
+ (save-excursion
+ (let ((s+1 (1+ start)))
+ (while (re-search-backward "/\\*" s+1 t)
+ (replace-match "/-*" t t))))
+ ))
+
+(defun verilog-uncomment-region ()
+ "Uncomment a commented area; change deformed comments back to normal.
+This command does nothing if the pointer is not in a commented
+area. See also `verilog-comment-region'."
+ (interactive)
+ (save-excursion
+ (let ((start (point))
+ (end (point)))
+ ;; Find the boundaries of the comment
+ (save-excursion
+ (setq start (progn (search-backward verilog-exclude-str-start nil t)
+ (point)))
+ (setq end (progn (search-forward verilog-exclude-str-end nil t)
+ (point))))
+ ;; Check if we're really inside a comment
+ (if (or (equal start (point)) (<= end (point)))
+ (message "Not standing within commented area.")
+ (progn
+ ;; Remove endcomment
+ (goto-char end)
+ (beginning-of-line)
+ (let ((pos (point)))
+ (end-of-line)
+ (delete-region pos (1+ (point))))
+ ;; Change comments back to normal
+ (save-excursion
+ (while (re-search-backward "\\*-/" start t)
+ (replace-match "*/" t t)))
+ (save-excursion
+ (while (re-search-backward "/-\\*" start t)
+ (replace-match "/*" t t)))
+ ;; Remove start comment
+ (goto-char start)
+ (beginning-of-line)
+ (let ((pos (point)))
+ (end-of-line)
+ (delete-region pos (1+ (point)))))))))
+
+(defun verilog-beg-of-defun ()
+ "Move backward to the beginning of the current function or procedure."
+ (interactive)
+ (verilog-re-search-backward verilog-defun-re nil 'move))
+
+(defun verilog-end-of-defun ()
+ "Move forward to the end of the current function or procedure."
+ (interactive)
+ (verilog-re-search-forward verilog-end-defun-re nil 'move))
+
+(defun verilog-get-beg-of-defun (&optional warn)
+ (save-excursion
+ (cond ((verilog-re-search-forward-quick verilog-defun-re nil t)
+ (point))
+ (t
+ (error "%s: Can't find module beginning" (verilog-point-text))
+ (point-max)))))
+(defun verilog-get-end-of-defun (&optional warn)
+ (save-excursion
+ (cond ((verilog-re-search-forward-quick verilog-end-defun-re nil t)
+ (point))
+ (t
+ (error "%s: Can't find endmodule" (verilog-point-text))
+ (point-max)))))
+
+(defun verilog-label-be (&optional arg)
+ "Label matching begin ... end, fork ... join and case ... endcase statements.
+With ARG, first kill any existing labels."
+ (interactive)
+ (let ((cnt 0)
+ (oldpos (point))
+ (b (progn
+ (verilog-beg-of-defun)
+ (point-marker)))
+ (e (progn
+ (verilog-end-of-defun)
+ (point-marker)))
+ )
+ (goto-char (marker-position b))
+ (if (> (- e b) 200)
+ (message "Relabeling module..."))
+ (while (and
+ (> (marker-position e) (point))
+ (verilog-re-search-forward
+ (concat
+ "\\<end\\(\\(function\\)\\|\\(task\\)\\|\\(module\\)\\|\\(primitive\\)\\|\\(interface\\)\\|\\(package\\)\\|\\(case\\)\\)?\\>"
+ "\\|\\(`endif\\)\\|\\(`else\\)")
+ nil 'move))
+ (goto-char (match-beginning 0))
+ (let ((indent-str (verilog-indent-line)))
+ (verilog-set-auto-endcomments indent-str 't)
+ (end-of-line)
+ (delete-horizontal-space)
+ )
+ (setq cnt (1+ cnt))
+ (if (= 9 (% cnt 10))
+ (message "%d..." cnt))
+ )
+ (goto-char oldpos)
+ (if (or
+ (> (- e b) 200)
+ (> cnt 20))
+ (message "%d lines auto commented" cnt))
+ ))
+
+(defun verilog-beg-of-statement ()
+ "Move backward to beginning of statement."
+ (interactive)
+ (while (save-excursion
+ (not (looking-at verilog-complete-reg))
+ (verilog-backward-syntactic-ws)
+ (not (or
+ (bolp)
+ (= (preceding-char) ?\;)
+ (save-excursion
+ (verilog-backward-token)
+ (looking-at verilog-end-block-re))
+ )))
+ (skip-chars-backward " \t")
+ (verilog-backward-token))
+ (let ((last (point)))
+ (while (progn
+ (setq last (point))
+ (and (not (looking-at verilog-complete-reg))
+ (verilog-continued-line))))
+ (goto-char last)
+ (verilog-forward-syntactic-ws)))
+
+(defun verilog-beg-of-statement-1 ()
+ "Move backward to beginning of statement."
+ (interactive)
+ (let ((pt (point)))
+
+ (while (and (not (looking-at verilog-complete-reg))
+ (setq pt (point))
+ (verilog-backward-token)
+ (not (looking-at verilog-complete-reg))
+ (verilog-backward-syntactic-ws)
+ (setq pt (point))
+ (not (bolp))
+ (not (= (preceding-char) ?\;))))
+; (while (progn
+; (setq pt (point))
+; (and (not (looking-at verilog-complete-reg))
+; (not (= (preceding-char) ?\;))
+; (verilog-continued-line))))
+ (goto-char pt)
+ (verilog-forward-ws&directives)))
+
+(defun verilog-end-of-statement ()
+ "Move forward to end of current statement."
+ (interactive)
+ (let ((nest 0) pos)
+ (or (looking-at verilog-beg-block-re)
+ ;; Skip to end of statement
+ (setq pos (catch 'found
+ (while t
+ (forward-sexp 1)
+ (verilog-skip-forward-comment-or-string)
+ (cond ((looking-at "[ \t]*;")
+ (skip-chars-forward "^;")
+ (forward-char 1)
+ (throw 'found (point)))
+ ((save-excursion
+ (forward-sexp -1)
+ (looking-at verilog-beg-block-re))
+ (goto-char (match-beginning 0))
+ (throw 'found nil))
+ ((eobp)
+ (throw 'found (point))))))))
+ (if (not pos)
+ ;; Skip a whole block
+ (catch 'found
+ (while t
+ (verilog-re-search-forward verilog-end-statement-re nil 'move)
+ (setq nest (if (match-end 1)
+ (1+ nest)
+ (1- nest)))
+ (cond ((eobp)
+ (throw 'found (point)))
+ ((= 0 nest)
+ (throw 'found (verilog-end-of-statement))))))
+ pos)))
+
+(defun verilog-in-case-region-p ()
+ "Return TRUE if in a case region;
+more specifically, point @ in the line foo : @ begin"
+ (interactive)
+ (save-excursion
+ (if (and
+ (progn (verilog-forward-syntactic-ws)
+ (looking-at "\\<begin\\>"))
+ (progn (verilog-backward-syntactic-ws)
+ (= (preceding-char) ?\:)))
+ (catch 'found
+ (let ((nest 1))
+ (while t
+ (verilog-re-search-backward
+ (concat "\\(\\<module\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|"
+ "\\(\\<endcase\\>\\)\\>")
+ nil 'move)
+ (cond
+ ((match-end 3)
+ (setq nest (1+ nest)))
+ ((match-end 2)
+ (if (= nest 1)
+ (throw 'found 1))
+ (setq nest (1- nest)))
+ (t
+ (throw 'found (= nest 0)))
+ ))))
+ nil)))
+(defun verilog-in-struct-region-p ()
+ "Return TRUE if in a struct region;
+more specifically, in a list after a struct|union keyword"
+ (interactive)
+ (save-excursion
+ (let* ((state (parse-partial-sexp (point-min) (point)))
+ (depth (nth 0 state)))
+ (if depth
+ (progn (backward-up-list depth)
+ (verilog-beg-of-statement)
+ (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>")
+ )
+ )
+ )
+ )
+ )
+
+(defun verilog-in-generate-region-p ()
+ "Return TRUE if in a generate region;
+more specifically, after a generate and before an endgenerate"
+ (interactive)
+ (let ((lim (save-excursion (verilog-beg-of-defun) (point)))
+ (nest 1)
+ )
+ (save-excursion
+ (while (and
+ (/= nest 0)
+ (verilog-re-search-backward "\\<\\(generate\\)\\|\\(endgenerate\\)\\>" lim 'move)
+ (cond
+ ((match-end 1) ; generate
+ (setq nest (1- nest)))
+ ((match-end 2) ; endgenerate
+ (setq nest (1+ nest)))
+ ))
+ ))
+ (= nest 0) )) ; return nest
+
+(defun verilog-in-fork-region-p ()
+ "Return true if between a fork and join."
+ (interactive)
+ (let ((lim (save-excursion (verilog-beg-of-defun) (point)))
+ (nest 1)
+ )
+ (save-excursion
+ (while (and
+ (/= nest 0)
+ (verilog-re-search-backward "\\<\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\>" lim 'move)
+ (cond
+ ((match-end 1) ; fork
+ (setq nest (1- nest)))
+ ((match-end 2) ; join
+ (setq nest (1+ nest)))
+ ))
+ ))
+ (= nest 0) )) ; return nest
+
+(defun verilog-backward-case-item (lim)
+ "Skip backward to nearest enclosing case item.
+Limit search to point LIM."
+ (interactive)
+ (let ((str 'nil)
+ (lim1
+ (progn
+ (save-excursion
+ (verilog-re-search-backward verilog-endcomment-reason-re
+ lim 'move)
+ (point)))))
+ ;; Try to find the real :
+ (if (save-excursion (search-backward ":" lim1 t))
+ (let ((colon 0)
+ b e )
+ (while
+ (and
+ (< colon 1)
+ (verilog-re-search-backward "\\(\\[\\)\\|\\(\\]\\)\\|\\(:\\)"
+ lim1 'move))
+ (cond
+ ((match-end 1) ;; [
+ (setq colon (1+ colon))
+ (if (>= colon 0)
+ (error "%s: unbalanced [" (verilog-point-text))))
+ ((match-end 2) ;; ]
+ (setq colon (1- colon)))
+
+ ((match-end 3) ;; :
+ (setq colon (1+ colon)))
+ ))
+ ;; Skip back to beginning of case item
+ (skip-chars-backward "\t ")
+ (verilog-skip-backward-comment-or-string)
+ (setq e (point))
+ (setq b
+ (progn
+ (if
+ (verilog-re-search-backward
+ "\\<\\(case[zx]?\\)\\>\\|;\\|\\<end\\>" nil 'move)
+ (progn
+ (cond
+ ((match-end 1)
+ (goto-char (match-end 1))
+ (verilog-forward-ws&directives)
+ (if (looking-at "(")
+ (progn
+ (forward-sexp)
+ (verilog-forward-ws&directives)))
+ (point))
+ (t
+ (goto-char (match-end 0))
+ (verilog-forward-ws&directives)
+ (point))
+ ))
+ (error "Malformed case item")
+ )))
+ (setq str (buffer-substring b e))
+ (if
+ (setq e
+ (string-match
+ "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str))
+ (setq str (concat (substring str 0 e) "...")))
+ str)
+ 'nil)))
+\f
+
+;;
+;; Other functions
+;;
+
+(defun kill-existing-comment ()
+ "Kill auto comment on this line."
+ (save-excursion
+ (let* (
+ (e (progn
+ (end-of-line)
+ (point)))
+ (b (progn
+ (beginning-of-line)
+ (search-forward "//" e t))))
+ (if b
+ (delete-region (- b 2) e)))))
+
+(defconst verilog-directive-nest-re
+ (concat "\\(`else\\>\\)\\|"
+ "\\(`endif\\>\\)\\|"
+ "\\(`if\\>\\)\\|"
+ "\\(`ifdef\\>\\)\\|"
+ "\\(`ifndef\\>\\)"))
+(defun verilog-set-auto-endcomments (indent-str kill-existing-comment)
+ "Add ending comment with given INDENT-STR.
+With KILL-EXISTING-COMMENT, remove what was there before.
+Insert `// case: 7 ' or `// NAME ' on this line if appropriate.
+Insert `// case expr ' if this line ends a case block.
+Insert `// ifdef FOO ' if this line ends code conditional on FOO.
+Insert `// NAME ' if this line ends a function, task, module, primitive or interface named NAME."
+ (save-excursion
+ (cond
+ (; Comment close preprocessor directives
+ (and
+ (looking-at "\\(`endif\\)\\|\\(`else\\)")
+ (or kill-existing-comment
+ (not (save-excursion
+ (end-of-line)
+ (search-backward "//" (verilog-get-beg-of-line) t)))))
+ (let ((nest 1) b e
+ m
+ (else (if (match-end 2) "!" " "))
+ )
+ (end-of-line)
+ (if kill-existing-comment
+ (kill-existing-comment))
+ (delete-horizontal-space)
+ (save-excursion
+ (backward-sexp 1)
+ (while (and (/= nest 0)
+ (verilog-re-search-backward verilog-directive-nest-re nil 'move))
+ (cond
+ ((match-end 1) ; `else
+ (if (= nest 1)
+ (setq else "!")))
+ ((match-end 2) ; `endif
+ (setq nest (1+ nest)))
+ ((match-end 3) ; `if
+ (setq nest (1- nest)))
+ ((match-end 4) ; `ifdef
+ (setq nest (1- nest)))
+ ((match-end 5) ; `ifndef
+ (setq nest (1- nest)))
+ ))
+ (if (match-end 0)
+ (setq
+ m (buffer-substring
+ (match-beginning 0)
+ (match-end 0))
+ b (progn
+ (skip-chars-forward "^ \t")
+ (verilog-forward-syntactic-ws)
+ (point))
+ e (progn
+ (skip-chars-forward "a-zA-Z0-9_")
+ (point)
+ ))))
+ (if b
+ (if (> (count-lines (point) b) verilog-minimum-comment-distance)
+ (insert (concat " // " else m " " (buffer-substring b e))))
+ (progn
+ (insert " // unmatched `else or `endif")
+ (ding 't))
+ )))
+
+ (; Comment close case/class/function/task/module and named block
+ (and (looking-at "\\<end")
+ (or kill-existing-comment
+ (not (save-excursion
+ (end-of-line)
+ (search-backward "//" (verilog-get-beg-of-line) t)))))
+ (let ((type (car indent-str)))
+ (unless (eq type 'declaration)
+ (unless (looking-at (concat "\\(" verilog-end-block-ordered-re "\\)[ \t]*:")) ;; ignore named ends
+ (if (looking-at verilog-end-block-ordered-re)
+ (cond
+ (;- This is a case block; search back for the start of this case
+ (match-end 1) ;; of verilog-end-block-ordered-re
+
+ (let ((err 't)
+ (str "UNMATCHED!!"))
+ (save-excursion
+ (verilog-leap-to-head)
+ (cond
+ ((looking-at "\\<randcase\\>")
+ (setq str "randcase")
+ (setq err nil)
+ )
+ ((match-end 0)
+ (goto-char (match-end 1))
+ (if nil
+ (let (s f)
+ (setq s (match-beginning 1))
+ (setq f (progn (end-of-line)
+ (point)))
+ (setq str (buffer-substring s f)))
+ (setq err nil))
+ (setq str (concat (buffer-substring (match-beginning 1) (match-end 1))
+ " "
+ (verilog-get-expr))))))
+ (end-of-line)
+ (if kill-existing-comment
+ (kill-existing-comment))
+ (delete-horizontal-space)
+ (insert (concat " // " str ))
+ (if err (ding 't))
+ ))
+
+ (;- This is a begin..end block
+ (match-end 2) ;; of verilog-end-block-ordered-re
+ (let ((str " // UNMATCHED !!")
+ (err 't)
+ (here (point))
+ there
+ cntx
+ )
+ (save-excursion
+ (verilog-leap-to-head)
+ (setq there (point))
+ (if (not (match-end 0))
+ (progn
+ (goto-char here)
+ (end-of-line)
+ (if kill-existing-comment
+ (kill-existing-comment))
+ (delete-horizontal-space)
+ (insert str)
+ (ding 't)
+ )
+ (let ((lim
+ (save-excursion (verilog-beg-of-defun) (point)))
+ (here (point))
+ )
+ (cond
+ (;-- handle named block differently
+ (looking-at verilog-named-block-re)
+ (search-forward ":")
+ (setq there (point))
+ (setq str (verilog-get-expr))
+ (setq err nil)
+ (setq str (concat " // block: " str )))
+
+ ((verilog-in-case-region-p) ;-- handle case item differently
+ (goto-char here)
+ (setq str (verilog-backward-case-item lim))
+ (setq there (point))
+ (setq err nil)
+ (setq str (concat " // case: " str )))
+
+ (;- try to find "reason" for this begin
+ (cond
+ (;
+ (eq here (progn
+ (verilog-backward-token)
+ (verilog-beg-of-statement-1)
+ (point)))
+ (setq err nil)
+ (setq str ""))
+ ((looking-at verilog-endcomment-reason-re)
+ (setq there (match-end 0))
+ (setq cntx (concat
+ (buffer-substring (match-beginning 0) (match-end 0)) " "))
+ (cond
+ (;- begin
+ (match-end 2)
+ (setq err nil)
+ (save-excursion
+ (if (and (verilog-continued-line)
+ (looking-at "\\<repeat\\>\\|\\<wait\\>\\|\\<always\\>"))
+ (progn
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq str
+ (concat " // "
+ (buffer-substring (match-beginning 0) (match-end 0)) " "
+ (verilog-get-expr))))
+ (setq str ""))))
+
+ (;- else
+ (match-end 4)
+ (let ((nest 0)
+ ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)")
+ )
+ (catch 'skip
+ (while (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 1) ; begin
+ (setq nest (1- nest)))
+ ((match-end 2) ; end
+ (setq nest (1+ nest)))
+ ((match-end 3)
+ (if (= 0 nest)
+ (progn
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq err nil)
+ (setq str (verilog-get-expr))
+ (setq str (concat " // else: !if" str ))
+ (throw 'skip 1))
+ )))
+ ))))
+
+ (;- end else
+ (match-end 5)
+ (goto-char there)
+ (let ((nest 0)
+ ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)")
+ )
+ (catch 'skip
+ (while (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 1) ; begin
+ (setq nest (1- nest)))
+ ((match-end 2) ; end
+ (setq nest (1+ nest)))
+ ((match-end 3)
+ (if (= 0 nest)
+ (progn
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq err nil)
+ (setq str (verilog-get-expr))
+ (setq str (concat " // else: !if" str ))
+ (throw 'skip 1))
+ )))
+ ))))
+
+ (;- task/function/initial et cetera
+ t
+ (match-end 0)
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq err nil)
+ (setq str (verilog-get-expr))
+ (setq str (concat " // " cntx str )))
+
+ (;-- otherwise...
+ (setq str " // auto-endcomment confused "))
+ ))
+
+ ((and
+ (verilog-in-case-region-p) ;-- handle case item differently
+ (progn
+ (setq there (point))
+ (goto-char here)
+ (setq str (verilog-backward-case-item lim))))
+ (setq err nil)
+ (setq str (concat " // case: " str )))
+
+ ((verilog-in-fork-region-p)
+ (setq err nil)
+ (setq str " // fork branch" ))
+
+ ((looking-at "\\<end\\>")
+ ;; HERE
+ (forward-word 1)
+ (verilog-forward-syntactic-ws)
+ (setq err nil)
+ (setq str (verilog-get-expr))
+ (setq str (concat " // " cntx str )))
+
+ ))))
+ (goto-char here)
+ (end-of-line)
+ (if kill-existing-comment
+ (kill-existing-comment))
+ (delete-horizontal-space)
+ (if (or err
+ (> (count-lines here there) verilog-minimum-comment-distance))
+ (insert str))
+ (if err (ding 't))
+ ))))
+ (;- this is endclass, which can be nested
+ (match-end 11) ;; of verilog-end-block-ordered-re
+ ;;(goto-char there)
+ (let ((nest 0)
+ ( reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>")
+ string
+ )
+ (save-excursion
+ (catch 'skip
+ (while (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 3) ; endclass
+ (ding 't)
+ (setq string "unmatched endclass")
+ (throw 'skip 1))
+
+ ((match-end 2) ; endclass
+ (setq nest (1+ nest)))
+
+ ((match-end 1) ; class
+ (setq nest (1- nest))
+ (if (< nest 0)
+ (progn
+ (goto-char (match-end 0))
+ (let (b e)
+ (setq b (progn
+ (skip-chars-forward "^ \t")
+ (verilog-forward-ws&directives)
+ (point))
+ e (progn
+ (skip-chars-forward "a-zA-Z0-9_")
+ (point)))
+ (setq string (buffer-substring b e)))
+ (throw 'skip 1))))
+ ))))
+ (end-of-line)
+ (insert (concat " // " string )))
+ )
+
+ (;- this is end{function,generate,task,module,primitive,table,generate}
+ ;- which can not be nested.
+ t
+ (let (string reg (width nil))
+ (end-of-line)
+ (if kill-existing-comment
+ (save-match-data
+ (kill-existing-comment)))
+ (delete-horizontal-space)
+ (backward-sexp)
+ (cond
+ ((match-end 5) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
+ (setq width "\\(\\s-*\\(\\[[^]]*\\]\\)\\|\\(real\\(time\\)?\\)\\|\\(integer\\)\\|\\(time\\)\\)?")
+ )
+ ((match-end 6) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)"))
+ ((match-end 7) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<\\(macro\\)?module\\>\\)\\|\\<endmodule\\>"))
+ ((match-end 8) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<primitive\\>\\)\\|\\(\\<\\(endprimitive\\|package\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 9) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<interface\\>\\)\\|\\(\\<\\(endinterface\\|package\\|primitive\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 10) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<package\\>\\)\\|\\(\\<\\(endpackage\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 11) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<class\\>\\)\\|\\(\\<\\(endclass\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 12) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<\\(endcovergroup\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 13) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<program\\>\\)\\|\\(\\<\\(endprogram\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 14) ;; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<\\(endsequence\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ )
+ (let (b e)
+ (save-excursion
+ (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 1)
+ (setq b (progn
+ (skip-chars-forward "^ \t")
+ (verilog-forward-ws&directives)
+ (if (and width (looking-at width))
+ (progn
+ (goto-char (match-end 0))
+ (verilog-forward-ws&directives)
+ ))
+ (point))
+ e (progn
+ (skip-chars-forward "a-zA-Z0-9_")
+ (point)))
+ (setq string (buffer-substring b e)))
+ (t
+ (ding 't)
+ (setq string "unmatched end(function|task|module|primitive|interface|package|class)")))))
+ (end-of-line)
+ (insert (concat " // " string )))
+ ))))))))))
+
+(defun verilog-get-expr()
+ "Grab expression at point, e.g, case ( a | b & (c ^d))"
+ (let* ((b (progn
+ (verilog-forward-syntactic-ws)
+ (skip-chars-forward " \t")
+ (point)))
+ (e (let ((par 1))
+ (cond
+ ((looking-at "@")
+ (forward-char 1)
+ (verilog-forward-syntactic-ws)
+ (if (looking-at "(")
+ (progn
+ (forward-char 1)
+ (while (and (/= par 0)
+ (verilog-re-search-forward "\\((\\)\\|\\()\\)" nil 'move))
+ (cond
+ ((match-end 1)
+ (setq par (1+ par)))
+ ((match-end 2)
+ (setq par (1- par)))))))
+ (point))
+ ((looking-at "(")
+ (forward-char 1)
+ (while (and (/= par 0)
+ (verilog-re-search-forward "\\((\\)\\|\\()\\)" nil 'move))
+ (cond
+ ((match-end 1)
+ (setq par (1+ par)))
+ ((match-end 2)
+ (setq par (1- par)))))
+ (point))
+ ((looking-at "\\[")
+ (forward-char 1)
+ (while (and (/= par 0)
+ (verilog-re-search-forward "\\(\\[\\)\\|\\(\\]\\)" nil 'move))
+ (cond
+ ((match-end 1)
+ (setq par (1+ par)))
+ ((match-end 2)
+ (setq par (1- par)))))
+ (verilog-forward-syntactic-ws)
+ (skip-chars-forward "^ \t\n\f")
+ (point))
+ ((looking-at "/[/\\*]")
+ b)
+ ('t
+ (skip-chars-forward "^: \t\n\f")
+ (point)
+ ))))
+ (str (buffer-substring b e)))
+ (if (setq e (string-match "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str))
+ (setq str (concat (substring str 0 e) "...")))
+ str))
+
+(defun verilog-expand-vector ()
+ "Take a signal vector on the current line and expand it to multiple lines.
+Useful for creating tri's and other expanded fields."
+ (interactive)
+ (verilog-expand-vector-internal "[" "]"))
+
+(defun verilog-expand-vector-internal (bra ket)
+ "Given BRA, the start brace and KET, the end brace, expand one line into many lines."
+ (save-excursion
+ (forward-line 0)
+ (let ((signal-string (buffer-substring (point)
+ (progn
+ (end-of-line) (point)))))
+ (if (string-match (concat "\\(.*\\)"
+ (regexp-quote bra)
+ "\\([0-9]*\\)\\(:[0-9]*\\|\\)\\(::[0-9---]*\\|\\)"
+ (regexp-quote ket)
+ "\\(.*\\)$") signal-string)
+ (let* ((sig-head (match-string 1 signal-string))
+ (vec-start (string-to-int (match-string 2 signal-string)))
+ (vec-end (if (= (match-beginning 3) (match-end 3))
+ vec-start
+ (string-to-int (substring signal-string (1+ (match-beginning 3)) (match-end 3)))))
+ (vec-range (if (= (match-beginning 4) (match-end 4))
+ 1
+ (string-to-int (substring signal-string (+ 2 (match-beginning 4)) (match-end 4)))))
+ (sig-tail (match-string 5 signal-string))
+ vec)
+ ;; Decode vectors
+ (setq vec nil)
+ (if (< vec-range 0)
+ (let ((tmp vec-start))
+ (setq vec-start vec-end
+ vec-end tmp
+ vec-range (- vec-range))))
+ (if (< vec-end vec-start)
+ (while (<= vec-end vec-start)
+ (setq vec (append vec (list vec-start)))
+ (setq vec-start (- vec-start vec-range)))
+ (while (<= vec-start vec-end)
+ (setq vec (append vec (list vec-start)))
+ (setq vec-start (+ vec-start vec-range))))
+ ;;
+ ;; Delete current line
+ (delete-region (point) (progn (forward-line 0) (point)))
+ ;;
+ ;; Expand vector
+ (while vec
+ (insert (concat sig-head bra (int-to-string (car vec)) ket sig-tail "\n"))
+ (setq vec (cdr vec)))
+ (delete-char -1)
+ ;;
+ )))))
+
+(defun verilog-strip-comments ()
+ "Strip all comments from the verilog code."
+ (interactive)
+ (goto-char (point-min))
+ (while (re-search-forward "//" nil t)
+ (if (verilog-within-string)
+ (re-search-forward "\"" nil t)
+ (if (verilog-in-star-comment-p)
+ (re-search-forward "\*/" nil t)
+ (let ((bpt (- (point) 2)))
+ (end-of-line)
+ (delete-region bpt (point))))))
+ ;;
+ (goto-char (point-min))
+ (while (re-search-forward "/\\*" nil t)
+ (if (verilog-within-string)
+ (re-search-forward "\"" nil t)
+ (let ((bpt (- (point) 2)))
+ (re-search-forward "\\*/")
+ (delete-region bpt (point))))))
+
+(defun verilog-one-line ()
+ "Convert structural verilog instances to occupy one line."
+ (interactive)
+ (goto-char (point-min))
+ (while (re-search-forward "\\([^;]\\)[ \t]*\n[ \t]*" nil t)
+ (replace-match "\\1 " nil nil)))
+
+(defun verilog-linter-name ()
+ "Return name of linter, either surelint or verilint."
+ (let ((compile-word1 (verilog-string-replace-matches "\\s .*$" "" nil nil
+ compile-command))
+ (lint-word1 (verilog-string-replace-matches "\\s .*$" "" nil nil
+ verilog-linter)))
+ (cond ((equal compile-word1 "surelint") `surelint)
+ ((equal compile-word1 "verilint") `verilint)
+ ((equal lint-word1 "surelint") `surelint)
+ ((equal lint-word1 "verilint") `verilint)
+ (t `surelint)))) ;; back compatibility
+
+(defun verilog-lint-off ()
+ "Convert a Verilog linter warning line into a disable statement.
+For example:
+ pci_bfm_null.v, line 46: Unused input: pci_rst_
+becomes a comment for the appropriate tool.
+
+The first word of the `compile-command' or `verilog-linter'
+variables are used to determine which product is being used.
+
+See \\[verilog-surelint-off] and \\[verilog-verilint-off]."
+ (interactive)
+ (let ((linter (verilog-linter-name)))
+ (cond ((equal linter `surelint)
+ (verilog-surelint-off))
+ ((equal linter `verilint)
+ (verilog-verilint-off))
+ (t (error "Linter name not set")))))
+
+(defun verilog-surelint-off ()
+ "Convert a SureLint warning line into a disable statement.
+Run from Verilog source window; assumes there is a *compile* buffer
+with point set appropriately.
+
+For example:
+ WARNING [STD-UDDONX]: xx.v, line 8: output out is never assigned.
+becomes:
+ // surefire lint_line_off UDDONX"
+ (interactive)
+ (save-excursion
+ (switch-to-buffer compilation-last-buffer)
+ (beginning-of-line)
+ (when
+ (looking-at "\\(INFO\\|WARNING\\|ERROR\\) \\[[^-]+-\\([^]]+\\)\\]: \\([^,]+\\), line \\([0-9]+\\): \\(.*\\)$")
+ (let* ((code (match-string 2))
+ (file (match-string 3))
+ (line (match-string 4))
+ (buffer (get-file-buffer file))
+ dir filename)
+ (unless buffer
+ (progn
+ (setq buffer
+ (and (file-exists-p file)
+ (find-file-noselect file)))
+ (or buffer
+ (let* ((pop-up-windows t))
+ (let ((name (expand-file-name
+ (read-file-name
+ (format "Find this error in: (default %s) "
+ file)
+ dir file t))))
+ (if (file-directory-p name)
+ (setq name (expand-file-name filename name)))
+ (setq buffer
+ (and (file-exists-p name)
+ (find-file-noselect name))))))))
+ (switch-to-buffer buffer)
+ (goto-line (string-to-number line))
+ (end-of-line)
+ (catch 'already
+ (cond
+ ((verilog-in-slash-comment-p)
+ (re-search-backward "//")
+ (cond
+ ((looking-at "// surefire lint_off_line ")
+ (goto-char (match-end 0))
+ (let ((lim (save-excursion (end-of-line) (point))))
+ (if (re-search-forward code lim 'move)
+ (throw 'already t)
+ (insert-string (concat " " code)))))
+ (t
+ )))
+ ((verilog-in-star-comment-p)
+ (re-search-backward "/\*")
+ (insert-string (format " // surefire lint_off_line %6s" code ))
+ )
+ (t
+ (insert-string (format " // surefire lint_off_line %6s" code ))
+ )))))))
+
+(defun verilog-verilint-off ()
+ "Convert a Verilint warning line into a disable statement.
+
+For example:
+ (W240) pci_bfm_null.v, line 46: Unused input: pci_rst_
+becomes:
+ //Verilint 240 off // WARNING: Unused input"
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\):?.*$")
+ (replace-match (format
+ ;; %3s makes numbers 1-999 line up nicely
+ "\\1//Verilint %3s off // WARNING: \\3"
+ (match-string 2)))
+ (beginning-of-line)
+ (verilog-indent-line))))
+
+(defun verilog-auto-save-compile ()
+ "Update automatics with \\[verilog-auto], save the buffer, and compile."
+ (interactive)
+ (verilog-auto) ; Always do it for safety
+ (save-buffer)
+ (compile compile-command))
+
+\f
+
+;;
+;; Batch
+;;
+
+(defmacro verilog-batch-error-wrapper (&rest body)
+ "Execute BODY and add error prefix to any errors found.
+This lets programs calling batch mode to easily extract error messages."
+ (` (condition-case err
+ (progn (,@ body))
+ (error
+ (error "%%Error: %s%s" (error-message-string err)
+ (if verilog-running-on-xemacs "\n" "")))))) ;; xemacs forgets to add a newline
+
+(defun verilog-batch-execute-func (funref)
+ "Internal processing of a batch command, running FUNREF on all command arguments."
+ (verilog-batch-error-wrapper
+ ;; General globals needed
+ (setq make-backup-files nil)
+ (setq-default make-backup-files nil)
+ (setq enable-local-variables t)
+ (setq enable-local-eval t)
+ ;; Make sure any sub-files we read get proper mode
+ (setq default-major-mode `verilog-mode)
+ ;; Ditto files already read in
+ (mapcar '(lambda (buf)
+ (when (buffer-file-name buf)
+ (save-excursion
+ (set-buffer buf)
+ (verilog-mode))))
+ (buffer-list))
+ ;; Process the files
+ (mapcar '(lambda (buf)
+ (when (buffer-file-name buf)
+ (save-excursion
+ (if (not (file-exists-p (buffer-file-name buf)))
+ (error (concat "File not found: " (buffer-file-name buf))))
+ (message (concat "Processing " (buffer-file-name buf)))
+ (set-buffer buf)
+ (funcall funref)
+ (save-buffer))))
+ (buffer-list))))
+
+(defun verilog-batch-auto ()
+ "For use with --batch, perform automatic expansions as a stand-alone tool.
+This sets up the appropriate Verilog-Mode environment, updates automatics
+with \\[verilog-auto] on all command-line files, and saves the buffers.
+For proper results, multiple filenames need to be passed on the command
+line in bottom-up order."
+ (unless noninteractive
+ (error "Use verilog-batch-auto only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (verilog-batch-execute-func `verilog-auto))
+
+(defun verilog-batch-delete-auto ()
+ "For use with --batch, perform automatic deletion as a stand-alone tool.
+This sets up the appropriate Verilog-Mode environment, deletes automatics
+with \\[verilog-delete-auto] on all command-line files, and saves the buffers."
+ (unless noninteractive
+ (error "Use verilog-batch-delete-auto only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (verilog-batch-execute-func `verilog-delete-auto))
+
+(defun verilog-batch-inject-auto ()
+ "For use with --batch, perform automatic injection as a stand-alone tool.
+This sets up the appropriate Verilog-Mode environment, injects new automatics
+with \\[verilog-inject-auto] on all command-line files, and saves the buffers.
+For proper results, multiple filenames need to be passed on the command
+line in bottom-up order."
+ (unless noninteractive
+ (error "Use verilog-batch-inject-auto only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (verilog-batch-execute-func `verilog-inject-auto))
+
+(defun verilog-batch-indent ()
+ "For use with --batch, reindent an a entire file as a stand-alone tool.
+This sets up the appropriate Verilog-Mode environment, calls
+\\[verilog-indent-buffer] on all command-line files, and saves the buffers."
+ (unless noninteractive
+ (error "Use verilog-batch-indent only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (verilog-batch-execute-func `verilog-indent-buffer))
+\f
+
+;;
+;; Indentation
+;;
+(defconst verilog-indent-alist
+ '((block . (+ ind verilog-indent-level))
+ (case . (+ ind verilog-case-indent))
+ (cparenexp . (+ ind verilog-indent-level))
+ (cexp . (+ ind verilog-cexp-indent))
+ (defun . verilog-indent-level-module)
+ (declaration . verilog-indent-level-declaration)
+ (directive . (verilog-calculate-indent-directive))
+ (tf . verilog-indent-level)
+ (behavioral . (+ verilog-indent-level-behavioral verilog-indent-level-module))
+ (statement . ind)
+ (cpp . 0)
+ (comment . (verilog-comment-indent))
+ (unknown . 3)
+ (string . 0)))
+
+(defun verilog-continued-line-1 (lim)
+ "Return true if this is a continued line.
+Set point to where line starts. Limit search to point LIM."
+ (let ((continued 't))
+ (if (eq 0 (forward-line -1))
+ (progn
+ (end-of-line)
+ (verilog-backward-ws&directives lim)
+ (if (bobp)
+ (setq continued nil)
+ (setq continued (verilog-backward-token))))
+ (setq continued nil))
+ continued))
+
+(defun verilog-calculate-indent ()
+ "Calculate the indent of the current Verilog line.
+Examine previous lines. Once a line is found that is definitive as to the
+type of the current line, return that lines' indent level and its
+type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
+ (save-excursion
+ (let* ((starting_position (point))
+ (par 0)
+ (begin (looking-at "[ \t]*begin\\>"))
+ (lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)" nil t)))
+ (type (catch 'nesting
+ ;; Keep working backwards until we can figure out
+ ;; what type of statement this is.
+ ;; Basically we need to figure out
+ ;; 1) if this is a continuation of the previous line;
+ ;; 2) are we in a block scope (begin..end)
+
+ ;; if we are in a comment, done.
+ (if (verilog-in-star-comment-p)
+ (throw 'nesting 'comment))
+
+ ;; if we have a directive, done.
+ (if (save-excursion (beginning-of-line) (looking-at verilog-directive-re-1))
+ (throw 'nesting 'directive))
+
+ ;; if we are in a parenthesized list, and the user likes to indent these, return.
+ (if (verilog-in-paren)
+ (if verilog-indent-lists
+ (progn (setq par 1)
+ (throw 'nesting 'block))
+ ()
+ )
+ )
+
+ ;; See if we are continuing a previous line
+ (while t
+ ;; trap out if we crawl off the top of the buffer
+ (if (bobp) (throw 'nesting 'cpp))
+
+ (if (verilog-continued-line-1 lim)
+ (let ((sp (point)))
+ (if (and
+ (not (looking-at verilog-complete-reg))
+ (verilog-continued-line-1 lim))
+ (progn (goto-char sp)
+ (throw 'nesting 'cexp))
+
+ (goto-char sp))
+
+ (if (and begin
+ (not verilog-indent-begin-after-if)
+ (looking-at verilog-no-indent-begin-re))
+ (progn
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (throw 'nesting 'statement))
+ (progn
+ (throw 'nesting 'cexp))))
+ ;; not a continued line
+ (goto-char starting_position))
+
+ (if (looking-at "\\<else\\>")
+ ;; search back for governing if, striding across begin..end pairs
+ ;; appropriately
+ (let ((elsec 1))
+ (while (verilog-re-search-backward verilog-ends-re nil 'move)
+ (cond
+ ((match-end 1) ; else, we're in deep
+ (setq elsec (1+ elsec)))
+ ((match-end 2) ; if
+ (setq elsec (1- elsec))
+ (if (= 0 elsec)
+ (if verilog-align-ifelse
+ (throw 'nesting 'statement)
+ (progn ;; back up to first word on this line
+ (beginning-of-line)
+ (verilog-forward-syntactic-ws)
+ (throw 'nesting 'statement)))))
+ (t ; endblock
+ ; try to leap back to matching outward block by striding across
+ ; indent level changing tokens then immediately
+ ; previous line governs indentation.
+ (let (( reg) (nest 1))
+;; verilog-ends => else|if|end|join(_any|_none|)|endcase|endclass|endtable|endspecify|endfunction|endtask|endgenerate|endgroup
+ (cond
+ ((match-end 3) ; end
+ ;; Search back for matching begin
+ (setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" ))
+ ((match-end 4) ; endcase
+ ;; Search back for matching case
+ (setq reg "\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" ))
+ ((match-end 5) ; endfunction
+ ;; Search back for matching function
+ (setq reg "\\(\\<function\\>\\)\\|\\(\\<endfunction\\>\\)" ))
+ ((match-end 6) ; endtask
+ ;; Search back for matching task
+ (setq reg "\\(\\<task\\>\\)\\|\\(\\<endtask\\>\\)" ))
+ ((match-end 7) ; endspecify
+ ;; Search back for matching specify
+ (setq reg "\\(\\<specify\\>\\)\\|\\(\\<endspecify\\>\\)" ))
+ ((match-end 8) ; endtable
+ ;; Search back for matching table
+ (setq reg "\\(\\<table\\>\\)\\|\\(\\<endtable\\>\\)" ))
+ ((match-end 9) ; endgenerate
+ ;; Search back for matching generate
+ (setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" ))
+ ((match-end 10) ; joins
+ ;; Search back for matching fork
+ (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|none\\)?\\>\\)" ))
+ ((match-end 11) ; class
+ ;; Search back for matching class
+ (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" ))
+ ((match-end 12) ; covergroup
+ ;; Search back for matching covergroup
+ (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" ))
+ )
+ (catch 'skip
+ (while (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 1) ; begin
+ (setq nest (1- nest))
+ (if (= 0 nest)
+ (throw 'skip 1)))
+ ((match-end 2) ; end
+ (setq nest (1+ nest)))))
+ )
+ ))
+ ))))
+ (throw 'nesting (verilog-calc-1))
+ )
+ );; catch nesting
+ );; type
+ )
+ ;; Return type of block and indent level.
+ (if (not type)
+ (setq type 'cpp))
+ (if (> par 0) ; Unclosed Parenthesis
+ (list 'cparenexp par)
+ (cond
+ ((eq type 'case)
+ (list type (verilog-case-indent-level)))
+ ((eq type 'statement)
+ (list type (current-column)))
+ ((eq type 'defun)
+ (list type 0))
+ (t
+ (list type (verilog-current-indent-level)))))
+ )))
+(defun verilog-wai ()
+ "Show matching nesting block for debugging."
+ (interactive)
+ (save-excursion
+ (let ((nesting (verilog-calc-1)))
+ (message "You are at nesting %s" nesting))))
+
+(defun verilog-calc-1 ()
+ (catch 'nesting
+ (while (verilog-re-search-backward verilog-indent-re nil 'move)
+ (cond
+ ((looking-at verilog-beg-block-re-ordered)
+ (cond
+ ((match-end 2) (throw 'nesting 'case))
+ ;; need to conside typedef struct here...
+ ((looking-at "\\<class\\|struct\\|function\\|task\\|property\\>")
+ ; *sigh* These words have an optional prefix:
+ ; extern {virtual|protected}? function a();
+ ; assert property (p_1);
+ ; typedef class foo;
+ ; and we don't want to confuse this with
+ ; function a();
+ ; property
+ ; ...
+ ; endfunction
+ (let ((here (point)))
+ (save-excursion
+ (verilog-beg-of-statement)
+ (if (= (point) here)
+ (throw 'nesting 'block))
+ )))
+ (t (throw 'nesting 'block))))
+
+ ((looking-at verilog-end-block-re)
+ (verilog-leap-to-head)
+ (if (verilog-in-case-region-p)
+ (progn
+ (verilog-leap-to-case-head)
+ (if (looking-at verilog-case-re)
+ (throw 'nesting 'case)))))
+
+ ((looking-at (if (verilog-in-generate-region-p)
+ verilog-defun-level-not-generate-re
+ verilog-defun-level-re))
+ (throw 'nesting 'defun))
+
+ ((looking-at verilog-cpp-level-re)
+ (throw 'nesting 'cpp))
+
+ ((bobp)
+ (throw 'nesting 'cpp))
+ ))))
+
+(defun verilog-calculate-indent-directive ()
+ "Return indentation level for directive.
+For speed, the searcher looks at the last directive, not the indent
+of the appropriate enclosing block."
+ (let ((base -1) ;; Indent of the line that determines our indentation
+ (ind 0) ;; Relative offset caused by other directives (like `endif on same line as `else)
+ )
+ ;; Start at current location, scan back for another directive
+
+ (save-excursion
+ (beginning-of-line)
+ (while (and (< base 0)
+ (verilog-re-search-backward verilog-directive-re nil t))
+ (cond ((save-excursion (skip-chars-backward " \t") (bolp))
+ (setq base (current-indentation))
+ ))
+ (cond ((and (looking-at verilog-directive-end) (< base 0)) ;; Only matters when not at BOL
+ (setq ind (- ind verilog-indent-level-directive)))
+ ((and (looking-at verilog-directive-middle) (>= base 0)) ;; Only matters when at BOL
+ (setq ind (+ ind verilog-indent-level-directive)))
+ ((looking-at verilog-directive-begin)
+ (setq ind (+ ind verilog-indent-level-directive)))))
+ ;; Adjust indent to starting indent of critical line
+ (setq ind (max 0 (+ ind base))))
+
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (cond ((or (looking-at verilog-directive-middle)
+ (looking-at verilog-directive-end))
+ (setq ind (max 0 (- ind verilog-indent-level-directive))))))
+ ind))
+
+(defun verilog-leap-to-case-head ()
+ (let ((nest 1))
+ (while (/= 0 nest)
+ (verilog-re-search-backward "\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" nil 'move)
+ (cond
+ ((match-end 1)
+ (setq nest (1- nest)))
+ ((match-end 2)
+ (setq nest (1+ nest)))
+ ((bobp)
+ (ding 't)
+ (setq nest 0))))))
+
+(defun verilog-leap-to-head ()
+ "Move point to the head of this block; jump from end to matching begin,
+from endcase to matching case, and so on."
+ (let ((reg nil)
+ snest
+ (nest 1))
+ (cond
+ ((looking-at "\\<end\\>")
+ ;; 1: Search back for matching begin
+ (setq reg (concat "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|"
+ "\\(\\<endcase\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )))
+ ((looking-at "\\<endcase\\>")
+ ;; 2: Search back for matching case
+ (setq reg "\\(\\<randcase\\>\\|\\<case[xz]?\\>\\)\\|\\(\\<endcase\\>\\)" ))
+ ((looking-at "\\<join\\(_any\\|_none\\)?\\>")
+ ;; 3: Search back for matching fork
+ (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" ))
+ ((looking-at "\\<endclass\\>")
+ ;; 4: Search back for matching class
+ (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" ))
+ ((looking-at "\\<endtable\\>")
+ ;; 5: Search back for matching table
+ (setq reg "\\(\\<table\\>\\)\\|\\(\\<endtable\\>\\)" ))
+ ((looking-at "\\<endspecify\\>")
+ ;; 6: Search back for matching specify
+ (setq reg "\\(\\<specify\\>\\)\\|\\(\\<endspecify\\>\\)" ))
+ ((looking-at "\\<endfunction\\>")
+ ;; 7: Search back for matching function
+ (setq reg "\\(\\<function\\>\\)\\|\\(\\<endfunction\\>\\)" ))
+ ((looking-at "\\<endgenerate\\>")
+ ;; 8: Search back for matching generate
+ (setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" ))
+ ((looking-at "\\<endtask\\>")
+ ;; 9: Search back for matching task
+ (setq reg "\\(\\<task\\>\\)\\|\\(\\<endtask\\>\\)" ))
+ ((looking-at "\\<endgroup\\>")
+ ;; 10: Search back for matching covergroup
+ (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" ))
+ ((looking-at "\\<endproperty\\>")
+ ;; 11: Search back for matching property
+ (setq reg "\\(\\<property\\>\\)\\|\\(\\<endproperty\\>\\)" ))
+ ((looking-at "\\<endinterface\\>")
+ ;; 12: Search back for matching interface
+ (setq reg "\\(\\<interface\\>\\)\\|\\(\\<endinterface\\>\\)" ))
+ ((looking-at "\\<endsequence\\>")
+ ;; 12: Search back for matching interface
+ (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" ))
+ )
+ (if reg
+ (catch 'skip
+ (let (sreg)
+ (while (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 1) ; begin
+ (setq nest (1- nest))
+ (if (= 0 nest)
+ ;; Now previous line describes syntax
+ (throw 'skip 1))
+ (if (and snest
+ (= snest nest))
+ (setq reg sreg)))
+ ((match-end 2) ; end
+ (setq nest (1+ nest)))
+ ((match-end 3)
+ ;; endcase, jump to case
+ (setq snest nest)
+ (setq nest (1+ nest))
+ (setq sreg reg)
+ (setq reg "\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" ))
+ ((match-end 4)
+ ;; join, jump to fork
+ (setq snest nest)
+ (setq nest (1+ nest))
+ (setq sreg reg)
+ (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" ))
+ )))))))
+
+(defun verilog-continued-line ()
+ "Return true if this is a continued line.
+Set point to where line starts"
+ (let ((continued 't))
+ (if (eq 0 (forward-line -1))
+ (progn
+ (end-of-line)
+ (verilog-backward-ws&directives)
+ (if (bobp)
+ (setq continued nil)
+ (while (and continued
+ (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp))))
+ (setq continued (verilog-backward-token))
+ ) ;; while
+ ))
+ (setq continued nil))
+ continued))
+
+(defun verilog-backward-token ()
+ "Step backward token, returning true if we are now at an end of line token."
+ (verilog-backward-syntactic-ws)
+ (cond
+ ((bolp)
+ nil)
+ (;-- Anything ending in a ; is complete
+ (= (preceding-char) ?\;)
+ nil)
+ (;-- constraint foo { a = b }
+ ; is a complete statement. *sigh*
+ (= (preceding-char) ?\})
+ (progn
+ (backward-char)
+ (backward-up-list 1)
+ (verilog-backward-syntactic-ws)
+ (forward-word -1) ; label for the (possible) constraint
+ (verilog-backward-syntactic-ws)
+ (forward-word -1)
+ (not (looking-at "\\<constraint\\>")))
+ )
+ (;-- Could be 'case (foo)' or 'always @(bar)' which is complete
+ ; also could be simply '@(foo)'
+ ; or foo u1 #(a=8)
+ ; (b, ... which ISN'T complete
+ ;;;; Do we need this???
+ (= (preceding-char) ?\))
+ (progn
+ (backward-char)
+ (backward-up-list 1)
+ (verilog-backward-syntactic-ws)
+ (let ((back (point)))
+ (forward-word -1)
+ (cond
+ ((looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|case\\(\\|[xz]\\)\\|for\\(\\|ever\\)\\|i\\(f\\|nitial\\)\\|repeat\\|while\\)\\>")
+ (not (looking-at "\\<randcase\\>\\|\\<case[xz]?\\>[^:]")))
+ (t
+ (goto-char back)
+ (cond
+ ((= (preceding-char) ?\@)
+ (backward-char)
+ (save-excursion
+ (verilog-backward-token)
+ (not (looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|initial\\|while\\)\\>"))))
+ ((= (preceding-char) ?\#)
+ t)
+ (t t))
+ )))))
+
+ (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete
+ t
+ (forward-word -1)
+ (cond
+ ((looking-at "\\(else\\)\\|\\(initial\\>\\)\\|\\(always\\(_latch\\|_ff\\|_comb\\)?\\>\\)")
+ t)
+ ((looking-at verilog-indent-re)
+ nil)
+ (t
+ (let
+ ((back (point)))
+ (verilog-backward-syntactic-ws)
+ (cond
+ ((= (preceding-char) ?\:)
+ (backward-char)
+ (verilog-backward-syntactic-ws)
+ (backward-sexp)
+ (if (looking-at verilog-nameable-item-re )
+ nil
+ t)
+ )
+ ((= (preceding-char) ?\#)
+ (backward-char)
+ t)
+ ((= (preceding-char) ?\`)
+ (backward-char)
+ t)
+
+ (t
+ (goto-char back)
+ t)
+ )))))))
+
+(defun verilog-backward-syntactic-ws (&optional bound)
+ "Backward skip over syntactic whitespace for Emacs 19.
+Optional BOUND limits search."
+ (save-restriction
+ (let* ((bound (or bound (point-min))) (here bound) )
+ (if (< bound (point))
+ (progn
+ (narrow-to-region bound (point))
+ (while (/= here (point))
+ (setq here (point))
+ (verilog-skip-backward-comments)
+ )))
+ ))
+ t)
+
+(defun verilog-forward-syntactic-ws (&optional bound)
+ "Forward skip over syntactic whitespace for Emacs 19.
+Optional BOUND limits search."
+ (save-restriction
+ (let* ((bound (or bound (point-max)))
+ (here bound)
+ )
+ (if (> bound (point))
+ (progn
+ (narrow-to-region (point) bound)
+ (while (/= here (point))
+ (setq here (point))
+ (forward-comment (buffer-size))
+ )))
+ )))
+
+(defun verilog-backward-ws&directives (&optional bound)
+ "Backward skip over syntactic whitespace and compiler directives for Emacs 19.
+Optional BOUND limits search."
+ (save-restriction
+ (let* ((bound (or bound (point-min)))
+ (here bound)
+ (p nil) )
+ (if (< bound (point))
+ (progn
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (cond
+ ((nth 7 state) ;; in // comment
+ (verilog-re-search-backward "//" nil 'move)
+ (skip-chars-backward "/"))
+ ((nth 4 state) ;; in /* */ comment
+ (verilog-re-search-backward "/\*" nil 'move))))
+ (narrow-to-region bound (point))
+ (while (/= here (point))
+ (setq here (point))
+ (verilog-skip-backward-comments)
+ (setq p
+ (save-excursion
+ (beginning-of-line)
+ (cond
+ ((verilog-within-translate-off)
+ (verilog-back-to-start-translate-off (point-min)))
+ ((looking-at verilog-directive-re-1)
+ (point))
+ (t
+ nil))))
+ (if p (goto-char p))
+ )))
+ )))
+
+(defun verilog-forward-ws&directives (&optional bound)
+ "Forward skip over syntactic whitespace and compiler directives for Emacs 19.
+Optional BOUND limits search."
+ (save-restriction
+ (let* ((bound (or bound (point-max)))
+ (here bound)
+ jump
+ )
+ (if (> bound (point))
+ (progn
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (cond
+ ((nth 7 state) ;; in // comment
+ (verilog-re-search-forward "//" nil 'move))
+ ((nth 4 state) ;; in /* */ comment
+ (verilog-re-search-forward "/\*" nil 'move))))
+ (narrow-to-region (point) bound)
+ (while (/= here (point))
+ (setq here (point)
+ jump nil)
+ (forward-comment (buffer-size))
+ (save-excursion
+ (beginning-of-line)
+ (if (looking-at verilog-directive-re-1)
+ (setq jump t)))
+ (if jump
+ (beginning-of-line 2))
+ )))
+ )))
+
+(defun verilog-in-comment-p ()
+ "Return true if in a star or // comment."
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (or (nth 4 state) (nth 7 state))))
+
+(defun verilog-in-star-comment-p ()
+ "Return true if in a star comment."
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (and
+ (nth 4 state) ; t if in a comment of style a // or b /**/
+ (not
+ (nth 7 state) ; t if in a comment of style b /**/
+ ))))
+
+(defun verilog-in-slash-comment-p ()
+ "Return true if in a slash comment."
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (nth 7 state)))
+
+(defun verilog-in-comment-or-string-p ()
+ "Return true if in a string or comment."
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (or (nth 3 state) (nth 4 state) (nth 7 state)))) ; Inside string or comment)
+
+(defun verilog-in-escaped-name-p ()
+ "Return true if in an escaped name."
+ (save-excursion
+ (backward-char)
+ (skip-chars-backward "^ \t\n\f")
+ (if (= (char-after (point) ) ?\\ )
+ t
+ nil)))
+
+(defun verilog-in-paren ()
+ "Return true if in a parenthetical expression."
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (/= 0 (nth 0 state))))
+
+(defun verilog-parenthesis-depth ()
+ "Return non zero if in parenthetical-expression."
+ (save-excursion
+ (nth 1 (parse-partial-sexp (point-min) (point)))))
+
+
+(defun verilog-skip-forward-comment-or-string ()
+ "Return true if in a string or comment."
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (cond
+ ((nth 3 state) ;Inside string
+ (goto-char (nth 3 state))
+ t)
+ ((nth 7 state) ;Inside // comment
+ (forward-line 1)
+ t)
+ ((nth 4 state) ;Inside any comment (hence /**/)
+ (search-forward "*/"))
+ (t
+ nil))))
+
+(defun verilog-skip-backward-comment-or-string ()
+ "Return true if in a string or comment."
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (cond
+ ((nth 3 state) ;Inside string
+ (search-backward "\"")
+ t)
+ ((nth 7 state) ;Inside // comment
+ (search-backward "//")
+ (skip-chars-backward "/")
+ t)
+ ((nth 4 state) ;Inside /* */ comment
+ (search-backward "/*")
+ t)
+ (t
+ nil))))
+
+(defun verilog-skip-backward-comments ()
+ "Return true if a comment was skipped."
+ (let ((more t))
+ (while more
+ (setq more
+ (let ((state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (cond
+ ((nth 7 state) ;Inside // comment
+ (search-backward "//")
+ (skip-chars-backward "/")
+ (skip-chars-backward " \t\n\f")
+ t)
+ ((nth 4 state) ;Inside /* */ comment
+ (search-backward "/*")
+ (skip-chars-backward " \t\n\f")
+ t)
+ ((and (not (bobp))
+ (= (char-before) ?\/)
+ (= (char-before (1- (point))) ?\*)
+ )
+ (goto-char (- (point) 2))
+ t)
+ (t
+ (skip-chars-backward " \t\n\f")
+ nil)))))))
+
+(defun verilog-skip-forward-comment-p ()
+ "If in comment, move to end and return true."
+ (let (state)
+ (progn
+ (setq state
+ (save-excursion
+ (parse-partial-sexp (point-min) (point))))
+ (cond
+ ((nth 3 state)
+ t)
+ ((nth 7 state) ;Inside // comment
+ (end-of-line)
+ (forward-char 1)
+ t)
+ ((nth 4 state) ;Inside any comment
+ t)
+ (t
+ nil)))))
+
+(defun verilog-indent-line-relative ()
+ "Cheap version of indent line.
+Only look at a few lines to determine indent level."
+ (interactive)
+ (let ((indent-str)
+ (sp (point)))
+ (if (looking-at "^[ \t]*$")
+ (cond ;- A blank line; No need to be too smart.
+ ((bobp)
+ (setq indent-str (list 'cpp 0)))
+ ((verilog-continued-line)
+ (let ((sp1 (point)))
+ (if (verilog-continued-line)
+ (progn (goto-char sp)
+ (setq indent-str (list 'statement (verilog-current-indent-level))))
+ (goto-char sp1)
+ (setq indent-str (list 'block (verilog-current-indent-level)))))
+ (goto-char sp))
+ ((goto-char sp)
+ (setq indent-str (verilog-calculate-indent))))
+ (progn (skip-chars-forward " \t")
+ (setq indent-str (verilog-calculate-indent))))
+ (verilog-do-indent indent-str)))
+
+(defun verilog-indent-line ()
+ "Indent for special part of code."
+ (verilog-do-indent (verilog-calculate-indent)))
+
+(defun verilog-do-indent (indent-str)
+ (let ((type (car indent-str))
+ (ind (car (cdr indent-str))))
+ (cond
+ (; handle continued exp
+ (eq type 'cexp)
+ (let ((here (point)))
+ (verilog-backward-syntactic-ws)
+ (cond
+ ((or
+ (= (preceding-char) ?\,)
+ (= (preceding-char) ?\])
+ (save-excursion
+ (verilog-beg-of-statement-1)
+ (looking-at verilog-declaration-re)))
+ (let* ( fst
+ (val
+ (save-excursion
+ (backward-char 1)
+ (verilog-beg-of-statement-1)
+ (setq fst (point))
+ (if (looking-at verilog-declaration-re)
+ (progn ;; we have multiple words
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (cond
+ ((and verilog-indent-declaration-macros
+ (= (following-char) ?\`))
+ (progn
+ (forward-char 1)
+ (forward-word 1)
+ (skip-chars-forward " \t")))
+ ((= (following-char) ?\[)
+ (progn
+ (forward-char 1)
+ (backward-up-list -1)
+ (skip-chars-forward " \t")))
+ )
+ (current-column))
+ (progn
+ (goto-char fst)
+ (+ (current-column) verilog-cexp-indent))
+ ))))
+ (goto-char here)
+ (indent-line-to val))
+ )
+ ((= (preceding-char) ?\) )
+ (goto-char here)
+ (let ((val (eval (cdr (assoc type verilog-indent-alist)))))
+ (indent-line-to val)))
+ (t
+ (goto-char here)
+ (let ((val))
+ (verilog-beg-of-statement-1)
+ (if (and (< (point) here)
+ (verilog-re-search-forward "=[ \\t]*" here 'move))
+ (setq val (current-column))
+ (setq val (eval (cdr (assoc type verilog-indent-alist)))))
+ (goto-char here)
+ (indent-line-to val)))
+ )))
+
+ (; handle inside parenthetical expressions
+ (eq type 'cparenexp)
+ (let ((val (save-excursion
+ (backward-up-list 1)
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (current-column))))
+ (indent-line-to val)
+ (if (and (not (verilog-in-struct-region-p))
+ (looking-at verilog-declaration-re))
+ (verilog-indent-declaration ind))
+ ))
+
+ (;-- Handle the ends
+ (looking-at verilog-end-block-re )
+ (let ((val (if (eq type 'statement)
+ (- ind verilog-indent-level)
+ ind)))
+ (indent-line-to val)))
+
+ (;-- Case -- maybe line 'em up
+ (and (eq type 'case) (not (looking-at "^[ \t]*$")))
+ (progn
+ (cond
+ ((looking-at "\\<endcase\\>")
+ (indent-line-to ind))
+ (t
+ (let ((val (eval (cdr (assoc type verilog-indent-alist)))))
+ (indent-line-to val))))))
+
+ (;-- defun
+ (and (eq type 'defun)
+ (looking-at verilog-zero-indent-re))
+ (indent-line-to 0))
+
+ (;-- declaration
+ (and (or
+ (eq type 'defun)
+ (eq type 'block))
+ (looking-at verilog-declaration-re))
+ (verilog-indent-declaration ind))
+
+ (;-- Everything else
+ t
+ (let ((val (eval (cdr (assoc type verilog-indent-alist)))))
+ (indent-line-to val)))
+ )
+ (if (looking-at "[ \t]+$")
+ (skip-chars-forward " \t"))
+ indent-str ; Return indent data
+ ))
+
+(defun verilog-current-indent-level ()
+ "Return the indent-level the current statement has."
+ (save-excursion
+ (let (par-pos)
+ (beginning-of-line)
+ (setq par-pos (verilog-parenthesis-depth))
+ (while par-pos
+ (goto-char par-pos)
+ (beginning-of-line)
+ (setq par-pos (verilog-parenthesis-depth)))
+ (skip-chars-forward " \t")
+ (current-column))))
+
+(defun verilog-case-indent-level ()
+ "Return the indent-level the current statement has.
+Do not count named blocks or case-statements."
+ (save-excursion
+ (skip-chars-forward " \t")
+ (cond
+ ((looking-at verilog-named-block-re)
+ (current-column))
+ ((and (not (looking-at verilog-case-re))
+ (looking-at "^[^:;]+[ \t]*:"))
+ (verilog-re-search-forward ":" nil t)
+ (skip-chars-forward " \t")
+ (current-column))
+ (t
+ (current-column)))))
+
+(defun verilog-indent-comment ()
+ "Indent current line as comment."
+ (let* ((stcol
+ (cond
+ ((verilog-in-star-comment-p)
+ (save-excursion
+ (re-search-backward "/\\*" nil t)
+ (1+(current-column))))
+ (comment-column
+ comment-column )
+ (t
+ (save-excursion
+ (re-search-backward "//" nil t)
+ (current-column)))
+ )))
+ (indent-line-to stcol)
+ stcol))
+
+(defun verilog-more-comment ()
+ "Make more comment lines like the previous."
+ (let* ((star 0)
+ (stcol
+ (cond
+ ((verilog-in-star-comment-p)
+ (save-excursion
+ (setq star 1)
+ (re-search-backward "/\\*" nil t)
+ (1+(current-column))))
+ (comment-column
+ comment-column )
+ (t
+ (save-excursion
+ (re-search-backward "//" nil t)
+ (current-column)))
+ )))
+ (progn
+ (indent-to stcol)
+ (if (and star
+ (save-excursion
+ (forward-line -1)
+ (skip-chars-forward " \t")
+ (looking-at "\*")))
+ (insert "* ")))))
+
+(defun verilog-comment-indent (&optional arg)
+ "Return the column number the line should be indented to.
+ARG is ignored, for `comment-indent-function' compatibility."
+ (cond
+ ((verilog-in-star-comment-p)
+ (save-excursion
+ (re-search-backward "/\\*" nil t)
+ (1+(current-column))))
+ ( comment-column
+ comment-column )
+ (t
+ (save-excursion
+ (re-search-backward "//" nil t)
+ (current-column)))))
+
+;;
+
+(defun verilog-pretty-declarations ()
+ "Line up declarations around point."
+ (interactive)
+ (save-excursion
+ (if (progn
+ (verilog-beg-of-statement-1)
+ (looking-at verilog-declaration-re))
+ (let* ((m1 (make-marker))
+ (e) (r)
+ (here (point))
+ (start
+ (progn
+ (verilog-beg-of-statement-1)
+ (while (looking-at verilog-declaration-re)
+ (beginning-of-line)
+ (setq e (point))
+ (verilog-backward-syntactic-ws)
+ (backward-char)
+ (verilog-beg-of-statement-1)) ;Ack, need to grok `define
+ e))
+ (end
+ (progn
+ (goto-char here)
+ (verilog-end-of-statement)
+ (setq e (point)) ;Might be on last line
+ (verilog-forward-syntactic-ws)
+ (while (looking-at verilog-declaration-re)
+ (beginning-of-line)
+ (verilog-end-of-statement)
+ (setq e (point))
+ (verilog-forward-syntactic-ws))
+ e))
+ (edpos (set-marker (make-marker) end))
+ (ind)
+ (base-ind
+ (progn
+ (goto-char start)
+ (verilog-do-indent (verilog-calculate-indent))
+ (verilog-forward-ws&directives)
+ (current-column)))
+ )
+ (goto-char end)
+ (goto-char start)
+ (if (> (- end start) 100)
+ (message "Lining up declarations..(please stand by)"))
+ ;; Get the beginning of line indent first
+ (while (progn (setq e (marker-position edpos))
+ (< (point) e))
+ (cond
+ ( (save-excursion (skip-chars-backward " \t")
+ (bolp))
+ (verilog-forward-ws&directives)
+ (indent-line-to base-ind)
+ (verilog-forward-ws&directives)
+ (verilog-re-search-forward "[ \t\n\f]" e 'move)
+ )
+ (t
+ (just-one-space)
+ (verilog-re-search-forward "[ \t\n\f]" e 'move)
+ )
+ )
+ )
+ ;;(forward-line))
+ ;; Now find biggest prefix
+ (setq ind (verilog-get-lineup-indent start edpos))
+ ;; Now indent each line.
+ (goto-char start)
+ (while (progn (setq e (marker-position edpos))
+ (setq r (- e (point)))
+ (> r 0))
+ (setq e (point))
+ (message "%d" r)
+ (cond
+ ((or (and verilog-indent-declaration-macros
+ (looking-at verilog-declaration-re-1-macro))
+ (looking-at verilog-declaration-re-1-no-macro))
+ (let ((p (match-end 0)))
+ (set-marker m1 p)
+ (if (verilog-re-search-forward "[[#`]" p 'move)
+ (progn
+ (forward-char -1)
+ (just-one-space)
+ (goto-char (marker-position m1))
+ (just-one-space)
+ (indent-to ind))
+ (progn
+ (just-one-space)
+ (indent-to ind))
+ )))
+ ((verilog-continued-line-1 start)
+ (goto-char e)
+ (indent-line-to ind))
+ (t ; Must be comment or white space
+ (goto-char e)
+ (verilog-forward-ws&directives)
+ (forward-line -1))
+ )
+ (forward-line 1))
+ (message "")))))
+
+(defun verilog-pretty-expr (&optional myre)
+ "Line up expressions around point."
+ (interactive "sRegular Expression: (<?=) ")
+ (save-excursion
+ (if (or (eq myre nil)
+ (string-equal myre ""))
+ (setq myre "<="))
+ (setq myre (concat "\\(^[^;" myre "]*\\)\\([" myre "]\\)"))
+ (beginning-of-line)
+ (if (and (not (looking-at (concat "^\\s-*" verilog-complete-reg)))
+ (looking-at myre))
+ (let* ((here (point))
+ (e) (r)
+ (start
+ (progn
+ (beginning-of-line)
+ (setq e (point))
+ (verilog-backward-syntactic-ws)
+ (beginning-of-line)
+ (while (and (not(looking-at (concat "^\\s-*" verilog-complete-reg)))
+ (looking-at myre))
+ (setq e (point))
+ (verilog-backward-syntactic-ws)
+ (beginning-of-line)
+ ) ;Ack, need to grok `define
+ e))
+ (end
+ (progn
+ (goto-char here)
+ (end-of-line)
+ (setq e (point)) ;Might be on last line
+ (verilog-forward-syntactic-ws)
+ (beginning-of-line)
+ (while (and (not(looking-at (concat "^\\s-*" verilog-complete-reg)))
+ (looking-at myre))
+ (end-of-line)
+ (setq e (point))
+ (verilog-forward-syntactic-ws)
+ (beginning-of-line)
+ )
+ e))
+ (edpos (set-marker (make-marker) end))
+ (ind)
+ )
+ (goto-char start)
+ (verilog-do-indent (verilog-calculate-indent))
+ (if (> (- end start) 100)
+ (message "Lining up expressions..(please stand by)"))
+
+ ;; Set indent to minimum throughout region
+ (while (< (point) (marker-position edpos))
+ (beginning-of-line)
+ (verilog-just-one-space myre)
+ (end-of-line)
+ (verilog-forward-syntactic-ws)
+ )
+
+ ;; Now find biggest prefix
+ (setq ind (verilog-get-lineup-indent-2 myre start edpos))
+
+ ;; Now indent each line.
+ (goto-char start)
+ (while (progn (setq e (marker-position edpos))
+ (setq r (- e (point)))
+ (> r 0))
+ (setq e (point))
+ (message "%d" r)
+ (cond
+ ((looking-at myre)
+ (goto-char (match-end 1))
+ (if (eq (char-after) ?=)
+ (indent-to (1+ ind)) ; line up the = of the <= with surrounding =
+ (indent-to ind)
+ )
+ )
+ ((verilog-continued-line-1 start)
+ (goto-char e)
+ (indent-line-to ind))
+ (t ; Must be comment or white space
+ (goto-char e)
+ (verilog-forward-ws&directives)
+ (forward-line -1))
+ )
+ (forward-line 1))
+ (message "")
+ ))))
+
+(defun verilog-just-one-space (myre)
+ "Remove extra spaces around regular expression MYRE."
+ (interactive)
+ (if (and (not(looking-at verilog-complete-reg))
+ (looking-at myre))
+ (let ((p1 (match-end 1))
+ (p2 (match-end 2)))
+ (progn
+ (goto-char p2)
+ (if (looking-at "\\s-") (just-one-space) )
+ (goto-char p1)
+ (forward-char -1)
+ (if (looking-at "\\s-") (just-one-space))
+ )
+ ))
+ (message ""))
+
+(defun verilog-indent-declaration (baseind)
+ "Indent current lines as declaration.
+Line up the variable names based on previous declaration's indentation.
+BASEIND is the base indent to offset everything."
+ (interactive)
+ (let ((pos (point-marker))
+ (lim (save-excursion
+ ;; (verilog-re-search-backward verilog-declaration-opener nil 'move)
+ (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)\\|\\(\\<task\\>\\)" nil 'move)
+ (point)))
+ (ind)
+ (val)
+ (m1 (make-marker))
+ )
+ (setq val (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist)))))
+ (indent-line-to val)
+
+ ;; Use previous declaration (in this module) as template.
+ (if (or (memq 'all verilog-auto-lineup)
+ (memq 'declaration verilog-auto-lineup))
+ (if (verilog-re-search-backward (or (and verilog-indent-declaration-macros
+ verilog-declaration-re-1-macro)
+ verilog-declaration-re-1-no-macro) lim t)
+ (progn
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (setq ind (current-column))
+ (goto-char pos)
+ (setq val (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist)))))
+ (indent-line-to val)
+ (if (and verilog-indent-declaration-macros
+ (looking-at verilog-declaration-re-2-macro))
+ (let ((p (match-end 0)))
+ (set-marker m1 p)
+ (if (verilog-re-search-forward "[[#`]" p 'move)
+ (progn
+ (forward-char -1)
+ (just-one-space)
+ (goto-char (marker-position m1))
+ (just-one-space)
+ (indent-to ind)
+ )
+ (if (/= (current-column) ind)
+ (progn
+ (just-one-space)
+ (indent-to ind))
+ )))
+ (if (looking-at verilog-declaration-re-2-no-macro)
+ (let ((p (match-end 0)))
+ (set-marker m1 p)
+ (if (verilog-re-search-forward "[[`#]" p 'move)
+ (progn
+ (forward-char -1)
+ (just-one-space)
+ (goto-char (marker-position m1))
+ (just-one-space)
+ (indent-to ind))
+ (if (/= (current-column) ind)
+ (progn
+ (just-one-space)
+ (indent-to ind))
+ )))
+ )))
+ )
+ )
+ (goto-char pos)
+ )
+ )
+
+(defun verilog-get-lineup-indent (b edpos)
+ "Return the indent level that will line up several lines within the region.
+Region is defined by B and EDPOS."
+ (save-excursion
+ (let ((ind 0) e)
+ (goto-char b)
+ ;; Get rightmost position
+ (while (progn (setq e (marker-position edpos))
+ (< (point) e))
+ (if (verilog-re-search-forward (or (and verilog-indent-declaration-macros
+ verilog-declaration-re-1-macro)
+ verilog-declaration-re-1-no-macro) e 'move)
+ (progn
+ (goto-char (match-end 0))
+ (verilog-backward-syntactic-ws)
+ (if (> (current-column) ind)
+ (setq ind (current-column)))
+ (goto-char (match-end 0)))))
+ (if (> ind 0)
+ (1+ ind)
+ ;; No lineup-string found
+ (goto-char b)
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (1+ (current-column))))))
+
+(defun verilog-get-lineup-indent-2 (myre b edpos)
+ "Return the indent level that will line up several lines within the region."
+ (save-excursion
+ (let ((ind 0) e)
+ (goto-char b)
+ ;; Get rightmost position
+ (while (progn (setq e (marker-position edpos))
+ (< (point) e))
+ (if (verilog-re-search-forward myre e 'move)
+ (progn
+ (goto-char (match-end 0))
+ (verilog-backward-syntactic-ws)
+ (if (> (current-column) ind)
+ (setq ind (current-column)))
+ (goto-char (match-end 0)))))
+ (if (> ind 0)
+ (1+ ind)
+ ;; No lineup-string found
+ (goto-char b)
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (1+ (current-column))))))
+
+(defun verilog-comment-depth (type val)
+ "A useful mode debugging aide. TYPE and VAL are comments for insertion."
+ (save-excursion
+ (let
+ ((b (prog2
+ (beginning-of-line)
+ (point-marker)
+ (end-of-line)))
+ (e (point-marker)))
+ (if (re-search-backward " /\\* \[#-\]# \[a-zA-Z\]+ \[0-9\]+ ## \\*/" b t)
+ (progn
+ (replace-match " /* -# ## */")
+ (end-of-line))
+ (progn
+ (end-of-line)
+ (insert " /* ## ## */"))))
+ (backward-char 6)
+ (insert
+ (format "%s %d" type val))))
+
+;; \f
+;;
+;; Completion
+;;
+(defvar verilog-str nil)
+(defvar verilog-all nil)
+(defvar verilog-pred nil)
+(defvar verilog-buffer-to-use nil)
+(defvar verilog-flag nil)
+(defvar verilog-toggle-completions nil
+ "*True means \\<verilog-mode-map>\\[verilog-complete-word] should try all possible completions one by one.
+Repeated use of \\[verilog-complete-word] will show you all of them.
+Normally, when there is more than one possible completion,
+it displays a list of all possible completions.")
+
+
+(defvar verilog-type-keywords
+ '(
+ "and" "buf" "bufif0" "bufif1" "cmos" "defparam" "inout" "input"
+ "integer" "localparam" "logic" "nand" "nmos" "nor" "not" "notif0"
+ "notif1" "or" "output" "parameter" "pmos" "pull0" "pull1" "pullup"
+ "rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran" "rtranif0"
+ "rtranif1" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
+ "triand" "trior" "trireg" "wand" "wire" "wor" "xnor" "xor"
+ )
+ "*Keywords for types used when completing a word in a declaration or parmlist.
+\(eg. integer, real, reg...)")
+
+(defvar verilog-cpp-keywords
+ '("module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else"
+ "endif")
+ "*Keywords to complete when at first word of a line in declarative scope.
+\(eg. initial, always, begin, assign.)
+The procedures and variables defined within the Verilog program
+will be completed runtime and should not be added to this list.")
+
+(defvar verilog-defun-keywords
+ (append
+ '(
+ "always" "always_comb" "always_ff" "always_latch" "assign"
+ "begin" "end" "generate" "endgenerate" "module" "endmodule"
+ "specify" "endspecify" "function" "endfunction" "initial" "final"
+ "task" "endtask" "primitive" "endprimitive"
+ )
+ verilog-type-keywords)
+ "*Keywords to complete when at first word of a line in declarative scope.
+\(eg. initial, always, begin, assign.)
+The procedures and variables defined within the Verilog program
+will be completed runtime and should not be added to this list.")
+
+(defvar verilog-block-keywords
+ '(
+ "begin" "break" "case" "continue" "else" "end" "endfunction"
+ "endgenerate" "endinterface" "endpackage" "endspecify" "endtask"
+ "for" "fork" "if" "join" "join_any" "join_none" "repeat" "return"
+ "while")
+ "*Keywords to complete when at first word of a line in behavioral scope.
+\(eg. begin, if, then, else, for, fork.)
+The procedures and variables defined within the Verilog program
+will be completed runtime and should not be added to this list.")
+
+(defvar verilog-tf-keywords
+ '("begin" "break" "fork" "join" "join_any" "join_none" "case" "end" "endtask" "endfunction" "if" "else" "for" "while" "repeat")
+ "*Keywords to complete when at first word of a line in a task or function.
+\(eg. begin, if, then, else, for, fork.)
+The procedures and variables defined within the Verilog program
+will be completed runtime and should not be added to this list.")
+
+(defvar verilog-case-keywords
+ '("begin" "fork" "join" "join_any" "join_none" "case" "end" "endcase" "if" "else" "for" "repeat")
+ "*Keywords to complete when at first word of a line in case scope.
+\(eg. begin, if, then, else, for, fork.)
+The procedures and variables defined within the Verilog program
+will be completed runtime and should not be added to this list.")
+
+(defvar verilog-separator-keywords
+ '("else" "then" "begin")
+ "*Keywords to complete when NOT standing at the first word of a statement.
+\(eg. else, then.)
+Variables and function names defined within the
+Verilog program are completed runtime and should not be added to this list.")
+
+(defun verilog-string-diff (str1 str2)
+ "Return index of first letter where STR1 and STR2 differs."
+ (catch 'done
+ (let ((diff 0))
+ (while t
+ (if (or (> (1+ diff) (length str1))
+ (> (1+ diff) (length str2)))
+ (throw 'done diff))
+ (or (equal (aref str1 diff) (aref str2 diff))
+ (throw 'done diff))
+ (setq diff (1+ diff))))))
+
+;; Calculate all possible completions for functions if argument is `function',
+;; completions for procedures if argument is `procedure' or both functions and
+;; procedures otherwise.
+
+(defun verilog-func-completion (type)
+ "Build regular expression for module/task/function names.
+TYPE is 'module, 'tf for task or function, or t if unknown."
+ (if (string= verilog-str "")
+ (setq verilog-str "[a-zA-Z_]"))
+ (let ((verilog-str (concat (cond
+ ((eq type 'module) "\\<\\(module\\)\\s +")
+ ((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
+ (t "\\<\\(task\\|function\\|module\\)\\s +"))
+ "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
+ match)
+
+ (if (not (looking-at verilog-defun-re))
+ (verilog-re-search-backward verilog-defun-re nil t))
+ (forward-char 1)
+
+ ;; Search through all reachable functions
+ (goto-char (point-min))
+ (while (verilog-re-search-forward verilog-str (point-max) t)
+ (progn (setq match (buffer-substring (match-beginning 2)
+ (match-end 2)))
+ (if (or (null verilog-pred)
+ (funcall verilog-pred match))
+ (setq verilog-all (cons match verilog-all)))))
+ (if (match-beginning 0)
+ (goto-char (match-beginning 0)))))
+
+(defun verilog-get-completion-decl (end)
+ "Macro for searching through current declaration (var, type or const)
+for matches of `str' and adding the occurrence tp `all' through point END."
+ (let ((re (or (and verilog-indent-declaration-macros
+ verilog-declaration-re-2-macro)
+ verilog-declaration-re-2-no-macro))
+ decl-end match)
+ ;; Traverse lines
+ (while (and (< (point) end)
+ (verilog-re-search-forward re end t))
+ ;; Traverse current line
+ (setq decl-end (save-excursion (verilog-declaration-end)))
+ (while (and (verilog-re-search-forward verilog-symbol-re decl-end t)
+ (not (match-end 1)))
+ (setq match (buffer-substring (match-beginning 0) (match-end 0)))
+ (if (string-match (concat "\\<" verilog-str) match)
+ (if (or (null verilog-pred)
+ (funcall verilog-pred match))
+ (setq verilog-all (cons match verilog-all)))))
+ (forward-line 1)
+ )
+ )
+ verilog-all
+ )
+
+(defun verilog-type-completion ()
+ "Calculate all possible completions for types."
+ (let ((start (point))
+ goon)
+ ;; Search for all reachable type declarations
+ (while (or (verilog-beg-of-defun)
+ (setq goon (not goon)))
+ (save-excursion
+ (if (and (< start (prog1 (save-excursion (verilog-end-of-defun)
+ (point))
+ (forward-char 1)))
+ (verilog-re-search-forward
+ "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
+ start t)
+ (not (match-end 1)))
+ ;; Check current type declaration
+ (verilog-get-completion-decl start))))))
+
+(defun verilog-var-completion ()
+ "Calculate all possible completions for variables (or constants)."
+ (let ((start (point)))
+ ;; Search for all reachable var declarations
+ (verilog-beg-of-defun)
+ (save-excursion
+ ;; Check var declarations
+ (verilog-get-completion-decl start))))
+
+(defun verilog-keyword-completion (keyword-list)
+ "Give list of all possible completions of keywords in KEYWORD-LIST."
+ (mapcar '(lambda (s)
+ (if (string-match (concat "\\<" verilog-str) s)
+ (if (or (null verilog-pred)
+ (funcall verilog-pred s))
+ (setq verilog-all (cons s verilog-all)))))
+ keyword-list))
+
+
+(defun verilog-completion (verilog-str verilog-pred verilog-flag)
+ "Function passed to `completing-read', `try-completion' or `all-completions'.
+Called to get completion on VERILOG-STR. If VERILOG-PRED is non-nil, it
+must be a function to be called for every match to check if this should
+really be a match. If VERILOG-FLAG is t, the function returns a list of all
+possible completions. If VERILOG-FLAG is nil it returns a string, the
+longest possible completion, or t if STR is an exact match. If VERILOG-FLAG
+is 'lambda, the function returns t if STR is an exact match, nil
+otherwise."
+ (save-excursion
+ (let ((verilog-all nil))
+ ;; Set buffer to use for searching labels. This should be set
+ ;; within functions which use verilog-completions
+ (set-buffer verilog-buffer-to-use)
+
+ ;; Determine what should be completed
+ (let ((state (car (verilog-calculate-indent))))
+ (cond ((eq state 'defun)
+ (save-excursion (verilog-var-completion))
+ (verilog-func-completion 'module)
+ (verilog-keyword-completion verilog-defun-keywords))
+
+ ((eq state 'behavioral)
+ (save-excursion (verilog-var-completion))
+ (verilog-func-completion 'module)
+ (verilog-keyword-completion verilog-defun-keywords))
+
+ ((eq state 'block)
+ (save-excursion (verilog-var-completion))
+ (verilog-func-completion 'tf)
+ (verilog-keyword-completion verilog-block-keywords))
+
+ ((eq state 'case)
+ (save-excursion (verilog-var-completion))
+ (verilog-func-completion 'tf)
+ (verilog-keyword-completion verilog-case-keywords))
+
+ ((eq state 'tf)
+ (save-excursion (verilog-var-completion))
+ (verilog-func-completion 'tf)
+ (verilog-keyword-completion verilog-tf-keywords))
+
+ ((eq state 'cpp)
+ (save-excursion (verilog-var-completion))
+ (verilog-keyword-completion verilog-cpp-keywords))
+
+ ((eq state 'cparenexp)
+ (save-excursion (verilog-var-completion)))
+
+ (t;--Anywhere else
+ (save-excursion (verilog-var-completion))
+ (verilog-func-completion 'both)
+ (verilog-keyword-completion verilog-separator-keywords))))
+
+ ;; Now we have built a list of all matches. Give response to caller
+ (verilog-completion-response))))
+
+(defun verilog-completion-response ()
+ (cond ((or (equal verilog-flag 'lambda) (null verilog-flag))
+ ;; This was not called by all-completions
+ (if (null verilog-all)
+ ;; Return nil if there was no matching label
+ nil
+ ;; Get longest string common in the labels
+ (let* ((elm (cdr verilog-all))
+ (match (car verilog-all))
+ (min (length match))
+ tmp)
+ (if (string= match verilog-str)
+ ;; Return t if first match was an exact match
+ (setq match t)
+ (while (not (null elm))
+ ;; Find longest common string
+ (if (< (setq tmp (verilog-string-diff match (car elm))) min)
+ (progn
+ (setq min tmp)
+ (setq match (substring match 0 min))))
+ ;; Terminate with match=t if this is an exact match
+ (if (string= (car elm) verilog-str)
+ (progn
+ (setq match t)
+ (setq elm nil))
+ (setq elm (cdr elm)))))
+ ;; If this is a test just for exact match, return nil ot t
+ (if (and (equal verilog-flag 'lambda) (not (equal match 't)))
+ nil
+ match))))
+ ;; If flag is t, this was called by all-completions. Return
+ ;; list of all possible completions
+ (verilog-flag
+ verilog-all)))
+
+(defvar verilog-last-word-numb 0)
+(defvar verilog-last-word-shown nil)
+(defvar verilog-last-completions nil)
+
+(defun verilog-complete-word ()
+ "Complete word at current point.
+\(See also `verilog-toggle-completions', `verilog-type-keywords',
+and `verilog-separator-keywords'.)"
+ (interactive)
+ (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
+ (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
+ (verilog-str (buffer-substring b e))
+ ;; The following variable is used in verilog-completion
+ (verilog-buffer-to-use (current-buffer))
+ (allcomp (if (and verilog-toggle-completions
+ (string= verilog-last-word-shown verilog-str))
+ verilog-last-completions
+ (all-completions verilog-str 'verilog-completion)))
+ (match (if verilog-toggle-completions
+ "" (try-completion
+ verilog-str (mapcar '(lambda (elm)
+ (cons elm 0)) allcomp)))))
+ ;; Delete old string
+ (delete-region b e)
+
+ ;; Toggle-completions inserts whole labels
+ (if verilog-toggle-completions
+ (progn
+ ;; Update entry number in list
+ (setq verilog-last-completions allcomp
+ verilog-last-word-numb
+ (if (>= verilog-last-word-numb (1- (length allcomp)))
+ 0
+ (1+ verilog-last-word-numb)))
+ (setq verilog-last-word-shown (elt allcomp verilog-last-word-numb))
+ ;; Display next match or same string if no match was found
+ (if (not (null allcomp))
+ (insert "" verilog-last-word-shown)
+ (insert "" verilog-str)
+ (message "(No match)")))
+ ;; The other form of completion does not necessarily do that.
+
+ ;; Insert match if found, or the original string if no match
+ (if (or (null match) (equal match 't))
+ (progn (insert "" verilog-str)
+ (message "(No match)"))
+ (insert "" match))
+ ;; Give message about current status of completion
+ (cond ((equal match 't)
+ (if (not (null (cdr allcomp)))
+ (message "(Complete but not unique)")
+ (message "(Sole completion)")))
+ ;; Display buffer if the current completion didn't help
+ ;; on completing the label.
+ ((and (not (null (cdr allcomp))) (= (length verilog-str)
+ (length match)))
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list allcomp))
+ ;; Wait for a key press. Then delete *Completion* window
+ (momentary-string-display "" (point))
+ (delete-window (get-buffer-window (get-buffer "*Completions*")))
+ )))))
+
+(defun verilog-show-completions ()
+ "Show all possible completions at current point."
+ (interactive)
+ (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
+ (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
+ (verilog-str (buffer-substring b e))
+ ;; The following variable is used in verilog-completion
+ (verilog-buffer-to-use (current-buffer))
+ (allcomp (if (and verilog-toggle-completions
+ (string= verilog-last-word-shown verilog-str))
+ verilog-last-completions
+ (all-completions verilog-str 'verilog-completion))))
+ ;; Show possible completions in a temporary buffer.
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list allcomp))
+ ;; Wait for a key press. Then delete *Completion* window
+ (momentary-string-display "" (point))
+ (delete-window (get-buffer-window (get-buffer "*Completions*")))))
+
+
+(defun verilog-get-default-symbol ()
+ "Return symbol around current point as a string."
+ (save-excursion
+ (buffer-substring (progn
+ (skip-chars-backward " \t")
+ (skip-chars-backward "a-zA-Z0-9_")
+ (point))
+ (progn
+ (skip-chars-forward "a-zA-Z0-9_")
+ (point)))))
+
+(defun verilog-build-defun-re (str &optional arg)
+ "Return function/task/module starting with STR as regular expression.
+With optional second ARG non-nil, STR is the complete name of the instruction."
+ (if arg
+ (concat "^\\(function\\|task\\|module\\)[ \t]+\\(" str "\\)\\>")
+ (concat "^\\(function\\|task\\|module\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>")))
+
+(defun verilog-comp-defun (verilog-str verilog-pred verilog-flag)
+ "Function passed to `completing-read', `try-completion' or `all-completions'.
+Returns a completion on any function name based on VERILOG-STR prefix. If
+VERILOG-PRED is non-nil, it must be a function to be called for every match
+to check if this should really be a match. If VERILOG-FLAG is t, the
+function returns a list of all possible completions. If it is nil it
+returns a string, the longest possible completion, or t if VERILOG-STR is
+an exact match. If VERILOG-FLAG is 'lambda, the function returns t if
+VERILOG-STR is an exact match, nil otherwise."
+ (save-excursion
+ (let ((verilog-all nil)
+ match)
+
+ ;; Set buffer to use for searching labels. This should be set
+ ;; within functions which use verilog-completions
+ (set-buffer verilog-buffer-to-use)
+
+ (let ((verilog-str verilog-str))
+ ;; Build regular expression for functions
+ (if (string= verilog-str "")
+ (setq verilog-str (verilog-build-defun-re "[a-zA-Z_]"))
+ (setq verilog-str (verilog-build-defun-re verilog-str)))
+ (goto-char (point-min))
+
+ ;; Build a list of all possible completions
+ (while (verilog-re-search-forward verilog-str nil t)
+ (setq match (buffer-substring (match-beginning 2) (match-end 2)))
+ (if (or (null verilog-pred)
+ (funcall verilog-pred match))
+ (setq verilog-all (cons match verilog-all)))))
+
+ ;; Now we have built a list of all matches. Give response to caller
+ (verilog-completion-response))))
+
+(defun verilog-goto-defun ()
+ "Move to specified Verilog module/task/function.
+The default is a name found in the buffer around point.
+If search fails, other files are checked based on
+`verilog-library-flags'."
+ (interactive)
+ (let* ((default (verilog-get-default-symbol))
+ ;; The following variable is used in verilog-comp-function
+ (verilog-buffer-to-use (current-buffer))
+ (label (if (not (string= default ""))
+ ;; Do completion with default
+ (completing-read (concat "Label: (default " default ") ")
+ 'verilog-comp-defun nil nil "")
+ ;; There is no default value. Complete without it
+ (completing-read "Label: "
+ 'verilog-comp-defun nil nil "")))
+ pt)
+ ;; If there was no response on prompt, use default value
+ (if (string= label "")
+ (setq label default))
+ ;; Goto right place in buffer if label is not an empty string
+ (or (string= label "")
+ (progn
+ (save-excursion
+ (goto-char (point-min))
+ (setq pt (re-search-forward (verilog-build-defun-re label t) nil t)))
+ (when pt
+ (goto-char pt)
+ (beginning-of-line))
+ pt)
+ (verilog-goto-defun-file label)
+ )))
+
+;; Eliminate compile warning
+(eval-when-compile
+ (if (not (boundp 'occur-pos-list))
+ (defvar occur-pos-list nil "Backward compatibility occur positions.")))
+
+(defun verilog-showscopes ()
+ "List all scopes in this module."
+ (interactive)
+ (let ((buffer (current-buffer))
+ (linenum 1)
+ (nlines 0)
+ (first 1)
+ (prevpos (point-min))
+ (final-context-start (make-marker))
+ (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)")
+ )
+ (with-output-to-temp-buffer "*Occur*"
+ (save-excursion
+ (message (format "Searching for %s ..." regexp))
+ ;; Find next match, but give up if prev match was at end of buffer.
+ (while (and (not (= prevpos (point-max)))
+ (verilog-re-search-forward regexp nil t))
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (save-match-data
+ (setq linenum (+ linenum (count-lines prevpos (point)))))
+ (setq prevpos (point))
+ (goto-char (match-end 0))
+ (let* ((start (save-excursion
+ (goto-char (match-beginning 0))
+ (forward-line (if (< nlines 0) nlines (- nlines)))
+ (point)))
+ (end (save-excursion
+ (goto-char (match-end 0))
+ (if (> nlines 0)
+ (forward-line (1+ nlines))
+ (forward-line 1))
+ (point)))
+ (tag (format "%3d" linenum))
+ (empty (make-string (length tag) ?\ ))
+ tem)
+ (save-excursion
+ (setq tem (make-marker))
+ (set-marker tem (point))
+ (set-buffer standard-output)
+ (setq occur-pos-list (cons tem occur-pos-list))
+ (or first (zerop nlines)
+ (insert "--------\n"))
+ (setq first nil)
+ (insert-buffer-substring buffer start end)
+ (backward-char (- end start))
+ (setq tem (if (< nlines 0) (- nlines) nlines))
+ (while (> tem 0)
+ (insert empty ?:)
+ (forward-line 1)
+ (setq tem (1- tem)))
+ (let ((this-linenum linenum))
+ (set-marker final-context-start
+ (+ (point) (- (match-end 0) (match-beginning 0))))
+ (while (< (point) final-context-start)
+ (if (null tag)
+ (setq tag (format "%3d" this-linenum)))
+ (insert tag ?:)))))))
+ (set-buffer-modified-p nil))))
+
+
+;; Highlight helper functions
+(defconst verilog-directive-regexp "\\(translate\\|coverage\\|lint\\)_")
+(defun verilog-within-translate-off ()
+ "Return point if within translate-off region, else nil."
+ (and (save-excursion
+ (re-search-backward
+ (concat "//\\s-*.*\\s-*" verilog-directive-regexp "\\(on\\|off\\)\\>")
+ nil t))
+ (equal "off" (match-string 2))
+ (point)))
+
+(defun verilog-start-translate-off (limit)
+ "Return point before translate-off directive if before LIMIT, else nil."
+ (when (re-search-forward
+ (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>")
+ limit t)
+ (match-beginning 0)))
+
+(defun verilog-back-to-start-translate-off (limit)
+ "Return point before translate-off directive if before LIMIT, else nil."
+ (when (re-search-backward
+ (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>")
+ limit t)
+ (match-beginning 0)))
+
+(defun verilog-end-translate-off (limit)
+ "Return point after translate-on directive if before LIMIT, else nil."
+
+ (re-search-forward (concat
+ "//\\s-*.*\\s-*" verilog-directive-regexp "on\\>") limit t))
+
+(defun verilog-match-translate-off (limit)
+ "Match a translate-off block, setting `match-data' and returning t, else nil.
+Bound search by LIMIT."
+ (when (< (point) limit)
+ (let ((start (or (verilog-within-translate-off)
+ (verilog-start-translate-off limit)))
+ (case-fold-search t))
+ (when start
+ (let ((end (or (verilog-end-translate-off limit) limit)))
+ (set-match-data (list start end))
+ (goto-char end))))))
+
+(defun verilog-font-lock-match-item (limit)
+ "Match, and move over, any declaration item after point.
+Bound search by LIMIT. Adapted from
+`font-lock-match-c-style-declaration-item-and-skip-to-next'."
+ (condition-case nil
+ (save-restriction
+ (narrow-to-region (point-min) limit)
+ ;; match item
+ (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)")
+ (save-match-data
+ (goto-char (match-end 1))
+ ;; move to next item
+ (if (looking-at "\\(\\s-*,\\)")
+ (goto-char (match-end 1))
+ (end-of-line) t))))
+ (error nil)))
+
+
+;; Added by Subbu Meiyappan for Header
+
+(defun verilog-header ()
+ "Insert a standard Verilog file header."
+ (interactive)
+ (let ((start (point)))
+ (insert "\
+//-----------------------------------------------------------------------------
+// Title : <title>
+// Project : <project>
+//-----------------------------------------------------------------------------
+// File : <filename>
+// Author : <author>
+// Created : <credate>
+// Last modified : <moddate>
+//-----------------------------------------------------------------------------
+// Description :
+// <description>
+//-----------------------------------------------------------------------------
+// Copyright (c) <copydate> by <company> This model is the confidential and
+// proprietary property of <company> and the possession or use of this
+// file requires a written license from <company>.
+//------------------------------------------------------------------------------
+// Modification history :
+// <modhist>
+//-----------------------------------------------------------------------------
+
+")
+ (goto-char start)
+ (search-forward "<filename>")
+ (replace-match (buffer-name) t t)
+ (search-forward "<author>") (replace-match "" t t)
+ (insert (user-full-name))
+ (insert " <" (user-login-name) "@" (system-name) ">")
+ (search-forward "<credate>") (replace-match "" t t)
+ (insert-date)
+ (search-forward "<moddate>") (replace-match "" t t)
+ (insert-date)
+ (search-forward "<copydate>") (replace-match "" t t)
+ (insert-year)
+ (search-forward "<modhist>") (replace-match "" t t)
+ (insert-date)
+ (insert " : created")
+ (goto-char start)
+ (let (string)
+ (setq string (read-string "title: "))
+ (search-forward "<title>")
+ (replace-match string t t)
+ (setq string (read-string "project: " verilog-project))
+ (make-variable-buffer-local 'verilog-project)
+ (setq verilog-project string)
+ (search-forward "<project>")
+ (replace-match string t t)
+ (setq string (read-string "Company: " verilog-company))
+ (make-variable-buffer-local 'verilog-company)
+ (setq verilog-company string)
+ (search-forward "<company>")
+ (replace-match string t t)
+ (search-forward "<company>")
+ (replace-match string t t)
+ (search-forward "<company>")
+ (replace-match string t t)
+ (search-backward "<description>")
+ (replace-match "" t t)
+ )))
+
+;; verilog-header Uses the insert-date function
+
+(defun insert-date ()
+ "Insert date from the system."
+ (interactive)
+ (let ((timpos))
+ (setq timpos (point))
+ (if verilog-date-scientific-format
+ (shell-command "date \"+@%Y/%m/%d\"" t)
+ (shell-command "date \"+@%d.%m.%Y\"" t))
+ (search-forward "@")
+ (delete-region timpos (point))
+ (end-of-line))
+ (delete-char 1))
+
+(defun insert-year ()
+ "Insert year from the system."
+ (interactive)
+ (let ((timpos))
+ (setq timpos (point))
+ (shell-command "date \"+@%Y\"" t)
+ (search-forward "@")
+ (delete-region timpos (point))
+ (end-of-line))
+ (delete-char 1))
+
+\f
+;;
+;; Signal list parsing
+;;
+
+;; Elements of a signal list
+(defsubst verilog-sig-name (sig)
+ (car sig))
+(defsubst verilog-sig-bits (sig)
+ (nth 1 sig))
+(defsubst verilog-sig-comment (sig)
+ (nth 2 sig))
+(defsubst verilog-sig-memory (sig)
+ (nth 3 sig))
+(defsubst verilog-sig-enum (sig)
+ (nth 4 sig))
+(defsubst verilog-sig-signed (sig)
+ (nth 5 sig))
+(defsubst verilog-sig-type (sig)
+ (nth 6 sig))
+(defsubst verilog-sig-multidim (sig)
+ (nth 7 sig))
+(defsubst verilog-sig-multidim-string (sig)
+ (if (verilog-sig-multidim sig)
+ (let ((str "") (args (verilog-sig-multidim sig)))
+ (while args
+ (setq str (concat str (car args)))
+ (setq args (cdr args)))
+ str)))
+(defsubst verilog-sig-width (sig)
+ (verilog-make-width-expression (verilog-sig-bits sig)))
+
+(defsubst verilog-alw-get-inputs (sigs)
+ (nth 2 sigs))
+(defsubst verilog-alw-get-outputs (sigs)
+ (nth 0 sigs))
+(defsubst verilog-alw-get-uses-delayed (sigs)
+ (nth 3 sigs))
+
+(defun verilog-signals-not-in (in-list not-list)
+ "Return list of signals in IN-LIST that aren't also in NOT-LIST.
+Signals must be in standard (base vector) form."
+ (let (out-list)
+ (while in-list
+ (if (not (assoc (car (car in-list)) not-list))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))
+;;(verilog-signals-not-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("EXT" "")))
+
+(defun verilog-signals-in (in-list other-list)
+ "Return list of signals in IN-LIST that are also in OTHER-LIST.
+Signals must be in standard (base vector) form."
+ (let (out-list)
+ (while in-list
+ (if (assoc (car (car in-list)) other-list)
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))
+;;(verilog-signals-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("EXT" "")))
+
+(defun verilog-signals-memory (in-list)
+ "Return list of signals in IN-LIST that are memoried (multidimensional)."
+ (let (out-list)
+ (while in-list
+ (if (nth 3 (car in-list))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ out-list))
+;;(verilog-signals-memory '(("A" nil nil "[3:0]")) '(("B" nil nil nil)))
+
+(defun verilog-signals-sort-compare (a b)
+ "Compare signal A and B for sorting."
+ (string< (car a) (car b)))
+
+(defun verilog-signals-not-params (in-list)
+ "Return list of signals in IN-LIST that aren't parameters or numeric constants."
+ (let (out-list)
+ (while in-list
+ (unless (boundp (intern (concat "vh-" (car (car in-list)))))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))
+
+(defun verilog-signals-combine-bus (in-list)
+ "Return a list of signals in IN-LIST, with busses combined.
+Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]."
+ (let (combo
+ out-list
+ sig highbit lowbit ; Temp information about current signal
+ sv-name sv-highbit sv-lowbit ; Details about signal we are forming
+ sv-comment sv-memory sv-enum sv-signed sv-type sv-multidim sv-busstring
+ bus)
+ ;; Shove signals so duplicated signals will be adjacent
+ (setq in-list (sort in-list `verilog-signals-sort-compare))
+ (while in-list
+ (setq sig (car in-list))
+ ;; No current signal; form from existing details
+ (unless sv-name
+ (setq sv-name (verilog-sig-name sig)
+ sv-highbit nil
+ sv-busstring nil
+ sv-comment (verilog-sig-comment sig)
+ sv-memory (verilog-sig-memory sig)
+ sv-enum (verilog-sig-enum sig)
+ sv-signed (verilog-sig-signed sig)
+ sv-type (verilog-sig-type sig)
+ sv-multidim (verilog-sig-multidim sig)
+ combo ""
+ ))
+ ;; Extract bus details
+ (setq bus (verilog-sig-bits sig))
+ (cond ((and bus
+ (or (and (string-match "\\[\\([0-9]+\\):\\([0-9]+\\)\\]" bus)
+ (setq highbit (string-to-int (match-string 1 bus))
+ lowbit (string-to-int (match-string 2 bus))))
+ (and (string-match "\\[\\([0-9]+\\)\\]" bus)
+ (setq highbit (string-to-int (match-string 1 bus))
+ lowbit highbit))))
+ ;; Combine bits in bus
+ (if sv-highbit
+ (setq sv-highbit (max highbit sv-highbit)
+ sv-lowbit (min lowbit sv-lowbit))
+ (setq sv-highbit highbit
+ sv-lowbit lowbit)))
+ (bus
+ ;; String, probably something like `preproc:0
+ (setq sv-busstring bus)))
+ ;; Peek ahead to next signal
+ (setq in-list (cdr in-list))
+ (setq sig (car in-list))
+ (cond ((and sig (equal sv-name (verilog-sig-name sig)))
+ ;; Combine with this signal
+ (if (and sv-busstring (not (equal sv-busstring (verilog-sig-bits sig))))
+ (message (concat "Warning, can't merge into single bus "
+ sv-name bus
+ ", the AUTOs may be wrong")))
+ (if (verilog-sig-comment sig) (setq combo ", ..."))
+ (setq sv-memory (or sv-memory (verilog-sig-memory sig))
+ sv-enum (or sv-enum (verilog-sig-enum sig))
+ sv-signed (or sv-signed (verilog-sig-signed sig))
+ sv-type (or sv-type (verilog-sig-type sig))
+ sv-multidim (or sv-multidim (verilog-sig-multidim sig))))
+ ;; Doesn't match next signal, add to que, zero in prep for next
+ ;; Note sig may also be nil for the last signal in the list
+ (t
+ (setq out-list
+ (cons (list sv-name
+ (or sv-busstring
+ (if sv-highbit
+ (concat "[" (int-to-string sv-highbit) ":" (int-to-string sv-lowbit) "]")))
+ (concat sv-comment combo)
+ sv-memory sv-enum sv-signed sv-type sv-multidim)
+ out-list)
+ sv-name nil)))
+ )
+ ;;
+ out-list))
+
+(defun verilog-sig-tieoff (sig &optional no-width)
+ "Return tieoff expression for given SIGNAL, with appropriate width.
+Ignore width if optional NO-WIDTH is set."
+ (let* ((width (if no-width nil (verilog-sig-width sig))))
+ (concat
+ (if (and verilog-active-low-regexp
+ (string-match verilog-active-low-regexp (verilog-sig-name sig)))
+ "~" "")
+ (cond ((not width)
+ "0")
+ ((string-match "^[0-9]+$" width)
+ (concat width (if (verilog-sig-signed sig) "'sh0" "'h0")))
+ (t
+ (concat "{" width "{1'b0}}"))))))
+
+;;
+;; Port/Wire/Etc Reading
+;;
+
+(defun verilog-read-inst-backward-name ()
+ "Internal. Move point back to beginning of inst-name."
+ (verilog-backward-open-paren)
+ (let (done)
+ (while (not done)
+ (verilog-re-search-backward-quick "\\()\\|\\b[a-zA-Z0-9`_\$]\\|\\]\\)" nil nil) ; ] isn't word boundary
+ (cond ((looking-at ")")
+ (verilog-backward-open-paren))
+ (t (setq done t)))))
+ (while (looking-at "\\]")
+ (verilog-backward-open-bracket)
+ (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_\$]\\|\\]\\)" nil nil))
+ (skip-chars-backward "a-zA-Z0-9`_$"))
+
+(defun verilog-read-inst-module ()
+ "Return module_name when point is inside instantiation."
+ (save-excursion
+ (verilog-read-inst-backward-name)
+ ;; Skip over instantiation name
+ (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_\$]\\|)\\)" nil nil) ; ) isn't word boundary
+ ;; Check for parameterized instantiations
+ (when (looking-at ")")
+ (verilog-backward-open-paren)
+ (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil))
+ (skip-chars-backward "a-zA-Z0-9'_$")
+ (looking-at "[a-zA-Z0-9`_\$]+")
+ ;; Important: don't use match string, this must work with emacs 19 font-lock on
+ (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
+
+(defun verilog-read-inst-name ()
+ "Return instance_name when point is inside instantiation."
+ (save-excursion
+ (verilog-read-inst-backward-name)
+ (looking-at "[a-zA-Z0-9`_\$]+")
+ ;; Important: don't use match string, this must work with emacs 19 font-lock on
+ (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
+
+(defun verilog-read-module-name ()
+ "Return module name when after its ( or ;."
+ (save-excursion
+ (re-search-backward "[(;]")
+ (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil)
+ (skip-chars-backward "a-zA-Z0-9`_$")
+ (looking-at "[a-zA-Z0-9`_\$]+")
+ ;; Important: don't use match string, this must work with emacs 19 font-lock on
+ (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
+
+(defun verilog-read-auto-params (num-param &optional max-param)
+ "Return parameter list inside auto.
+Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
+ (let ((olist))
+ (save-excursion
+ ;; /*AUTOPUNT("parameter", "parameter")*/
+ (search-backward "(")
+ (while (looking-at "(?\\s *\"\\([^\"]*\\)\"\\s *,?")
+ (setq olist (cons (match-string 1) olist))
+ (goto-char (match-end 0))))
+ (or (eq nil num-param)
+ (<= num-param (length olist))
+ (error "%s: Expected %d parameters" (verilog-point-text) num-param))
+ (if (eq max-param nil) (setq max-param num-param))
+ (or (eq nil max-param)
+ (>= max-param (length olist))
+ (error "%s: Expected <= %d parameters" (verilog-point-text) max-param))
+ (nreverse olist)))
+
+(defun verilog-read-decls ()
+ "Compute signal declaration information for the current module at point.
+Return a array of [outputs inouts inputs wire reg assign const]."
+ (let ((end-mod-point (or (verilog-get-end-of-defun t) (point-max)))
+ (functask 0) (paren 0)
+ sigs-in sigs-out sigs-inout sigs-wire sigs-reg sigs-assign sigs-const sigs-gparam
+ vec expect-signal keywd newsig rvalue enum io signed typedefed multidim)
+ (save-excursion
+ (verilog-beg-of-defun)
+ (setq sigs-const (verilog-read-auto-constants (point) end-mod-point))
+ (while (< (point) end-mod-point)
+ ;;(if dbg (setq dbg (cons (format "Pt %s Vec %s Kwd'%s'\n" (point) vec keywd) dbg)))
+ (cond
+ ((looking-at "//")
+ (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ (setq enum (match-string 1)))
+ (search-forward "\n"))
+ ((looking-at "/\\*")
+ (forward-char 2)
+ (if (looking-at "[^*]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ (setq enum (match-string 1)))
+ (or (search-forward "*/")
+ (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
+ ((looking-at "(\\*")
+ (forward-char 2)
+ (or (looking-at "\\s-*)") ; It's a "always @ (*)"
+ (search-forward "*)")
+ (error "%s: Unmatched (* *), at char %d" (verilog-point-text) (point))))
+ ((eq ?\" (following-char))
+ (or (re-search-forward "[^\\]\"" nil t) ;; don't forward-char first, since we look for a non backslash first
+ (error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point))))
+ ((eq ?\; (following-char))
+ (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil)
+ (forward-char 1))
+ ((eq ?= (following-char))
+ (setq rvalue t newsig nil)
+ (forward-char 1))
+ ((and rvalue
+ (cond ((and (eq ?, (following-char))
+ (eq paren 0))
+ (setq rvalue nil)
+ (forward-char 1)
+ t)
+ ;; ,'s can occur inside {} & funcs
+ ((looking-at "[{(]")
+ (setq paren (1+ paren))
+ (forward-char 1)
+ t)
+ ((looking-at "[})]")
+ (setq paren (1- paren))
+ (forward-char 1)
+ t)
+ )))
+ ((looking-at "\\s-*\\(\\[[^]]+\\]\\)")
+ (goto-char (match-end 0))
+ (cond (newsig ; Memory, not just width. Patch last signal added's memory (nth 3)
+ (setcar (cdr (cdr (cdr newsig))) (match-string 1)))
+ (vec ;; Multidimensional
+ (setq multidim (cons vec multidim))
+ (setq vec (verilog-string-replace-matches
+ "\\s-+" "" nil nil (match-string 1))))
+ (t ;; Bit width
+ (setq vec (verilog-string-replace-matches
+ "\\s-+" "" nil nil (match-string 1))))))
+ ;; Normal or escaped identifier -- note we remember the \ if escaped
+ ((looking-at "\\s-*\\([a-zA-Z0-9`_$]+\\|\\\\[^ \t\n\f]+\\)")
+ (goto-char (match-end 0))
+ (setq keywd (match-string 1))
+ (when (string-match "^\\\\" keywd)
+ (setq keywd (concat keywd " "))) ;; Escaped ID needs space at end
+ (cond ((equal keywd "input")
+ (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed nil multidim nil io t expect-signal 'sigs-in))
+ ((equal keywd "output")
+ (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed nil multidim nil io t expect-signal 'sigs-out))
+ ((equal keywd "inout")
+ (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed nil multidim nil io t expect-signal 'sigs-inout))
+ ((or (equal keywd "wire")
+ (equal keywd "tri")
+ (equal keywd "tri0")
+ (equal keywd "tri1"))
+ (unless io (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil expect-signal 'sigs-wire)))
+ ((or (equal keywd "reg")
+ (equal keywd "trireg"))
+ (unless io (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil expect-signal 'sigs-reg)))
+ ((equal keywd "assign")
+ (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil expect-signal 'sigs-assign))
+ ((or (equal keywd "supply0")
+ (equal keywd "supply1")
+ (equal keywd "supply")
+ (equal keywd "localparam"))
+ (unless io (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil expect-signal 'sigs-const)))
+ ((or (equal keywd "parameter"))
+ (unless io (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil expect-signal 'sigs-gparam)))
+ ((equal keywd "signed")
+ (setq signed "signed"))
+ ((or (equal keywd "function")
+ (equal keywd "task"))
+ (setq functask (1+ functask)))
+ ((or (equal keywd "endfunction")
+ (equal keywd "endtask"))
+ (setq functask (1- functask)))
+ ((or (equal keywd "`ifdef")
+ (equal keywd "`ifndef"))
+ (setq rvalue t))
+ ((verilog-typedef-name-p keywd)
+ (setq typedefed keywd))
+ ((and expect-signal
+ (eq functask 0)
+ (not (member keywd verilog-keywords))
+ (not rvalue))
+ ;; Add new signal to expect-signal's variable
+ (setq newsig (list keywd vec nil nil enum signed typedefed multidim))
+ (set expect-signal (cons newsig
+ (symbol-value expect-signal))))))
+ (t
+ (forward-char 1)))
+ (skip-syntax-forward " "))
+ ;; Return arguments
+ (vector (nreverse sigs-out)
+ (nreverse sigs-inout)
+ (nreverse sigs-in)
+ (nreverse sigs-wire)
+ (nreverse sigs-reg)
+ (nreverse sigs-assign)
+ (nreverse sigs-const)
+ (nreverse sigs-gparam)
+ ))))
+
+(defvar sigs-in nil) ; Prevent compile warning
+(defvar sigs-inout nil) ; Prevent compile warning
+(defvar sigs-out nil) ; Prevent compile warning
+
+(defun verilog-read-sub-decls-sig (submodi comment port sig vec multidim)
+ "For verilog-read-sub-decls-line, add a signal."
+ (let (portdata)
+ (when sig
+ (setq port (verilog-symbol-detick-denumber port))
+ (setq sig (verilog-symbol-detick-denumber sig))
+ (if sig (setq sig (verilog-string-replace-matches "^[---+~!|&]+" "" nil nil sig)))
+ (if vec (setq vec (verilog-symbol-detick-denumber vec)))
+ (if multidim (setq multidim (mapcar `verilog-symbol-detick-denumber multidim)))
+ (unless (or (not sig)
+ (equal sig "")) ;; Ignore .foo(1'b1) assignments
+ (cond ((setq portdata (assoc port (verilog-modi-get-inouts submodi)))
+ (setq sigs-inout (cons (list sig vec (concat "To/From " comment) nil nil
+ (verilog-sig-signed portdata)
+ (verilog-sig-type portdata)
+ multidim)
+ sigs-inout)))
+ ((setq portdata (assoc port (verilog-modi-get-outputs submodi)))
+ (setq sigs-out (cons (list sig vec (concat "From " comment) nil nil
+ (verilog-sig-signed portdata)
+ (verilog-sig-type portdata)
+ multidim)
+ sigs-out)))
+ ((setq portdata (assoc port (verilog-modi-get-inputs submodi)))
+ (setq sigs-in (cons (list sig vec (concat "To " comment) nil nil
+ (verilog-sig-signed portdata)
+ (verilog-sig-type portdata)
+ multidim)
+ sigs-in)))
+ ;; (t -- warning pin isn't defined.) ; Leave for lint tool
+ )))))
+
+(defun verilog-read-sub-decls-line (submodi comment)
+ "For read-sub-decls, read lines of port defs until none match anymore.
+Return the list of signals found, using submodi to look up each port."
+ (let (done port sig vec multidim)
+ (save-excursion
+ (forward-line 1)
+ (while (not done)
+ ;; Get port name
+ (cond ((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*(\\s-*")
+ (setq port (match-string 1))
+ (goto-char (match-end 0)))
+ ((looking-at "\\s-*\\.\\s-*\\(\\\\[^ \t\n\f]*\\)\\s-*(\\s-*")
+ (setq port (concat (match-string 1) " ")) ;; escaped id's need trailing space
+ (goto-char (match-end 0)))
+ ((looking-at "\\s-*\\.[^(]*(")
+ (setq port nil) ;; skip this line
+ (goto-char (match-end 0)))
+ (t
+ (setq port nil done t))) ;; Unknown, ignore rest of line
+ ;; Get signal name
+ (when port
+ (setq multidim nil)
+ (cond ((looking-at "\\(\\\\[^ \t\n\f]*\\)\\s-*)")
+ (setq sig (concat (match-string 1) " ") ;; escaped id's need trailing space
+ vec nil))
+ ; We intentionally ignore (non-escaped) signals with .s in them
+ ; this prevents AUTOWIRE etc from noticing hierarchical sigs.
+ ((looking-at "\\([^[({).]*\\)\\s-*)")
+ (setq sig (verilog-string-remove-spaces (match-string 1))
+ vec nil))
+ ((looking-at "\\([^[({).]*\\)\\s-*\\(\\[[^]]+\\]\\)\\s-*)")
+ (setq sig (verilog-string-remove-spaces (match-string 1))
+ vec (match-string 2)))
+ ((looking-at "\\([^[({).]*\\)\\s-*/\\*\\(\\[[^*]+\\]\\)\\*/\\s-*)")
+ (setq sig (verilog-string-remove-spaces (match-string 1))
+ vec nil)
+ (let ((parse (match-string 2)))
+ (while (string-match "^\\(\\[[^]]+\\]\\)\\(.*\\)$" parse)
+ (when vec (setq multidim (cons vec multidim)))
+ (setq vec (match-string 1 parse))
+ (setq parse (match-string 2 parse)))))
+ ((looking-at "{\\(.*\\)}.*\\s-*)")
+ (let ((mlst (split-string (match-string 1) ","))
+ mstr)
+ (while (setq mstr (pop mlst))
+ ;;(unless noninteractive (message "sig: %s " mstr))
+ (cond
+ ((string-match "\\(['`a-zA-Z0-9_$]+\\)\\s-*$" mstr)
+ (setq sig (verilog-string-remove-spaces (match-string 1 mstr))
+ vec nil)
+ ;;(unless noninteractive (message "concat sig1: %s %s" mstr (match-string 1 mstr)))
+ )
+ ((string-match "\\([^[({).]+\\)\\s-*\\(\\[[^]]+\\]\\)\\s-*" mstr)
+ (setq sig (verilog-string-remove-spaces (match-string 1 mstr))
+ vec (match-string 2 mstr))
+ ;;(unless noninteractive (message "concat sig2: '%s' '%s' '%s'" mstr (match-string 1 mstr) (match-string 2 mstr)))
+ )
+ (t
+ (setq sig nil)))
+ ;; Process signals
+ (verilog-read-sub-decls-sig submodi comment port sig vec multidim))))
+ (t
+ (setq sig nil)))
+ ;; Process signals
+ (verilog-read-sub-decls-sig submodi comment port sig vec multidim))
+ ;;
+ (forward-line 1)))))
+
+(defun verilog-read-sub-decls ()
+ "Internally parse signals going to modules under this module.
+Return a array of [ outputs inouts inputs ] signals for modules that are
+instantiated in this module. For example if declare A A (.B(SIG)) and SIG
+is a output, then SIG will be included in the list.
+
+This only works on instantiations created with /*AUTOINST*/ converted by
+\\[verilog-auto-inst]. Otherwise, it would have to read in the whole
+component library to determine connectivity of the design.
+
+One work around for this problem is to manually create // Inputs and //
+Outputs comments above subcell signals, for example:
+
+ module1 instance1x (
+ // Outputs
+ .out (out),
+ // Inputs
+ .in (in));"
+ (save-excursion
+ (let ((end-mod-point (verilog-get-end-of-defun t))
+ st-point end-inst-point
+ ;; below 3 modified by verilog-read-sub-decls-line
+ sigs-out sigs-inout sigs-in)
+ (verilog-beg-of-defun)
+ (while (re-search-forward "\\(/\\*AUTOINST\\*/\\|\\.\\*\\)" end-mod-point t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (unless (verilog-inside-comment-p)
+ ;; Attempt to snarf a comment
+ (let* ((submod (verilog-read-inst-module))
+ (inst (verilog-read-inst-name))
+ (comment (concat inst " of " submod ".v")) submodi)
+ (when (setq submodi (verilog-modi-lookup submod t))
+ ;; This could have used a list created by verilog-auto-inst
+ ;; However I want it to be runnable even on user's manually added signals
+ (verilog-backward-open-paren)
+ (setq end-inst-point (save-excursion (forward-sexp 1) (point))
+ st-point (point))
+ (while (re-search-forward "\\s *(?\\s *// Outputs" end-inst-point t)
+ (verilog-read-sub-decls-line submodi comment)) ;; Modifies sigs-out
+ (goto-char st-point)
+ (while (re-search-forward "\\s *// Inouts" end-inst-point t)
+ (verilog-read-sub-decls-line submodi comment)) ;; Modifies sigs-inout
+ (goto-char st-point)
+ (while (re-search-forward "\\s *// Inputs" end-inst-point t)
+ (verilog-read-sub-decls-line submodi comment)) ;; Modifies sigs-in
+ )))))
+ ;; Combine duplicate bits
+ ;;(setq rr (vector sigs-out sigs-inout sigs-in))
+ (vector (verilog-signals-combine-bus (nreverse sigs-out))
+ (verilog-signals-combine-bus (nreverse sigs-inout))
+ (verilog-signals-combine-bus (nreverse sigs-in))))))
+
+(defun verilog-read-inst-pins ()
+ "Return a array of [ pins ] for the current instantiation at point.
+For example if declare A A (.B(SIG)) then B will be included in the list."
+ (save-excursion
+ (let ((end-mod-point (point)) ;; presume at /*AUTOINST*/ point
+ pins pin)
+ (verilog-backward-open-paren)
+ (while (re-search-forward "\\.\\([^(,) \t\n\f]*\\)\\s-*" end-mod-point t)
+ (setq pin (match-string 1))
+ (unless (verilog-inside-comment-p)
+ (setq pins (cons (list pin) pins))
+ (when (looking-at "(")
+ (forward-sexp 1))))
+ (vector pins))))
+
+(defun verilog-read-arg-pins ()
+ "Return a array of [ pins ] for the current argument declaration at point."
+ (save-excursion
+ (let ((end-mod-point (point)) ;; presume at /*AUTOARG*/ point
+ pins pin)
+ (verilog-backward-open-paren)
+ (while (re-search-forward "\\([a-zA-Z0-9$_.%`]+\\)" end-mod-point t)
+ (setq pin (match-string 1))
+ (unless (verilog-inside-comment-p)
+ (setq pins (cons (list pin) pins))))
+ (vector pins))))
+
+(defun verilog-read-auto-constants (beg end-mod-point)
+ "Return a list of AUTO_CONSTANTs used in the region from BEG to END-MOD-POINT."
+ ;; Insert new
+ (save-excursion
+ (let (sig-list tpl-end-pt)
+ (goto-char beg)
+ (while (re-search-forward "\\<AUTO_CONSTANT" end-mod-point t)
+ (if (not (looking-at "\\s *("))
+ (error "%s: Missing () after AUTO_CONSTANT" (verilog-point-text)))
+ (search-forward "(" end-mod-point)
+ (setq tpl-end-pt (save-excursion
+ (backward-char 1)
+ (forward-sexp 1) ;; Moves to paren that closes argdecl's
+ (backward-char 1)
+ (point)))
+ (while (re-search-forward "\\s-*\\([\"a-zA-Z0-9$_.%`]+\\)\\s-*,*" tpl-end-pt t)
+ (setq sig-list (cons (list (match-string 1) nil nil) sig-list))))
+ sig-list)))
+
+(defun verilog-read-auto-lisp (start end)
+ "Look for and evaluate a AUTO_LISP between START and END."
+ (save-excursion
+ (goto-char start)
+ (while (re-search-forward "\\<AUTO_LISP(" end t)
+ (backward-char)
+ (let* ((beg-pt (prog1 (point)
+ (forward-sexp 1))) ;; Closing paren
+ (end-pt (point)))
+ (eval-region beg-pt end-pt nil)))))
+
+(eval-when-compile
+ ;; These are passed in a let, not global
+ (if (not (boundp 'sigs-in))
+ (defvar sigs-in nil) (defvar sigs-out nil)
+ (defvar got-sig nil) (defvar got-rvalue nil) (defvar uses-delayed nil)))
+
+(defun verilog-read-always-signals-recurse
+ (exit-keywd rvalue ignore-next)
+ "Recursive routine for parentheses/bracket matching.
+EXIT-KEYWD is expression to stop at, nil if top level.
+RVALUE is true if at right hand side of equal.
+IGNORE-NEXT is true to ignore next token, fake from inside case statement."
+ (let* ((semi-rvalue (equal "endcase" exit-keywd)) ;; true if after a ; we are looking for rvalue
+ keywd last-keywd sig-tolk sig-last-tolk gotend end-else-check)
+ ;;(if dbg (setq dbg (concat dbg (format "Recursion %S %S %S\n" exit-keywd rvalue ignore-next))))
+ (while (not (or (eobp) gotend))
+ (cond
+ ((looking-at "//")
+ (search-forward "\n"))
+ ((looking-at "/\\*")
+ (or (search-forward "*/")
+ (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
+ ((looking-at "(\\*")
+ (or (looking-at "(\\*\\s-*)") ; It's a "always @ (*)"
+ (search-forward "*)")
+ (error "%s: Unmatched (* *), at char %d" (verilog-point-text) (point))))
+ (t (setq keywd (buffer-substring-no-properties
+ (point)
+ (save-excursion (when (eq 0 (skip-chars-forward "a-zA-Z0-9$_.%`"))
+ (forward-char 1))
+ (point)))
+ sig-last-tolk sig-tolk
+ sig-tolk nil)
+ ;;(if dbg (setq dbg (concat dbg (format "\tPt %S %S\t%S %S %S\n" (point) keywd rvalue ignore-next end-else-check))))
+ (cond
+ ((equal keywd "\"")
+ (or (re-search-forward "[^\\]\"" nil t)
+ (error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point))))
+ ;; else at top level loop, keep parsing
+ ((and end-else-check (equal keywd "else"))
+ ;;(if dbg (setq dbg (concat dbg (format "\tif-check-else %s\n" keywd))))
+ ;; no forward movement, want to see else in lower loop
+ (setq end-else-check nil))
+ ;; End at top level loop
+ ((and end-else-check (looking-at "[^ \t\n\f]"))
+ ;;(if dbg (setq dbg (concat dbg (format "\tif-check-else-other %s\n" keywd))))
+ (setq gotend t))
+ ;; Final statement?
+ ((and exit-keywd (equal keywd exit-keywd))
+ (setq gotend t)
+ (forward-char (length keywd)))
+ ;; Standard tokens...
+ ((equal keywd ";")
+ (setq ignore-next nil rvalue semi-rvalue)
+ ;; Final statement at top level loop?
+ (when (not exit-keywd)
+ ;;(if dbg (setq dbg (concat dbg (format "\ttop-end-check %s\n" keywd))))
+ (setq end-else-check t))
+ (forward-char 1))
+ ((equal keywd "'")
+ (if (looking-at "'s?[hdxbo][0-9a-fA-F_xz? \t]*")
+ (goto-char (match-end 0))
+ (forward-char 1)))
+ ((equal keywd ":") ;; Case statement, begin/end label, x?y:z
+ (cond ((equal "endcase" exit-keywd) ;; case x: y=z; statement next
+ (setq ignore-next nil rvalue nil))
+ ((not rvalue) ;; begin label
+ (setq ignore-next t rvalue nil)))
+ (forward-char 1))
+ ((equal keywd "=")
+ (if (eq (char-before) ?< )
+ (setq uses-delayed 1))
+ (setq ignore-next nil rvalue t)
+ (forward-char 1))
+ ((equal keywd "?")
+ (forward-char 1)
+ (verilog-read-always-signals-recurse ":" rvalue nil))
+ ((equal keywd "[")
+ (forward-char 1)
+ (verilog-read-always-signals-recurse "]" t nil))
+ ((equal keywd "(")
+ (forward-char 1)
+ (cond (sig-last-tolk ;; Function call; zap last signal
+ (setq got-sig nil)))
+ (cond ((equal last-keywd "for")
+ (verilog-read-always-signals-recurse ";" nil nil)
+ (verilog-read-always-signals-recurse ";" t nil)
+ (verilog-read-always-signals-recurse ")" nil nil))
+ (t (verilog-read-always-signals-recurse ")" t nil))))
+ ((equal keywd "begin")
+ (skip-syntax-forward "w_")
+ (verilog-read-always-signals-recurse "end" nil nil)
+ ;;(if dbg (setq dbg (concat dbg (format "\tgot-end %s\n" exit-keywd))))
+ (setq ignore-next nil rvalue semi-rvalue)
+ (if (not exit-keywd) (setq end-else-check t)))
+ ((or (equal keywd "case")
+ (equal keywd "casex")
+ (equal keywd "casez"))
+ (skip-syntax-forward "w_")
+ (verilog-read-always-signals-recurse "endcase" t nil)
+ (setq ignore-next nil rvalue semi-rvalue)
+ (if (not exit-keywd) (setq gotend t))) ;; top level begin/end
+ ((string-match "^[$`a-zA-Z_]" keywd) ;; not exactly word constituent
+ (cond ((or (equal keywd "`ifdef")
+ (equal keywd "`ifndef"))
+ (setq ignore-next t))
+ ((or ignore-next
+ (member keywd verilog-keywords)
+ (string-match "^\\$" keywd)) ;; PLI task
+ (setq ignore-next nil))
+ (t
+ (setq keywd (verilog-symbol-detick-denumber keywd))
+ (if got-sig (if got-rvalue
+ (setq sigs-in (cons got-sig sigs-in))
+ (setq sigs-out (cons got-sig sigs-out))))
+ (setq got-rvalue rvalue
+ got-sig (if (or (not keywd)
+ (assoc keywd (if got-rvalue sigs-in sigs-out)))
+ nil (list keywd nil nil))
+ sig-tolk t)))
+ (skip-chars-forward "a-zA-Z0-9$_.%`"))
+ (t
+ (forward-char 1)))
+ ;; End of non-comment token
+ (setq last-keywd keywd)
+ ))
+ (skip-syntax-forward " "))
+ ;;(if dbg (setq dbg (concat dbg (format "ENDRecursion %s\n" exit-keywd))))
+ ))
+
+(defun verilog-read-always-signals ()
+ "Parse always block at point and return list of (outputs inout inputs)."
+ ;; Insert new
+ (save-excursion
+ (let* (;;(dbg "")
+ sigs-in sigs-out
+ got-sig got-rvalue
+ uses-delayed) ;; Found signal/rvalue; push if not function
+ (search-forward ")")
+ (verilog-read-always-signals-recurse nil nil nil)
+ ;; Return what was found
+ (if got-sig (if got-rvalue
+ (setq sigs-in (cons got-sig sigs-in))
+ (setq sigs-out (cons got-sig sigs-out))))
+ ;;(if dbg (message dbg))
+ (list sigs-out nil sigs-in uses-delayed))))
+
+(defun verilog-read-instants ()
+ "Parse module at point and return list of ( ( file instance ) ... )."
+ (verilog-beg-of-defun)
+ (let* ((end-mod-point (verilog-get-end-of-defun t))
+ (state nil)
+ (instants-list nil))
+ (save-excursion
+ (while (< (point) end-mod-point)
+ ;; Stay at level 0, no comments
+ (while (progn
+ (setq state (parse-partial-sexp (point) end-mod-point 0 t nil))
+ (or (> (car state) 0) ; in parens
+ (nth 5 state) ; comment
+ ))
+ (forward-line 1))
+ (beginning-of-line)
+ (if (looking-at "^\\s-*\\([a-zA-Z0-9`_$]+\\)\\s-+\\([a-zA-Z0-9`_$]+\\)\\s-*(")
+ ;;(if (looking-at "^\\(.+\\)$")
+ (let ((module (match-string 1))
+ (instant (match-string 2)))
+ (if (not (member module verilog-keywords))
+ (setq instants-list (cons (list module instant) instants-list)))))
+ (forward-line 1)
+ ))
+ instants-list))
+
+
+(defun verilog-read-auto-template (module)
+ "Look for a auto_template for the instantiation of the given MODULE.
+If found returns the signal name connections. Return REGEXP and
+list of ( (signal_name connection_name)... )"
+ (save-excursion
+ ;; Find beginning
+ (let ((tpl-regexp "\\([0-9]+\\)")
+ (lineno 0)
+ (templateno 0)
+ tpl-sig-list tpl-wild-list tpl-end-pt rep)
+ (cond ((or
+ (re-search-backward (concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t)
+ (progn
+ (goto-char (point-min))
+ (re-search-forward (concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t)))
+ (goto-char (match-end 0))
+ ;; Parse "REGEXP"
+ ;; We reserve @"..." for future lisp expressions that evaluate once-per-AUTOINST
+ (when (looking-at "\\s-*\"\\([^\"]*)\\)\"")
+ (setq tpl-regexp (match-string 1))
+ (goto-char (match-end 0)))
+ (search-forward "(")
+ ;; Parse lines in the template
+ (when verilog-auto-inst-template-numbers
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward "AUTO_TEMPLATE" nil t)
+ (setq templateno (1+ templateno)))))
+ (setq tpl-end-pt (save-excursion
+ (backward-char 1)
+ (forward-sexp 1) ;; Moves to paren that closes argdecl's
+ (backward-char 1)
+ (point)))
+ ;;
+ (while (< (point) tpl-end-pt)
+ (cond ((looking-at "\\s-*\\.\\([a-zA-Z0-9`_$]+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
+ (setq tpl-sig-list (cons (list
+ (match-string-no-properties 1)
+ (match-string-no-properties 2)
+ templateno lineno)
+ tpl-sig-list))
+ (goto-char (match-end 0)))
+ ;; Regexp form??
+ ((looking-at
+ ;; Regexp bug in xemacs disallows ][ inside [], and wants + last
+ "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]+\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
+ (setq rep (match-string-no-properties 3))
+ (goto-char (match-end 0))
+ (setq tpl-wild-list
+ (cons (list
+ (concat "^"
+ (verilog-string-replace-matches "@" "\\\\([0-9]+\\\\)" nil nil
+ (match-string 1))
+ "$")
+ rep
+ templateno lineno)
+ tpl-wild-list)))
+ ((looking-at "[ \t\f]+")
+ (goto-char (match-end 0)))
+ ((looking-at "\n")
+ (setq lineno (1+ lineno))
+ (goto-char (match-end 0)))
+ ((looking-at "//")
+ (search-forward "\n"))
+ ((looking-at "/\\*")
+ (forward-char 2)
+ (or (search-forward "*/")
+ (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
+ (t
+ (error "%s: AUTO_TEMPLATE parsing error: %s"
+ (verilog-point-text)
+ (progn (looking-at ".*$") (match-string 0))))
+ ))
+ ;; Return
+ (vector tpl-regexp
+ (list tpl-sig-list tpl-wild-list)))
+ ;; If no template found
+ (t (vector tpl-regexp nil))))))
+;;(progn (find-file "auto-template.v") (verilog-read-auto-template "ptl_entry"))
+
+(defun verilog-set-define (defname defvalue &optional buffer enumname)
+ "Set the definition DEFNAME to the DEFVALUE in the given BUFFER.
+Optionally associate it with the specified enumeration ENUMNAME."
+ (save-excursion
+ (set-buffer (or buffer (current-buffer)))
+ (let ((mac (intern (concat "vh-" defname))))
+ ;;(message "Define %s=%s" defname defvalue) (sleep-for 1)
+ ;; Need to define to a constant if no value given
+ (set (make-variable-buffer-local mac)
+ (if (equal defvalue "") "1" defvalue)))
+ (if enumname
+ (let ((enumvar (intern (concat "venum-" enumname))))
+ ;;(message "Define %s=%s" defname defvalue) (sleep-for 1)
+ (make-variable-buffer-local enumvar)
+ (add-to-list enumvar defname)))
+ ))
+
+(defun verilog-read-defines (&optional filename recurse subcall)
+ "Read `defines and parameters for the current file, or optional FILENAME.
+If the filename is provided, `verilog-library-flags' will be used to
+resolve it. If optional RECURSE is non-nil, recurse through `includes.
+
+Parameters must be simple assignments to constants, or have their own
+\"parameter\" label rather then a list of parameters. Thus:
+
+ parameter X = 5, Y = 10; // Ok
+ parameter X = {1'b1, 2'h2}; // Ok
+ parameter X = {1'b1, 2'h2}, Y = 10; // Bad, make into 2 parameter lines
+
+Defines must be simple text substitutions, one on a line, starting
+at the beginning of the line. Any ifdefs or multiline comments around the
+define are ignored.
+
+Defines are stored inside Emacs variables using the name vh-{definename}.
+
+This function is useful for setting vh-* variables. The file variables
+feature can be used to set defines that `verilog-mode' can see; put at the
+*END* of your file something like:
+
+ // Local Variables:
+ // vh-macro:\"macro_definition\"
+ // End:
+
+If macros are defined earlier in the same file and you want their values,
+you can read them automatically (provided `enable-local-eval' is on):
+
+ // Local Variables:
+ // eval:(verilog-read-defines)
+ // eval:(verilog-read-defines \"group_standard_includes.v\")
+ // End:
+
+Note these are only read when the file is first visited, you must use
+\\[find-alternate-file] RET to have these take effect after editing them!
+
+If you want to disable the \"Process `eval' or hook local variables\"
+warning message, you need to add to your .emacs file:
+
+ (setq enable-local-eval t)"
+ (let ((origbuf (current-buffer)))
+ (save-excursion
+ (unless subcall (verilog-getopt-flags))
+ (when filename
+ (let ((fns (verilog-library-filenames filename (buffer-file-name))))
+ (if fns
+ (set-buffer (find-file-noselect (car fns)))
+ (error (concat (verilog-point-text)
+ ": Can't find verilog-read-defines file: " filename)))))
+ (when recurse
+ (goto-char (point-min))
+ (while (re-search-forward "^\\s-*`include\\s-+\\([^ \t\n\f]+\\)" nil t)
+ (let ((inc (verilog-string-replace-matches "\"" "" nil nil (match-string-no-properties 1))))
+ (unless (verilog-inside-comment-p)
+ (verilog-read-defines inc recurse t)))))
+ ;; Read `defines
+ ;; note we don't use verilog-re... it's faster this way, and that
+ ;; function has problems when comments are at the end of the define
+ (goto-char (point-min))
+ (while (re-search-forward "^\\s-*`define\\s-+\\([a-zA-Z0-9_$]+\\)\\s-+\\(.*\\)$" nil t)
+ (let ((defname (match-string-no-properties 1))
+ (defvalue (match-string-no-properties 2)))
+ (setq defvalue (verilog-string-replace-matches "\\s-*/[/*].*$" "" nil nil defvalue))
+ (verilog-set-define defname defvalue origbuf)))
+ ;; Hack: Read parameters
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\s-*\\(parameter\\|localparam\\)\\(\\(\\s-*\\[[^]]*\\]\\|\\)\\s-+\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\|\\)\\s-*" nil t)
+ (let ((var (match-string-no-properties 4))
+ (val (match-string-no-properties 5))
+ enumname)
+ ;; The primary way of getting defines is verilog-read-decls
+ ;; However, that isn't called yet for included files, so we'll add another scheme
+ (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ (setq enumname (match-string-no-properties 1)))
+ (if var
+ (verilog-set-define var val origbuf enumname))
+ (forward-comment 999)
+ (while (looking-at "\\s-*,?\\s-*\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\s-*")
+ (verilog-set-define (match-string-no-properties 1) (match-string-no-properties 2) origbuf enumname)
+ (goto-char (match-end 0))
+ (forward-comment 999))))
+ )))
+
+(defun verilog-read-includes ()
+ "Read `includes for the current file.
+This will find all of the `includes which are at the beginning of lines,
+ignoring any ifdefs or multiline comments around them.
+`verilog-read-defines' is then performed on the current and each included
+file.
+
+It is often useful put at the *END* of your file something like:
+
+ // Local Variables:
+ // eval:(verilog-read-defines)
+ // eval:(verilog-read-includes)
+ // End:
+
+Note includes are only read when the file is first visited, you must use
+\\[find-alternate-file] RET to have these take effect after editing them!
+
+It is good to get in the habit of including all needed files in each .v
+file that needs it, rather then waiting for compile time. This will aid
+this process, Verilint, and readability. To prevent defining the same
+variable over and over when many modules are compiled together, put a test
+around the inside each include file:
+
+foo.v (a include):
+ `ifdef _FOO_V // include if not already included
+ `else
+ `define _FOO_V
+ ... contents of file
+ `endif // _FOO_V"
+;;slow: (verilog-read-defines nil t))
+ (save-excursion
+ (verilog-getopt-flags)
+ (goto-char (point-min))
+ (while (re-search-forward "^\\s-*`include\\s-+\\([^ \t\n\f]+\\)" nil t)
+ (let ((inc (verilog-string-replace-matches "\"" "" nil nil (match-string 1))))
+ (verilog-read-defines inc nil t)))))
+
+(defun verilog-read-signals (&optional start end)
+ "Return a simple list of all possible signals in the file.
+Bounded by optional region from START to END. Overly aggressive but fast.
+Some macros and such are also found and included. For dinotrace.el"
+ (let (sigs-all keywd)
+ (progn;save-excursion
+ (goto-char (or start (point-min)))
+ (setq end (or end (point-max)))
+ (while (re-search-forward "[\"/a-zA-Z_.%`]" end t)
+ (forward-char -1)
+ (cond
+ ((looking-at "//")
+ (search-forward "\n"))
+ ((looking-at "/\\*")
+ (search-forward "*/"))
+ ((looking-at "(\\*")
+ (or (looking-at "(\\*\\s-*)") ; It's a "always @ (*)"
+ (search-forward "*)")))
+ ((eq ?\" (following-char))
+ (re-search-forward "[^\\]\"")) ;; don't forward-char first, since we look for a non backslash first
+ ((looking-at "\\s-*\\([a-zA-Z0-9$_.%`]+\\)")
+ (goto-char (match-end 0))
+ (setq keywd (match-string-no-properties 1))
+ (or (member keywd verilog-keywords)
+ (member keywd sigs-all)
+ (setq sigs-all (cons keywd sigs-all))))
+ (t (forward-char 1)))
+ )
+ ;; Return list
+ sigs-all)))
+
+;;
+;; Argument file parsing
+;;
+
+(defun verilog-getopt (arglist)
+ "Parse -f, -v etc arguments in ARGLIST list or string."
+ (unless (listp arglist) (setq arglist (list arglist)))
+ (let ((space-args '())
+ arg next-param)
+ ;; Split on spaces, so users can pass whole command lines
+ (while arglist
+ (setq arg (car arglist)
+ arglist (cdr arglist))
+ (while (string-match "^\\([^ \t\n\f]+\\)[ \t\n\f]*\\(.*$\\)" arg)
+ (setq space-args (append space-args
+ (list (match-string-no-properties 1 arg))))
+ (setq arg (match-string 2 arg))))
+ ;; Parse arguments
+ (while space-args
+ (setq arg (car space-args)
+ space-args (cdr space-args))
+ (cond
+ ;; Need another arg
+ ((equal arg "-f")
+ (setq next-param arg))
+ ((equal arg "-v")
+ (setq next-param arg))
+ ((equal arg "-y")
+ (setq next-param arg))
+ ;; +libext+(ext1)+(ext2)...
+ ((string-match "^\\+libext\\+\\(.*\\)" arg)
+ (setq arg (match-string 1 arg))
+ (while (string-match "\\([^+]+\\)\\+?\\(.*\\)" arg)
+ (verilog-add-list-unique `verilog-library-extensions
+ (match-string 1 arg))
+ (setq arg (match-string 2 arg))))
+ ;;
+ ((or (string-match "^-D\\([^+=]*\\)[+=]\\(.*\\)" arg) ;; -Ddefine=val
+ (string-match "^-D\\([^+=]*\\)\\(\\)" arg) ;; -Ddefine
+ (string-match "^\\+define\\([^+=]*\\)[+=]\\(.*\\)" arg) ;; +define+val
+ (string-match "^\\+define\\([^+=]*\\)\\(\\)" arg)) ;; +define+define
+ (verilog-set-define (match-string 1 arg) (match-string 2 arg)))
+ ;;
+ ((or (string-match "^\\+incdir\\+\\(.*\\)" arg) ;; +incdir+dir
+ (string-match "^-I\\(.*\\)" arg)) ;; -Idir
+ (verilog-add-list-unique `verilog-library-directories
+ (match-string 1 arg)))
+ ;; Ignore
+ ((equal "+librescan" arg))
+ ((string-match "^-U\\(.*\\)" arg)) ;; -Udefine
+ ;; Second parameters
+ ((equal next-param "-f")
+ (setq next-param nil)
+ (verilog-getopt-file arg))
+ ((equal next-param "-v")
+ (setq next-param nil)
+ (verilog-add-list-unique `verilog-library-files arg))
+ ((equal next-param "-y")
+ (setq next-param nil)
+ (verilog-add-list-unique `verilog-library-directories arg))
+ ;; Filename
+ ((string-match "^[^-+]" arg)
+ (verilog-add-list-unique `verilog-library-files arg))
+ ;; Default - ignore; no warning
+ )
+ )
+ )
+ )
+;;(verilog-getopt (list "+libext+.a+.b" "+incdir+foodir" "+define+a+aval" "-f" "otherf" "-v" "library" "-y" "dir"))
+
+(defun verilog-getopt-file (filename)
+ "Read verilog options from the specified FILENAME."
+ (save-excursion
+ (let ((fns (verilog-library-filenames filename (buffer-file-name)))
+ (orig-buffer (current-buffer))
+ line)
+ (if fns
+ (set-buffer (find-file-noselect (car fns)))
+ (error (concat (verilog-point-text)
+ "Can't find verilog-getopt-file -f file: " filename)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq line (buffer-substring (point)
+ (save-excursion (end-of-line) (point))))
+ (forward-line 1)
+ (when (string-match "//" line)
+ (setq line (substring line 0 (match-beginning 0))))
+ (save-excursion
+ (set-buffer orig-buffer) ; Variables are buffer-local, so need right context.
+ (verilog-getopt line))))))
+
+(defun verilog-getopt-flags ()
+ "Convert `verilog-library-flags' into standard library variables."
+ ;; If the flags are local, then all the outputs should be local also
+ (when (local-variable-p `verilog-library-flags (current-buffer))
+ (make-variable-buffer-local 'verilog-library-extensions)
+ (make-variable-buffer-local 'verilog-library-directories)
+ (make-variable-buffer-local 'verilog-library-files)
+ (make-variable-buffer-local 'verilog-library-flags))
+ ;; Allow user to customize
+ (run-hooks 'verilog-before-getopt-flags-hook)
+ ;; Process arguments
+ (verilog-getopt verilog-library-flags)
+ ;; Allow user to customize
+ (run-hooks 'verilog-getopt-flags-hook))
+
+(defun verilog-add-list-unique (varref object)
+ "Append to VARREF list the given OBJECT,
+unless it is already a member of the variable's list"
+ (unless (member object (symbol-value varref))
+ (set varref (append (symbol-value varref) (list object))))
+ varref)
+;;(progn (setq l '()) (verilog-add-list-unique `l "a") (verilog-add-list-unique `l "a") l)
+
+\f
+;;
+;; Module name lookup
+;;
+
+(defun verilog-module-inside-filename-p (module filename)
+ "Return point if MODULE is specified inside FILENAME, else nil.
+Allows version control to check out the file if need be."
+ (and (or (file-exists-p filename)
+ (and
+ (condition-case nil
+ (fboundp 'vc-backend)
+ (error nil))
+ (vc-backend filename)))
+ (let (pt)
+ (save-excursion
+ (set-buffer (find-file-noselect filename))
+ (goto-char (point-min))
+ (while (and
+ ;; It may be tempting to look for verilog-defun-re, don't, it slows things down a lot!
+ (verilog-re-search-forward-quick "\\<module\\>" nil t)
+ (verilog-re-search-forward-quick "[(;]" nil t))
+ (if (equal module (verilog-read-module-name))
+ (setq pt (point))))
+ pt))))
+
+(defun verilog-is-number (symbol)
+ "Return true if SYMBOL is number-like."
+ (or (string-match "^[0-9 \t:]+$" symbol)
+ (string-match "^[---]*[0-9]+$" symbol)
+ (string-match "^[0-9 \t]+'s?[hdxbo][0-9a-fA-F_xz? \t]*$" symbol)
+ ))
+
+(defun verilog-symbol-detick (symbol wing-it)
+ "Return a expanded SYMBOL name without any defines.
+If the variable vh-{symbol} is defined, return that value.
+If undefined, and WING-IT, return just SYMBOL without the tick, else nil."
+ (while (and symbol (string-match "^`" symbol))
+ (setq symbol (substring symbol 1))
+ (setq symbol
+ (if (boundp (intern (concat "vh-" symbol)))
+ ;; Emacs has a bug where boundp on a buffer-local variable in only one
+ ;; buffer returns t in another. This can confuse, so check for nil.
+ (let ((val (eval (intern (concat "vh-" symbol)))))
+ (if (eq val nil)
+ (if wing-it symbol nil)
+ val))
+ (if wing-it symbol nil))))
+ symbol)
+;;(verilog-symbol-detick "`mod" nil)
+
+(defun verilog-symbol-detick-denumber (symbol)
+ "Return SYMBOL with defines converted and any numbers dropped to nil."
+ (when (string-match "^`" symbol)
+ ;; This only will work if the define is a simple signal, not
+ ;; something like a[b]. Sorry, it should be substituted into the parser
+ (setq symbol
+ (verilog-string-replace-matches
+ "\[[^0-9: \t]+\]" "" nil nil
+ (or (verilog-symbol-detick symbol nil)
+ (if verilog-auto-sense-defines-constant
+ "0"
+ symbol)))))
+ (if (verilog-is-number symbol)
+ nil
+ symbol))
+
+(defun verilog-expand-dirnames (&optional dirnames)
+ "Return a list of existing directories given a list of wildcarded DIRNAMES.
+Or, just the existing dirnames themselves if there are no wildcards."
+ (interactive)
+ (unless dirnames (error "`verilog-library-directories' should include at least '.'"))
+ (setq dirnames (reverse dirnames)) ; not nreverse
+ (let ((dirlist nil)
+ pattern dirfile dirfiles dirname root filename rest)
+ (while dirnames
+ (setq dirname (substitute-in-file-name (car dirnames))
+ dirnames (cdr dirnames))
+ (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ;; root
+ "\\([^/\\]*[*?][^/\\]*\\)" ;; filename with *?
+ "\\(.*\\)") ;; rest
+ dirname)
+ (setq root (match-string 1 dirname)
+ filename (match-string 2 dirname)
+ rest (match-string 3 dirname)
+ pattern filename)
+ ;; now replace those * and ? with .+ and .
+ ;; use ^ and /> to get only whole file names
+ ;;verilog-string-replace-matches
+ (setq pattern (verilog-string-replace-matches "[*]" ".+" nil nil pattern)
+ pattern (verilog-string-replace-matches "[?]" "." nil nil pattern)
+
+ ;; Unfortunately allows abc/*/rtl to match abc/rtl
+ ;; because abc/.. shows up in dirfiles. Solutions welcome.
+ dirfiles (if (file-directory-p root) ; Ignore version control external
+ (directory-files root t pattern nil)))
+ (while dirfiles
+ (setq dirfile (expand-file-name (concat (car dirfiles) rest))
+ dirfiles (cdr dirfiles))
+ (if (file-directory-p dirfile)
+ (setq dirlist (cons dirfile dirlist))))
+ )
+ ;; Defaults
+ (t
+ (if (file-directory-p dirname)
+ (setq dirlist (cons dirname dirlist))))
+ ))
+ dirlist))
+;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v"))
+
+(defun verilog-library-filenames (filename current &optional check-ext)
+ "Return a search path to find the given FILENAME name.
+Uses the CURRENT filename, `verilog-library-directories' and
+`verilog-library-extensions' variables to build the path.
+With optional CHECK-EXT also check `verilog-library-extensions'."
+ (let ((ckdir (verilog-expand-dirnames verilog-library-directories))
+ fn outlist)
+ (while ckdir
+ (let ((ckext (if check-ext verilog-library-extensions `(""))))
+ (while ckext
+ (setq fn (expand-file-name
+ (concat filename (car ckext))
+ (expand-file-name (car ckdir) (file-name-directory current))))
+ (if (file-exists-p fn)
+ (setq outlist (cons fn outlist)))
+ (setq ckext (cdr ckext))))
+ (setq ckdir (cdr ckdir)))
+ (nreverse outlist)))
+
+(defun verilog-module-filenames (module current)
+ "Return a search path to find the given MODULE name.
+Uses the CURRENT filename, `verilog-library-extensions',
+`verilog-library-directories' and `verilog-library-files'
+variables to build the path."
+ ;; Return search locations for it
+ (append (list current) ; first, current buffer
+ (verilog-library-filenames module current t)
+ verilog-library-files)) ; finally, any libraries
+
+;;
+;; Module Information
+;;
+;; Many of these functions work on "modi" a module information structure
+;; A modi is: [module-name-string file-name begin-point]
+
+(defvar verilog-cache-enabled t
+ "If true, enable caching of signals, etc. Set to nil for debugging to make things SLOW!")
+
+(defvar verilog-modi-cache-list nil
+ "Cache of ((Module Function) Buf-Tick Buf-Modtime Func-Returns)...
+For speeding up verilog-modi-get-* commands.
+Buffer-local.")
+
+(defvar verilog-modi-cache-preserve-tick nil
+ "Modification tick after which the cache is still considered valid.
+Use verilog-preserve-cache's to set")
+(defvar verilog-modi-cache-preserve-buffer nil
+ "Modification tick after which the cache is still considered valid.
+Use verilog-preserve-cache's to set")
+
+(defun verilog-modi-current ()
+ "Return the modi structure for the module currently at point."
+ (let* (name pt)
+ ;; read current module's name
+ (save-excursion
+ (verilog-re-search-backward-quick verilog-defun-re nil nil)
+ (verilog-re-search-forward-quick "(" nil nil)
+ (setq name (verilog-read-module-name))
+ (setq pt (point)))
+ ;; return
+ (vector name (or (buffer-file-name) (current-buffer)) pt)))
+
+(defvar verilog-modi-lookup-last-mod nil "Cache of last module looked up.")
+(defvar verilog-modi-lookup-last-modi nil "Cache of last modi returned.")
+(defvar verilog-modi-lookup-last-current nil "Cache of last `current-buffer' looked up.")
+(defvar verilog-modi-lookup-last-tick nil "Cache of last `buffer-modified-tick' looked up.")
+
+(defun verilog-modi-lookup (module allow-cache)
+ "Find the file and point at which MODULE is defined.
+If ALLOW-CACHE is set, check and remember cache of previous lookups.
+Return modi if successful, else print message."
+ (let* ((current (or (buffer-file-name) (current-buffer))))
+ (cond ((and verilog-modi-lookup-last-modi
+ verilog-cache-enabled
+ allow-cache
+ (equal verilog-modi-lookup-last-mod module)
+ (equal verilog-modi-lookup-last-current current)
+ (equal verilog-modi-lookup-last-tick (buffer-modified-tick)))
+ ;; ok as is
+ )
+ (t (let* ((realmod (verilog-symbol-detick module t))
+ (orig-filenames (verilog-module-filenames realmod current))
+ (filenames orig-filenames)
+ pt)
+ (while (and filenames (not pt))
+ (if (not (setq pt (verilog-module-inside-filename-p realmod (car filenames))))
+ (setq filenames (cdr filenames))))
+ (cond (pt (setq verilog-modi-lookup-last-modi
+ (vector realmod (car filenames) pt)))
+ (t (setq verilog-modi-lookup-last-modi nil)
+ (error (concat (verilog-point-text)
+ ": Can't locate " module " module definition"
+ (if (not (equal module realmod))
+ (concat " (Expanded macro to " realmod ")")
+ "")
+ "\n Check the verilog-library-directories variable."
+ "\n I looked in (if not listed, doesn't exist):\n\t" (mapconcat 'concat orig-filenames "\n\t"))))
+ )
+ (setq verilog-modi-lookup-last-mod module
+ verilog-modi-lookup-last-current current
+ verilog-modi-lookup-last-tick (buffer-modified-tick)))))
+ verilog-modi-lookup-last-modi
+ ))
+
+(defsubst verilog-modi-name (modi)
+ (aref modi 0))
+(defsubst verilog-modi-file-or-buffer (modi)
+ (aref modi 1))
+(defsubst verilog-modi-point (modi)
+ (aref modi 2))
+
+(defun verilog-modi-filename (modi)
+ "Filename of MODI, or name of buffer if its never been saved."
+ (if (bufferp (verilog-modi-file-or-buffer modi))
+ (or (buffer-file-name (verilog-modi-file-or-buffer modi))
+ (buffer-name (verilog-modi-file-or-buffer modi)))
+ (verilog-modi-file-or-buffer modi)))
+
+(defun verilog-modi-goto (modi)
+ "Move point/buffer to specified MODI."
+ (or modi (error "Passed unfound modi to goto, check earlier"))
+ (set-buffer (if (bufferp (verilog-modi-file-or-buffer modi))
+ (verilog-modi-file-or-buffer modi)
+ (find-file-noselect (verilog-modi-file-or-buffer modi))))
+ (or (equal major-mode `verilog-mode) ;; Put into verilog mode to get syntax
+ (verilog-mode))
+ (goto-char (verilog-modi-point modi)))
+
+(defun verilog-goto-defun-file (module)
+ "Move point to the file at which a given MODULE is defined."
+ (interactive "sGoto File for Module: ")
+ (let* ((modi (verilog-modi-lookup module nil)))
+ (when modi
+ (verilog-modi-goto modi)
+ (switch-to-buffer (current-buffer)))))
+
+(defun verilog-modi-cache-results (modi function)
+ "Run on MODI the given FUNCTION. Locate the module in a file.
+Cache the output of function so next call may have faster access."
+ (let (func-returns fass)
+ (save-excursion
+ (verilog-modi-goto modi)
+ (if (and (setq fass (assoc (list (verilog-modi-name modi) function)
+ verilog-modi-cache-list))
+ ;; Destroy caching when incorrect; Modified or file changed
+ (not (and verilog-cache-enabled
+ (or (equal (buffer-modified-tick) (nth 1 fass))
+ (and verilog-modi-cache-preserve-tick
+ (<= verilog-modi-cache-preserve-tick (nth 1 fass))
+ (equal verilog-modi-cache-preserve-buffer (current-buffer))))
+ (equal (visited-file-modtime) (nth 2 fass)))))
+ (setq verilog-modi-cache-list nil
+ fass nil))
+ (cond (fass
+ ;; Found
+ (setq func-returns (nth 3 fass)))
+ (t
+ ;; Read from file
+ ;; Clear then restore any hilighting to make emacs19 happy
+ (let ((fontlocked (when (and (memq 'v19 verilog-emacs-features)
+ (boundp 'font-lock-mode)
+ font-lock-mode)
+ (font-lock-mode nil)
+ t)))
+ (setq func-returns (funcall function))
+ (when fontlocked (font-lock-mode t)))
+ ;; Cache for next time
+ (make-variable-buffer-local 'verilog-modi-cache-list)
+ (setq verilog-modi-cache-list
+ (cons (list (list (verilog-modi-name modi) function)
+ (buffer-modified-tick)
+ (visited-file-modtime)
+ func-returns)
+ verilog-modi-cache-list)))
+ ))
+ ;;
+ func-returns))
+
+(defun verilog-modi-cache-add (modi function element sig-list)
+ "Add function return results to the module cache.
+Update MODI's cache for given FUNCTION so that the return ELEMENT of that
+function now contains the additional SIG-LIST parameters."
+ (let (fass)
+ (save-excursion
+ (verilog-modi-goto modi)
+ (if (setq fass (assoc (list (verilog-modi-name modi) function)
+ verilog-modi-cache-list))
+ (let ((func-returns (nth 3 fass)))
+ (aset func-returns element
+ (append sig-list (aref func-returns element))))))))
+
+(defmacro verilog-preserve-cache (&rest body)
+ "Execute the BODY forms, allowing cache preservation within BODY.
+This means that changes to the buffer will not result in the cache being
+flushed. If the changes affect the modsig state, they must call the
+modsig-cache-add-* function, else the results of later calls may be
+incorrect. Without this, changes are assumed to be adding/removing signals
+and invalidating the cache."
+ `(let ((verilog-modi-cache-preserve-tick (buffer-modified-tick))
+ (verilog-modi-cache-preserve-buffer (current-buffer)))
+ (progn ,@body)))
+
+(defsubst verilog-modi-get-decls (modi)
+ (verilog-modi-cache-results modi 'verilog-read-decls))
+
+(defsubst verilog-modi-get-sub-decls (modi)
+ (verilog-modi-cache-results modi 'verilog-read-sub-decls))
+
+;; Signal reading for given module
+;; Note these all take modi's - as returned from the verilog-modi-current function
+(defsubst verilog-modi-get-outputs (modi)
+ (aref (verilog-modi-get-decls modi) 0))
+(defsubst verilog-modi-get-inouts (modi)
+ (aref (verilog-modi-get-decls modi) 1))
+(defsubst verilog-modi-get-inputs (modi)
+ (aref (verilog-modi-get-decls modi) 2))
+(defsubst verilog-modi-get-wires (modi)
+ (aref (verilog-modi-get-decls modi) 3))
+(defsubst verilog-modi-get-regs (modi)
+ (aref (verilog-modi-get-decls modi) 4))
+(defsubst verilog-modi-get-assigns (modi)
+ (aref (verilog-modi-get-decls modi) 5))
+(defsubst verilog-modi-get-consts (modi)
+ (aref (verilog-modi-get-decls modi) 6))
+(defsubst verilog-modi-get-gparams (modi)
+ (aref (verilog-modi-get-decls modi) 7))
+(defsubst verilog-modi-get-sub-outputs (modi)
+ (aref (verilog-modi-get-sub-decls modi) 0))
+(defsubst verilog-modi-get-sub-inouts (modi)
+ (aref (verilog-modi-get-sub-decls modi) 1))
+(defsubst verilog-modi-get-sub-inputs (modi)
+ (aref (verilog-modi-get-sub-decls modi) 2))
+
+
+(defun verilog-signals-matching-enum (in-list enum)
+ "Return all signals in IN-LIST matching the given ENUM."
+ (let (out-list)
+ (while in-list
+ (if (equal (verilog-sig-enum (car in-list)) enum)
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ ;; New scheme
+ (let* ((enumvar (intern (concat "venum-" enum)))
+ (enumlist (and (boundp enumvar) (eval enumvar))))
+ (while enumlist
+ (add-to-list 'out-list (list (car enumlist)))
+ (setq enumlist (cdr enumlist))))
+ (nreverse out-list)))
+
+(defun verilog-signals-not-matching-regexp (in-list regexp)
+ "Return all signals in IN-LIST not matching the given REGEXP, if non-nil."
+ (if (not regexp)
+ in-list
+ (let (out-list)
+ (while in-list
+ (if (not (string-match regexp (verilog-sig-name (car in-list))))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list))))
+
+;; Combined
+(defun verilog-modi-get-signals (modi)
+ (append
+ (verilog-modi-get-outputs modi)
+ (verilog-modi-get-inouts modi)
+ (verilog-modi-get-inputs modi)
+ (verilog-modi-get-wires modi)
+ (verilog-modi-get-regs modi)
+ (verilog-modi-get-assigns modi)
+ (verilog-modi-get-consts modi)
+ (verilog-modi-get-gparams modi)))
+
+(defun verilog-modi-get-ports (modi)
+ (append
+ (verilog-modi-get-outputs modi)
+ (verilog-modi-get-inouts modi)
+ (verilog-modi-get-inputs modi)))
+
+(defsubst verilog-modi-cache-add-outputs (modi sig-list)
+ (verilog-modi-cache-add modi 'verilog-read-decls 0 sig-list))
+(defsubst verilog-modi-cache-add-inouts (modi sig-list)
+ (verilog-modi-cache-add modi 'verilog-read-decls 1 sig-list))
+(defsubst verilog-modi-cache-add-inputs (modi sig-list)
+ (verilog-modi-cache-add modi 'verilog-read-decls 2 sig-list))
+(defsubst verilog-modi-cache-add-wires (modi sig-list)
+ (verilog-modi-cache-add modi 'verilog-read-decls 3 sig-list))
+(defsubst verilog-modi-cache-add-regs (modi sig-list)
+ (verilog-modi-cache-add modi 'verilog-read-decls 4 sig-list))
+
+(defun verilog-signals-from-signame (signame-list)
+ "Return signals in standard form from SIGNAME-LIST, a simple list of signal names."
+ (mapcar (function (lambda (name) (list name nil nil)))
+ signame-list))
+\f
+;;
+;; Auto creation utilities
+;;
+
+(defun verilog-auto-search-do (search-for func)
+ "Search for the given auto text SEARCH-FOR, and perform FUNC where it occurs."
+ (goto-char (point-min))
+ (while (search-forward search-for nil t)
+ (if (not (save-excursion
+ (goto-char (match-beginning 0))
+ (verilog-inside-comment-p)))
+ (funcall func))))
+
+(defun verilog-auto-re-search-do (search-for func)
+ "Search for the given auto text SEARCH-FOR, and perform FUNC where it occurs."
+ (goto-char (point-min))
+ (while (re-search-forward search-for nil t)
+ (if (not (save-excursion
+ (goto-char (match-beginning 0))
+ (verilog-inside-comment-p)))
+ (funcall func))))
+
+(defun verilog-insert-one-definition (sig type indent-pt)
+ "Print out a definition for SIGNAL of the given TYPE,
+with appropriate INDENT-PT indentation."
+ (indent-to indent-pt)
+ (insert type)
+ (when (verilog-sig-signed sig)
+ (insert " " (verilog-sig-signed sig)))
+ (when (verilog-sig-multidim sig)
+ (insert " " (verilog-sig-multidim-string sig)))
+ (when (verilog-sig-bits sig)
+ (insert " " (verilog-sig-bits sig)))
+ (indent-to (max 24 (+ indent-pt 16)))
+ (unless (= (char-syntax (preceding-char)) ?\ )
+ (insert " ")) ; Need space between "]name" if indent-to did nothing
+ (insert (verilog-sig-name sig)))
+
+(defun verilog-insert-definition (sigs direction indent-pt v2k &optional dont-sort)
+ "Print out a definition for a list of SIGS of the given DIRECTION,
+with appropriate INDENT-PT indentation. If V2K, use Verilog 2001 I/O
+format. Sort unless DONT-SORT. DIRECTION is normally wire/reg/output."
+ (or dont-sort
+ (setq sigs (sort (copy-alist sigs) `verilog-signals-sort-compare)))
+ (while sigs
+ (let ((sig (car sigs)))
+ (verilog-insert-one-definition
+ sig
+ ;; Want "type x" or "output type x", not "wire type x"
+ (cond ((verilog-sig-type sig)
+ (concat
+ (if (not (equal direction "wire"))
+ (concat direction " "))
+ (verilog-sig-type sig)))
+ (t direction))
+ indent-pt)
+ (insert (if v2k "," ";"))
+ (if (or (not (verilog-sig-comment sig))
+ (equal "" (verilog-sig-comment sig)))
+ (insert "\n")
+ (indent-to (max 48 (+ indent-pt 40)))
+ (insert (concat "// " (verilog-sig-comment sig) "\n")))
+ (setq sigs (cdr sigs)))))
+
+(eval-when-compile
+ (if (not (boundp 'indent-pt))
+ (defvar indent-pt nil "Local used by insert-indent")))
+
+(defun verilog-insert-indent (&rest stuff)
+ "Indent to position stored in local `indent-pt' variable, then insert STUFF.
+Presumes that any newlines end a list element."
+ (let ((need-indent t))
+ (while stuff
+ (if need-indent (indent-to indent-pt))
+ (setq need-indent nil)
+ (insert (car stuff))
+ (setq need-indent (string-match "\n$" (car stuff))
+ stuff (cdr stuff)))))
+;;(let ((indent-pt 10)) (verilog-insert-indent "hello\n" "addon" "there\n"))
+
+(defun verilog-repair-open-comma ()
+ "If backwards-from-point is other then a open parenthesis insert comma."
+ (save-excursion
+ (verilog-backward-syntactic-ws)
+ (when (save-excursion
+ (backward-char 1)
+ (and (not (looking-at "[(,]"))
+ (progn
+ (verilog-re-search-backward "[(`]" nil t)
+ (looking-at "("))))
+ (insert ","))))
+
+(defun verilog-repair-close-comma ()
+ "If point is at a comma followed by a close parenthesis, fix it.
+This repairs those mis-inserted by a AUTOARG."
+ ;; It would be much nicer if Verilog allowed extra commas like Perl does!
+ (save-excursion
+ (verilog-forward-close-paren)
+ (backward-char 1)
+ (verilog-backward-syntactic-ws)
+ (backward-char 1)
+ (when (looking-at ",")
+ (delete-char 1))))
+
+(defun verilog-get-list (start end)
+ "Return the elements of a comma separated list between START and END."
+ (interactive)
+ (let ((my-list (list))
+ my-string)
+ (save-excursion
+ (while (< (point) end)
+ (when (re-search-forward "\\([^,{]+\\)" end t)
+ (setq my-string (verilog-string-remove-spaces (match-string 1)))
+ (setq my-list (nconc my-list (list my-string) ))
+ (goto-char (match-end 0))))
+ my-list)))
+
+(defun verilog-make-width-expression (range-exp)
+ "Return an expression calculating the length of a range [x:y] in RANGE-EXP."
+ ;; strip off the []
+ (cond ((not range-exp)
+ "1")
+ (t
+ (if (string-match "^\\[\\(.*\\)\\]$" range-exp)
+ (setq range-exp (match-string 1 range-exp)))
+ (cond ((not range-exp)
+ "1")
+ ((string-match "^\\s *\\([0-9]+\\)\\s *:\\s *\\([0-9]+\\)\\s *$" range-exp)
+ (int-to-string (1+ (abs (- (string-to-int (match-string 1 range-exp))
+ (string-to-int (match-string 2 range-exp)))))))
+ ((string-match "^\\(.*\\)\\s *:\\s *\\(.*\\)\\s *$" range-exp)
+ (concat "(1+(" (match-string 1 range-exp)
+ ")"
+ (if (equal "0" (match-string 2 range-exp)) ;; Don't bother with -(0)
+ ""
+ (concat "-(" (match-string 2 range-exp) ")"))
+ ")"))
+ (t nil)))))
+;;(verilog-make-width-expression "`A:`B")
+
+(defun verilog-typedef-name-p (variable-name)
+ "Return true if the VARIABLE-NAME is a type definition."
+ (when verilog-typedef-regexp
+ (string-match verilog-typedef-regexp variable-name)))
+\f
+;;
+;; Auto deletion
+;;
+
+(defun verilog-delete-autos-lined ()
+ "Delete autos that occupy multiple lines, between begin and end comments."
+ (let ((pt (point)))
+ (forward-line 1)
+ (when (and
+ (looking-at "\\s-*// Beginning")
+ (search-forward "// End of automatic" nil t))
+ ;; End exists
+ (end-of-line)
+ (delete-region pt (point))
+ (forward-line 1))
+ ))
+
+(defun verilog-forward-close-paren ()
+ "Find the close parenthesis that match the current point,
+ignore other close parenthesis with matching open parens"
+ (let ((parens 1))
+ (while (> parens 0)
+ (unless (verilog-re-search-forward-quick "[()]" nil t)
+ (error "%s: Mismatching ()" (verilog-point-text)))
+ (cond ((= (preceding-char) ?\( )
+ (setq parens (1+ parens)))
+ ((= (preceding-char) ?\) )
+ (setq parens (1- parens)))))))
+
+(defun verilog-backward-open-paren ()
+ "Find the open parenthesis that match the current point,
+ignore other open parenthesis with matching close parens"
+ (let ((parens 1))
+ (while (> parens 0)
+ (unless (verilog-re-search-backward-quick "[()]" nil t)
+ (error "%s: Mismatching ()" (verilog-point-text)))
+ (cond ((= (following-char) ?\) )
+ (setq parens (1+ parens)))
+ ((= (following-char) ?\( )
+ (setq parens (1- parens)))))))
+
+(defun verilog-backward-open-bracket ()
+ "Find the open bracket that match the current point,
+ignore other open bracket with matching close bracket"
+ (let ((parens 1))
+ (while (> parens 0)
+ (unless (verilog-re-search-backward-quick "[][]" nil t)
+ (error "%s: Mismatching []" (verilog-point-text)))
+ (cond ((= (following-char) ?\] )
+ (setq parens (1+ parens)))
+ ((= (following-char) ?\[ )
+ (setq parens (1- parens)))))))
+
+(defun verilog-delete-to-paren ()
+ "Delete the automatic inst/sense/arg created by autos.
+Deletion stops at the matching end parenthesis."
+ (delete-region (point)
+ (save-excursion
+ (verilog-backward-open-paren)
+ (forward-sexp 1) ;; Moves to paren that closes argdecl's
+ (backward-char 1)
+ (point))))
+
+(defun verilog-auto-star-safe ()
+ "Return if a .* AUTOINST is safe to delete or expand.
+It was created by the AUTOS themselves, or by the user."
+ (and verilog-auto-star-expand
+ (looking-at "[ \t\n\f,]*\\([)]\\|// \\(Outputs\\|Inouts\\|Inputs\\)\\)")))
+
+(defun verilog-delete-auto-star-all ()
+ "Delete a .* AUTOINST, if it is safe."
+ (when (verilog-auto-star-safe)
+ (verilog-delete-to-paren)))
+
+(defun verilog-delete-auto-star-implicit ()
+ "Delete all .* implicit connections created by `verilog-auto-star'.
+This function will be called automatically at save unless
+`verilog-auto-star-save' is set, any non-templated expanded pins will be
+removed."
+ (interactive)
+ (let (paren-pt indent have-close-paren)
+ (save-excursion
+ (goto-char (point-min))
+ ;; We need to match these even outside of comments.
+ ;; For reasonable performance, we don't check if inside comments, sorry.
+ (while (re-search-forward "// Implicit \\.\\*" nil t)
+ (setq paren-pt (point))
+ (beginning-of-line)
+ (setq have-close-paren
+ (save-excursion
+ (when (search-forward ");" paren-pt t)
+ (setq indent (current-indentation))
+ t)))
+ (delete-region (point) (+ 1 paren-pt)) ; Nuke line incl CR
+ (when have-close-paren
+ ;; Delete extra commentary
+ (save-excursion
+ (while (progn
+ (forward-line -1)
+ (looking-at "\\s *//\\s *\\(Outputs\\|Inouts\\|Inputs\\)\n"))
+ (delete-region (match-beginning 0) (match-end 0))))
+ ;; If it is simple, we can put the ); on the same line as the last text
+ (let ((rtn-pt (point)))
+ (save-excursion
+ (while (progn (backward-char 1)
+ (looking-at "[ \t\n\f]")))
+ (when (looking-at ",")
+ (delete-region (+ 1 (point)) rtn-pt))))
+ (when (bolp)
+ (indent-to indent))
+ (insert ");\n")
+ ;; Still need to kill final comma - always is one as we put one after the .*
+ (re-search-backward ",")
+ (delete-char 1))))))
+
+(defun verilog-delete-auto ()
+ "Delete the automatic outputs, regs, and wires created by \\[verilog-auto].
+Use \\[verilog-auto] to re-insert the updated AUTOs.
+
+The hooks `verilog-before-delete-auto-hook' and `verilog-delete-auto-hook' are
+called before and after this function, respectively."
+ (interactive)
+ (save-excursion
+ (if (buffer-file-name)
+ (find-file-noselect (buffer-file-name))) ;; To check we have latest version
+ ;; Allow user to customize
+ (run-hooks 'verilog-before-delete-auto-hook)
+
+ ;; Remove those that have multi-line insertions
+ (verilog-auto-re-search-do "/\\*AUTO\\(OUTPUTEVERY\\|CONCATCOMMENT\\|WIRE\\|REG\\|DEFINEVALUE\\|REGINPUT\\|INPUT\\|OUTPUT\\|INOUT\\|RESET\\|TIEOFF\\|UNUSED\\)\\*/"
+ 'verilog-delete-autos-lined)
+ ;; Remove those that have multi-line insertions with parameters
+ (verilog-auto-re-search-do "/\\*AUTO\\(INOUTMODULE\\|ASCIIENUM\\)([^)]*)\\*/"
+ 'verilog-delete-autos-lined)
+ ;; Remove those that are in parenthesis
+ (verilog-auto-re-search-do "/\\*\\(AS\\|AUTO\\(ARG\\|CONCATWIDTH\\|INST\\|INSTPARAM\\|SENSE\\)\\)\\*/"
+ 'verilog-delete-to-paren)
+ ;; Do .* instantiations, but avoid removing any user pins by looking for our magic comments
+ (verilog-auto-re-search-do "\\.\\*"
+ 'verilog-delete-auto-star-all)
+ ;; Remove template comments ... anywhere in case was pasted after AUTOINST removed
+ (goto-char (point-min))
+ (while (re-search-forward "\\s-*// \\(Templated\\|Implicit \\.\\*\\)[ \tLT0-9]*$" nil t)
+ (replace-match ""))
+
+ ;; Final customize
+ (run-hooks 'verilog-delete-auto-hook)))
+\f
+;;
+;; Auto inject
+;;
+
+(defun verilog-inject-auto ()
+ "Examine legacy non-AUTO code and insert AUTOs in appropriate places.
+
+Any always @ blocks with sensitivity lists that match computed lists will
+be replaced with /*AS*/ comments.
+
+Any cells will get /*AUTOINST*/ added to the end of the pin list. Pins with
+have identical names will be deleted.
+
+Argument lists will not be deleted, /*AUTOARG*/ will only be inserted to
+support adding new ports. You may wish to delete older ports yourself.
+
+For example:
+
+ module ex_inject (i, o);
+ input i;
+ input j;
+ output o;
+ always @ (i or j)
+ o = i | j;
+ cell cell (.foobar(baz),
+ .j(j));
+ endmodule
+
+Typing \\[verilog-inject-auto] will make this into:
+
+ module ex_inject (i, o/*AUTOARG*/
+ // Inputs
+ j);
+ input i;
+ output o;
+ always @ (/*AS*/i or j)
+ o = i | j;
+ cell cell (.foobar(baz),
+ /*AUTOINST*/
+ // Outputs
+ .j(j));
+ endmodule"
+ (interactive)
+ (verilog-auto t))
+
+(defun verilog-inject-arg ()
+ "Inject AUTOARG into new code. See `verilog-inject-auto'."
+ ;; Presume one module per file.
+ (save-excursion
+ (goto-char (point-min))
+ (while (verilog-re-search-forward-quick "\\<module\\>" nil t)
+ (let ((endmodp (save-excursion
+ (verilog-re-search-forward-quick "\\<endmodule\\>" nil t)
+ (point))))
+ ;; See if there's already a comment .. inside a comment so not verilog-re-search
+ (when (not (re-search-forward "/\\*AUTOARG\\*/" endmodp t))
+ (verilog-re-search-forward-quick ";" nil t)
+ (backward-char 1)
+ (verilog-backward-syntactic-ws)
+ (backward-char 1) ; Moves to paren that closes argdecl's
+ (when (looking-at ")")
+ (insert "/*AUTOARG*/")))))))
+
+(defun verilog-inject-sense ()
+ "Inject AUTOSENSE into new code. See `verilog-inject-auto'."
+ (save-excursion
+ (goto-char (point-min))
+ (while (verilog-re-search-forward-quick "\\<always\\s *@\\s *(" nil t)
+ (let ((start-pt (point))
+ (modi (verilog-modi-current))
+ pre-sigs
+ got-sigs)
+ (backward-char 1)
+ (forward-sexp 1)
+ (backward-char 1) ;; End )
+ (when (not (verilog-re-search-backward "/\\*\\(AUTOSENSE\\|AS\\)\\*/" start-pt t))
+ (setq pre-sigs (verilog-signals-from-signame
+ (verilog-read-signals start-pt (point)))
+ got-sigs (verilog-auto-sense-sigs modi nil))
+ (when (not (or (verilog-signals-not-in pre-sigs got-sigs) ; Both are equal?
+ (verilog-signals-not-in got-sigs pre-sigs)))
+ (delete-region start-pt (point))
+ (insert "/*AS*/")))))))
+
+(defun verilog-inject-inst ()
+ "Inject AUTOINST into new code. See `verilog-inject-auto'."
+ (save-excursion
+ (goto-char (point-min))
+ ;; It's hard to distinguish modules; we'll instead search for pins.
+ (while (verilog-re-search-forward-quick "\\.\\s *[a-zA-Z0-9`_\$]+\\s *(\\s *[a-zA-Z0-9`_\$]+\\s *)" nil t)
+ (verilog-backward-open-paren) ;; Inst start
+ (cond
+ ((= (preceding-char) ?\#) ;; #(...) parameter section, not pin. Skip.
+ (forward-char 1)
+ (verilog-forward-close-paren)) ;; Parameters done
+ (t
+ (forward-char 1)
+ (let ((indent-pt (+ (current-column)))
+ (end-pt (save-excursion (verilog-forward-close-paren) (point))))
+ (cond ((verilog-re-search-forward "\\(/\\*AUTOINST\\*/\\|\\.\\*\\)" end-pt t)
+ (goto-char end-pt)) ;; Already there, continue search with next instance
+ (t
+ ;; Delete identical interconnect
+ (let ((case-fold-search nil)) ;; So we don't convert upper-to-lower, etc
+ (while (verilog-re-search-forward "\\.\\s *\\([a-zA-Z0-9`_\$]+\\)*\\s *(\\s *\\1\\s *)\\s *" end-pt t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq end-pt (- end-pt (- (match-end 0) (match-beginning 0)))) ;; Keep it correct
+ (while (or (looking-at "[ \t\n\f,]+")
+ (looking-at "//[^\n]*"))
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq end-pt (- end-pt (- (match-end 0) (match-beginning 0)))))))
+ (verilog-forward-close-paren)
+ (backward-char 1)
+ ;; Not verilog-re-search, as we don't want to strip comments
+ (while (re-search-backward "[ \t\n\f]+" (- (point) 1) t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (insert "\n")
+ (indent-to indent-pt)
+ (insert "/*AUTOINST*/")))))))))
+\f
+;;
+;; Auto save
+;;
+
+(defun verilog-auto-save-check ()
+ "On saving see if we need auto update."
+ (cond ((not verilog-auto-save-policy)) ; disabled
+ ((not (save-excursion
+ (save-match-data
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (re-search-forward "AUTO" nil t))))))
+ ((eq verilog-auto-save-policy 'force)
+ (verilog-auto))
+ ((not (buffer-modified-p)))
+ ((eq verilog-auto-update-tick (buffer-modified-tick))) ; up-to-date
+ ((eq verilog-auto-save-policy 'detect)
+ (verilog-auto))
+ (t
+ (when (yes-or-no-p "AUTO statements not recomputed, do it now? ")
+ (verilog-auto))
+ ;; Don't ask again if didn't update
+ (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick))
+ ))
+ (when (not verilog-auto-star-save)
+ (verilog-delete-auto-star-implicit))
+ nil) ;; Always return nil -- we don't write the file ourselves
+
+(defun verilog-auto-read-locals ()
+ "Return file local variable segment at bottom of file."
+ (save-excursion
+ (goto-char (point-max))
+ (if (re-search-backward "Local Variables:" nil t)
+ (buffer-substring-no-properties (point) (point-max))
+ "")))
+
+(defun verilog-auto-reeval-locals (&optional force)
+ "Read file local variable segment at bottom of file if it has changed.
+If FORCE, always reread it."
+ (make-variable-buffer-local 'verilog-auto-last-file-locals)
+ (let ((curlocal (verilog-auto-read-locals)))
+ (when (or force (not (equal verilog-auto-last-file-locals curlocal)))
+ (setq verilog-auto-last-file-locals curlocal)
+ ;; Note this may cause this function to be recursively invoked.
+ ;; The above when statement will prevent it from recursing forever.
+ (hack-local-variables)
+ t)))
+\f
+;;
+;; Auto creation
+;;
+
+(defun verilog-auto-arg-ports (sigs message indent-pt)
+ "Print a list of ports for a AUTOINST.
+Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT."
+ (when sigs
+ (insert "\n")
+ (indent-to indent-pt)
+ (insert message)
+ (insert "\n")
+ (let ((space ""))
+ (indent-to indent-pt)
+ (while sigs
+ (cond ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column)
+ (insert "\n")
+ (indent-to indent-pt))
+ (t (insert space)))
+ (insert (verilog-sig-name (car sigs)) ",")
+ (setq sigs (cdr sigs)
+ space " ")))))
+
+(defun verilog-auto-arg ()
+ "Expand AUTOARG statements.
+Replace the argument declarations at the beginning of the
+module with ones automatically derived from input and output
+statements. This can be dangerous if the module is instantiated
+using position-based connections, so use only name-based when
+instantiating the resulting module. Long lines are split based
+on the `fill-column', see \\[set-fill-column].
+
+Limitations:
+ Concatenation and outputting partial busses is not supported.
+
+ Typedefs must match `verilog-typedef-regexp', which is disabled by default.
+
+For example:
+
+ module ex_arg (/*AUTOARG*/);
+ input i;
+ output o;
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_arg (/*AUTOARG*/
+ // Outputs
+ o,
+ // Inputs
+ i
+ );
+ input i;
+ output o;
+ endmodule
+
+Any ports declared between the ( and /*AUTOARG*/ are presumed to be
+predeclared and are not redeclared by AUTOARG. AUTOARG will make a
+conservative guess on adding a comma for the first signal, if you have any
+ifdefs or complicated expressions before the AUTOARG you will need to
+choose the comma yourself.
+
+Avoid declaring ports manually, as it makes code harder to maintain."
+ (save-excursion
+ (let ((modi (verilog-modi-current))
+ (skip-pins (aref (verilog-read-arg-pins) 0)))
+ (verilog-repair-open-comma)
+ (verilog-auto-arg-ports (verilog-signals-not-in
+ (verilog-modi-get-outputs modi)
+ skip-pins)
+ "// Outputs"
+ verilog-indent-level-declaration)
+ (verilog-auto-arg-ports (verilog-signals-not-in
+ (verilog-modi-get-inouts modi)
+ skip-pins)
+ "// Inouts"
+ verilog-indent-level-declaration)
+ (verilog-auto-arg-ports (verilog-signals-not-in
+ (verilog-modi-get-inputs modi)
+ skip-pins)
+ "// Inputs"
+ verilog-indent-level-declaration)
+ (verilog-repair-close-comma)
+ (unless (eq (char-before) ?/ )
+ (insert "\n"))
+ (indent-to verilog-indent-level-declaration)
+ )))
+
+(defun verilog-auto-inst-port-map (port-st)
+ nil)
+
+(defvar vector-skip-list nil) ; Prevent compile warning
+(defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning
+(defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
+(defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
+(defvar vl-width nil "See `verilog-auto-inst'.") ; Prevent compile warning
+(defvar vl-dir nil "See `verilog-auto-inst'.") ; Prevent compile warning
+
+(defun verilog-auto-inst-port (port-st indent-pt tpl-list tpl-num for-star)
+ "Print out a instantiation connection for this PORT-ST.
+Insert to INDENT-PT, use template TPL-LIST.
+@ are instantiation numbers, replaced with TPL-NUM.
+@\"(expression @)\" are evaluated, with @ as a variable."
+ (let* ((port (verilog-sig-name port-st))
+ (tpl-ass (or (assoc port (car tpl-list))
+ (verilog-auto-inst-port-map port-st)))
+ ;; vl-* are documented for user use
+ (vl-name (verilog-sig-name port-st))
+ (vl-width (verilog-sig-width port-st))
+ (vl-bits (if (or verilog-auto-inst-vector
+ (not (assoc port vector-skip-list))
+ (not (equal (verilog-sig-bits port-st)
+ (verilog-sig-bits (assoc port vector-skip-list)))))
+ (or (verilog-sig-bits port-st) "")
+ ""))
+ ;; Default if not found
+ (tpl-net (if (verilog-sig-multidim port-st)
+ (concat port "/*" (verilog-sig-multidim-string port-st)
+ vl-bits "*/")
+ (concat port vl-bits))))
+ ;; Find template
+ (cond (tpl-ass ; Template of exact port name
+ (setq tpl-net (nth 1 tpl-ass)))
+ ((nth 1 tpl-list) ; Wildcards in template, search them
+ (let ((wildcards (nth 1 tpl-list)))
+ (while wildcards
+ (when (string-match (nth 0 (car wildcards)) port)
+ (setq tpl-ass (car wildcards) ; so allow @ parsing
+ tpl-net (replace-match (nth 1 (car wildcards))
+ t nil port)))
+ (setq wildcards (cdr wildcards))))))
+ ;; Parse Templated variable
+ (when tpl-ass
+ ;; Evaluate @"(lispcode)"
+ (when (string-match "@\".*[^\\]\"" tpl-net)
+ (while (string-match "@\"\\(\\([^\\\"]*\\(\\\\.\\)*\\)*\\)\"" tpl-net)
+ (setq tpl-net
+ (concat
+ (substring tpl-net 0 (match-beginning 0))
+ (save-match-data
+ (let* ((expr (match-string 1 tpl-net))
+ (value
+ (progn
+ (setq expr (verilog-string-replace-matches "\\\\\"" "\"" nil nil expr))
+ (setq expr (verilog-string-replace-matches "@" tpl-num nil nil expr))
+ (prin1 (eval (car (read-from-string expr)))
+ (lambda (ch) ())))))
+ (if (numberp value) (setq value (number-to-string value)))
+ value
+ ))
+ (substring tpl-net (match-end 0))))))
+ ;; Replace @ and [] magic variables in final output
+ (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net))
+ (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net))
+ )
+ (indent-to indent-pt)
+ (insert "." port)
+ (indent-to verilog-auto-inst-column)
+ (insert "(" tpl-net "),")
+ (cond (tpl-ass
+ (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
+ verilog-auto-inst-column))
+ (insert " // Templated")
+ (when verilog-auto-inst-template-numbers
+ (insert " T" (int-to-string (nth 2 tpl-ass))
+ " L" (int-to-string (nth 3 tpl-ass)))))
+ (for-star
+ (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
+ verilog-auto-inst-column))
+ (insert " // Implicit .\*"))) ;For some reason the . or * must be escaped...
+ (insert "\n")))
+;;(verilog-auto-inst-port (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3")
+;;(x "incom[@\"(+ (* 8 @) 7)\":@\"(* 8 @)\"]")
+;;(x ".out (outgo[@\"(concat (+ (* 8 @) 7) \\\":\\\" ( * 8 @))\"]));")
+
+(defun verilog-auto-inst-first ()
+ "Insert , etc before first ever port in this instant, as part of \\[verilog-auto-inst]."
+ ;; Do we need a trailing comma?
+ ;; There maybe a ifdef or something similar before us. What a mess. Thus
+ ;; to avoid trouble we only insert on preceeding ) or *.
+ ;; Insert first port on new line
+ (insert "\n") ;; Must insert before search, so point will move forward if insert comma
+ (save-excursion
+ (verilog-re-search-backward "[^ \t\n\f]" nil nil)
+ (when (looking-at ")\\|\\*") ;; Generally don't insert, unless we are fairly sure
+ (forward-char 1)
+ (insert ","))))
+
+(defun verilog-auto-star ()
+ "Expand SystemVerilog .* pins, as part of \\[verilog-auto].
+
+If `verilog-auto-star-expand' is set, .* pins are treated if they were
+AUTOINST statements, otherwise they are ignored. For safety, Verilog-Mode
+will also ignore any .* that are not last in your pin list (this prevents
+it from deleting pins following the .* when it expands the AUTOINST.)
+
+On writing your file, unless `verilog-auto-star-save' is set, any
+non-templated expanded pins will be removed. You may do this at any time
+with \\[verilog-delete-auto-star-implicit].
+
+If you are converting a module to use .* for the first time, you may wish
+to use \\[verilog-inject-auto] and then replace the created AUTOINST with .*.
+
+See `verilog-auto-inst' for examples, templates, and more information."
+ (when (verilog-auto-star-safe)
+ (verilog-auto-inst)))
+
+(defun verilog-auto-inst ()
+ "Expand AUTOINST statements, as part of \\[verilog-auto].
+Replace the pin connections to an instantiation with ones
+automatically derived from the module header of the instantiated netlist.
+
+If `verilog-auto-star-expand' is set, also expand SystemVerilog .* ports,
+and delete them before saving unless `verilog-auto-star-save' is set.
+See `verilog-auto-star' for more information.
+
+Limitations:
+ Module names must be resolvable to filenames by adding a
+ `verilog-library-extensions', and being found in the same directory, or
+ by changing the variable `verilog-library-flags' or
+ `verilog-library-directories'. Macros `modname are translated through the
+ vh-{name} Emacs variable, if that is not found, it just ignores the `.
+
+ In templates you must have one signal per line, ending in a ), or ));,
+ and have proper () nesting, including a final ); to end the template.
+
+ Typedefs must match `verilog-typedef-regexp', which is disabled by default.
+
+ SystemVerilog multidimmensional input/output has only experimental support.
+
+For example, first take the submodule inst.v:
+
+ module inst (o,i)
+ output [31:0] o;
+ input i;
+ wire [31:0] o = {32{i}};
+ endmodule
+
+This is then used in a upper level module:
+
+ module ex_inst (o,i)
+ output o;
+ input i;
+ inst inst (/*AUTOINST*/);
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_inst (o,i)
+ output o;
+ input i;
+ inst inst (/*AUTOINST*/
+ // Outputs
+ .ov (ov[31:0]),
+ // Inputs
+ .i (i));
+ endmodule
+
+Where the list of inputs and outputs came from the inst module.
+\f
+Exceptions:
+
+ Unless you are instantiating a module multiple times, or the module is
+ something trivial like a adder, DO NOT CHANGE SIGNAL NAMES ACROSS HIERARCHY.
+ It just makes for unmaintainable code. To sanitize signal names, try
+ vrename from http://www.veripool.com
+
+ When you need to violate this suggestion there are two ways to list
+ exceptions, placing them before the AUTOINST, or using templates.
+
+ Any ports defined before the /*AUTOINST*/ are not included in the list of
+ automatics. This is similar to making a template as described below, but
+ is restricted to simple connections just like you normally make. Also note
+ that any signals before the AUTOINST will only be picked up by AUTOWIRE if
+ you have the appropriate // Input or // Output comment, and exactly the
+ same line formatting as AUTOINST itself uses.
+
+ inst inst (// Inputs
+ .i (my_i_dont_mess_with_it),
+ /*AUTOINST*/
+ // Outputs
+ .ov (ov[31:0]));
+
+\f
+Templates:
+
+ For multiple instantiations based upon a single template, create a
+ commented out template:
+
+ /* instantiating_module_name AUTO_TEMPLATE (
+ .sig3 (sigz[]),
+ );
+ */
+
+ Templates go ABOVE the instantiation(s). When a instantiation is
+ expanded `verilog-mode' simply searches up for the closest template.
+ Thus you can have multiple templates for the same module, just alternate
+ between the template for a instantiation and the instantiation itself.
+
+ The module name must be the same as the name of the module in the
+ instantiation name, and the code \"AUTO_TEMPLATE\" must be in these exact
+ words and capitalized. Only signals that must be different for each
+ instantiation need to be listed.
+
+ Inside a template, a [] in a connection name (with nothing else inside
+ the brackets) will be replaced by the same bus subscript as it is being
+ connected to, or the [] will be removed if it is a single bit signal.
+ Generally it is a good idea to do this for all connections in a template,
+ as then they will work for any width signal, and with AUTOWIRE. See
+ PTL_BUS becoming PTL_BUSNEW below.
+
+ If you have a complicated template, set `verilog-auto-inst-template-numbers'
+ to see which regexps are matching. Don't leave that mode set after
+ debugging is completed though, it will result in lots of extra differences
+ and merge conflicts.
+
+ For example:
+
+ /* psm_mas AUTO_TEMPLATE (
+ .ptl_bus (ptl_busnew[]),
+ );
+ */
+ psm_mas ms2m (/*AUTOINST*/);
+
+ Typing \\[verilog-auto] will make this into:
+
+ psm_mas ms2m (/*AUTOINST*/
+ // Outputs
+ .NotInTemplate (NotInTemplate),
+ .ptl_bus (ptl_busnew[3:0]), // Templated
+ ....
+\f
+@ Templates:
+
+ It is common to instantiate a cell multiple times, so templates make it
+ trivial to substitute part of the cell name into the connection name.
+
+ /* cell_type AUTO_TEMPLATE <optional \"REGEXP\"> (
+ .sig1 (sigx[@]),
+ .sig2 (sigy[@\"(% (+ 1 @) 4)\"]),
+ );
+ */
+
+ If no regular expression is provided immediately after the AUTO_TEMPLATE
+ keyword, then the @ character in any connection names will be replaced
+ with the instantiation number; the first digits found in the cell's
+ instantiation name.
+
+ If a regular expression is provided, the @ character will be replaced
+ with the first \(\) grouping that matches against the cell name. Using a
+ regexp of \"\\([0-9]+\\)\" provides identical values for @ as when no
+ regexp is provided. If you use multiple layers of parenthesis,
+ \"test\\([^0-9]+\\)_\\([0-9]+\\)\" would replace @ with non-number
+ characters after test and before _, whereas
+ \"\\(test\\([a-z]+\\)_\\([0-9]+\\)\\)\" would replace @ with the entire
+ match.
+
+ For example:
+
+ /* psm_mas AUTO_TEMPLATE (
+ .ptl_mapvalidx (ptl_mapvalid[@]),
+ .ptl_mapvalidp1x (ptl_mapvalid[@\"(% (+ 1 @) 4)\"]),
+ );
+ */
+ psm_mas ms2m (/*AUTOINST*/);
+
+ Typing \\[verilog-auto] will make this into:
+
+ psm_mas ms2m (/*AUTOINST*/
+ // Outputs
+ .ptl_mapvalidx (ptl_mapvalid[2]),
+ .ptl_mapvalidp1x (ptl_mapvalid[3]));
+
+ Note the @ character was replaced with the 2 from \"ms2m\".
+
+ Alternatively, using a regular expression for @:
+
+ /* psm_mas AUTO_TEMPLATE \"_\\([a-z]+\\)\" (
+ .ptl_mapvalidx (@_ptl_mapvalid),
+ .ptl_mapvalidp1x (ptl_mapvalid_@),
+ );
+ */
+ psm_mas ms2_FOO (/*AUTOINST*/);
+ psm_mas ms2_BAR (/*AUTOINST*/);
+
+ Typing \\[verilog-auto] will make this into:
+
+ psm_mas ms2_FOO (/*AUTOINST*/
+ // Outputs
+ .ptl_mapvalidx (FOO_ptl_mapvalid),
+ .ptl_mapvalidp1x (ptl_mapvalid_FOO));
+ psm_mas ms2_BAR (/*AUTOINST*/
+ // Outputs
+ .ptl_mapvalidx (BAR_ptl_mapvalid),
+ .ptl_mapvalidp1x (ptl_mapvalid_BAR));
+
+\f
+Regexp Templates:
+
+ A template entry of the form
+
+ .pci_req\\([0-9]+\\)_l (pci_req_jtag_[\\1]),
+
+ will apply a Emacs style regular expression search for any port beginning
+ in pci_req followed by numbers and ending in _l and connecting that to
+ the pci_req_jtag_[] net, with the bus subscript coming from what matches
+ inside the first set of \\( \\). Thus pci_req2_l becomes pci_req_jtag_[2].
+
+ Since \\([0-9]+\\) is so common and ugly to read, a @ in the port name
+ does the same thing. (Note a @ in the connection/replacement text is
+ completely different -- still use \\1 there!) Thus this is the same as
+ the above template:
+
+ .pci_req@_l (pci_req_jtag_[\\1]),
+
+ Here's another example to remove the _l, useful when naming conventions
+ specify _ alone to mean active low. Note the use of [] to keep the bus
+ subscript:
+
+ .\\(.*\\)_l (\\1_[]),
+\f
+Lisp Templates:
+
+ First any regular expression template is expanded.
+
+ If the syntax @\"( ... )\" is found in a connection, the expression in
+ quotes will be evaluated as a Lisp expression, with @ replaced by the
+ instantiation number. The MAPVALIDP1X example above would put @+1 modulo
+ 4 into the brackets. Quote all double-quotes inside the expression with
+ a leading backslash (\\\"). There are special variables defined that are
+ useful in these Lisp functions:
+
+ vl-name Name portion of the input/output port
+ vl-bits Bus bits portion of the input/output port ('[2:0]')
+ vl-width Width of the input/output port ('3' for [2:0])
+ May be a (...) expression if bits isn't a constant.
+ vl-dir Direction of the pin input/output/inout.
+ vl-cell-type Module name/type of the cell ('psm_mas')
+ vl-cell-name Instance name of the cell ('ms2m')
+
+ Normal Lisp variables may be used in expressions. See
+ `verilog-read-defines' which can set vh-{definename} variables for use
+ here. Also, any comments of the form:
+
+ /*AUTO_LISP(setq foo 1)*/
+
+ will evaluate any Lisp expression inside the parenthesis between the
+ beginning of the buffer and the point of the AUTOINST. This allows
+ functions to be defined or variables to be changed between instantiations.
+
+ Note that when using lisp expressions errors may occur when @ is not a
+ number, you may need to use the standard Emacs Lisp functions
+ `number-to-string' and `string-to-number'.
+
+ After the evaluation is completed, @ substitution and [] substitution
+ occur."
+ (save-excursion
+ ;; Find beginning
+ (let* ((pt (point))
+ (for-star (save-excursion (backward-char 2) (looking-at "\\.\\*")))
+ (indent-pt (save-excursion (verilog-backward-open-paren)
+ (1+ (current-column))))
+ (verilog-auto-inst-column (max verilog-auto-inst-column
+ (+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
+ (modi (verilog-modi-current))
+ (vector-skip-list (unless verilog-auto-inst-vector
+ (verilog-modi-get-signals modi)))
+ submod submodi inst skip-pins tpl-list tpl-num did-first)
+ ;; Find module name that is instantiated
+ (setq submod (verilog-read-inst-module)
+ inst (verilog-read-inst-name)
+ vl-cell-type submod
+ vl-cell-name inst
+ skip-pins (aref (verilog-read-inst-pins) 0))
+
+ ;; Parse any AUTO_LISP() before here
+ (verilog-read-auto-lisp (point-min) pt)
+
+ ;; Lookup position, etc of submodule
+ ;; Note this may raise an error
+ (when (setq submodi (verilog-modi-lookup submod t))
+ ;; If there's a number in the instantiation, it may be a argument to the
+ ;; automatic variable instantiation program.
+ (let* ((tpl-info (verilog-read-auto-template submod))
+ (tpl-regexp (aref tpl-info 0)))
+ (setq tpl-num (if (string-match tpl-regexp inst)
+ (match-string 1 inst)
+ "")
+ tpl-list (aref tpl-info 1)))
+ ;; Find submodule's signals and dump
+ (let ((sig-list (verilog-signals-not-in
+ (verilog-modi-get-outputs submodi)
+ skip-pins))
+ (vl-dir "output"))
+ (when sig-list
+ (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
+ (indent-to indent-pt)
+ (insert "// Outputs\n") ;; Note these are searched for in verilog-read-sub-decls
+ (mapcar (function (lambda (port)
+ (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star)))
+ sig-list)))
+ (let ((sig-list (verilog-signals-not-in
+ (verilog-modi-get-inouts submodi)
+ skip-pins))
+ (vl-dir "inout"))
+ (when sig-list
+ (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
+ (indent-to indent-pt)
+ (insert "// Inouts\n")
+ (mapcar (function (lambda (port)
+ (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star)))
+ sig-list)))
+ (let ((sig-list (verilog-signals-not-in
+ (verilog-modi-get-inputs submodi)
+ skip-pins))
+ (vl-dir "input"))
+ (when sig-list
+ (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
+ (indent-to indent-pt)
+ (insert "// Inputs\n")
+ (mapcar (function (lambda (port)
+ (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star)))
+ sig-list)))
+ ;; Kill extra semi
+ (save-excursion
+ (cond (did-first
+ (re-search-backward "," pt t)
+ (delete-char 1)
+ (insert ");")
+ (search-forward "\n") ;; Added by inst-port
+ (delete-backward-char 1)
+ (if (search-forward ")" nil t) ;; From user, moved up a line
+ (delete-backward-char 1))
+ (if (search-forward ";" nil t) ;; Don't error if user had syntax error and forgot it
+ (delete-backward-char 1))
+ )))
+ ))))
+
+(defun verilog-auto-inst-param ()
+ "Expand AUTOINSTPARAM statements, as part of \\[verilog-auto].
+Replace the parameter connections to an instantiation with ones
+automatically derived from the module header of the instantiated netlist.
+
+See \\[verilog-auto-inst] for limitations, and templates to customize the
+output.
+
+For example, first take the submodule inst.v:
+
+ module inst (o,i)
+ parameter PAR;
+ endmodule
+
+This is then used in a upper level module:
+
+ module ex_inst (o,i)
+ parameter PAR;
+ inst #(/*AUTOINSTPARAM*/)
+ inst (/*AUTOINST*/);
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_inst (o,i)
+ output o;
+ input i;
+ inst (/*AUTOINSTPARAM*/
+ // Parameters
+ .PAR (PAR));
+ inst (/*AUTOINST*/);
+ endmodule
+
+Where the list of parameter connections come from the inst module.
+\f
+Templates:
+
+ You can customize the parameter connections using AUTO_TEMPLATEs,
+ just as you would with \\[verilog-auto-inst]."
+ (save-excursion
+ ;; Find beginning
+ (let* ((pt (point))
+ (indent-pt (save-excursion (verilog-backward-open-paren)
+ (1+ (current-column))))
+ (verilog-auto-inst-column (max verilog-auto-inst-column
+ (+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
+ (modi (verilog-modi-current))
+ (vector-skip-list (unless verilog-auto-inst-vector
+ (verilog-modi-get-signals modi)))
+ submod submodi inst skip-pins tpl-list tpl-num did-first)
+ ;; Find module name that is instantiated
+ (setq submod (save-excursion
+ ;; Get to the point where AUTOINST normally is to read the module
+ (verilog-re-search-forward-quick "[(;]" nil nil)
+ (verilog-read-inst-module))
+ inst (save-excursion
+ ;; Get to the point where AUTOINST normally is to read the module
+ (verilog-re-search-forward-quick "[(;]" nil nil)
+ (verilog-read-inst-name))
+ vl-cell-type submod
+ vl-cell-name inst
+ skip-pins (aref (verilog-read-inst-pins) 0))
+
+ ;; Parse any AUTO_LISP() before here
+ (verilog-read-auto-lisp (point-min) pt)
+
+ ;; Lookup position, etc of submodule
+ ;; Note this may raise an error
+ (when (setq submodi (verilog-modi-lookup submod t))
+ ;; If there's a number in the instantiation, it may be a argument to the
+ ;; automatic variable instantiation program.
+ (let* ((tpl-info (verilog-read-auto-template submod))
+ (tpl-regexp (aref tpl-info 0)))
+ (setq tpl-num (if (string-match tpl-regexp inst)
+ (match-string 1 inst)
+ "")
+ tpl-list (aref tpl-info 1)))
+ ;; Find submodule's signals and dump
+ (let ((sig-list (verilog-signals-not-in
+ (verilog-modi-get-gparams submodi)
+ skip-pins))
+ (vl-dir "parameter"))
+ (when sig-list
+ (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
+ (indent-to indent-pt)
+ (insert "// Parameters\n") ;; Note these are searched for in verilog-read-sub-decls
+ (mapcar (function (lambda (port)
+ (verilog-auto-inst-port port indent-pt tpl-list tpl-num nil)))
+ sig-list)))
+ ;; Kill extra semi
+ (save-excursion
+ (cond (did-first
+ (re-search-backward "," pt t)
+ (delete-char 1)
+ (insert ")")
+ (search-forward "\n") ;; Added by inst-port
+ (delete-backward-char 1)
+ (if (search-forward ")" nil t) ;; From user, moved up a line
+ (delete-backward-char 1))
+ )))
+ ))))
+
+(defun verilog-auto-reg ()
+ "Expand AUTOREG statements, as part of \\[verilog-auto].
+Make reg statements for any output that isn't already declared,
+and isn't a wire output from a block.
+
+Limitations:
+ This ONLY detects outputs of AUTOINSTants (see `verilog-read-sub-decls').
+
+ This does NOT work on memories, declare those yourself.
+
+An example:
+
+ module ex_reg (o,i)
+ output o;
+ input i;
+ /*AUTOREG*/
+ always o = i;
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_reg (o,i)
+ output o;
+ input i;
+ /*AUTOREG*/
+ // Beginning of automatic regs (for this module's undeclared outputs)
+ reg o;
+ // End of automatics
+ always o = i;
+ endmodule"
+ (save-excursion
+ ;; Point must be at insertion point.
+ (let* ((indent-pt (current-indentation))
+ (modi (verilog-modi-current))
+ (sig-list (verilog-signals-not-in
+ (verilog-modi-get-outputs modi)
+ (append (verilog-modi-get-wires modi)
+ (verilog-modi-get-regs modi)
+ (verilog-modi-get-assigns modi)
+ (verilog-modi-get-consts modi)
+ (verilog-modi-get-gparams modi)
+ (verilog-modi-get-sub-outputs modi)
+ (verilog-modi-get-sub-inouts modi)
+ ))))
+ (forward-line 1)
+ (when sig-list
+ (verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n")
+ (verilog-insert-definition sig-list "reg" indent-pt nil)
+ (verilog-modi-cache-add-regs modi sig-list)
+ (verilog-insert-indent "// End of automatics\n"))
+ )))
+
+(defun verilog-auto-reg-input ()
+ "Expand AUTOREGINPUT statements, as part of \\[verilog-auto].
+Make reg statements instantiation inputs that aren't already declared.
+This is useful for making a top level shell for testing the module that is
+to be instantiated.
+
+Limitations:
+ This ONLY detects inputs of AUTOINSTants (see `verilog-read-sub-decls').
+
+ This does NOT work on memories, declare those yourself.
+
+An example (see `verilog-auto-inst' for what else is going on here):
+
+ module ex_reg_input (o,i)
+ output o;
+ input i;
+ /*AUTOREGINPUT*/
+ inst inst (/*AUTOINST*/);
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_reg_input (o,i)
+ output o;
+ input i;
+ /*AUTOREGINPUT*/
+ // Beginning of automatic reg inputs (for undeclared ...
+ reg [31:0] iv; // From inst of inst.v
+ // End of automatics
+ inst inst (/*AUTOINST*/
+ // Outputs
+ .o (o[31:0]),
+ // Inputs
+ .iv (iv));
+ endmodule"
+ (save-excursion
+ ;; Point must be at insertion point.
+ (let* ((indent-pt (current-indentation))
+ (modi (verilog-modi-current))
+ (sig-list (verilog-signals-combine-bus
+ (verilog-signals-not-in
+ (append (verilog-modi-get-sub-inputs modi)
+ (verilog-modi-get-sub-inouts modi))
+ (verilog-modi-get-signals modi)
+ ))))
+ (forward-line 1)
+ (when sig-list
+ (verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n")
+ (verilog-insert-definition sig-list "reg" indent-pt nil)
+ (verilog-modi-cache-add-regs modi sig-list)
+ (verilog-insert-indent "// End of automatics\n"))
+ )))
+
+(defun verilog-auto-wire ()
+ "Expand AUTOWIRE statements, as part of \\[verilog-auto].
+Make wire statements for instantiations outputs that aren't
+already declared.
+
+Limitations:
+ This ONLY detects outputs of AUTOINSTants (see `verilog-read-sub-decls'),
+ and all busses must have widths, such as those from AUTOINST, or using []
+ in AUTO_TEMPLATEs.
+
+ This does NOT work on memories or SystemVerilog .name connections,
+ declare those yourself.
+
+An example (see `verilog-auto-inst' for what else is going on here):
+
+ module ex_wire (o,i)
+ output o;
+ input i;
+ /*AUTOWIRE*/
+ inst inst (/*AUTOINST*/);
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_wire (o,i)
+ output o;
+ input i;
+ /*AUTOWIRE*/
+ // Beginning of automatic wires
+ wire [31:0] ov; // From inst of inst.v
+ // End of automatics
+ inst inst (/*AUTOINST*/
+ // Outputs
+ .ov (ov[31:0]),
+ // Inputs
+ .i (i));
+ wire o = | ov;
+ endmodule"
+ (save-excursion
+ ;; Point must be at insertion point.
+ (let* ((indent-pt (current-indentation))
+ (modi (verilog-modi-current))
+ (sig-list (verilog-signals-combine-bus
+ (verilog-signals-not-in
+ (append (verilog-modi-get-sub-outputs modi)
+ (verilog-modi-get-sub-inouts modi))
+ (verilog-modi-get-signals modi)
+ ))))
+ (forward-line 1)
+ (when sig-list
+ (verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n")
+ (verilog-insert-definition sig-list "wire" indent-pt nil)
+ (verilog-modi-cache-add-wires modi sig-list)
+ (verilog-insert-indent "// End of automatics\n")
+ (when nil ;; Too slow on huge modules, plus makes everyone's module change
+ (beginning-of-line)
+ (setq pnt (point))
+ (verilog-pretty-declarations)
+ (goto-char pnt)
+ (verilog-pretty-expr "//")))
+ )))
+
+(defun verilog-auto-output ()
+ "Expand AUTOOUTPUT statements, as part of \\[verilog-auto].
+Make output statements for any output signal from an /*AUTOINST*/ that
+isn't a input to another AUTOINST. This is useful for modules which
+only instantiate other modules.
+
+Limitations:
+ This ONLY detects outputs of AUTOINSTants (see `verilog-read-sub-decls').
+
+ If placed inside the parenthesis of a module declaration, it creates
+ Verilog 2001 style, else uses Verilog 1995 style.
+
+ If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
+ instantiation, all bets are off. (For example due to a AUTO_TEMPLATE).
+
+ Typedefs must match `verilog-typedef-regexp', which is disabled by default.
+
+ Signals matching `verilog-auto-output-ignore-regexp' are not included.
+
+An example (see `verilog-auto-inst' for what else is going on here):
+
+ module ex_output (ov,i)
+ input i;
+ /*AUTOOUTPUT*/
+ inst inst (/*AUTOINST*/);
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_output (ov,i)
+ input i;
+ /*AUTOOUTPUT*/
+ // Beginning of automatic outputs (from unused autoinst outputs)
+ output [31:0] ov; // From inst of inst.v
+ // End of automatics
+ inst inst (/*AUTOINST*/
+ // Outputs
+ .ov (ov[31:0]),
+ // Inputs
+ .i (i));
+ endmodule"
+ (save-excursion
+ ;; Point must be at insertion point.
+ (let* ((indent-pt (current-indentation))
+ (v2k (verilog-in-paren))
+ (modi (verilog-modi-current))
+ (sig-list (verilog-signals-not-in
+ (verilog-modi-get-sub-outputs modi)
+ (append (verilog-modi-get-outputs modi)
+ (verilog-modi-get-inouts modi)
+ (verilog-modi-get-sub-inputs modi)
+ (verilog-modi-get-sub-inouts modi)
+ ))))
+ (setq sig-list (verilog-signals-not-matching-regexp
+ sig-list verilog-auto-output-ignore-regexp))
+ (forward-line 1)
+ (when v2k (verilog-repair-open-comma))
+ (when sig-list
+ (verilog-insert-indent "// Beginning of automatic outputs (from unused autoinst outputs)\n")
+ (verilog-insert-definition sig-list "output" indent-pt v2k)
+ (verilog-modi-cache-add-outputs modi sig-list)
+ (verilog-insert-indent "// End of automatics\n"))
+ (when v2k (verilog-repair-close-comma))
+ )))
+
+(defun verilog-auto-output-every ()
+ "Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto].
+Make output statements for any signals that aren't primary inputs or
+outputs already. This makes every signal in the design a output. This is
+useful to get Synopsys to preserve every signal in the design, since it
+won't optimize away the outputs.
+
+An example:
+
+ module ex_output_every (o,i,tempa,tempb)
+ output o;
+ input i;
+ /*AUTOOUTPUTEVERY*/
+ wire tempa = i;
+ wire tempb = tempa;
+ wire o = tempb;
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_output_every (o,i,tempa,tempb)
+ output o;
+ input i;
+ /*AUTOOUTPUTEVERY*/
+ // Beginning of automatic outputs (every signal)
+ output tempb;
+ output tempa;
+ // End of automatics
+ wire tempa = i;
+ wire tempb = tempa;
+ wire o = tempb;
+ endmodule"
+ (save-excursion
+ ;;Point must be at insertion point
+ (let* ((indent-pt (current-indentation))
+ (v2k (verilog-in-paren))
+ (modi (verilog-modi-current))
+ (sig-list (verilog-signals-combine-bus
+ (verilog-signals-not-in
+ (verilog-modi-get-signals modi)
+ (verilog-modi-get-ports modi)
+ ))))
+ (forward-line 1)
+ (when v2k (verilog-repair-open-comma))
+ (when sig-list
+ (verilog-insert-indent "// Beginning of automatic outputs (every signal)\n")
+ (verilog-insert-definition sig-list "output" indent-pt v2k)
+ (verilog-modi-cache-add-outputs modi sig-list)
+ (verilog-insert-indent "// End of automatics\n"))
+ (when v2k (verilog-repair-close-comma))
+ )))
+
+(defun verilog-auto-input ()
+ "Expand AUTOINPUT statements, as part of \\[verilog-auto].
+Make input statements for any input signal into an /*AUTOINST*/ that
+isn't declared elsewhere inside the module. This is useful for modules which
+only instantiate other modules.
+
+Limitations:
+ This ONLY detects outputs of AUTOINSTants (see `verilog-read-sub-decls').
+
+ If placed inside the parenthesis of a module declaration, it creates
+ Verilog 2001 style, else uses Verilog 1995 style.
+
+ If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
+ instantiation, all bets are off. (For example due to a AUTO_TEMPLATE).
+
+ Typedefs must match `verilog-typedef-regexp', which is disabled by default.
+
+ Signals matching `verilog-auto-input-ignore-regexp' are not included.
+
+An example (see `verilog-auto-inst' for what else is going on here):
+
+ module ex_input (ov,i)
+ output [31:0] ov;
+ /*AUTOINPUT*/
+ inst inst (/*AUTOINST*/);
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_input (ov,i)
+ output [31:0] ov;
+ /*AUTOINPUT*/
+ // Beginning of automatic inputs (from unused autoinst inputs)
+ input i; // From inst of inst.v
+ // End of automatics
+ inst inst (/*AUTOINST*/
+ // Outputs
+ .ov (ov[31:0]),
+ // Inputs
+ .i (i));
+ endmodule"
+ (save-excursion
+ (let* ((indent-pt (current-indentation))
+ (v2k (verilog-in-paren))
+ (modi (verilog-modi-current))
+ (sig-list (verilog-signals-not-in
+ (verilog-modi-get-sub-inputs modi)
+ (append (verilog-modi-get-inputs modi)
+ (verilog-modi-get-inouts modi)
+ (verilog-modi-get-wires modi)
+ (verilog-modi-get-regs modi)
+ (verilog-modi-get-consts modi)
+ (verilog-modi-get-gparams modi)
+ (verilog-modi-get-sub-outputs modi)
+ (verilog-modi-get-sub-inouts modi)
+ ))))
+ (setq sig-list (verilog-signals-not-matching-regexp
+ sig-list verilog-auto-input-ignore-regexp))
+ (forward-line 1)
+ (when v2k (verilog-repair-open-comma))
+ (when sig-list
+ (verilog-insert-indent "// Beginning of automatic inputs (from unused autoinst inputs)\n")
+ (verilog-insert-definition sig-list "input" indent-pt v2k)
+ (verilog-modi-cache-add-inputs modi sig-list)
+ (verilog-insert-indent "// End of automatics\n"))
+ (when v2k (verilog-repair-close-comma))
+ )))
+
+(defun verilog-auto-inout ()
+ "Expand AUTOINOUT statements, as part of \\[verilog-auto].
+Make inout statements for any inout signal in an /*AUTOINST*/ that
+isn't declared elsewhere inside the module.
+
+Limitations:
+ This ONLY detects outputs of AUTOINSTants (see `verilog-read-sub-decls').
+
+ If placed inside the parenthesis of a module declaration, it creates
+ Verilog 2001 style, else uses Verilog 1995 style.
+
+ If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
+ instantiation, all bets are off. (For example due to a AUTO_TEMPLATE).
+
+ Typedefs must match `verilog-typedef-regexp', which is disabled by default.
+
+ Signals matching `verilog-auto-inout-ignore-regexp' are not included.
+
+An example (see `verilog-auto-inst' for what else is going on here):
+
+ module ex_inout (ov,i)
+ input i;
+ /*AUTOINOUT*/
+ inst inst (/*AUTOINST*/);
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_inout (ov,i)
+ input i;
+ /*AUTOINOUT*/
+ // Beginning of automatic inouts (from unused autoinst inouts)
+ inout [31:0] ov; // From inst of inst.v
+ // End of automatics
+ inst inst (/*AUTOINST*/
+ // Inouts
+ .ov (ov[31:0]),
+ // Inputs
+ .i (i));
+ endmodule"
+ (save-excursion
+ ;; Point must be at insertion point.
+ (let* ((indent-pt (current-indentation))
+ (v2k (verilog-in-paren))
+ (modi (verilog-modi-current))
+ (sig-list (verilog-signals-not-in
+ (verilog-modi-get-sub-inouts modi)
+ (append (verilog-modi-get-outputs modi)
+ (verilog-modi-get-inouts modi)
+ (verilog-modi-get-inputs modi)
+ (verilog-modi-get-sub-inputs modi)
+ (verilog-modi-get-sub-outputs modi)
+ ))))
+ (setq sig-list (verilog-signals-not-matching-regexp
+ sig-list verilog-auto-inout-ignore-regexp))
+ (forward-line 1)
+ (when v2k (verilog-repair-open-comma))
+ (when sig-list
+ (verilog-insert-indent "// Beginning of automatic inouts (from unused autoinst inouts)\n")
+ (verilog-insert-definition sig-list "inout" indent-pt v2k)
+ (verilog-modi-cache-add-inouts modi sig-list)
+ (verilog-insert-indent "// End of automatics\n"))
+ (when v2k (verilog-repair-close-comma))
+ )))
+
+(defun verilog-auto-inout-module ()
+ "Expand AUTOINOUTMODULE statements, as part of \\[verilog-auto].
+Take input/output/inout statements from the specified module and insert
+into the current module. This is useful for making null templates and
+shell modules which need to have identical I/O with another module. Any
+I/O which are already defined in this module will not be redefined.
+
+Limitations:
+ If placed inside the parenthesis of a module declaration, it creates
+ Verilog 2001 style, else uses Verilog 1995 style.
+
+ Concatenation and outputting partial busses is not supported.
+
+ Module names must be resolvable to filenames. See `verilog-auto-inst'.
+
+ Signals are not inserted in the same order as in the original module,
+ though they will appear to be in the same order to a AUTOINST
+ instantiating either module.
+
+An example:
+
+ module ex_shell (/*AUTOARG*/)
+ /*AUTOINOUTMODULE(\"ex_main\")*/
+ endmodule
+
+ module ex_main (i,o,io)
+ input i;
+ output o;
+ inout io;
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ex_shell (/*AUTOARG*/i,o,io)
+ /*AUTOINOUTMODULE(\"ex_main\")*/
+ // Beginning of automatic in/out/inouts (from specific module)
+ input i;
+ output o;
+ inout io;
+ // End of automatics
+ endmodule"
+ (save-excursion
+ (let* ((submod (car (verilog-read-auto-params 1))) submodi)
+ ;; Lookup position, etc of co-module
+ ;; Note this may raise an error
+ (when (setq submodi (verilog-modi-lookup submod t))
+ (let* ((indent-pt (current-indentation))
+ (v2k (verilog-in-paren))
+ (modi (verilog-modi-current))
+ (sig-list-i (verilog-signals-not-in
+ (verilog-modi-get-inputs submodi)
+ (append (verilog-modi-get-inputs modi))))
+ (sig-list-o (verilog-signals-not-in
+ (verilog-modi-get-outputs submodi)
+ (append (verilog-modi-get-outputs modi))))
+ (sig-list-io (verilog-signals-not-in
+ (verilog-modi-get-inouts submodi)
+ (append (verilog-modi-get-inouts modi)))))
+ (forward-line 1)
+ (when v2k (verilog-repair-open-comma))
+ (when (or sig-list-i sig-list-o sig-list-io)
+ (verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n")
+ ;; Don't sort them so a upper AUTOINST will match the main module
+ (verilog-insert-definition sig-list-o "output" indent-pt v2k t)
+ (verilog-insert-definition sig-list-io "inout" indent-pt v2k t)
+ (verilog-insert-definition sig-list-i "input" indent-pt v2k t)
+ (verilog-modi-cache-add-inputs modi sig-list-i)
+ (verilog-modi-cache-add-outputs modi sig-list-o)
+ (verilog-modi-cache-add-inouts modi sig-list-io)
+ (verilog-insert-indent "// End of automatics\n"))
+ (when v2k (verilog-repair-close-comma))
+ )))))
+
+(defun verilog-auto-sense-sigs (modi presense-sigs)
+ "Return list of signals for current AUTOSENSE block."
+ (let* ((sigss (verilog-read-always-signals))
+ (sig-list (verilog-signals-not-params
+ (verilog-signals-not-in (verilog-alw-get-inputs sigss)
+ (append (and (not verilog-auto-sense-include-inputs)
+ (verilog-alw-get-outputs sigss))
+ (verilog-modi-get-consts modi)
+ (verilog-modi-get-gparams modi)
+ presense-sigs)))))
+ sig-list))
+
+(defun verilog-auto-sense ()
+ "Expand AUTOSENSE statements, as part of \\[verilog-auto].
+Replace the always (/*AUTOSENSE*/) sensitivity list (/*AS*/ for short)
+with one automatically derived from all inputs declared in the always
+statement. Signals that are generated within the same always block are NOT
+placed into the sensitivity list (see `verilog-auto-sense-include-inputs').
+Long lines are split based on the `fill-column', see \\[set-fill-column].
+
+Limitations:
+ Verilog does not allow memories (multidimensional arrays) in sensitivity
+ lists. AUTOSENSE will thus exclude them, and add a /*memory or*/ comment.
+
+Constant signals:
+ AUTOSENSE cannot always determine if a `define is a constant or a signal
+ (it could be in a include file for example). If a `define or other signal
+ is put into the AUTOSENSE list and is not desired, use the AUTO_CONSTANT
+ declaration anywhere in the module (parenthesis are required):
+
+ /* AUTO_CONSTANT ( `this_is_really_constant_dont_autosense_it ) */
+
+ Better yet, use a parameter, which will be understood to be constant
+ automatically.
+
+OOps!
+ If AUTOSENSE makes a mistake, please report it. (First try putting
+ a begin/end after your always!) As a workaround, if a signal that
+ shouldn't be in the sensitivity list was, use the AUTO_CONSTANT above.
+ If a signal should be in the sensitivity list wasn't, placing it before
+ the /*AUTOSENSE*/ comment will prevent it from being deleted when the
+ autos are updated (or added if it occurs there already).
+
+An example:
+
+ always @ (/*AUTOSENSE*/) begin
+ /* AUTO_CONSTANT (`constant) */
+ outin = ina | inb | `constant;
+ out = outin;
+ end
+
+Typing \\[verilog-auto] will make this into:
+
+ always @ (/*AUTOSENSE*/ina or inb) begin
+ /* AUTO_CONSTANT (`constant) */
+ outin = ina | inb | `constant;
+ out = outin;
+ end"
+ (save-excursion
+ ;; Find beginning
+ (let* ((start-pt (save-excursion
+ (verilog-re-search-backward "(" nil t)
+ (point)))
+ (indent-pt (save-excursion
+ (or (and (goto-char start-pt) (1+ (current-column)))
+ (current-indentation))))
+ (modi (verilog-modi-current))
+ (sig-memories (verilog-signals-memory
+ (append
+ (verilog-modi-get-regs modi)
+ (verilog-modi-get-wires modi))))
+ sig-list not-first presense-sigs)
+ ;; Read signals in always, eliminate outputs from sense list
+ (setq presense-sigs (verilog-signals-from-signame
+ (save-excursion
+ (verilog-read-signals start-pt (point)))))
+ (setq sig-list (verilog-auto-sense-sigs modi presense-sigs))
+ (when sig-memories
+ (let ((tlen (length sig-list)))
+ (setq sig-list (verilog-signals-not-in sig-list sig-memories))
+ (if (not (eq tlen (length sig-list))) (insert " /*memory or*/ "))))
+ (if (and presense-sigs ;; Add a "or" if not "(.... or /*AUTOSENSE*/"
+ (save-excursion (goto-char (point))
+ (verilog-re-search-backward "[a-zA-Z0-9$_.%`]+" start-pt t)
+ (verilog-re-search-backward "\\s-" start-pt t)
+ (while (looking-at "\\s-`endif")
+ (verilog-re-search-backward "[a-zA-Z0-9$_.%`]+" start-pt t)
+ (verilog-re-search-backward "\\s-" start-pt t))
+ (not (looking-at "\\s-or\\b"))))
+ (setq not-first t))
+ (setq sig-list (sort sig-list `verilog-signals-sort-compare))
+ (while sig-list
+ (cond ((> (+ 4 (current-column) (length (verilog-sig-name (car sig-list)))) fill-column) ;+4 for width of or
+ (insert "\n")
+ (indent-to indent-pt)
+ (if not-first (insert "or ")))
+ (not-first (insert " or ")))
+ (insert (verilog-sig-name (car sig-list)))
+ (setq sig-list (cdr sig-list)
+ not-first t))
+ )))
+
+(defun verilog-auto-reset ()
+ "Expand AUTORESET statements, as part of \\[verilog-auto].
+Replace the /*AUTORESET*/ comment with code to initialize all
+registers set elsewhere in the always block.
+
+Limitations:
+ AUTORESET will not clear memories.
+
+ AUTORESET uses <= if there are any <= in the block, else it uses =.
+
+/*AUTORESET*/ presumes that any signals mentioned between the previous
+begin/case/if statement and the AUTORESET comment are being reset manually
+and should not be automatically reset. This includes omitting any signals
+used on the right hand side of assignments.
+
+By default, AUTORESET will include the width of the signal in the autos,
+this is a recent change. To control this behavior, see
+`verilog-auto-reset-widths'.
+
+AUTORESET ties signals to deasserted, which is presumed to be zero.
+Signals that match `verilog-active-low-regexp' will be deasserted by tieing
+them to a one.
+
+An example:
+
+ always @(posedge clk or negedge reset_l) begin
+ if (!reset_l) begin
+ c <= 1;
+ /*AUTORESET*/
+ end
+ else begin
+ a <= in_a;
+ b <= in_b;
+ c <= in_c;
+ end
+ end
+
+Typing \\[verilog-auto] will make this into:
+
+ always @(posedge core_clk or negedge reset_l) begin
+ if (!reset_l) begin
+ c <= 1;
+ /*AUTORESET*/
+ // Beginning of autoreset for uninitialized flops
+ a <= 0;
+ b <= 0;
+ // End of automatics
+ end
+ else begin
+ a <= in_a;
+ b <= in_b;
+ c <= in_c;
+ end
+ end"
+
+ (interactive)
+ (save-excursion
+ ;; Find beginning
+ (let* ((indent-pt (current-indentation))
+ (modi (verilog-modi-current))
+ (all-list (verilog-modi-get-signals modi))
+ sigss sig-list prereset-sigs assignment-str)
+ ;; Read signals in always, eliminate outputs from reset list
+ (setq prereset-sigs (verilog-signals-from-signame
+ (save-excursion
+ (verilog-read-signals
+ (save-excursion
+ (verilog-re-search-backward "\\(@\\|\\<begin\\>\\|\\<if\\>\\|\\<case\\>\\)" nil t)
+ (point))
+ (point)))))
+ (save-excursion
+ (verilog-re-search-backward "@" nil t)
+ (setq sigss (verilog-read-always-signals)))
+ (setq assignment-str (if (verilog-alw-get-uses-delayed sigss)
+ (concat " <= " verilog-assignment-delay)
+ " = "))
+ (setq sig-list (verilog-signals-not-in (verilog-alw-get-outputs sigss)
+ prereset-sigs))
+ (setq sig-list (sort sig-list `verilog-signals-sort-compare))
+ (when sig-list
+ (insert "\n");
+ (indent-to indent-pt)
+ (insert "// Beginning of autoreset for uninitialized flops\n");
+ (indent-to indent-pt)
+ (while sig-list
+ (let ((sig (or (assoc (verilog-sig-name (car sig-list)) all-list) ;; As sig-list has no widths
+ (car sig-list))))
+ (insert (verilog-sig-name sig)
+ assignment-str
+ (verilog-sig-tieoff sig (not verilog-auto-reset-widths))
+ ";\n")
+ (indent-to indent-pt)
+ (setq sig-list (cdr sig-list))))
+ (insert "// End of automatics"))
+ )))
+
+(defun verilog-auto-tieoff ()
+ "Expand AUTOTIEOFF statements, as part of \\[verilog-auto].
+Replace the /*AUTOTIEOFF*/ comment with code to wire-tie all unused output
+signals to deasserted.
+
+/*AUTOTIEOFF*/ is used to make stub modules; modules that have the same
+input/output list as another module, but no internals. Specifically, it
+finds all outputs in the module, and if that input is not otherwise declared
+as a register or wire, creates a tieoff.
+
+AUTORESET ties signals to deasserted, which is presumed to be zero.
+Signals that match `verilog-active-low-regexp' will be deasserted by tieing
+them to a one.
+
+An example of making a stub for another module:
+
+ module FooStub (/*AUTOINST*/);
+ /*AUTOINOUTMODULE(\"Foo\")*/
+ /*AUTOTIEOFF*/
+ // verilator lint_off UNUSED
+ wire _unused_ok = &{1'b0,
+ /*AUTOUNUSED*/
+ 1'b0};
+ // verilator lint_on UNUSED
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module FooStub (/*AUTOINST*/...);
+ /*AUTOINOUTMODULE(\"Foo\")*/
+ // Beginning of autotieoff
+ output [2:0] foo;
+ // End of automatics
+
+ /*AUTOTIEOFF*/
+ // Beginning of autotieoff
+ wire [2:0] foo = 3'b0;
+ // End of automatics
+ ...
+ endmodule"
+ (interactive)
+ (save-excursion
+ ;; Find beginning
+ (let* ((indent-pt (current-indentation))
+ (modi (verilog-modi-current))
+ (sig-list (verilog-signals-not-in
+ (verilog-modi-get-outputs modi)
+ (append (verilog-modi-get-wires modi)
+ (verilog-modi-get-regs modi)
+ (verilog-modi-get-assigns modi)
+ (verilog-modi-get-consts modi)
+ (verilog-modi-get-gparams modi)
+ (verilog-modi-get-sub-outputs modi)
+ (verilog-modi-get-sub-inouts modi)
+ ))))
+ (when sig-list
+ (forward-line 1)
+ (verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n")
+ (setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare))
+ (verilog-modi-cache-add-wires modi sig-list) ; Before we trash list
+ (while sig-list
+ (let ((sig (car sig-list)))
+ (verilog-insert-one-definition sig "wire" indent-pt)
+ (indent-to (max 48 (+ indent-pt 40)))
+ (insert "= " (verilog-sig-tieoff sig)
+ ";\n")
+ (setq sig-list (cdr sig-list))))
+ (verilog-insert-indent "// End of automatics\n")
+ ))))
+
+(defun verilog-auto-unused ()
+ "Expand AUTOUNUSED statements, as part of \\[verilog-auto].
+Replace the /*AUTOUNUSED*/ comment with a comma separated list of all unused
+input and inout signals.
+
+/*AUTOUNUSED*/ is used to make stub modules; modules that have the same
+input/output list as another module, but no internals. Specifically, it
+finds all inputs and inouts in the module, and if that input is not otherwise
+used, adds it to a comma separated list.
+
+The comma separated list is intended to be used to create a _unused_ok
+signal. Using the exact name \"_unused_ok\" for name of the temporary
+signal is recommended as it will insure maximum forward compatibility, it
+also makes lint warnings easy to understand; ignore any unused warnings
+with \"unused\" in the signal name.
+
+To reduce simulation time, the _unused_ok signal should be forced to a
+constant to prevent wiggling. The easiest thing to do is use a
+reduction-and with 1'b0 as shown.
+
+This way all unused signals are in one place, making it convenient to add
+your tool's specific pragmas around the assignment to disable any unused
+warnings.
+
+You can add signals you do not want included in AUTOUNUSED with
+`verilog-auto-unused-ignore-regexp'.
+
+An example of making a stub for another module:
+
+ module FooStub (/*AUTOINST*/);
+ /*AUTOINOUTMODULE(\"Foo\")*/
+ /*AUTOTIEOFF*/
+ // verilator lint_off UNUSED
+ wire _unused_ok = &{1'b0,
+ /*AUTOUNUSED*/
+ 1'b0};
+ // verilator lint_on UNUSED
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ ...
+ // verilator lint_off UNUSED
+ wire _unused_ok = &{1'b0,
+ /*AUTOUNUSED*/
+ // Beginning of automatics
+ unused_input_a,
+ unused_input_b,
+ unused_input_c,
+ // End of automatics
+ 1'b0};
+ // verilator lint_on UNUSED
+ endmodule"
+ (interactive)
+ (save-excursion
+ ;; Find beginning
+ (let* ((indent-pt (progn (search-backward "/*") (current-column)))
+ (modi (verilog-modi-current))
+ (sig-list (verilog-signals-not-in
+ (append (verilog-modi-get-inputs modi)
+ (verilog-modi-get-inouts modi))
+ (append (verilog-modi-get-sub-inputs modi)
+ (verilog-modi-get-sub-inouts modi)
+ ))))
+ (setq sig-list (verilog-signals-not-matching-regexp
+ sig-list verilog-auto-unused-ignore-regexp))
+ (when sig-list
+ (forward-line 1)
+ (verilog-insert-indent "// Beginning of automatic unused inputs\n")
+ (setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare))
+ (while sig-list
+ (let ((sig (car sig-list)))
+ (indent-to indent-pt)
+ (insert (verilog-sig-name sig) ",\n")
+ (setq sig-list (cdr sig-list))))
+ (verilog-insert-indent "// End of automatics\n")
+ ))))
+
+(defun verilog-enum-ascii (signm elim-regexp)
+ "Convert a enum name SIGNM to a ascii string for insertion.
+Remove user provided prefix ELIM-REGEXP."
+ (or elim-regexp (setq elim-regexp "_ DONT MATCH IT_"))
+ (let ((case-fold-search t))
+ ;; All upper becomes all lower for readability
+ (downcase (verilog-string-replace-matches elim-regexp "" nil nil signm))))
+
+(defun verilog-auto-ascii-enum ()
+ "Expand AUTOASCIIENUM statements, as part of \\[verilog-auto].
+Create a register to contain the ASCII decode of a enumerated signal type.
+This will allow trace viewers to show the ASCII name of states.
+
+First, parameters are built into a enumeration using the synopsys enum
+comment. The comment must be between the keyword and the symbol.
+(Annoying, but that's what Synopsys's dc_shell FSM reader requires.)
+
+Next, registers which that enum applies to are also tagged with the same
+enum. Synopsys also suggests labeling state vectors, but `verilog-mode'
+doesn't care.
+
+Finally, a AUTOASCIIENUM command is used.
+
+ The first parameter is the name of the signal to be decoded.
+
+ The second parameter is the name to store the ASCII code into. For the
+ signal foo, I suggest the name _foo__ascii, where the leading _ indicates
+ a signal that is just for simulation, and the magic characters _ascii
+ tell viewers like Dinotrace to display in ASCII format.
+
+ The final optional parameter is a string which will be removed from the
+ state names.
+
+An example:
+
+ //== State enumeration
+ parameter [2:0] // synopsys enum state_info
+ SM_IDLE = 3'b000,
+ SM_SEND = 3'b001,
+ SM_WAIT1 = 3'b010;
+ //== State variables
+ reg [2:0] /* synopsys enum state_info */
+ state_r; /* synopsys state_vector state_r */
+ reg [2:0] /* synopsys enum state_info */
+ state_e1;
+
+ //== ASCII state decoding
+
+ /*AUTOASCIIENUM(\"state_r\", \"state_ascii_r\", \"SM_\")*/
+
+Typing \\[verilog-auto] will make this into:
+
+ ... same front matter ...
+
+ /*AUTOASCIIENUM(\"state_r\", \"state_ascii_r\", \"SM_\")*/
+ // Beginning of automatic ASCII enum decoding
+ reg [39:0] state_ascii_r; // Decode of state_r
+ always @(state_r) begin
+ case ({state_r})
+ SM_IDLE: state_ascii_r = \"idle \";
+ SM_SEND: state_ascii_r = \"send \";
+ SM_WAIT1: state_ascii_r = \"wait1\";
+ default: state_ascii_r = \"%Erro\";
+ endcase
+ end
+ // End of automatics"
+ (save-excursion
+ (let* ((params (verilog-read-auto-params 2 3))
+ (undecode-name (nth 0 params))
+ (ascii-name (nth 1 params))
+ (elim-regexp (nth 2 params))
+ ;;
+ (indent-pt (current-indentation))
+ (modi (verilog-modi-current))
+ ;;
+ (sig-list-consts (append (verilog-modi-get-consts modi)
+ (verilog-modi-get-gparams modi)))
+ (sig-list-all (append (verilog-modi-get-regs modi)
+ (verilog-modi-get-outputs modi)
+ (verilog-modi-get-inouts modi)
+ (verilog-modi-get-inputs modi)
+ (verilog-modi-get-wires modi)))
+ ;;
+ (undecode-sig (or (assoc undecode-name sig-list-all)
+ (error "%s: Signal %s not found in design" (verilog-point-text) undecode-name)))
+ (undecode-enum (or (verilog-sig-enum undecode-sig)
+ (error "%s: Signal %s does not have a enum tag" (verilog-point-text) undecode-name)))
+ ;;
+ (enum-sigs (or (verilog-signals-matching-enum sig-list-consts undecode-enum)
+ (error "%s: No state definitions for %s" (verilog-point-text) undecode-enum)))
+ ;;
+ (enum-chars 0)
+ (ascii-chars 0))
+ ;;
+ ;; Find number of ascii chars needed
+ (let ((tmp-sigs enum-sigs))
+ (while tmp-sigs
+ (setq enum-chars (max enum-chars (length (verilog-sig-name (car tmp-sigs))))
+ ascii-chars (max ascii-chars (length (verilog-enum-ascii
+ (verilog-sig-name (car tmp-sigs))
+ elim-regexp)))
+ tmp-sigs (cdr tmp-sigs))))
+ ;;
+ (forward-line 1)
+ (verilog-insert-indent "// Beginning of automatic ASCII enum decoding\n")
+ (let ((decode-sig-list (list (list ascii-name (format "[%d:0]" (- (* ascii-chars 8) 1))
+ (concat "Decode of " undecode-name) nil nil))))
+ (verilog-insert-definition decode-sig-list "reg" indent-pt nil)
+ (verilog-modi-cache-add-regs modi decode-sig-list))
+ ;;
+ (verilog-insert-indent "always @(" undecode-name ") begin\n")
+ (setq indent-pt (+ indent-pt verilog-indent-level))
+ (indent-to indent-pt)
+ (insert "case ({" undecode-name "})\n")
+ (setq indent-pt (+ indent-pt verilog-case-indent))
+ ;;
+ (let ((tmp-sigs enum-sigs)
+ (chrfmt (format "%%-%ds %s = \"%%-%ds\";\n" (1+ (max 8 enum-chars))
+ ascii-name ascii-chars))
+ (errname (substring "%Error" 0 (min 6 ascii-chars))))
+ (while tmp-sigs
+ (verilog-insert-indent
+ (format chrfmt (concat (verilog-sig-name (car tmp-sigs)) ":")
+ (verilog-enum-ascii (verilog-sig-name (car tmp-sigs))
+ elim-regexp)))
+ (setq tmp-sigs (cdr tmp-sigs)))
+ (verilog-insert-indent (format chrfmt "default:" errname)))
+ ;;
+ (setq indent-pt (- indent-pt verilog-case-indent))
+ (verilog-insert-indent "endcase\n")
+ (setq indent-pt (- indent-pt verilog-indent-level))
+ (verilog-insert-indent "end\n"
+ "// End of automatics\n")
+ )))
+
+(defun verilog-auto-templated-rel ()
+ "Replace Templated relative line numbers with absolute line numbers.
+Internal use only. This hacks around the line numbers in AUTOINST Templates
+being different from the final output's line numbering."
+ (let ((templateno 0) (template-line (list 0)))
+ ;; Find line number each template is on
+ (goto-char (point-min))
+ (while (search-forward "AUTO_TEMPLATE" nil t)
+ (setq templateno (1+ templateno))
+ (setq template-line (cons (count-lines (point-min) (point)) template-line)))
+ (setq template-line (nreverse template-line))
+ ;; Replace T# L# with absolute line number
+ (goto-char (point-min))
+ (while (re-search-forward " Templated T\\([0-9]+\\) L\\([0-9]+\\)" nil t)
+ (replace-match (concat " Templated "
+ (int-to-string (+ (nth (string-to-int (match-string 1))
+ template-line)
+ (string-to-int (match-string 2)))))
+ t t))))
+
+\f
+;;
+;; Auto top level
+;;
+
+(defun verilog-auto (&optional inject) ; Use verilog-inject-auto instead of passing a arg
+ "Expand AUTO statements.
+Look for any /*AUTO...*/ commands in the code, as used in
+instantiations or argument headers. Update the list of signals
+following the /*AUTO...*/ command.
+
+Use \\[verilog-delete-auto] to remove the AUTOs.
+
+Use \\[verilog-inject-auto] to insert AUTOs for the first time.
+
+Use \\[verilog-faq] for a pointer to frequently asked questions.
+
+The hooks `verilog-before-auto-hook' and `verilog-auto-hook' are
+called before and after this function, respectively.
+
+For example:
+ module (/*AUTOARG*/)
+ /*AUTOINPUT*/
+ /*AUTOOUTPUT*/
+ /*AUTOWIRE*/
+ /*AUTOREG*/
+ somesub sub #(/*AUTOINSTPARAM*/) (/*AUTOINST*/);
+
+You can also update the AUTOs from the shell using:
+ emacs --batch <filenames.v> -f verilog-batch-auto
+Or fix indentation with:
+ emacs --batch <filenames.v> -f verilog-batch-indent
+Likewise, you can delete or inject AUTOs with:
+ emacs --batch <filenames.v> -f verilog-batch-delete-auto
+ emacs --batch <filenames.v> -f verilog-batch-inject-auto
+
+Using \\[describe-function], see also:
+ `verilog-auto-arg' for AUTOARG module instantiations
+ `verilog-auto-ascii-enum' for AUTOASCIIENUM enumeration decoding
+ `verilog-auto-inout-module' for AUTOINOUTMODULE copying i/o from elsewhere
+ `verilog-auto-inout' for AUTOINOUT making hierarchy inouts
+ `verilog-auto-input' for AUTOINPUT making hierarchy inputs
+ `verilog-auto-inst' for AUTOINST instantiation pins
+ `verilog-auto-star' for AUTOINST .* SystemVerilog pins
+ `verilog-auto-inst-param' for AUTOINSTPARAM instantiation params
+ `verilog-auto-output' for AUTOOUTPUT making hierarchy outputs
+ `verilog-auto-output-every' for AUTOOUTPUTEVERY making all outputs
+ `verilog-auto-reg' for AUTOREG registers
+ `verilog-auto-reg-input' for AUTOREGINPUT instantiation registers
+ `verilog-auto-reset' for AUTORESET flop resets
+ `verilog-auto-sense' for AUTOSENSE always sensitivity lists
+ `verilog-auto-tieoff' for AUTOTIEOFF output tieoffs
+ `verilog-auto-unused' for AUTOUNUSED unused inputs/inouts
+ `verilog-auto-wire' for AUTOWIRE instantiation wires
+
+ `verilog-read-defines' for reading `define values
+ `verilog-read-includes' for reading `includes
+
+If you have bugs with these autos, try contacting the AUTOAUTHOR
+Wilson Snyder (wsnyder@wsnyder.org), and/or see http://www.veripool.com."
+ (interactive)
+ (unless noninteractive (message "Updating AUTOs..."))
+ (if (featurep 'dinotrace)
+ (dinotrace-unannotate-all))
+ (let ((oldbuf (if (not (buffer-modified-p))
+ (buffer-string)))
+ ;; Before version 20, match-string with font-lock returns a
+ ;; vector that is not equal to the string. IE if on "input"
+ ;; nil==(equal "input" (progn (looking-at "input") (match-string 0)))
+ (fontlocked (when (and ;(memq 'v19 verilog-emacs-features)
+ (boundp 'font-lock-mode)
+ font-lock-mode)
+ (font-lock-mode nil)
+ t)))
+ (unwind-protect
+ (save-excursion
+ ;; If we're not in verilog-mode, change syntax table so parsing works right
+ (unless (eq major-mode `verilog-mode) (verilog-mode))
+ ;; Allow user to customize
+ (run-hooks 'verilog-before-auto-hook)
+ ;; Try to save the user from needing to revert-file to reread file local-variables
+ (verilog-auto-reeval-locals)
+ (verilog-read-auto-lisp (point-min) (point-max))
+ (verilog-getopt-flags)
+ ;; These two may seem obvious to do always, but on large includes it can be way too slow
+ (when verilog-auto-read-includes
+ (verilog-read-includes)
+ (verilog-read-defines nil nil t))
+ ;; This particular ordering is important
+ ;; INST: Lower modules correct, no internal dependencies, FIRST
+ (verilog-preserve-cache
+ ;; Clear existing autos else we'll be screwed by existing ones
+ (verilog-delete-auto)
+ ;; Injection if appropriate
+ (when inject
+ (verilog-inject-inst)
+ (verilog-inject-sense)
+ (verilog-inject-arg))
+ ;;
+ (verilog-auto-search-do "/*AUTOINSTPARAM*/" 'verilog-auto-inst-param)
+ (verilog-auto-search-do "/*AUTOINST*/" 'verilog-auto-inst)
+ (verilog-auto-search-do ".*" 'verilog-auto-star)
+ ;; Doesn't matter when done, but combine it with a common changer
+ (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense)
+ (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset)
+ ;; Must be done before autoin/out as creates a reg
+ (verilog-auto-re-search-do "/\\*AUTOASCIIENUM([^)]*)\\*/" 'verilog-auto-ascii-enum)
+ ;;
+ ;; first in/outs from other files
+ (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE([^)]*)\\*/" 'verilog-auto-inout-module)
+ ;; next in/outs which need previous sucked inputs first
+ (verilog-auto-search-do "/*AUTOOUTPUT*/" 'verilog-auto-output)
+ (verilog-auto-search-do "/*AUTOINPUT*/" 'verilog-auto-input)
+ (verilog-auto-search-do "/*AUTOINOUT*/" 'verilog-auto-inout)
+ ;; Then tie off those in/outs
+ (verilog-auto-search-do "/*AUTOTIEOFF*/" 'verilog-auto-tieoff)
+ ;; Wires/regs must be after inputs/outputs
+ (verilog-auto-search-do "/*AUTOWIRE*/" 'verilog-auto-wire)
+ (verilog-auto-search-do "/*AUTOREG*/" 'verilog-auto-reg)
+ (verilog-auto-search-do "/*AUTOREGINPUT*/" 'verilog-auto-reg-input)
+ ;; outputevery needs AUTOOUTPUTs done first
+ (verilog-auto-search-do "/*AUTOOUTPUTEVERY*/" 'verilog-auto-output-every)
+ ;; After we've created all new variables
+ (verilog-auto-search-do "/*AUTOUNUSED*/" 'verilog-auto-unused)
+ ;; Must be after all inputs outputs are generated
+ (verilog-auto-search-do "/*AUTOARG*/" 'verilog-auto-arg)
+ ;; Fix line numbers (comments only)
+ (verilog-auto-templated-rel)
+ )
+ ;;
+ (run-hooks 'verilog-auto-hook)
+ ;;
+ (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick))
+ ;;
+ ;; If end result is same as when started, clear modified flag
+ (cond ((and oldbuf (equal oldbuf (buffer-string)))
+ (set-buffer-modified-p nil)
+ (unless noninteractive (message "Updating AUTOs...done (no changes)")))
+ (t (unless noninteractive (message "Updating AUTOs...done")))))
+ ;; Unwind forms
+ (progn
+ ;; Restore font-lock
+ (when fontlocked (font-lock-mode t)))
+ )))
+\f
+
+;;
+;; Skeleton based code insertion
+;;
+(defvar verilog-template-map nil
+ "Keymap used in Verilog mode for smart template operations.")
+
+(let ((verilog-mp (make-sparse-keymap)))
+ (define-key verilog-mp "a" 'verilog-sk-always)
+ (define-key verilog-mp "b" 'verilog-sk-begin)
+ (define-key verilog-mp "c" 'verilog-sk-case)
+ (define-key verilog-mp "f" 'verilog-sk-for)
+ (define-key verilog-mp "g" 'verilog-sk-generate)
+ (define-key verilog-mp "h" 'verilog-sk-header)
+ (define-key verilog-mp "i" 'verilog-sk-initial)
+ (define-key verilog-mp "j" 'verilog-sk-fork)
+ (define-key verilog-mp "m" 'verilog-sk-module)
+ (define-key verilog-mp "p" 'verilog-sk-primitive)
+ (define-key verilog-mp "r" 'verilog-sk-repeat)
+ (define-key verilog-mp "s" 'verilog-sk-specify)
+ (define-key verilog-mp "t" 'verilog-sk-task)
+ (define-key verilog-mp "w" 'verilog-sk-while)
+ (define-key verilog-mp "x" 'verilog-sk-casex)
+ (define-key verilog-mp "z" 'verilog-sk-casez)
+ (define-key verilog-mp "?" 'verilog-sk-if)
+ (define-key verilog-mp ":" 'verilog-sk-else-if)
+ (define-key verilog-mp "/" 'verilog-sk-comment)
+ (define-key verilog-mp "A" 'verilog-sk-assign)
+ (define-key verilog-mp "F" 'verilog-sk-function)
+ (define-key verilog-mp "I" 'verilog-sk-input)
+ (define-key verilog-mp "O" 'verilog-sk-output)
+ (define-key verilog-mp "S" 'verilog-sk-state-machine)
+ (define-key verilog-mp "=" 'verilog-sk-inout)
+ (define-key verilog-mp "W" 'verilog-sk-wire)
+ (define-key verilog-mp "R" 'verilog-sk-reg)
+ (define-key verilog-mp "D" 'verilog-sk-define-signal)
+ (setq verilog-template-map verilog-mp))
+
+;;
+;; Place the templates into Verilog Mode. They may be inserted under any key.
+;; C-c C-t will be the default. If you use templates a lot, you
+;; may want to consider moving the binding to another key in your .emacs
+;; file.
+;;
+;(define-key verilog-mode-map "\C-ct" verilog-template-map)
+(define-key verilog-mode-map "\C-c\C-t" verilog-template-map)
+
+;;; ---- statement skeletons ------------------------------------------
+
+(define-skeleton verilog-sk-prompt-condition
+ "Prompt for the loop condition."
+ "[condition]: " str )
+
+(define-skeleton verilog-sk-prompt-init
+ "Prompt for the loop init statement."
+ "[initial statement]: " str )
+
+(define-skeleton verilog-sk-prompt-inc
+ "Prompt for the loop increment statement."
+ "[increment statement]: " str )
+
+(define-skeleton verilog-sk-prompt-name
+ "Prompt for the name of something."
+ "[name]: " str)
+
+(define-skeleton verilog-sk-prompt-clock
+ "Prompt for the name of something."
+ "name and edge of clock(s): " str)
+
+(defvar verilog-sk-reset nil)
+(defun verilog-sk-prompt-reset ()
+ "Prompt for the name of a state machine reset."
+ (setq verilog-sk-reset (read-input "name of reset: " "rst")))
+
+
+(define-skeleton verilog-sk-prompt-state-selector
+ "Prompt for the name of a state machine selector."
+ "name of selector (eg {a,b,c,d}): " str )
+
+(define-skeleton verilog-sk-prompt-output
+ "Prompt for the name of something."
+ "output: " str)
+
+(define-skeleton verilog-sk-prompt-msb
+ "Prompt for least significant bit specification."
+ "msb:" str & ?: & (verilog-sk-prompt-lsb) | -1 )
+
+(define-skeleton verilog-sk-prompt-lsb
+ "Prompt for least significant bit specification."
+ "lsb:" str )
+
+(defvar verilog-sk-p nil)
+(define-skeleton verilog-sk-prompt-width
+ "Prompt for a width specification."
+ ()
+ (progn
+ (setq verilog-sk-p (point))
+ (verilog-sk-prompt-msb)
+ (if (> (point) verilog-sk-p) "] " " ")))
+
+(defun verilog-sk-header ()
+ "Insert a descriptive header at the top of the file."
+ (interactive "*")
+ (save-excursion
+ (goto-char (point-min))
+ (verilog-sk-header-tmpl)))
+
+(define-skeleton verilog-sk-header-tmpl
+ "Insert a comment block containing the module title, author, etc."
+ "[Description]: "
+ "// -*- Mode: Verilog -*-"
+ "\n// Filename : " (buffer-name)
+ "\n// Description : " str
+ "\n// Author : " (user-full-name)
+ "\n// Created On : " (current-time-string)
+ "\n// Last Modified By: ."
+ "\n// Last Modified On: ."
+ "\n// Update Count : 0"
+ "\n// Status : Unknown, Use with caution!"
+ "\n")
+
+(define-skeleton verilog-sk-module
+ "Insert a module definition."
+ ()
+ > "module " (verilog-sk-prompt-name) " (/*AUTOARG*/ ) ;" \n
+ > _ \n
+ > (- verilog-indent-level-behavioral) "endmodule" (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-primitive
+ "Insert a task definition."
+ ()
+ > "primitive " (verilog-sk-prompt-name) " ( " (verilog-sk-prompt-output) ("input:" ", " str ) " );"\n
+ > _ \n
+ > (- verilog-indent-level-behavioral) "endprimitive" (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-task
+ "Insert a task definition."
+ ()
+ > "task " (verilog-sk-prompt-name) & ?; \n
+ > _ \n
+ > "begin" \n
+ > \n
+ > (- verilog-indent-level-behavioral) "end" \n
+ > (- verilog-indent-level-behavioral) "endtask" (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-function
+ "Insert a function definition."
+ ()
+ > "function [" (verilog-sk-prompt-width) | -1 (verilog-sk-prompt-name) ?; \n
+ > _ \n
+ > "begin" \n
+ > \n
+ > (- verilog-indent-level-behavioral) "end" \n
+ > (- verilog-indent-level-behavioral) "endfunction" (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-always
+ "Insert always block. Uses the minibuffer to prompt
+for sensitivity list."
+ ()
+ > "always @ ( /*AUTOSENSE*/ ) begin\n"
+ > _ \n
+ > (- verilog-indent-level-behavioral) "end" \n >
+ )
+
+(define-skeleton verilog-sk-initial
+ "Insert an initial block."
+ ()
+ > "initial begin\n"
+ > _ \n
+ > (- verilog-indent-level-behavioral) "end" \n > )
+
+(define-skeleton verilog-sk-specify
+ "Insert specify block. "
+ ()
+ > "specify\n"
+ > _ \n
+ > (- verilog-indent-level-behavioral) "endspecify" \n > )
+
+(define-skeleton verilog-sk-generate
+ "Insert generate block. "
+ ()
+ > "generate\n"
+ > _ \n
+ > (- verilog-indent-level-behavioral) "endgenerate" \n > )
+
+(define-skeleton verilog-sk-begin
+ "Insert begin end block. Uses the minibuffer to prompt for name"
+ ()
+ > "begin" (verilog-sk-prompt-name) \n
+ > _ \n
+ > (- verilog-indent-level-behavioral) "end"
+)
+
+(define-skeleton verilog-sk-fork
+ "Insert an fork join block."
+ ()
+ > "fork\n"
+ > "begin" \n
+ > _ \n
+ > (- verilog-indent-level-behavioral) "end" \n
+ > "begin" \n
+ > \n
+ > (- verilog-indent-level-behavioral) "end" \n
+ > (- verilog-indent-level-behavioral) "join" \n
+ > )
+
+
+(define-skeleton verilog-sk-case
+ "Build skeleton case statement, prompting for the selector expression,
+and the case items."
+ "[selector expression]: "
+ > "case (" str ") " \n
+ > ("case selector: " str ": begin" \n > _ \n > (- verilog-indent-level-behavioral) "end" \n )
+ resume: > (- verilog-case-indent) "endcase" (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-casex
+ "Build skeleton casex statement, prompting for the selector expression,
+and the case items."
+ "[selector expression]: "
+ > "casex (" str ") " \n
+ > ("case selector: " str ": begin" \n > _ \n > (- verilog-indent-level-behavioral) "end" \n )
+ resume: > (- verilog-case-indent) "endcase" (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-casez
+ "Build skeleton casez statement, prompting for the selector expression,
+and the case items."
+ "[selector expression]: "
+ > "casez (" str ") " \n
+ > ("case selector: " str ": begin" \n > _ \n > (- verilog-indent-level-behavioral) "end" \n )
+ resume: > (- verilog-case-indent) "endcase" (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-if
+ "Insert a skeleton if statement."
+ > "if (" (verilog-sk-prompt-condition) & ")" " begin" \n
+ > _ \n
+ > (- verilog-indent-level-behavioral) "end " \n )
+
+(define-skeleton verilog-sk-else-if
+ "Insert a skeleton else if statement."
+ > (verilog-indent-line) "else if ("
+ (progn (setq verilog-sk-p (point)) nil) (verilog-sk-prompt-condition) (if (> (point) verilog-sk-p) ") " -1 ) & " begin" \n
+ > _ \n
+ > "end" (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-datadef
+ "Common routine to get data definition"
+ ()
+ (verilog-sk-prompt-width) | -1 ("name (RET to end):" str ", ") -2 ";" \n)
+
+(define-skeleton verilog-sk-input
+ "Insert an input definition."
+ ()
+ > "input [" (verilog-sk-datadef))
+
+(define-skeleton verilog-sk-output
+ "Insert an output definition."
+ ()
+ > "output [" (verilog-sk-datadef))
+
+(define-skeleton verilog-sk-inout
+ "Insert an inout definition."
+ ()
+ > "inout [" (verilog-sk-datadef))
+
+(defvar verilog-sk-signal nil)
+(define-skeleton verilog-sk-def-reg
+ "Insert a reg definition."
+ ()
+ > "reg [" (verilog-sk-prompt-width) | -1 verilog-sk-signal ";" \n (verilog-pretty-declarations) )
+
+(defun verilog-sk-define-signal ()
+ "Insert a definition of signal under point at top of module."
+ (interactive "*")
+ (let* (
+ (sig-re "[a-zA-Z0-9_]*")
+ (v1 (buffer-substring
+ (save-excursion
+ (skip-chars-backward sig-re)
+ (point))
+ (save-excursion
+ (skip-chars-forward sig-re)
+ (point))))
+ )
+ (if (not (member v1 verilog-keywords))
+ (save-excursion
+ (setq verilog-sk-signal v1)
+ (verilog-beg-of-defun)
+ (verilog-end-of-statement)
+ (verilog-forward-syntactic-ws)
+ (verilog-sk-def-reg)
+ (message "signal at point is %s" v1))
+ (message "object at point (%s) is a keyword" v1))
+ )
+ )
+
+
+(define-skeleton verilog-sk-wire
+ "Insert a wire definition."
+ ()
+ > "wire [" (verilog-sk-datadef))
+
+(define-skeleton verilog-sk-reg
+ "Insert a reg definition."
+ ()
+ > "reg [" (verilog-sk-datadef))
+
+(define-skeleton verilog-sk-assign
+ "Insert a skeleton assign statement."
+ ()
+ > "assign " (verilog-sk-prompt-name) " = " _ ";" \n)
+
+(define-skeleton verilog-sk-while
+ "Insert a skeleton while loop statement."
+ ()
+ > "while (" (verilog-sk-prompt-condition) ") begin" \n
+ > _ \n
+ > (- verilog-indent-level-behavioral) "end " (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-repeat
+ "Insert a skeleton repeat loop statement."
+ ()
+ > "repeat (" (verilog-sk-prompt-condition) ") begin" \n
+ > _ \n
+ > (- verilog-indent-level-behavioral) "end " (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-for
+ "Insert a skeleton while loop statement."
+ ()
+ > "for ("
+ (verilog-sk-prompt-init) "; "
+ (verilog-sk-prompt-condition) "; "
+ (verilog-sk-prompt-inc)
+ ") begin" \n
+ > _ \n
+ > (- verilog-indent-level-behavioral) "end " (progn (electric-verilog-terminate-line) nil))
+
+(define-skeleton verilog-sk-comment
+ "Inserts three comment lines, making a display comment."
+ ()
+ > "/*\n"
+ > "* " _ \n
+ > "*/")
+
+(define-skeleton verilog-sk-state-machine
+ "Insert a state machine definition."
+ "Name of state variable: "
+ '(setq input "state")
+ > "// State registers for " str | -23 \n
+ '(setq verilog-sk-state str)
+ > "reg [" (verilog-sk-prompt-width) | -1 verilog-sk-state ", next_" verilog-sk-state ?; \n
+ '(setq input nil)
+ > \n
+ > "// State FF for " verilog-sk-state \n
+ > "always @ ( " (read-string "clock:" "posedge clk") " or " (verilog-sk-prompt-reset) " ) begin" \n
+ > "if ( " verilog-sk-reset " ) " verilog-sk-state " = 0; else" \n
+ > verilog-sk-state " = next_" verilog-sk-state ?; \n
+ > (- verilog-indent-level-behavioral) "end" (progn (electric-verilog-terminate-line) nil)
+ > \n
+ > "// Next State Logic for " verilog-sk-state \n
+ > "always @ ( /*AUTOSENSE*/ ) begin\n"
+ > "case (" (verilog-sk-prompt-state-selector) ") " \n
+ > ("case selector: " str ": begin" \n > "next_" verilog-sk-state " = " _ ";" \n > (- verilog-indent-level-behavioral) "end" \n )
+ resume: > (- verilog-case-indent) "endcase" (progn (electric-verilog-terminate-line) nil)
+ > (- verilog-indent-level-behavioral) "end" (progn (electric-verilog-terminate-line) nil))
+
+;; Eliminate compile warning
+(eval-when-compile
+ (if (not (boundp 'mode-popup-menu))
+ (defvar mode-popup-menu nil "Compatibility with XEmacs.")))
+
+;; ---- add menu 'Statements' in Verilog mode (MH)
+(defun verilog-add-statement-menu ()
+ "Add the menu 'Statements' to the menu bar in Verilog mode."
+ (if verilog-running-on-xemacs
+ (progn
+ (easy-menu-add verilog-stmt-menu)
+ (easy-menu-add verilog-menu)
+ (setq mode-popup-menu (cons "Verilog Mode" verilog-stmt-menu)))))
+
+(add-hook 'verilog-mode-hook 'verilog-add-statement-menu)
+
+\f
+
+;;
+;; Include file loading with mouse/return event
+;;
+;; idea & first impl.: M. Rouat (eldo-mode.el)
+;; second (emacs/xemacs) impl.: G. Van der Plas (spice-mode.el)
+
+(if verilog-running-on-xemacs
+ (require 'overlay)
+ (require 'lucid)) ;; what else can we do ??
+
+(defconst verilog-include-file-regexp
+ "^`include\\s-+\"\\([^\n\"]*\\)\""
+ "Regexp that matches the include file.")
+
+(defvar verilog-mode-mouse-map nil
+ "Map containing mouse bindings for `verilog-mode'.")
+
+(if verilog-mode-mouse-map
+ ()
+ (let ((map (make-sparse-keymap))) ; as described in info pages, make a map
+ (set-keymap-parent map verilog-mode-map)
+ ;; mouse button bindings
+ (define-key map "\r" 'verilog-load-file-at-point)
+ (if verilog-running-on-xemacs
+ (define-key map 'button2 'verilog-load-file-at-mouse);ffap-at-mouse ?
+ (define-key map [mouse-2] 'verilog-load-file-at-mouse))
+ (if verilog-running-on-xemacs
+ (define-key map 'Sh-button2 'mouse-yank) ; you wanna paste don't you ?
+ (define-key map [S-mouse-2] 'mouse-yank-at-click))
+ (setq verilog-mode-mouse-map map))) ;; copy complete map now
+
+;; create set-extent-keymap procedure when it does not exist
+(eval-and-compile
+ (unless (fboundp 'set-extent-keymap)
+ (defun set-extent-keymap (extent keymap)
+ "fallback version of set-extent-keymap (for emacs 2[01])"
+ (set-extent-property extent 'local-map keymap))))
+
+(defun verilog-colorize-include-files (beg end old-len)
+ "This function colorizes included files when the mouse passes over them.
+Clicking on the middle-mouse button loads them in a buffer (as in dired)."
+ (save-excursion
+ (save-match-data
+ (let (end-point)
+ (goto-char end)
+ (setq end-point (verilog-get-end-of-line))
+ (goto-char beg)
+ (beginning-of-line) ; scan entire line !
+ ;; delete overlays existing on this line
+ (let ((overlays (overlays-in (point) end-point)))
+ (while overlays
+ (if (and
+ (overlay-get (car overlays) 'detachable)
+ (overlay-get (car overlays) 'verilog-include-file))
+ (delete-overlay (car overlays)))
+ (setq overlays (cdr overlays)))) ; let
+ ;; make new ones, could reuse deleted one ?
+ (while (search-forward-regexp verilog-include-file-regexp end-point t)
+ (let (extent)
+ (goto-char (match-beginning 1))
+ (or (extent-at (point) (buffer-name) 'mouse-face) ;; not yet extended
+ (progn
+ (setq extent (make-extent (match-beginning 1) (match-end 1)))
+ (set-extent-property extent 'start-closed 't)
+ (set-extent-property extent 'end-closed 't)
+ (set-extent-property extent 'detachable 't)
+ (set-extent-property extent 'verilog-include-file 't)
+ (set-extent-property extent 'mouse-face 'highlight)
+ (set-extent-keymap extent verilog-mode-mouse-map)))))))))
+
+
+(defun verilog-colorize-include-files-buffer ()
+ "Colorize a include file."
+ (interactive)
+ ;; delete overlays
+ (let ((overlays (overlays-in (point-min) (point-max))))
+ (while overlays
+ (if (and
+ (overlay-get (car overlays) 'detachable)
+ (overlay-get (car overlays) 'verilog-include-file))
+ (delete-overlay (car overlays)))
+ (setq overlays (cdr overlays)))) ; let
+ ;; remake overlays
+ (verilog-colorize-include-files (point-min) (point-max) nil))
+
+;; ffap-at-mouse isn't useful for verilog mode. It uses library paths.
+;; so define this function to do more or less the same as ffap-at-mouse
+;; but first resolve filename...
+(defun verilog-load-file-at-mouse (event)
+ "Load file under button 2 click's EVENT.
+Files are checked based on `verilog-library-directories'."
+ (interactive "@e")
+ (save-excursion ;; implement a verilog specific ffap-at-mouse
+ (mouse-set-point event)
+ (beginning-of-line)
+ (if (looking-at verilog-include-file-regexp)
+ (if (and (car (verilog-library-filenames
+ (match-string 1) (buffer-file-name)))
+ (file-readable-p (car (verilog-library-filenames
+ (match-string 1) (buffer-file-name)))))
+ (find-file (car (verilog-library-filenames
+ (match-string 1) (buffer-file-name))))
+ (progn
+ (message
+ "File '%s' isn't readable, use shift-mouse2 to paste in this field"
+ (match-string 1))))
+ )))
+
+;; ffap isn't useable for verilog mode. It uses library paths.
+;; so define this function to do more or less the same as ffap
+;; but first resolve filename...
+(defun verilog-load-file-at-point ()
+ "Load file under point.
+Files are checked based on `verilog-library-directories'."
+ (interactive)
+ (save-excursion ;; implement a verilog specific ffap
+ (beginning-of-line)
+ (if (looking-at verilog-include-file-regexp)
+ (if (and
+ (car (verilog-library-filenames
+ (match-string 1) (buffer-file-name)))
+ (file-readable-p (car (verilog-library-filenames
+ (match-string 1) (buffer-file-name)))))
+ (find-file (car (verilog-library-filenames
+ (match-string 1) (buffer-file-name))))))
+ ))
+
+
+;;
+;; Bug reporting
+;;
+
+(defun verilog-faq ()
+ "Tell the user their current version, and where to get the FAQ etc."
+ (interactive)
+ (with-output-to-temp-buffer "*verilog-mode help*"
+ (princ (format "You are using verilog-mode %s\n" verilog-mode-version))
+ (princ "\n")
+ (princ "For new releases, see http://www.verilog.com\n")
+ (princ "\n")
+ (princ "For frequently asked questions, see http://www.veripool.com/verilog-mode-faq.html\n")
+ (princ "\n")
+ (princ "To submit a bug, use M-x verilog-submit-bug-report\n")
+ (princ "\n")))
+
+(defun verilog-submit-bug-report ()
+ "Submit via mail a bug report on verilog-mode.el."
+ (interactive)
+ (let ((reporter-prompt-for-summary-p t))
+ (reporter-submit-bug-report
+ "mac@verilog.com"
+ (concat "verilog-mode v" verilog-mode-version)
+ '(
+ verilog-align-ifelse
+ verilog-auto-endcomments
+ verilog-auto-hook
+ verilog-auto-indent-on-newline
+ verilog-auto-inst-vector
+ verilog-auto-inst-template-numbers
+ verilog-auto-lineup
+ verilog-auto-newline
+ verilog-auto-save-policy
+ verilog-auto-sense-defines-constant
+ verilog-auto-sense-include-inputs
+ verilog-before-auto-hook
+ verilog-case-indent
+ verilog-cexp-indent
+ verilog-compiler
+ verilog-coverage
+ verilog-highlight-translate-off
+ verilog-indent-begin-after-if
+ verilog-indent-declaration-macros
+ verilog-indent-level
+ verilog-indent-level-behavioral
+ verilog-indent-level-declaration
+ verilog-indent-level-directive
+ verilog-indent-level-module
+ verilog-indent-lists
+ verilog-library-flags
+ verilog-library-directories
+ verilog-library-extensions
+ verilog-library-files
+ verilog-linter
+ verilog-minimum-comment-distance
+ verilog-mode-hook
+ verilog-simulator
+ verilog-tab-always-indent
+ verilog-tab-to-comment
+ )
+ nil nil
+ (concat "Hi Mac,
+
+I want to report a bug. I've read the `Bugs' section of `Info' on
+Emacs, so I know how to make a clear and unambiguous report. To get
+to that Info section, I typed
+
+M-x info RET m " invocation-name " RET m bugs RET
+
+Before I go further, I want to say that Verilog mode has changed my life.
+I save so much time, my files are colored nicely, my co workers respect
+my coding ability... until now. I'd really appreciate anything you
+could do to help me out with this minor deficiency in the product.
+
+If you have bugs with the AUTO functions, please CC the AUTOAUTHOR Wilson
+Snyder (wsnyder@wsnyder.org) and/or see http://www.veripool.com.
+You may also want to look at the Verilog-Mode FAQ, see
+http://www.veripool.com/verilog-mode-faq.html.
+
+To reproduce the bug, start a fresh Emacs via " invocation-name "
+-no-init-file -no-site-file'. In a new buffer, in verilog mode, type
+the code included below.
+
+Given those lines, I expected [[Fill in here]] to happen;
+but instead, [[Fill in here]] happens!.
+
+== The code: =="))))
+
+;; Local Variables:
+;; checkdoc-permit-comma-termination-flag:t
+;; checkdoc-force-docstrings-flag:nil
+;; End:
+
+;;; verilog-mode.el ends here
--- /dev/null
+; -*-Emacs-Lisp-*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; File: xcscope.el
+; RCS: $RCSfile: xcscope.el,v $ $Revision: 1.14 $ $Date: 2002/04/10 16:59:00 $ $Author: darrylo $
+; Description: cscope interface for (X)Emacs
+; Author: Darryl Okahata
+; Created: Wed Apr 19 17:03:38 2000
+; Modified: Thu Apr 4 17:22:22 2002 (Darryl Okahata) darrylo@soco.agilent.com
+; Language: Emacs-Lisp
+; Package: N/A
+; Status: Experimental
+;
+; (C) Copyright 2000, 2001, 2002, Darryl Okahata <darrylo@sonic.net>,
+; all rights reserved.
+; GNU Emacs enhancements (C) Copyright 2001,
+; Triet H. Lai <thlai@mail.usyd.edu.au>
+; Fuzzy matching and navigation code (C) Copyright 2001,
+; Steven Elliott <selliott4@austin.rr.com>
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ALPHA VERSION 0.96
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This is a cscope interface for (X)Emacs.
+;; It currently runs under Unix only.
+;;
+;; Using cscope, you can easily search for where symbols are used and defined.
+;; Cscope is designed to answer questions like:
+;;
+;; Where is this variable used?
+;; What is the value of this preprocessor symbol?
+;; Where is this function in the source files?
+;; What functions call this function?
+;; What functions are called by this function?
+;; Where does the message "out of space" come from?
+;; Where is this source file in the directory structure?
+;; What files include this header file?
+;;
+;; Send comments to one of: darrylo@soco.agilent.com
+;; darryl_okahata@agilent.com
+;; darrylo@sonic.net
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; ***** INSTALLATION *****
+;;
+;; * NOTE: this interface currently runs under Unix only.
+;;
+;; This module needs a shell script called "cscope-indexer", which
+;; should have been supplied along with this emacs-lisp file. The
+;; purpose of "cscope-indexer" is to create and optionally maintain
+;; the cscope databases. If all of your source files are in one
+;; directory, you don't need this script; it's very nice to have,
+;; though, as it handles recursive subdirectory indexing, and can be
+;; used in a nightly or weekly cron job to index very large source
+;; repositories. See the beginning of the file, "cscope-indexer", for
+;; usage information.
+;;
+;; Installation steps:
+;;
+;; 0. (It is, of course, assumed that cscope is already properly
+;; installed on the current system.)
+;;
+;; 1. Install the "cscope-indexer" script into some convenient
+;; directory in $PATH. The only real constraint is that (X)Emacs
+;; must be able to find and execute it. You may also have to edit
+;; the value of PATH in the script, although this is unlikely; the
+;; majority of people should be able to use the script, "as-is".
+;;
+;; 2. Make sure that the "cscope-indexer" script is executable. In
+;; particular, if you had to ftp this file, it is probably no
+;; longer executable.
+;;
+;; 3. Put this emacs-lisp file somewhere where (X)Emacs can find it. It
+;; basically has to be in some directory listed in "load-path".
+;;
+;; 4. Edit your ~/.emacs file to add the line:
+;;
+;; (require 'xcscope)
+;;
+;; 5. If you intend to use xcscope.el often you can optionally edit your
+;; ~/.emacs file to add keybindings that reduce the number of keystrokes
+;; required. For example, the following will add "C-f#" keybindings, which
+;; are easier to type than the usual "C-c s" prefixed keybindings. Note
+;; that specifying "global-map" instead of "cscope:map" makes the
+;; keybindings available in all buffers:
+;;
+;; (define-key global-map [(control f3)] 'cscope-set-initial-directory)
+;; (define-key global-map [(control f4)] 'cscope-unset-initial-directory)
+;; (define-key global-map [(control f5)] 'cscope-find-this-symbol)
+;; (define-key global-map [(control f6)] 'cscope-find-global-definition)
+;; (define-key global-map [(control f7)]
+;; 'cscope-find-global-definition-no-prompting)
+;; (define-key global-map [(control f8)] 'cscope-pop-mark)
+;; (define-key global-map [(control f9)] 'cscope-next-symbol)
+;; (define-key global-map [(control f10)] 'cscope-next-file)
+;; (define-key global-map [(control f11)] 'cscope-prev-symbol)
+;; (define-key global-map [(control f12)] 'cscope-prev-file)
+;; (define-key global-map [(meta f9)] 'cscope-display-buffer)
+;; (defin-ekey global-map [(meta f10)] 'cscope-display-buffer-toggle)
+;;
+;; 6. Restart (X)Emacs. That's it.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; ***** USING THIS MODULE *****
+;;
+;; * Basic usage:
+;;
+;; If all of your C/C++/lex/yacc source files are in the same
+;; directory, you can just start using this module. If your files are
+;; spread out over multiple directories, see "Advanced usage", below.
+;;
+;; Just edit a source file, and use the pull-down or pop-up (button 3)
+;; menus to select one of:
+;;
+;; Find symbol
+;; Find global definition
+;; Find called functions
+;; Find functions calling a function
+;; Find text string
+;; Find egrep pattern
+;; Find a file
+;; Find files #including a file
+;;
+;; The cscope database will be automatically created in the same
+;; directory as the source files (assuming that you've never used
+;; cscope before), and a buffer will pop-up displaying the results.
+;; You can then use button 2 (the middle button) on the mouse to edit
+;; the selected file, or you can move the text cursor over a selection
+;; and press [Enter].
+;;
+;; Hopefully, the interface should be fairly intuitive.
+;;
+;;
+;; * Locating the cscope databases:
+;;
+;; This module will first use the variable, `cscope-database-regexps',
+;; to search for a suitable database directory. If a database location
+;; cannot be found using this variable then a search is begun at the
+;; variable, `cscope-initial-directory', if set, or the current
+;; directory otherwise. If the directory is not a cscope database
+;; directory then the directory's parent, parent's parent, etc. is
+;; searched until a cscope database directory is found, or the root
+;; directory is reached. If the root directory is reached, the current
+;; directory will be used.
+;;
+;; A cscope database directory is one in which EITHER a cscope database
+;; file (e.g., "cscope.out") OR a cscope file list (e.g.,
+;; "cscope.files") exists. If only "cscope.files" exists, the
+;; corresponding "cscope.out" will be automatically created by cscope
+;; when a search is done. By default, the cscope database file is called
+;; "cscope.out", but this can be changed (on a global basis) via the
+;; variable, `cscope-database-file'. There is limited support for cscope
+;; databases that are named differently than that given by
+;; `cscope-database-file', using the variable, `cscope-database-regexps'.
+;;
+;; Note that the variable, `cscope-database-regexps', is generally not
+;; needed, as the normal hierarchical database search is sufficient
+;; for placing and/or locating the cscope databases. However, there
+;; may be cases where it makes sense to place the cscope databases
+;; away from where the source files are kept; in this case, this
+;; variable is used to determine the mapping. One use for this
+;; variable is when you want to share the database file with other
+;; users; in this case, the database may be located in a directory
+;; separate from the source files.
+;;
+;; Setting the variable, `cscope-initial-directory', is useful when a
+;; search is to be expanded by specifying a cscope database directory
+;; that is a parent of the directory that this module would otherwise
+;; use. For example, consider a project that contains the following
+;; cscope database directories:
+;;
+;; /users/jdoe/sources
+;; /users/jdoe/sources/proj1
+;; /users/jdoe/sources/proj2
+;;
+;; If a search is initiated from a .c file in /users/jdoe/sources/proj1
+;; then (assuming the variable, `cscope-database-regexps', is not set)
+;; /users/jdoe/sources/proj1 will be used as the cscope data base directory.
+;; Only matches in files in /users/jdoe/sources/proj1 will be found. This
+;; can be remedied by typing "C-c s a" and then "M-del" to remove single
+;; path element in order to use a cscope database directory of
+;; /users/jdoe/sources. Normal searching can be restored by typing "C-c s A".
+;;
+;;
+;; * Keybindings:
+;;
+;; All keybindings use the "C-c s" prefix, but are usable only while
+;; editing a source file, or in the cscope results buffer:
+;;
+;; C-c s s Find symbol.
+;; C-c s d Find global definition.
+;; C-c s g Find global definition (alternate binding).
+;; C-c s G Find global definition without prompting.
+;; C-c s c Find functions calling a function.
+;; C-c s C Find called functions (list functions called
+;; from a function).
+;; C-c s t Find text string.
+;; C-c s e Find egrep pattern.
+;; C-c s f Find a file.
+;; C-c s i Find files #including a file.
+;;
+;; These pertain to navigation through the search results:
+;;
+;; C-c s b Display *cscope* buffer.
+;; C-c s B Auto display *cscope* buffer toggle.
+;; C-c s n Next symbol.
+;; C-c s N Next file.
+;; C-c s p Previous symbol.
+;; C-c s P Previous file.
+;; C-c s u Pop mark.
+;;
+;; These pertain to setting and unsetting the variable,
+;; `cscope-initial-directory', (location searched for the cscope database
+;; directory):
+;;
+;; C-c s a Set initial directory.
+;; C-c s A Unset initial directory.
+;;
+;; These pertain to cscope database maintenance:
+;;
+;; C-c s L Create list of files to index.
+;; C-c s I Create list and index.
+;; C-c s E Edit list of files to index.
+;; C-c s W Locate this buffer's cscope directory
+;; ("W" --> "where").
+;; C-c s S Locate this buffer's cscope directory.
+;; (alternate binding: "S" --> "show").
+;; C-c s T Locate this buffer's cscope directory.
+;; (alternate binding: "T" --> "tell").
+;; C-c s D Dired this buffer's directory.
+;;
+;;
+;; * Advanced usage:
+;;
+;; If the source files are spread out over multiple directories,
+;; you've got a few choices:
+;;
+;; [ NOTE: you will need to have the script, "cscope-indexer",
+;; properly installed in order for the following to work. ]
+;;
+;; 1. If all of the directories exist below a common directory
+;; (without any extraneous, unrelated subdirectories), you can tell
+;; this module to place the cscope database into the top-level,
+;; common directory. This assumes that you do not have any cscope
+;; databases in any of the subdirectories. If you do, you should
+;; delete them; otherwise, they will take precedence over the
+;; top-level database.
+;;
+;; If you do have cscope databases in any subdirectory, the
+;; following instructions may not work right.
+;;
+;; It's pretty easy to tell this module to use a top-level, common
+;; directory:
+;;
+;; a. Make sure that the menu pick, "Cscope/Index recursively", is
+;; checked (the default value).
+;;
+;; b. Select the menu pick, "Cscope/Create list and index", and
+;; specify the top-level directory. This will run the script,
+;; "cscope-indexer", in the background, so you can do other
+;; things if indexing takes a long time. A list of files to
+;; index will be created in "cscope.files", and the cscope
+;; database will be created in "cscope.out".
+;;
+;; Once this has been done, you can then use the menu picks
+;; (described in "Basic usage", above) to search for symbols.
+;;
+;; Note, however, that, if you add or delete source files, you'll
+;; have to either rebuild the database using the above procedure,
+;; or edit the file, "cscope.files" to add/delete the names of the
+;; source files. To edit this file, you can use the menu pick,
+;; "Cscope/Edit list of files to index".
+;;
+;;
+;; 2. If most of the files exist below a common directory, but a few
+;; are outside, you can use the menu pick, "Cscope/Create list of
+;; files to index", and specify the top-level directory. Make sure
+;; that "Cscope/Index recursively", is checked before you do so,
+;; though. You can then edit the list of files to index using the
+;; menu pick, "Cscope/Edit list of files to index". Just edit the
+;; list to include any additional source files not already listed.
+;;
+;; Once you've created, edited, and saved the list, you can then
+;; use the menu picks described under "Basic usage", above, to
+;; search for symbols. The first time you search, you will have to
+;; wait a while for cscope to fully index the source files, though.
+;; If you have a lot of source files, you may want to manually run
+;; cscope to build the database:
+;;
+;; cd top-level-directory # or wherever
+;; rm -f cscope.out # not always necessary
+;; cscope -b
+;;
+;;
+;; 3. If the source files are scattered in many different, unrelated
+;; places, you'll have to manually create cscope.files and put a
+;; list of all pathnames into it. Then build the database using:
+;;
+;; cd some-directory # wherever cscope.files exists
+;; rm -f cscope.out # not always necessary
+;; cscope -b
+;;
+;; Next, read the documentation for the variable,
+;; "cscope-database-regexps", and set it appropriately, such that
+;; the above-created cscope database will be referenced when you
+;; edit a related source file.
+;;
+;; Once this has been done, you can then use the menu picks
+;; described under "Basic usage", above, to search for symbols.
+;;
+;;
+;; * Interesting configuration variables:
+;;
+;; "cscope-truncate-lines"
+;; This is the value of `truncate-lines' to use in cscope
+;; buffers; the default is the current setting of
+;; `truncate-lines'. This variable exists because it can be
+;; easier to read cscope buffers with truncated lines, while
+;; other buffers do not have truncated lines.
+;;
+;; "cscope-use-relative-paths"
+;; If non-nil, use relative paths when creating the list of files
+;; to index. The path is relative to the directory in which the
+;; cscope database will be created. If nil, absolute paths will
+;; be used. Absolute paths are good if you plan on moving the
+;; database to some other directory (if you do so, you'll
+;; probably also have to modify `cscope-database-regexps').
+;; Absolute paths may also be good if you share the database file
+;; with other users (you'll probably want to specify some
+;; automounted network path for this).
+;;
+;; "cscope-index-recursively"
+;; If non-nil, index files in the current directory and all
+;; subdirectories. If nil, only files in the current directory
+;; are indexed. This variable is only used when creating the
+;; list of files to index, or when creating the list of files and
+;; the corresponding cscope database.
+;;
+;; "cscope-name-line-width"
+;; The width of the combined "function name:line number" field in
+;; the cscope results buffer. If negative, the field is
+;; left-justified.
+;;
+;; "cscope-do-not-update-database"
+;; If non-nil, never check and/or update the cscope database when
+;; searching. Beware of setting this to non-nil, as this will
+;; disable automatic database creation, updating, and
+;; maintenance.
+;;
+;; "cscope-display-cscope-buffer"
+;; If non-nil, display the *cscope* buffer after each search
+;; (default). This variable can be set in order to reduce the
+;; number of keystrokes required to navigate through the matches.
+;;
+;; "cscope-database-regexps"
+;; List to force directory-to-cscope-database mappings.
+;; This is a list of `(REGEXP DBLIST [ DBLIST ... ])', where:
+;;
+;; REGEXP is a regular expression matched against the current buffer's
+;; current directory. The current buffer is typically some source file,
+;; and you're probably searching for some symbol in or related to this
+;; file. Basically, this regexp is used to relate the current directory
+;; to a cscope database. You need to start REGEXP with "^" if you want
+;; to match from the beginning of the current directory.
+;;
+;; DBLIST is a list that contains one or more of:
+;;
+;; ( DBDIR )
+;; ( DBDIR ( OPTIONS ) )
+;; ( t )
+;; t
+;;
+;; Here, DBDIR is a directory (or a file) that contains a cscope
+;; database. If DBDIR is a directory, then it is expected that the
+;; cscope database, if present, has the filename given by the variable,
+;; `cscope-database-file'; if DBDIR is a file, then DBDIR is the path
+;; name to a cscope database file (which does not have to be the same as
+;; that given by `cscope-database-file'). If only DBDIR is specified,
+;; then that cscope database will be searched without any additional
+;; cscope command-line options. If OPTIONS is given, then OPTIONS is a
+;; list of strings, where each string is a separate cscope command-line
+;; option.
+;;
+;; In the case of "( t )", this specifies that the search is to use the
+;; normal hierarchical database search. This option is used to
+;; explicitly search using the hierarchical database search either before
+;; or after other cscope database directories.
+;;
+;; If "t" is specified (not inside a list), this tells the searching
+;; mechanism to stop searching if a match has been found (at the point
+;; where "t" is encountered). This is useful for those projects that
+;; consist of many subprojects. You can specify the most-used
+;; subprojects first, followed by a "t", and then followed by a master
+;; cscope database directory that covers all subprojects. This will
+;; cause the most-used subprojects to be searched first (hopefully
+;; quickly), and the search will then stop if a match was found. If not,
+;; the search will continue using the master cscope database directory.
+;;
+;; Here, `cscope-database-regexps' is generally not used, as the normal
+;; hierarchical database search is sufficient for placing and/or locating
+;; the cscope databases. However, there may be cases where it makes
+;; sense to place the cscope databases away from where the source files
+;; are kept; in this case, this variable is used to determine the
+;; mapping.
+;;
+;; This module searches for the cscope databases by first using this
+;; variable; if a database location cannot be found using this variable,
+;; then the current directory is searched, then the parent, then the
+;; parent's parent, until a cscope database directory is found, or the
+;; root directory is reached. If the root directory is reached, the
+;; current directory will be used.
+;;
+;; A cscope database directory is one in which EITHER a cscope database
+;; file (e.g., "cscope.out") OR a cscope file list (e.g.,
+;; "cscope.files") exists. If only "cscope.files" exists, the
+;; corresponding "cscope.out" will be automatically created by cscope
+;; when a search is done. By default, the cscope database file is called
+;; "cscope.out", but this can be changed (on a global basis) via the
+;; variable, `cscope-database-file'. There is limited support for cscope
+;; databases that are named differently than that given by
+;; `cscope-database-file', using the variable, `cscope-database-regexps'.
+;;
+;; Here is an example of `cscope-database-regexps':
+;;
+;; (setq cscope-database-regexps
+;; '(
+;; ( "^/users/jdoe/sources/proj1"
+;; ( t )
+;; ( "/users/jdoe/sources/proj2")
+;; ( "/users/jdoe/sources/proj3/mycscope.out")
+;; ( "/users/jdoe/sources/proj4")
+;; t
+;; ( "/some/master/directory" ("-d" "-I/usr/local/include") )
+;; )
+;; ( "^/users/jdoe/sources/gnome/"
+;; ( "/master/gnome/database" ("-d") )
+;; )
+;; ))
+;;
+;; If the current buffer's directory matches the regexp,
+;; "^/users/jdoe/sources/proj1", then the following search will be
+;; done:
+;;
+;; 1. First, the normal hierarchical database search will be used to
+;; locate a cscope database.
+;;
+;; 2. Next, searches will be done using the cscope database
+;; directories, "/users/jdoe/sources/proj2",
+;; "/users/jdoe/sources/proj3/mycscope.out", and
+;; "/users/jdoe/sources/proj4". Note that, instead of the file,
+;; "cscope.out", the file, "mycscope.out", will be used in the
+;; directory "/users/jdoe/sources/proj3".
+;;
+;; 3. If a match was found, searching will stop.
+;;
+;; 4. If a match was not found, searching will be done using
+;; "/some/master/directory", and the command-line options "-d"
+;; and "-I/usr/local/include" will be passed to cscope.
+;;
+;; If the current buffer's directory matches the regexp,
+;; "^/users/jdoe/sources/gnome", then the following search will be
+;; done:
+;;
+;; The search will be done only using the directory,
+;; "/master/gnome/database". The "-d" option will be passed to
+;; cscope.
+;;
+;; If the current buffer's directory does not match any of the above
+;; regexps, then only the normal hierarchical database search will be
+;; done.
+;;
+;;
+;; * Other notes:
+;;
+;; 1. The script, "cscope-indexer", uses a sed command to determine
+;; what is and is not a C/C++/lex/yacc source file. It's idea of a
+;; source file may not correspond to yours.
+;;
+;; 2. This module is called, "xcscope", because someone else has
+;; already written a "cscope.el" (although it's quite old).
+;;
+;;
+;; * KNOWN BUGS:
+;;
+;; 1. Cannot handle whitespace in directory or file names.
+;;
+;; 2. By default, colored faces are used to display results. If you happen
+;; to use a black background, part of the results may be invisible
+;; (because the foreground color may be black, too). There are at least
+;; two solutions for this:
+;;
+;; 2a. Turn off colored faces, by setting `cscope-use-face' to `nil',
+;; e.g.:
+;;
+;; (setq cscope-use-face nil)
+;;
+;; 2b. Explicitly set colors for the faces used by cscope. The faces
+;; are:
+;;
+;; cscope-file-face
+;; cscope-function-face
+;; cscope-line-number-face
+;; cscope-line-face
+;; cscope-mouse-face
+;;
+;; The face most likely to cause problems (e.g., black-on-black
+;; color) is `cscope-line-face'.
+;;
+;; 3. The support for cscope databases different from that specified by
+;; `cscope-database-file' is quirky. If the file does not exist, it
+;; will not be auto-created (unlike files names by
+;; `cscope-database-file'). You can manually force the file to be
+;; created by using touch(1) to create a zero-length file; the
+;; database will be created the next time a search is done.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'easymenu)
+
+
+(defgroup cscope nil
+ "Cscope interface for (X)Emacs.
+Using cscope, you can easily search for where symbols are used and defined.
+It is designed to answer questions like:
+
+ Where is this variable used?
+ What is the value of this preprocessor symbol?
+ Where is this function in the source files?
+ What functions call this function?
+ What functions are called by this function?
+ Where does the message \"out of space\" come from?
+ Where is this source file in the directory structure?
+ What files include this header file?
+"
+ :prefix "cscope-"
+ :group 'tools)
+
+
+(defcustom cscope-do-not-update-database nil
+ "*If non-nil, never check and/or update the cscope database when searching.
+Beware of setting this to non-nil, as this will disable automatic database
+creation, updating, and maintenance."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-database-regexps nil
+ "*List to force directory-to-cscope-database mappings.
+This is a list of `(REGEXP DBLIST [ DBLIST ... ])', where:
+
+REGEXP is a regular expression matched against the current buffer's
+current directory. The current buffer is typically some source file,
+and you're probably searching for some symbol in or related to this
+file. Basically, this regexp is used to relate the current directory
+to a cscope database. You need to start REGEXP with \"^\" if you want
+to match from the beginning of the current directory.
+
+DBLIST is a list that contains one or more of:
+
+ ( DBDIR )
+ ( DBDIR ( OPTIONS ) )
+ ( t )
+ t
+
+Here, DBDIR is a directory (or a file) that contains a cscope database.
+If DBDIR is a directory, then it is expected that the cscope database,
+if present, has the filename given by the variable,
+`cscope-database-file'; if DBDIR is a file, then DBDIR is the path name
+to a cscope database file (which does not have to be the same as that
+given by `cscope-database-file'). If only DBDIR is specified, then that
+cscope database will be searched without any additional cscope
+command-line options. If OPTIONS is given, then OPTIONS is a list of
+strings, where each string is a separate cscope command-line option.
+
+In the case of \"( t )\", this specifies that the search is to use the
+normal hierarchical database search. This option is used to
+explicitly search using the hierarchical database search either before
+or after other cscope database directories.
+
+If \"t\" is specified (not inside a list), this tells the searching
+mechanism to stop searching if a match has been found (at the point
+where \"t\" is encountered). This is useful for those projects that
+consist of many subprojects. You can specify the most-used
+subprojects first, followed by a \"t\", and then followed by a master
+cscope database directory that covers all subprojects. This will
+cause the most-used subprojects to be searched first (hopefully
+quickly), and the search will then stop if a match was found. If not,
+the search will continue using the master cscope database directory.
+
+Here, `cscope-database-regexps' is generally not used, as the normal
+hierarchical database search is sufficient for placing and/or locating
+the cscope databases. However, there may be cases where it makes
+sense to place the cscope databases away from where the source files
+are kept; in this case, this variable is used to determine the
+mapping.
+
+This module searches for the cscope databases by first using this
+variable; if a database location cannot be found using this variable,
+then the current directory is searched, then the parent, then the
+parent's parent, until a cscope database directory is found, or the
+root directory is reached. If the root directory is reached, the
+current directory will be used.
+
+A cscope database directory is one in which EITHER a cscope database
+file (e.g., \"cscope.out\") OR a cscope file list (e.g.,
+\"cscope.files\") exists. If only \"cscope.files\" exists, the
+corresponding \"cscope.out\" will be automatically created by cscope
+when a search is done. By default, the cscope database file is called
+\"cscope.out\", but this can be changed (on a global basis) via the
+variable, `cscope-database-file'. There is limited support for cscope
+databases that are named differently than that given by
+`cscope-database-file', using the variable, `cscope-database-regexps'.
+
+Here is an example of `cscope-database-regexps':
+
+ (setq cscope-database-regexps
+ '(
+ ( \"^/users/jdoe/sources/proj1\"
+ ( t )
+ ( \"/users/jdoe/sources/proj2\")
+ ( \"/users/jdoe/sources/proj3/mycscope.out\")
+ ( \"/users/jdoe/sources/proj4\")
+ t
+ ( \"/some/master/directory\" (\"-d\" \"-I/usr/local/include\") )
+ )
+ ( \"^/users/jdoe/sources/gnome/\"
+ ( \"/master/gnome/database\" (\"-d\") )
+ )
+ ))
+
+If the current buffer's directory matches the regexp,
+\"^/users/jdoe/sources/proj1\", then the following search will be
+done:
+
+ 1. First, the normal hierarchical database search will be used to
+ locate a cscope database.
+
+ 2. Next, searches will be done using the cscope database
+ directories, \"/users/jdoe/sources/proj2\",
+ \"/users/jdoe/sources/proj3/mycscope.out\", and
+ \"/users/jdoe/sources/proj4\". Note that, instead of the file,
+ \"cscope.out\", the file, \"mycscope.out\", will be used in the
+ directory \"/users/jdoe/sources/proj3\".
+
+ 3. If a match was found, searching will stop.
+
+ 4. If a match was not found, searching will be done using
+ \"/some/master/directory\", and the command-line options \"-d\"
+ and \"-I/usr/local/include\" will be passed to cscope.
+
+If the current buffer's directory matches the regexp,
+\"^/users/jdoe/sources/gnome\", then the following search will be
+done:
+
+ The search will be done only using the directory,
+ \"/master/gnome/database\". The \"-d\" option will be passed to
+ cscope.
+
+If the current buffer's directory does not match any of the above
+regexps, then only the normal hierarchical database search will be
+done.
+
+"
+ :type '(repeat (list :format "%v"
+ (choice :value ""
+ (regexp :tag "Buffer regexp")
+ string)
+ (choice :value ""
+ (directory :tag "Cscope database directory")
+ string)
+ (string :value ""
+ :tag "Optional cscope command-line arguments")
+ ))
+ :group 'cscope)
+(defcustom cscope-name-line-width -30
+ "*The width of the combined \"function name:line number\" field in the
+cscope results buffer. If negative, the field is left-justified."
+ :type 'integer
+ :group 'cscope)
+
+
+(defcustom cscope-truncate-lines truncate-lines
+ "*The value of `truncate-lines' to use in cscope buffers.
+This variable exists because it can be easier to read cscope buffers
+with truncated lines, while other buffers do not have truncated lines."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-display-times t
+ "*If non-nil, display how long each search took.
+The elasped times are in seconds. Floating-point support is required
+for this to work."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-program "cscope"
+ "*The pathname of the cscope executable to use."
+ :type 'string
+ :group 'cscope)
+
+
+(defcustom cscope-index-file "cscope.files"
+ "*The name of the cscope file list file."
+ :type 'string
+ :group 'cscope)
+
+
+(defcustom cscope-database-file "cscope.out"
+ "*The name of the cscope database file."
+ :type 'string
+ :group 'cscope)
+
+
+(defcustom cscope-edit-single-match t
+ "*If non-nil and only one match is output, edit the matched location."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-display-cscope-buffer t
+ "*If non-nil automatically display the *cscope* buffer after each search."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-stop-at-first-match-dir nil
+ "*If non-nil, stop searching through multiple databases if a match is found.
+This option is useful only if multiple cscope database directories are being
+used. When multiple databases are searched, setting this variable to non-nil
+will cause searches to stop when a search outputs anything; no databases after
+this one will be searched."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-use-relative-paths t
+ "*If non-nil, use relative paths when creating the list of files to index.
+The path is relative to the directory in which the cscope database
+will be created. If nil, absolute paths will be used. Absolute paths
+are good if you plan on moving the database to some other directory
+(if you do so, you'll probably also have to modify
+\`cscope-database-regexps\'). Absolute paths may also be good if you
+share the database file with other users (you\'ll probably want to
+specify some automounted network path for this)."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-index-recursively t
+ "*If non-nil, index files in the current directory and all subdirectories.
+If nil, only files in the current directory are indexed. This
+variable is only used when creating the list of files to index, or
+when creating the list of files and the corresponding cscope database."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-no-mouse-prompts nil
+ "*If non-nil, use the symbol under the cursor instead of prompting.
+Do not prompt for a value, except for when seaching for a egrep pattern
+or a file."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-suppress-empty-matches t
+ "*If non-nil, delete empty matches.")
+
+
+(defcustom cscope-indexing-script "cscope-indexer"
+ "*The shell script used to create cscope indices."
+ :type 'string
+ :group 'cscope)
+
+
+(defcustom cscope-symbol-chars "A-Za-z0-9_"
+ "*A string containing legal characters in a symbol.
+The current syntax table should really be used for this."
+ :type 'string
+ :group 'cscope)
+
+
+(defcustom cscope-filename-chars "-.,/A-Za-z0-9_~!@#$%&+=\\\\"
+ "*A string containing legal characters in a symbol.
+The current syntax table should really be used for this."
+ :type 'string
+ :group 'cscope)
+
+
+(defcustom cscope-allow-arrow-overlays t
+ "*If non-nil, use an arrow overlay to show target lines.
+Arrow overlays are only used when the following functions are used:
+
+ cscope-show-entry-other-window
+ cscope-show-next-entry-other-window
+ cscope-show-prev-entry-other-window
+
+The arrow overlay is removed when other cscope functions are used.
+Note that the arrow overlay is not an actual part of the text, and can
+be removed by quitting the cscope buffer."
+ :type 'boolean
+ :group 'cscope)
+
+
+(defcustom cscope-overlay-arrow-string "=>"
+ "*The overlay string to use when displaying arrow overlays."
+ :type 'string
+ :group 'cscope)
+
+
+(defvar cscope-minor-mode-hooks nil
+ "List of hooks to call when entering cscope-minor-mode.")
+
+
+(defconst cscope-separator-line
+ "-------------------------------------------------------------------------------\n"
+ "Line of text to use as a visual separator.
+Must end with a newline.")
+
+
+;;;;
+;;;; Faces for fontification
+;;;;
+
+(defcustom cscope-use-face t
+ "*Whether to use text highlighting (à la font-lock) or not."
+ :group 'cscope
+ :type '(boolean))
+
+
+(defface cscope-file-face
+ '((((class color) (background dark))
+ (:foreground "yellow"))
+ (((class color) (background light))
+ (:foreground "blue"))
+ (t (:bold t)))
+ "Face used to highlight file name in the *cscope* buffer."
+ :group 'cscope)
+
+
+(defface cscope-function-face
+ '((((class color) (background dark))
+ (:foreground "cyan"))
+ (((class color) (background light))
+ (:foreground "magenta"))
+ (t (:bold t)))
+ "Face used to highlight function name in the *cscope* buffer."
+ :group 'cscope)
+
+
+(defface cscope-line-number-face
+ '((((class color) (background dark))
+ (:foreground "red"))
+ (((class color) (background light))
+ (:foreground "red"))
+ (t (:bold t)))
+ "Face used to highlight line number in the *cscope* buffer."
+ :group 'cscope)
+
+
+(defface cscope-line-face
+ '((((class color) (background dark))
+ (:foreground "green"))
+ (((class color) (background light))
+ (:foreground "black"))
+ (t (:bold nil)))
+ "Face used to highlight the rest of line in the *cscope* buffer."
+ :group 'cscope)
+
+
+(defface cscope-mouse-face
+ '((((class color) (background dark))
+ (:foreground "white" :background "blue"))
+ (((class color) (background light))
+ (:foreground "white" :background "blue"))
+ (t (:bold nil)))
+ "Face used when mouse pointer is within the region of an entry."
+ :group 'cscope)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Probably, nothing user-customizable past this point.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defconst cscope-running-in-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
+
+(defvar cscope-list-entry-keymap nil
+ "The keymap used in the *cscope* buffer which lists search results.")
+(if cscope-list-entry-keymap
+ nil
+ (setq cscope-list-entry-keymap (make-keymap))
+ (suppress-keymap cscope-list-entry-keymap)
+ ;; The following section does not appear in the "Cscope" menu.
+ (if cscope-running-in-xemacs
+ (define-key cscope-list-entry-keymap [button2] 'cscope-mouse-select-entry-other-window)
+ (define-key cscope-list-entry-keymap [mouse-2] 'cscope-mouse-select-entry-other-window))
+ (define-key cscope-list-entry-keymap [return] 'cscope-select-entry-other-window)
+ (define-key cscope-list-entry-keymap " " 'cscope-show-entry-other-window)
+ (define-key cscope-list-entry-keymap "o" 'cscope-select-entry-one-window)
+ (define-key cscope-list-entry-keymap "q" 'cscope-bury-buffer)
+ (define-key cscope-list-entry-keymap "Q" 'cscope-quit)
+ (define-key cscope-list-entry-keymap "h" 'cscope-help)
+ (define-key cscope-list-entry-keymap "?" 'cscope-help)
+ ;; The following line corresponds to be beginning of the "Cscope" menu.
+ (define-key cscope-list-entry-keymap "s" 'cscope-find-this-symbol)
+ (define-key cscope-list-entry-keymap "d" 'cscope-find-this-symbol)
+ (define-key cscope-list-entry-keymap "g" 'cscope-find-global-definition)
+ (define-key cscope-list-entry-keymap "G"
+ 'cscope-find-global-definition-no-prompting)
+ (define-key cscope-list-entry-keymap "c" 'cscope-find-functions-calling-this-function)
+ (define-key cscope-list-entry-keymap "C" 'cscope-find-called-functions)
+ (define-key cscope-list-entry-keymap "t" 'cscope-find-this-text-string)
+ (define-key cscope-list-entry-keymap "e" 'cscope-find-egrep-pattern)
+ (define-key cscope-list-entry-keymap "f" 'cscope-find-this-file)
+ (define-key cscope-list-entry-keymap "i" 'cscope-find-files-including-file)
+ ;; --- (The '---' indicates that this line corresponds to a menu separator.)
+ (define-key cscope-list-entry-keymap "n" 'cscope-next-symbol)
+ (define-key cscope-list-entry-keymap "N" 'cscope-next-file)
+ (define-key cscope-list-entry-keymap "p" 'cscope-prev-symbol)
+ (define-key cscope-list-entry-keymap "P" 'cscope-prev-file)
+ (define-key cscope-list-entry-keymap "u" 'cscope-pop-mark)
+ ;; ---
+ (define-key cscope-list-entry-keymap "a" 'cscope-set-initial-directory)
+ (define-key cscope-list-entry-keymap "A" 'cscope-unset-initial-directory)
+ ;; ---
+ (define-key cscope-list-entry-keymap "L" 'cscope-create-list-of-files-to-index)
+ (define-key cscope-list-entry-keymap "I" 'cscope-index-files)
+ (define-key cscope-list-entry-keymap "E" 'cscope-edit-list-of-files-to-index)
+ (define-key cscope-list-entry-keymap "W" 'cscope-tell-user-about-directory)
+ (define-key cscope-list-entry-keymap "S" 'cscope-tell-user-about-directory)
+ (define-key cscope-list-entry-keymap "T" 'cscope-tell-user-about-directory)
+ (define-key cscope-list-entry-keymap "D" 'cscope-dired-directory)
+ ;; The previous line corresponds to be end of the "Cscope" menu.
+ )
+
+
+(defvar cscope-list-entry-hook nil
+ "*Hook run after cscope-list-entry-mode entered.")
+
+
+(defun cscope-list-entry-mode ()
+ "Major mode for jumping/showing entry from the list in the *cscope* buffer.
+
+\\{cscope-list-entry-keymap}"
+ (use-local-map cscope-list-entry-keymap)
+ (setq buffer-read-only t
+ mode-name "cscope"
+ major-mode 'cscope-list-entry-mode
+ overlay-arrow-string cscope-overlay-arrow-string)
+ (or overlay-arrow-position
+ (setq overlay-arrow-position (make-marker)))
+ (run-hooks 'cscope-list-entry-hook))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar cscope-output-buffer-name "*cscope*"
+ "The name of the cscope output buffer.")
+
+
+(defvar cscope-info-buffer-name "*cscope-info*"
+ "The name of the cscope information buffer.")
+
+
+(defvar cscope-process nil
+ "The current cscope process.")
+(make-variable-buffer-local 'cscope-process)
+
+
+(defvar cscope-process-output nil
+ "A buffer for holding partial cscope process output.")
+(make-variable-buffer-local 'cscope-process-output)
+
+
+(defvar cscope-command-args nil
+ "Internal variable for holding major command args to pass to cscope.")
+(make-variable-buffer-local 'cscope-command-args)
+
+
+(defvar cscope-start-directory nil
+ "Internal variable used to save the initial start directory.
+The results buffer gets reset to this directory when a search has
+completely finished.")
+(make-variable-buffer-local 'cscope-start-directory)
+
+
+(defvar cscope-search-list nil
+ "A list of (DIR . FLAGS) entries.
+This is a list of database directories to search. Each entry in the list
+is a (DIR . FLAGS) cell. DIR is the directory to search, and FLAGS are the
+flags to pass to cscope when using this database directory. FLAGS can be
+nil (meaning, \"no flags\").")
+(make-variable-buffer-local 'cscope-search-list)
+
+
+(defvar cscope-searched-dirs nil
+ "The list of database directories already searched.")
+(make-variable-buffer-local 'cscope-searched-dirs)
+
+
+(defvar cscope-filter-func nil
+ "Internal variable for holding the filter function to use (if any) when
+searching.")
+(make-variable-buffer-local 'cscope-filter-func)
+
+
+(defvar cscope-sentinel-func nil
+ "Internal variable for holding the sentinel function to use (if any) when
+searching.")
+(make-variable-buffer-local 'cscope-filter-func)
+
+
+(defvar cscope-last-file nil
+ "The file referenced by the last line of cscope process output.")
+(make-variable-buffer-local 'cscope-last-file)
+
+
+(defvar cscope-start-time nil
+ "The search start time, in seconds.")
+(make-variable-buffer-local 'cscope-start-time)
+
+
+(defvar cscope-first-match nil
+ "The first match result output by cscope.")
+(make-variable-buffer-local 'cscope-first-match)
+
+
+(defvar cscope-first-match-point nil
+ "Buffer location of the first match.")
+(make-variable-buffer-local 'cscope-first-match-point)
+
+
+(defvar cscope-item-start nil
+ "The point location of the start of a search's output, before header info.")
+(make-variable-buffer-local 'cscope-output-start)
+
+
+(defvar cscope-output-start nil
+ "The point location of the start of a search's output.")
+(make-variable-buffer-local 'cscope-output-start)
+
+
+(defvar cscope-matched-multiple nil
+ "Non-nil if cscope output multiple matches.")
+(make-variable-buffer-local 'cscope-matched-multiple)
+
+
+(defvar cscope-stop-at-first-match-dir-meta nil
+ "")
+(make-variable-buffer-local 'cscope-stop-at-first-match-dir-meta)
+
+
+(defvar cscope-symbol nil
+ "The last symbol searched for.")
+
+
+(defvar cscope-adjust t
+ "True if the symbol searched for (cscope-symbol) should be on
+the line specified by the cscope database. In such cases the point will be
+adjusted if need be (fuzzy matching).")
+
+
+(defvar cscope-adjust-range 1000
+ "How far the point should be adjusted if the symbol is not on the line
+specified by the cscope database.")
+
+
+(defvar cscope-marker nil
+ "The location from which cscope was invoked.")
+
+
+(defvar cscope-marker-window nil
+ "The window which should contain cscope-marker. This is the window from
+which cscope-marker is set when searches are launched from the *cscope*
+buffer.")
+
+
+(defvar cscope-marker-ring-length 16
+ "Length of the cscope marker ring.")
+
+
+(defvar cscope-marker-ring (make-ring cscope-marker-ring-length)
+ "Ring of markers which are locations from which cscope was invoked.")
+
+
+(defvar cscope-initial-directory nil
+ "When set the directory in which searches for the cscope database
+directory should begin.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar cscope:map nil
+ "The cscope keymap.")
+(if cscope:map
+ nil
+ (setq cscope:map (make-sparse-keymap))
+ ;; The following line corresponds to be beginning of the "Cscope" menu.
+ (define-key cscope:map "\C-css" 'cscope-find-this-symbol)
+ (define-key cscope:map "\C-csd" 'cscope-find-global-definition)
+ (define-key cscope:map "\C-csg" 'cscope-find-global-definition)
+ (define-key cscope:map "\C-csG" 'cscope-find-global-definition-no-prompting)
+ (define-key cscope:map "\C-csc" 'cscope-find-functions-calling-this-function)
+ (define-key cscope:map "\C-csC" 'cscope-find-called-functions)
+ (define-key cscope:map "\C-cst" 'cscope-find-this-text-string)
+ (define-key cscope:map "\C-cse" 'cscope-find-egrep-pattern)
+ (define-key cscope:map "\C-csf" 'cscope-find-this-file)
+ (define-key cscope:map "\C-csi" 'cscope-find-files-including-file)
+ ;; --- (The '---' indicates that this line corresponds to a menu separator.)
+ (define-key cscope:map "\C-csb" 'cscope-display-buffer)
+ (define-key cscope:map "\C-csB" 'cscope-display-buffer-toggle)
+ (define-key cscope:map "\C-csn" 'cscope-next-symbol)
+ (define-key cscope:map "\C-csN" 'cscope-next-file)
+ (define-key cscope:map "\C-csp" 'cscope-prev-symbol)
+ (define-key cscope:map "\C-csP" 'cscope-prev-file)
+ (define-key cscope:map "\C-csu" 'cscope-pop-mark)
+ ;; ---
+ (define-key cscope:map "\C-csa" 'cscope-set-initial-directory)
+ (define-key cscope:map "\C-csA" 'cscope-unset-initial-directory)
+ ;; ---
+ (define-key cscope:map "\C-csL" 'cscope-create-list-of-files-to-index)
+ (define-key cscope:map "\C-csI" 'cscope-index-files)
+ (define-key cscope:map "\C-csE" 'cscope-edit-list-of-files-to-index)
+ (define-key cscope:map "\C-csW" 'cscope-tell-user-about-directory)
+ (define-key cscope:map "\C-csS" 'cscope-tell-user-about-directory)
+ (define-key cscope:map "\C-csT" 'cscope-tell-user-about-directory)
+ (define-key cscope:map "\C-csD" 'cscope-dired-directory))
+ ;; The previous line corresponds to be end of the "Cscope" menu.
+
+(easy-menu-define cscope:menu
+ (list cscope:map cscope-list-entry-keymap)
+ "cscope menu"
+ '("Cscope"
+ [ "Find symbol" cscope-find-this-symbol t ]
+ [ "Find global definition" cscope-find-global-definition t ]
+ [ "Find global definition no prompting"
+ cscope-find-global-definition-no-prompting t ]
+ [ "Find functions calling a function"
+ cscope-find-functions-calling-this-function t ]
+ [ "Find called functions" cscope-find-called-functions t ]
+ [ "Find text string" cscope-find-this-text-string t ]
+ [ "Find egrep pattern" cscope-find-egrep-pattern t ]
+ [ "Find a file" cscope-find-this-file t ]
+ [ "Find files #including a file"
+ cscope-find-files-including-file t ]
+ "-----------"
+ [ "Display *cscope* buffer" cscope-display-buffer t ]
+ [ "Auto display *cscope* buffer toggle"
+ cscope-display-buffer-toggle t ]
+ [ "Next symbol" cscope-next-symbol t ]
+ [ "Next file" cscope-next-file t ]
+ [ "Previous symbol" cscope-prev-symbol t ]
+ [ "Previous file" cscope-prev-file t ]
+ [ "Pop mark" cscope-pop-mark t ]
+ "-----------"
+ ( "Cscope Database"
+ [ "Set initial directory"
+ cscope-set-initial-directory t ]
+ [ "Unset initial directory"
+ cscope-unset-initial-directory t ]
+ "-----------"
+ [ "Create list of files to index"
+ cscope-create-list-of-files-to-index t ]
+ [ "Create list and index"
+ cscope-index-files t ]
+ [ "Edit list of files to index"
+ cscope-edit-list-of-files-to-index t ]
+ [ "Locate this buffer's cscope directory"
+ cscope-tell-user-about-directory t ]
+ [ "Dired this buffer's cscope directory"
+ cscope-dired-directory t ]
+ )
+ "-----------"
+ ( "Options"
+ [ "Auto edit single match"
+ (setq cscope-edit-single-match
+ (not cscope-edit-single-match))
+ :style toggle :selected cscope-edit-single-match ]
+ [ "Auto display *cscope* buffer"
+ (setq cscope-display-cscope-buffer
+ (not cscope-display-cscope-buffer))
+ :style toggle :selected cscope-display-cscope-buffer ]
+ [ "Stop at first matching database"
+ (setq cscope-stop-at-first-match-dir
+ (not cscope-stop-at-first-match-dir))
+ :style toggle
+ :selected cscope-stop-at-first-match-dir ]
+ [ "Never update cscope database"
+ (setq cscope-do-not-update-database
+ (not cscope-do-not-update-database))
+ :style toggle :selected cscope-do-not-update-database ]
+ [ "Index recursively"
+ (setq cscope-index-recursively
+ (not cscope-index-recursively))
+ :style toggle :selected cscope-index-recursively ]
+ [ "Suppress empty matches"
+ (setq cscope-suppress-empty-matches
+ (not cscope-suppress-empty-matches))
+ :style toggle :selected cscope-suppress-empty-matches ]
+ [ "Use relative paths"
+ (setq cscope-use-relative-paths
+ (not cscope-use-relative-paths))
+ :style toggle :selected cscope-use-relative-paths ]
+ [ "No mouse prompts" (setq cscope-no-mouse-prompts
+ (not cscope-no-mouse-prompts))
+ :style toggle :selected cscope-no-mouse-prompts ]
+ )
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal functions and variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar cscope-common-text-plist
+ (let (plist)
+ (setq plist (plist-put plist 'mouse-face 'cscope-mouse-face))
+ plist)
+ "List of common text properties to be added to the entry line.")
+
+
+(defun cscope-insert-with-text-properties (text filename &optional line-number)
+ "Insert an entry with given TEXT, add entry attributes as text properties.
+The text properties to be added:
+- common property: mouse-face,
+- properties are used to open target file and its location: cscope-file,
+ cscope-line-number"
+ (let ((plist cscope-common-text-plist)
+ beg end)
+ (setq beg (point))
+ (insert text)
+ (setq end (point)
+ plist (plist-put plist 'cscope-file filename))
+ (if line-number
+ (progn
+ (if (stringp line-number)
+ (setq line-number (string-to-number line-number)))
+ (setq plist (plist-put plist 'cscope-line-number line-number))
+ ))
+ (add-text-properties beg end plist)
+ ))
+
+
+(if cscope-running-in-xemacs
+ (progn
+ (defalias 'cscope-event-window 'event-window)
+ (defalias 'cscope-event-point 'event-point)
+ (defalias 'cscope-recenter 'recenter)
+ )
+ (defun cscope-event-window (event)
+ "Return the window at which the mouse EVENT occurred."
+ (posn-window (event-start event)))
+ (defun cscope-event-point (event)
+ "Return the point at which the mouse EVENT occurred."
+ (posn-point (event-start event)))
+ (defun cscope-recenter (&optional n window)
+ "Center point in WINDOW and redisplay frame. With N, put point on line N."
+ (save-selected-window
+ (if (windowp window)
+ (select-window window))
+ (recenter n)))
+ )
+
+
+(defun cscope-show-entry-internal (file line-number
+ &optional save-mark-p window arrow-p)
+ "Display the buffer corresponding to FILE and LINE-NUMBER
+in some window. If optional argument WINDOW is given,
+display the buffer in that WINDOW instead. The window is
+not selected. Save point on mark ring before goto
+LINE-NUMBER if optional argument SAVE-MARK-P is non-nil.
+Put `overlay-arrow-string' if arrow-p is non-nil.
+Returns the window displaying BUFFER."
+ (let (buffer old-pos old-point new-point forward-point backward-point
+ line-end line-length)
+ (if (and (stringp file)
+ (integerp line-number))
+ (progn
+ (unless (file-readable-p file)
+ (error "%s is not readable or exists" file))
+ (setq buffer (find-file-noselect file))
+ (if (windowp window)
+ (set-window-buffer window buffer)
+ (setq window (display-buffer buffer)))
+ (set-buffer buffer)
+ (if (> line-number 0)
+ (progn
+ (setq old-pos (point))
+ (goto-line line-number)
+ (setq old-point (point))
+ (if (and cscope-adjust cscope-adjust-range)
+ (progn
+ ;; Calculate the length of the line specified by cscope.
+ (end-of-line)
+ (setq line-end (point))
+ (goto-char old-point)
+ (setq line-length (- line-end old-point))
+
+ ;; Search forward and backward for the pattern.
+ (setq forward-point (search-forward
+ cscope-symbol
+ (+ old-point
+ cscope-adjust-range) t))
+ (goto-char old-point)
+ (setq backward-point (search-backward
+ cscope-symbol
+ (- old-point
+ cscope-adjust-range) t))
+ (if forward-point
+ (progn
+ (if backward-point
+ (setq new-point
+ ;; Use whichever of forward-point or
+ ;; backward-point is closest to old-point.
+ ;; Give forward-point a line-length advantage
+ ;; so that if the symbol is on the current
+ ;; line the current line is chosen.
+ (if (<= (- (- forward-point line-length)
+ old-point)
+ (- old-point backward-point))
+ forward-point
+ backward-point))
+ (setq new-point forward-point)))
+ (if backward-point
+ (setq new-point backward-point)
+ (setq new-point old-point)))
+ (goto-char new-point)
+ (beginning-of-line)
+ (setq new-point (point)))
+ (setq new-point old-point))
+ (set-window-point window new-point)
+ (if (and cscope-allow-arrow-overlays arrow-p)
+ (set-marker overlay-arrow-position (point))
+ (set-marker overlay-arrow-position nil))
+ (or (not save-mark-p)
+ (= old-pos (point))
+ (push-mark old-pos))
+ ))
+
+ (if cscope-marker
+ (progn ;; The search was successful. Save the marker so it
+ ;; can be returned to by cscope-pop-mark.
+ (ring-insert cscope-marker-ring cscope-marker)
+ ;; Unset cscope-marker so that moving between matches
+ ;; (cscope-next-symbol, etc.) does not fill
+ ;; cscope-marker-ring.
+ (setq cscope-marker nil)))
+ (setq cscope-marker-window window)
+ )
+ (message "No entry found at point."))
+ )
+ window)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; functions in *cscope* buffer which lists the search results
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun cscope-select-entry-other-window ()
+ "Display the entry at point in other window, select the window.
+Push current point on mark ring and select the entry window."
+ (interactive)
+ (let ((file (get-text-property (point) 'cscope-file))
+ (line-number (get-text-property (point) 'cscope-line-number))
+ window)
+ (setq window (cscope-show-entry-internal file line-number t))
+ (if (windowp window)
+ (select-window window))
+ ))
+
+
+(defun cscope-select-entry-one-window ()
+ "Display the entry at point in one window, select the window."
+ (interactive)
+ (let ((file (get-text-property (point) 'cscope-file))
+ (line-number (get-text-property (point) 'cscope-line-number))
+ window)
+ (setq window (cscope-show-entry-internal file line-number t))
+ (if (windowp window)
+ (progn
+ (select-window window)
+ (sit-for 0) ;; Redisplay hack to allow delete-other-windows
+ ;; to continue displaying the correct location.
+ (delete-other-windows window)
+ ))
+ ))
+
+
+(defun cscope-select-entry-specified-window (window)
+ "Display the entry at point in a specified window, select the window."
+ (interactive)
+ (let ((file (get-text-property (point) 'cscope-file))
+ (line-number (get-text-property (point) 'cscope-line-number)))
+ (setq window (cscope-show-entry-internal file line-number t window))
+ (if (windowp window)
+ (select-window window))
+ ))
+
+
+(defun cscope-mouse-select-entry-other-window (event)
+ "Display the entry over which the mouse event occurred, select the window."
+ (interactive "e")
+ (let ((ep (cscope-event-point event))
+ (win (cscope-event-window event))
+ buffer file line-number window)
+ (if ep
+ (progn
+ (setq buffer (window-buffer win)
+ file (get-text-property ep 'cscope-file buffer)
+ line-number (get-text-property ep 'cscope-line-number buffer))
+ (select-window win)
+ (setq window (cscope-show-entry-internal file line-number t))
+ (if (windowp window)
+ (select-window window))
+ )
+ (message "No entry found at point.")
+ )
+ ))
+
+
+(defun cscope-show-entry-other-window ()
+ "Display the entry at point in other window.
+Point is not saved on mark ring."
+ (interactive)
+ (let ((file (get-text-property (point) 'cscope-file))
+ (line-number (get-text-property (point) 'cscope-line-number)))
+ (cscope-show-entry-internal file line-number nil nil t)
+ ))
+
+
+(defun cscope-buffer-search (do-symbol do-next)
+ "The body of the following four functions."
+ (let* (line-number old-point point
+ (search-file (not do-symbol))
+ (search-prev (not do-next))
+ (direction (if do-next 1 -1))
+ (old-buffer (current-buffer))
+ (old-buffer-window (get-buffer-window old-buffer))
+ (buffer (get-buffer cscope-output-buffer-name))
+ (buffer-window (get-buffer-window (or buffer (error "The *cscope* buffer does not exist yet"))))
+ )
+ (set-buffer buffer)
+ (setq old-point (point))
+ (forward-line direction)
+ (setq point (point))
+ (setq line-number (get-text-property point 'cscope-line-number))
+ (while (or (not line-number)
+ (or (and do-symbol (= line-number -1))
+ (and search-file (/= line-number -1))))
+ (forward-line direction)
+ (setq point (point))
+ (if (or (and do-next (>= point (point-max)))
+ (and search-prev (<= point (point-min))))
+ (progn
+ (goto-char old-point)
+ (error "The %s of the *cscope* buffer has been reached"
+ (if do-next "end" "beginning"))))
+ (setq line-number (get-text-property point 'cscope-line-number)))
+ (if (eq old-buffer buffer) ;; In the *cscope* buffer.
+ (cscope-show-entry-other-window)
+ (cscope-select-entry-specified-window old-buffer-window) ;; else
+ (if (windowp buffer-window)
+ (set-window-point buffer-window point)))
+ (set-buffer old-buffer)
+ ))
+
+
+(defun cscope-display-buffer ()
+ "Display the *cscope* buffer."
+ (interactive)
+ (let ((buffer (get-buffer cscope-output-buffer-name)))
+ (if buffer
+ (pop-to-buffer buffer)
+ (error "The *cscope* buffer does not exist yet"))))
+
+
+(defun cscope-display-buffer-toggle ()
+ "Toggle cscope-display-cscope-buffer, which corresponds to
+\"Auto display *cscope* buffer\"."
+ (interactive)
+ (setq cscope-display-cscope-buffer (not cscope-display-cscope-buffer))
+ (message "The cscope-display-cscope-buffer variable is now %s."
+ (if cscope-display-cscope-buffer "set" "unset")))
+
+
+(defun cscope-next-symbol ()
+ "Move to the next symbol in the *cscope* buffer."
+ (interactive)
+ (cscope-buffer-search t t))
+
+
+(defun cscope-next-file ()
+ "Move to the next file in the *cscope* buffer."
+ (interactive)
+ (cscope-buffer-search nil t))
+
+
+(defun cscope-prev-symbol ()
+ "Move to the previous symbol in the *cscope* buffer."
+ (interactive)
+ (cscope-buffer-search t nil))
+
+
+(defun cscope-prev-file ()
+ "Move to the previous file in the *cscope* buffer."
+ (interactive)
+ (cscope-buffer-search nil nil))
+
+
+(defun cscope-pop-mark ()
+ "Pop back to where cscope was last invoked."
+ (interactive)
+
+ ;; This function is based on pop-tag-mark, which can be found in
+ ;; lisp/progmodes/etags.el.
+
+ (if (ring-empty-p cscope-marker-ring)
+ (error "There are no marked buffers in the cscope-marker-ring yet"))
+ (let* ( (marker (ring-remove cscope-marker-ring 0))
+ (old-buffer (current-buffer))
+ (marker-buffer (marker-buffer marker))
+ marker-window
+ (marker-point (marker-position marker))
+ (cscope-buffer (get-buffer cscope-output-buffer-name)) )
+
+ ;; After the following both cscope-marker-ring and cscope-marker will be
+ ;; in the state they were immediately after the last search. This way if
+ ;; the user now makes a selection in the previously generated *cscope*
+ ;; buffer things will behave the same way as if that selection had been
+ ;; made immediately after the last search.
+ (setq cscope-marker marker)
+
+ (if marker-buffer
+ (if (eq old-buffer cscope-buffer)
+ (progn ;; In the *cscope* buffer.
+ (set-buffer marker-buffer)
+ (setq marker-window (display-buffer marker-buffer))
+ (set-window-point marker-window marker-point)
+ (select-window marker-window))
+ (switch-to-buffer marker-buffer))
+ (error "The marked buffer has been deleted"))
+ (goto-char marker-point)
+ (set-buffer old-buffer)))
+
+
+(defun cscope-set-initial-directory (cs-id)
+ "Set the cscope-initial-directory variable. The
+cscope-initial-directory variable, when set, specifies the directory
+where searches for the cscope database directory should begin. This
+overrides the current directory, which would otherwise be used."
+ (interactive "DCscope Initial Directory: ")
+ (setq cscope-initial-directory cs-id))
+
+
+(defun cscope-unset-initial-directory ()
+ "Unset the cscope-initial-directory variable."
+ (interactive)
+ (setq cscope-initial-directory nil)
+ (message "The cscope-initial-directory variable is now unset."))
+
+
+(defun cscope-help ()
+ (interactive)
+ (message
+ (format "RET=%s, SPC=%s, o=%s, n=%s, p=%s, q=%s, h=%s"
+ "Select"
+ "Show"
+ "SelectOneWin"
+ "ShowNext"
+ "ShowPrev"
+ "Quit"
+ "Help")))
+
+
+(defun cscope-bury-buffer ()
+ "Clean up cscope, if necessary, and bury the buffer."
+ (interactive)
+ (let ()
+ (if overlay-arrow-position
+ (set-marker overlay-arrow-position nil))
+ (setq overlay-arrow-position nil
+ overlay-arrow-string nil)
+ (bury-buffer (get-buffer cscope-output-buffer-name))
+ ))
+
+
+(defun cscope-quit ()
+ (interactive)
+ (cscope-bury-buffer)
+ (kill-buffer cscope-output-buffer-name)
+ )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun cscope-canonicalize-directory (dir)
+ (or dir
+ (setq dir default-directory))
+ (setq dir (file-name-as-directory
+ (expand-file-name (substitute-in-file-name dir))))
+ dir
+ )
+
+
+(defun cscope-search-directory-hierarchy (directory)
+ "Look for a cscope database in the directory hierarchy.
+Starting from DIRECTORY, look upwards for a cscope database."
+ (let (this-directory database-dir)
+ (catch 'done
+ (if (file-regular-p directory)
+ (throw 'done directory))
+ (setq directory (cscope-canonicalize-directory directory)
+ this-directory directory)
+ (while this-directory
+ (if (or (file-exists-p (concat this-directory cscope-database-file))
+ (file-exists-p (concat this-directory cscope-index-file)))
+ (progn
+ (setq database-dir this-directory)
+ (throw 'done database-dir)
+ ))
+ (if (string-match "^\\(/\\|[A-Za-z]:[\\/]\\)$" this-directory)
+ (throw 'done directory))
+ (setq this-directory (file-name-as-directory
+ (file-name-directory
+ (directory-file-name this-directory))))
+ ))
+ ))
+
+
+(defun cscope-find-info (top-directory)
+ "Locate a suitable cscope database directory.
+First, `cscope-database-regexps' is used to search for a suitable
+database directory. If a database location cannot be found using this
+variable, then the current directory is searched, then the parent,
+then the parent's parent, until a cscope database directory is found,
+or the root directory is reached. If the root directory is reached,
+the current directory will be used."
+ (let (info regexps dir-regexp this-directory)
+ (setq top-directory (cscope-canonicalize-directory
+ (or top-directory cscope-initial-directory)))
+ (catch 'done
+ ;; Try searching using `cscope-database-regexps' ...
+ (setq regexps cscope-database-regexps)
+ (while regexps
+ (setq dir-regexp (car (car regexps)))
+ (cond
+ ( (stringp dir-regexp)
+ (if (string-match dir-regexp top-directory)
+ (progn
+ (setq info (cdr (car regexps)))
+ (throw 'done t)
+ )) )
+ ( (and (symbolp dir-regexp) dir-regexp)
+ (progn
+ (setq info (cdr (car regexps)))
+ (throw 'done t)
+ ) ))
+ (setq regexps (cdr regexps))
+ )
+
+ ;; Try looking in the directory hierarchy ...
+ (if (setq this-directory
+ (cscope-search-directory-hierarchy top-directory))
+ (progn
+ (setq info (list (list this-directory)))
+ (throw 'done t)
+ ))
+
+ ;; Should we add any more places to look?
+
+ ) ;; end catch
+ (if (not info)
+ (setq info (list (list top-directory))))
+ info
+ ))
+
+
+(defun cscope-make-entry-line (func-name line-number line)
+ ;; The format of entry line:
+ ;; func-name[line-number]______line
+ ;; <- cscope-name-line-width ->
+ ;; `format' of Emacs doesn't have "*s" spec.
+ (let* ((fmt (format "%%%ds %%s" cscope-name-line-width))
+ (str (format fmt (format "%s[%s]" func-name line-number) line))
+ beg end)
+ (if cscope-use-face
+ (progn
+ (setq end (length func-name))
+ (put-text-property 0 end 'face 'cscope-function-face str)
+ (setq beg (1+ end)
+ end (+ beg (length line-number)))
+ (put-text-property beg end 'face 'cscope-line-number-face str)
+ (setq end (length str)
+ beg (- end (length line)))
+ (put-text-property beg end 'face 'cscope-line-face str)
+ ))
+ str))
+
+
+(defun cscope-process-filter (process output)
+ "Accept cscope process output and reformat it for human readability.
+Magic text properties are added to allow the user to select lines
+using the mouse."
+ (let ( (old-buffer (current-buffer)) )
+ (unwind-protect
+ (progn
+ (set-buffer (process-buffer process))
+ ;; Make buffer-read-only nil
+ (let (buffer-read-only line file function-name line-number moving)
+ (setq moving (= (point) (process-mark process)))
+ (save-excursion
+ (goto-char (process-mark process))
+ ;; Get the output thus far ...
+ (if cscope-process-output
+ (setq cscope-process-output (concat cscope-process-output
+ output))
+ (setq cscope-process-output output))
+ ;; Slice and dice it into lines.
+ ;; While there are whole lines left ...
+ (while (and cscope-process-output
+ (string-match "\\([^\n]+\n\\)\\(\\(.\\|\n\\)*\\)"
+ cscope-process-output))
+ (setq file nil
+ glimpse-stripped-directory nil
+ )
+ ;; Get a line
+ (setq line (substring cscope-process-output
+ (match-beginning 1) (match-end 1)))
+ (setq cscope-process-output (substring cscope-process-output
+ (match-beginning 2)
+ (match-end 2)))
+ (if (= (length cscope-process-output) 0)
+ (setq cscope-process-output nil))
+
+ ;; This should always match.
+ (if (string-match
+ "^\\([^ \t]+\\)[ \t]+\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(.*\\)\n"
+ line)
+ (progn
+ (let (str)
+ (setq file (substring line (match-beginning 1)
+ (match-end 1))
+ function-name (substring line (match-beginning 2)
+ (match-end 2))
+ line-number (substring line (match-beginning 3)
+ (match-end 3))
+ line (substring line (match-beginning 4)
+ (match-end 4))
+ )
+ ;; If the current file is not the same as the previous
+ ;; one ...
+ (if (not (and cscope-last-file
+ (string= file cscope-last-file)))
+ (progn
+ ;; The current file is different.
+
+ ;; Insert a separating blank line if
+ ;; necessary.
+ (if cscope-last-file (insert "\n"))
+ ;; Insert the file name
+ (setq str (concat "*** " file ":"))
+ (if cscope-use-face
+ (put-text-property 0 (length str)
+ 'face 'cscope-file-face
+ str))
+ (cscope-insert-with-text-properties
+ str
+ (expand-file-name file)
+ ;; Yes, -1 is intentional
+ -1)
+ (insert "\n")
+ ))
+ (if (not cscope-first-match)
+ (setq cscope-first-match-point (point)))
+ ;; ... and insert the line, with the
+ ;; appropriate indentation.
+ (cscope-insert-with-text-properties
+ (cscope-make-entry-line function-name
+ line-number
+ line)
+ (expand-file-name file)
+ line-number)
+ (insert "\n")
+ (setq cscope-last-file file)
+ (if cscope-first-match
+ (setq cscope-matched-multiple t)
+ (setq cscope-first-match
+ (cons (expand-file-name file)
+ (string-to-number line-number))))
+ ))
+ (insert line "\n")
+ ))
+ (set-marker (process-mark process) (point))
+ )
+ (if moving
+ (goto-char (process-mark process)))
+ (set-buffer-modified-p nil)
+ ))
+ (set-buffer old-buffer))
+ ))
+
+
+(defun cscope-process-sentinel (process event)
+ "Sentinel for when the cscope process dies."
+ (let* ( (buffer (process-buffer process)) window update-window
+ (done t) (old-buffer (current-buffer))
+ (old-buffer-window (get-buffer-window old-buffer)) )
+ (set-buffer buffer)
+ (save-window-excursion
+ (save-excursion
+ (if (or (and (setq window (get-buffer-window buffer))
+ (= (window-point window) (point-max)))
+ (= (point) (point-max)))
+ (progn
+ (setq update-window t)
+ ))
+ (delete-process process)
+ (let (buffer-read-only continue)
+ (goto-char (point-max))
+ (if (and cscope-suppress-empty-matches
+ (= cscope-output-start (point)))
+ (delete-region cscope-item-start (point-max))
+ (progn
+ (if (not cscope-start-directory)
+ (setq cscope-start-directory default-directory))
+ (insert cscope-separator-line)
+ ))
+ (setq continue
+ (and cscope-search-list
+ (not (and cscope-first-match
+ cscope-stop-at-first-match-dir
+ (not cscope-stop-at-first-match-dir-meta)))))
+ (if continue
+ (setq continue (cscope-search-one-database)))
+ (if continue
+ (progn
+ (setq done nil)
+ )
+ (progn
+ (insert "\nSearch complete.")
+ (if cscope-display-times
+ (let ( (times (current-time)) cscope-stop elapsed-time )
+ (setq cscope-stop (+ (* (car times) 65536.0)
+ (car (cdr times))
+ (* (car (cdr (cdr times))) 1.0E-6)))
+ (setq elapsed-time (- cscope-stop cscope-start-time))
+ (insert (format " Search time = %.2f seconds."
+ elapsed-time))
+ ))
+ (setq cscope-process nil)
+ (if cscope-running-in-xemacs
+ (setq modeline-process ": Search complete"))
+ (if cscope-start-directory
+ (setq default-directory cscope-start-directory))
+ (if (not cscope-first-match)
+ (message "No matches were found."))
+ )
+ ))
+ (set-buffer-modified-p nil)
+ ))
+ (if (and done cscope-first-match-point update-window)
+ (if window
+ (set-window-point window cscope-first-match-point)
+ (goto-char cscope-first-match-point))
+ )
+ (cond
+ ( (not done) ;; we're not done -- do nothing for now
+ (if update-window
+ (if window
+ (set-window-point window (point-max))
+ (goto-char (point-max))))
+ )
+ ( cscope-first-match
+ (if cscope-display-cscope-buffer
+ (if (and cscope-edit-single-match (not cscope-matched-multiple))
+ (cscope-show-entry-internal(car cscope-first-match)
+ (cdr cscope-first-match) t))
+ (cscope-select-entry-specified-window old-buffer-window))
+ )
+ )
+ (if (and done (eq old-buffer buffer) cscope-first-match)
+ (cscope-help))
+ (set-buffer old-buffer)
+ ))
+
+
+(defun cscope-search-one-database ()
+ "Pop a database entry from cscope-search-list and do a search there."
+ (let ( next-item options cscope-directory database-file outbuf done
+ base-database-file-name)
+ (setq outbuf (get-buffer-create cscope-output-buffer-name))
+ (save-excursion
+ (catch 'finished
+ (set-buffer outbuf)
+ (setq options '("-L"))
+ (while (and (not done) cscope-search-list)
+ (setq next-item (car cscope-search-list)
+ cscope-search-list (cdr cscope-search-list)
+ base-database-file-name cscope-database-file
+ )
+ (if (listp next-item)
+ (progn
+ (setq cscope-directory (car next-item))
+ (if (not (stringp cscope-directory))
+ (setq cscope-directory
+ (cscope-search-directory-hierarchy
+ default-directory)))
+ (if (file-regular-p cscope-directory)
+ (progn
+ ;; Handle the case where `cscope-directory' is really
+ ;; a full path name to a cscope database.
+ (setq base-database-file-name
+ (file-name-nondirectory cscope-directory)
+ cscope-directory
+ (file-name-directory cscope-directory))
+ ))
+ (setq cscope-directory
+ (file-name-as-directory cscope-directory))
+ (if (not (member cscope-directory cscope-searched-dirs))
+ (progn
+ (setq cscope-searched-dirs (cons cscope-directory
+ cscope-searched-dirs)
+ done t)
+ ))
+ )
+ (progn
+ (if (and cscope-first-match
+ cscope-stop-at-first-match-dir
+ cscope-stop-at-first-match-dir-meta)
+ (throw 'finished nil))
+ ))
+ )
+ (if (not done)
+ (throw 'finished nil))
+ (if (car (cdr next-item))
+ (let (newopts)
+ (setq newopts (car (cdr next-item)))
+ (if (not (listp newopts))
+ (error (format "Cscope options must be a list: %s" newopts)))
+ (setq options (append options newopts))
+ ))
+ (if cscope-command-args
+ (setq options (append options cscope-command-args)))
+ (setq database-file (concat cscope-directory base-database-file-name)
+ cscope-searched-dirs (cons cscope-directory
+ cscope-searched-dirs)
+ )
+
+ ;; The database file and the directory containing the database file
+ ;; must both be writable.
+ (if (or (not (file-writable-p database-file))
+ (not (file-writable-p (file-name-directory database-file)))
+ cscope-do-not-update-database)
+ (setq options (cons "-d" options)))
+
+ (goto-char (point-max))
+ (setq cscope-item-start (point))
+ (if (string= base-database-file-name cscope-database-file)
+ (insert "\nDatabase directory: " cscope-directory "\n"
+ cscope-separator-line)
+ (insert "\nDatabase directory/file: "
+ cscope-directory base-database-file-name "\n"
+ cscope-separator-line))
+ ;; Add the correct database file to search
+ (setq options (cons base-database-file-name options))
+ (setq options (cons "-f" options))
+ (setq cscope-output-start (point))
+ (setq default-directory cscope-directory)
+ (if cscope-filter-func
+ (progn
+ (setq cscope-process-output nil
+ cscope-last-file nil
+ )
+ (setq cscope-process
+ (apply 'start-process "cscope" outbuf
+ cscope-program options))
+ (set-process-filter cscope-process cscope-filter-func)
+ (set-process-sentinel cscope-process cscope-sentinel-func)
+ (set-marker (process-mark cscope-process) (point))
+ (process-kill-without-query cscope-process)
+ (if cscope-running-in-xemacs
+ (setq modeline-process ": Searching ..."))
+ (setq buffer-read-only t)
+ )
+ (apply 'call-process cscope-program nil outbuf t options)
+ )
+ t
+ ))
+ ))
+
+
+(defun cscope-call (msg args &optional directory filter-func sentinel-func)
+ "Generic function to call to process cscope requests.
+ARGS is a list of command-line arguments to pass to the cscope
+process. DIRECTORY is the current working directory to use (generally,
+the directory in which the cscope database is located, but not
+necessarily), if different that the current one. FILTER-FUNC and
+SENTINEL-FUNC are optional process filter and sentinel, respectively."
+ (let ( (outbuf (get-buffer-create cscope-output-buffer-name))
+ (old-buffer (current-buffer)) )
+ (if cscope-process
+ (error "A cscope search is still in progress -- only one at a time is allowed"))
+ (setq directory (cscope-canonicalize-directory
+ (or cscope-initial-directory directory)))
+ (if (eq outbuf old-buffer) ;; In the *cscope* buffer.
+ (if cscope-marker-window
+ (progn
+ ;; Assume that cscope-marker-window is the window, from the
+ ;; users perspective, from which the search was launched and the
+ ;; window that should be returned to upon cscope-pop-mark.
+ (set-buffer (window-buffer cscope-marker-window))
+ (setq cscope-marker (point-marker))
+ (set-buffer old-buffer)))
+ (progn ;; Not in the *cscope buffer.
+ ;; Set the cscope-marker-window to whichever window this search
+ ;; was launched from.
+ (setq cscope-marker-window (get-buffer-window old-buffer))
+ (setq cscope-marker (point-marker))))
+ (save-excursion
+ (set-buffer outbuf)
+ (if cscope-display-times
+ (let ( (times (current-time)) )
+ (setq cscope-start-time (+ (* (car times) 65536.0) (car (cdr times))
+ (* (car (cdr (cdr times))) 1.0E-6)))))
+ (setq default-directory directory
+ cscope-start-directory nil
+ cscope-search-list (cscope-find-info directory)
+ cscope-searched-dirs nil
+ cscope-command-args args
+ cscope-filter-func filter-func
+ cscope-sentinel-func sentinel-func
+ cscope-first-match nil
+ cscope-first-match-point nil
+ cscope-stop-at-first-match-dir-meta (memq t cscope-search-list)
+ cscope-matched-multiple nil
+ buffer-read-only nil)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (setq truncate-lines cscope-truncate-lines)
+ (if msg
+ (insert msg "\n"))
+ (cscope-search-one-database)
+ )
+ (if cscope-display-cscope-buffer
+ (progn
+ (pop-to-buffer outbuf)
+ (cscope-help))
+ (set-buffer outbuf))
+ (goto-char (point-max))
+ (cscope-list-entry-mode)
+ ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar cscope-unix-index-process-buffer-name "*cscope-indexing-buffer*"
+ "The name of the buffer to use for displaying indexing status/progress.")
+
+
+(defvar cscope-unix-index-process-buffer nil
+ "The buffer to use for displaying indexing status/progress.")
+
+
+(defvar cscope-unix-index-process nil
+ "The current indexing process.")
+
+
+(defun cscope-unix-index-files-sentinel (process event)
+ "Simple sentinel to print a message saying that indexing is finished."
+ (let (buffer)
+ (save-window-excursion
+ (save-excursion
+ (setq buffer (process-buffer process))
+ (set-buffer buffer)
+ (goto-char (point-max))
+ (insert cscope-separator-line "\nIndexing finished\n")
+ (delete-process process)
+ (setq cscope-unix-index-process nil)
+ (set-buffer-modified-p nil)
+ ))
+ ))
+
+
+(defun cscope-unix-index-files-internal (top-directory header-text args)
+ "Core function to call the indexing script."
+ (let ()
+ (save-excursion
+ (setq top-directory (cscope-canonicalize-directory top-directory))
+ (setq cscope-unix-index-process-buffer
+ (get-buffer-create cscope-unix-index-process-buffer-name))
+ (display-buffer cscope-unix-index-process-buffer)
+ (set-buffer cscope-unix-index-process-buffer)
+ (setq buffer-read-only nil)
+ (setq default-directory top-directory)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (if header-text
+ (insert header-text))
+ (setq args (append args
+ (list "-v"
+ "-i" cscope-index-file
+ "-f" cscope-database-file
+ (if cscope-use-relative-paths
+ "." top-directory))))
+ (if cscope-index-recursively
+ (setq args (cons "-r" args)))
+ (setq cscope-unix-index-process
+ (apply 'start-process "cscope-indexer"
+ cscope-unix-index-process-buffer
+ cscope-indexing-script args))
+ (set-process-sentinel cscope-unix-index-process
+ 'cscope-unix-index-files-sentinel)
+ (process-kill-without-query cscope-unix-index-process)
+ )
+ ))
+
+
+(defun cscope-index-files (top-directory)
+ "Index files in a directory.
+This function creates a list of files to index, and then indexes
+the listed files.
+The variable, \"cscope-index-recursively\", controls whether or not
+subdirectories are indexed."
+ (interactive "DIndex files in directory: ")
+ (let ()
+ (cscope-unix-index-files-internal
+ top-directory
+ (format "Creating cscope index `%s' in:\n\t%s\n\n%s"
+ cscope-database-file top-directory cscope-separator-line)
+ nil)
+ ))
+
+
+(defun cscope-create-list-of-files-to-index (top-directory)
+ "Create a list of files to index.
+The variable, \"cscope-index-recursively\", controls whether or not
+subdirectories are indexed."
+ (interactive "DCreate file list in directory: ")
+ (let ()
+ (cscope-unix-index-files-internal
+ top-directory
+ (format "Creating cscope file list `%s' in:\n\t%s\n\n"
+ cscope-index-file top-directory)
+ '("-l"))
+ ))
+
+
+(defun cscope-edit-list-of-files-to-index ()
+ "Search for and edit the list of files to index.
+If this functions causes a new file to be edited, that means that a
+cscope.out file was found without a corresponding cscope.files file."
+ (interactive)
+ (let (info directory file)
+ (setq info (cscope-find-info nil))
+ (if (/= (length info) 1)
+ (error "There is no unique cscope database directory!"))
+ (setq directory (car (car info)))
+ (if (not (stringp directory))
+ (setq directory
+ (cscope-search-directory-hierarchy default-directory)))
+ (setq file (concat (file-name-as-directory directory) cscope-index-file))
+ (find-file file)
+ (message (concat "File: " file))
+ ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun cscope-tell-user-about-directory ()
+ "Display the name of the directory containing the cscope database."
+ (interactive)
+ (let (info directory)
+ (setq info (cscope-find-info nil))
+ (if (= (length info) 1)
+ (progn
+ (setq directory (car (car info)))
+ (message (concat "Cscope directory: " directory))
+ )
+ (let ( (outbuf (get-buffer-create cscope-info-buffer-name)) )
+ (display-buffer outbuf)
+ (save-excursion
+ (set-buffer outbuf)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert "Cscope search directories:\n")
+ (while info
+ (if (listp (car info))
+ (progn
+ (setq directory (car (car info)))
+ (if (not (stringp directory))
+ (setq directory
+ (cscope-search-directory-hierarchy
+ default-directory)))
+ (insert "\t" directory "\n")
+ ))
+ (setq info (cdr info))
+ )
+ )
+ ))
+ ))
+
+
+(defun cscope-dired-directory ()
+ "Run dired upon the cscope database directory.
+If possible, the cursor is moved to the name of the cscope database
+file."
+ (interactive)
+ (let (info directory buffer p1 p2 pos)
+ (setq info (cscope-find-info nil))
+ (if (/= (length info) 1)
+ (error "There is no unique cscope database directory!"))
+ (setq directory (car (car info)))
+ (if (not (stringp directory))
+ (setq directory
+ (cscope-search-directory-hierarchy default-directory)))
+ (setq buffer (dired-noselect directory nil))
+ (switch-to-buffer buffer)
+ (set-buffer buffer)
+ (save-excursion
+ (goto-char (point-min))
+ (setq p1 (search-forward cscope-index-file nil t))
+ (if p1
+ (setq p1 (- p1 (length cscope-index-file))))
+ )
+ (save-excursion
+ (goto-char (point-min))
+ (setq p2 (search-forward cscope-database-file nil t))
+ (if p2
+ (setq p2 (- p2 (length cscope-database-file))))
+ )
+ (cond
+ ( (and p1 p2)
+ (if (< p1 p2)
+ (setq pos p1)
+ (setq pos p2))
+ )
+ ( p1
+ (setq pos p1)
+ )
+ ( p2
+ (setq pos p2)
+ )
+ )
+ (if pos
+ (set-window-point (get-buffer-window buffer) pos))
+ ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun cscope-extract-symbol-at-cursor (extract-filename)
+ (let* ( (symbol-chars (if extract-filename
+ cscope-filename-chars
+ cscope-symbol-chars))
+ (symbol-char-regexp (concat "[" symbol-chars "]"))
+ )
+ (save-excursion
+ (buffer-substring-no-properties
+ (progn
+ (if (not (looking-at symbol-char-regexp))
+ (re-search-backward "\\w" nil t))
+ (skip-chars-backward symbol-chars)
+ (point))
+ (progn
+ (skip-chars-forward symbol-chars)
+ (point)
+ )))
+ ))
+
+
+(defun cscope-prompt-for-symbol (prompt extract-filename)
+ "Prompt the user for a cscope symbol."
+ (let (sym)
+ (setq sym (cscope-extract-symbol-at-cursor extract-filename))
+ (if (or (not sym)
+ (string= sym "")
+ (not (and cscope-running-in-xemacs
+ cscope-no-mouse-prompts current-mouse-event
+ (or (mouse-event-p current-mouse-event)
+ (misc-user-event-p current-mouse-event))))
+ ;; Always prompt for symbol in dired mode.
+ (eq major-mode 'dired-mode)
+ )
+ (setq sym (read-from-minibuffer prompt sym))
+ sym)
+ ))
+
+
+(defun cscope-find-this-symbol (symbol)
+ "Locate a symbol in source code."
+ (interactive (list
+ (cscope-prompt-for-symbol "Find this symbol: " nil)
+ ))
+ (let ( (cscope-adjust t) ) ;; Use fuzzy matching.
+ (setq cscope-symbol symbol)
+ (cscope-call (format "Finding symbol: %s" symbol)
+ (list "-0" symbol) nil 'cscope-process-filter
+ 'cscope-process-sentinel)
+ ))
+
+
+(defun cscope-find-global-definition (symbol)
+ "Find a symbol's global definition."
+ (interactive (list
+ (cscope-prompt-for-symbol "Find this global definition: " nil)
+ ))
+ (let ( (cscope-adjust t) ) ;; Use fuzzy matching.
+ (setq cscope-symbol symbol)
+ (cscope-call (format "Finding global definition: %s" symbol)
+ (list "-1" symbol) nil 'cscope-process-filter
+ 'cscope-process-sentinel)
+ ))
+
+
+(defun cscope-find-global-definition-no-prompting ()
+ "Find a symbol's global definition without prompting."
+ (interactive)
+ (let ( (symbol (cscope-extract-symbol-at-cursor nil))
+ (cscope-adjust t) ) ;; Use fuzzy matching.
+ (setq cscope-symbol symbol)
+ (cscope-call (format "Finding global definition: %s" symbol)
+ (list "-1" symbol) nil 'cscope-process-filter
+ 'cscope-process-sentinel)
+ ))
+
+
+(defun cscope-find-called-functions (symbol)
+ "Display functions called by a function."
+ (interactive (list
+ (cscope-prompt-for-symbol
+ "Find functions called by this function: " nil)
+ ))
+ (let ( (cscope-adjust nil) ) ;; Disable fuzzy matching.
+ (setq cscope-symbol symbol)
+ (cscope-call (format "Finding functions called by: %s" symbol)
+ (list "-2" symbol) nil 'cscope-process-filter
+ 'cscope-process-sentinel)
+ ))
+
+
+(defun cscope-find-functions-calling-this-function (symbol)
+ "Display functions calling a function."
+ (interactive (list
+ (cscope-prompt-for-symbol
+ "Find functions calling this function: " nil)
+ ))
+ (let ( (cscope-adjust t) ) ;; Use fuzzy matching.
+ (setq cscope-symbol symbol)
+ (cscope-call (format "Finding functions calling: %s" symbol)
+ (list "-3" symbol) nil 'cscope-process-filter
+ 'cscope-process-sentinel)
+ ))
+
+
+(defun cscope-find-this-text-string (symbol)
+ "Locate where a text string occurs."
+ (interactive (list
+ (cscope-prompt-for-symbol "Find this text string: " nil)
+ ))
+ (let ( (cscope-adjust t) ) ;; Use fuzzy matching.
+ (setq cscope-symbol symbol)
+ (cscope-call (format "Finding text string: %s" symbol)
+ (list "-4" symbol) nil 'cscope-process-filter
+ 'cscope-process-sentinel)
+ ))
+
+
+(defun cscope-find-egrep-pattern (symbol)
+ "Run egrep over the cscope database."
+ (interactive (list
+ (let (cscope-no-mouse-prompts)
+ (cscope-prompt-for-symbol "Find this egrep pattern: " nil))
+ ))
+ (let ( (cscope-adjust t) ) ;; Use fuzzy matching.
+ (setq cscope-symbol symbol)
+ (cscope-call (format "Finding egrep pattern: %s" symbol)
+ (list "-6" symbol) nil 'cscope-process-filter
+ 'cscope-process-sentinel)
+ ))
+
+
+(defun cscope-find-this-file (symbol)
+ "Locate a file."
+ (interactive (list
+ (let (cscope-no-mouse-prompts)
+ (cscope-prompt-for-symbol "Find this file: " t))
+ ))
+ (let ( (cscope-adjust nil) ) ;; Disable fuzzy matching.
+ (setq cscope-symbol symbol)
+ (cscope-call (format "Finding file: %s" symbol)
+ (list "-7" symbol) nil 'cscope-process-filter
+ 'cscope-process-sentinel)
+ ))
+
+
+(defun cscope-find-files-including-file (symbol)
+ "Locate all files #including a file."
+ (interactive (list
+ (let (cscope-no-mouse-prompts)
+ (cscope-prompt-for-symbol
+ "Find files #including this file: " t))
+ ))
+ (let ( (cscope-adjust t) ) ;; Use fuzzy matching.
+ (setq cscope-symbol symbol)
+ (cscope-call (format "Finding files #including file: %s" symbol)
+ (list "-8" symbol) nil 'cscope-process-filter
+ 'cscope-process-sentinel)
+ ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar cscope-minor-mode nil
+ "")
+(make-variable-buffer-local 'cscope-minor-mode)
+(put 'cscope-minor-mode 'permanent-local t)
+
+
+(defun cscope-minor-mode (&optional arg)
+ ""
+ (progn
+ (setq cscope-minor-mode (if (null arg) t (car arg)))
+ (if cscope-minor-mode
+ (progn
+ (easy-menu-add cscope:menu cscope:map)
+ (run-hooks 'cscope-minor-mode-hooks)
+ ))
+ cscope-minor-mode
+ ))
+
+
+(defun cscope:hook ()
+ ""
+ (progn
+ (cscope-minor-mode)
+ ))
+
+
+(or (assq 'cscope-minor-mode minor-mode-map-alist)
+ (setq minor-mode-map-alist (cons (cons 'cscope-minor-mode cscope:map)
+ minor-mode-map-alist)))
+
+(add-hook 'c-mode-hook (function cscope:hook))
+(add-hook 'c++-mode-hook (function cscope:hook))
+(add-hook 'dired-mode-hook (function cscope:hook))
+
+(provide 'xcscope)
--- /dev/null
+;;; xml-rpc.el --- An elisp implementation of clientside XML-RPC
+
+;; Copyright (C) 2002-2010 Mark A. Hershberger
+;; Copyright (C) 2001 CodeFactory AB.
+;; Copyright (C) 2001 Daniel Lundin.
+;; Copyright (C) 2006 Shun-ichi Goto
+;; Modified for non-ASCII character handling.
+
+;; Author: Mark A. Hershberger <mah@everybody.org>
+;; Original Author: Daniel Lundin <daniel@codefactory.se>
+;; Version: 1.6.8
+;; Created: May 13 2001
+;; Keywords: xml rpc network
+;; URL: http://launchpad.net/xml-rpc-el
+;; Last Modified: <2010-02-27 07:02:36 mah>
+
+(defconst xml-rpc-version "1.6.8"
+ "Current version of xml-rpc.el")
+
+;; This file is NOT (yet) part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is an XML-RPC client implementation in elisp, capable of both
+;; synchronous and asynchronous method calls (using the url package's async
+;; retrieval functionality).
+;; XML-RPC is remote procedure calls over HTTP using XML to describe the
+;; function call and return values.
+
+;; xml-rpc.el represents XML-RPC datatypes as lisp values, automatically
+;; converting to and from the XML datastructures as needed, both for method
+;; parameters and return values, making using XML-RPC methods fairly
+;; transparent to the lisp code.
+
+;;; Installation:
+
+;; If you use ELPA (http://tromey.com/elpa), you can install via the
+;; M-x package-list-packages interface. This is preferrable as you
+;; will have access to updates automatically.
+
+;; Otherwise, just make sure this file in your load-path (usually
+;; ~/.emacs.d is included) and put (require 'xml-rpc) in your
+;; ~/.emacs or ~/.emacs.d/init.el file.
+
+;;; Requirements
+
+;; xml-rpc.el uses the url package for http handling and xml.el for
+;; XML parsing. url is a part of the W3 browser package. The url
+;; package that is part of Emacs 22+ works great.
+;;
+;; xml.el is a part of GNU Emacs 21, but can also be downloaded from
+;; here: <URL:ftp://ftp.codefactory.se/pub/people/daniel/elisp/xml.el>
+
+;;; Bug reports
+
+;; Please use M-x xml-rpc-submit-bug-report to report bugs.
+
+;;; XML-RPC datatypes are represented as follows
+
+;; int: 42
+;; float/double: 42.0
+;; string: "foo"
+;; array: '(1 2 3 4) '(1 2 3 (4.1 4.2))
+;; struct: '(("name" . "daniel") ("height" . 6.1))
+;; dateTime: (:datetime (1234 124))
+
+
+;;; Examples
+
+;; Here follows some examples demonstrating the use of xml-rpc.el
+
+;; Normal synchronous operation
+;; ----------------------------
+
+;; (xml-rpc-method-call "http://localhost:80/RPC" 'foo-method foo bar zoo)
+
+;; Asynchronous example (cb-foo will be called when the methods returns)
+;; ---------------------------------------------------------------------
+
+;; (defun cb-foo (foo)
+;; (print (format "%s" foo)))
+
+;; (xml-rpc-method-call-async 'cb-foo "http://localhost:80/RPC"
+;; 'foo-method foo bar zoo)
+
+
+;; Some real world working examples for fun and play
+;; -------------------------------------------------
+
+;; Check the temperature (celsius) outside jonas@codefactory.se's apartment
+
+;; (xml-rpc-method-call
+;; "http://flint.bengburken.net:80/xmlrpc/onewire_temp.php"
+;; 'onewire.getTemp)
+
+
+;; Fetch the latest NetBSD news the past 5 days from O'reillynet
+
+;; (xml-rpc-method-call "http://www.oreillynet.com/meerkat/xml-rpc/server.php"
+;; 'meerkat.getItems
+;; '(("channel" . 1024)
+;; ("search" . "/NetBSD/")
+;; ("time_period" . "5DAY")
+;; ("ids" . 0)
+;; ("descriptions" . 200)
+;; ("categories" . 0)
+;; ("channels" . 0)
+;; ("dates" . 0)
+;; ("num_items" . 5)))
+
+
+;;; History:
+
+;; 1.6.8 - Add a report-xml-rpc-bug function
+
+;; 1.6.7 - Skipped version
+
+;; 1.6.6 - Use the correct dateTime elements. Fix bug in parsing null int.
+
+;; 1.6.5.1 - Fix compile time warnings.
+
+;; 1.6.5 - Made handling of dateTime elements more robust.
+
+;; 1.6.4.1 - Updated to work with both Emacs22 and Emacs23.
+
+;; 1.6.2.2 - Modified to allow non-ASCII string again.
+;; It can handle non-ASCII page name and comment
+;; on Emacs 21 also.
+
+;; 1.6.2.1 - Modified to allow non-ASCII string.
+;; If xml-rpc-allow-unicode-string is non-nil,
+;; make 'value' object instead of 'base64' object.
+;; This is good for WikiRPC.
+
+;; 1.6.2 - Fix whitespace issues to work better with new xml.el
+;; Fix bug in string handling.
+;; Add support for gzip-encoding when needed.
+
+;; 1.6.1 - base64 support added.
+;; url-insert-entities-in-string done on string types now.
+
+;; 1.6 - Fixed dependencies (remove w3, add cl).
+;; Move string-to-boolean and boolean-to-string into xml-rpc
+;; namespace.
+;; Fix bug in xml-rpc-xml-to-response where non-existent var was.
+;; More tweaking of "Connection: close" header.
+;; Fix bug in xml-rpc-request-process-buffer so that this works with
+;; different mixes of the url.el code.
+
+;; 1.5.1 - Added Andrew J Cosgriff's patch to make the
+;; xml-rpc-clean-string function work in XEmacs.
+
+;; 1.5 - Added headers to the outgoing url-retreive-synchronously
+;; so that it would close connections immediately on completion.
+
+;; 1.4 - Added conditional debugging code. Added version tag.
+
+;; 1.2 - Better error handling. The documentation didn't match
+;; the code. That was changed so that an error was
+;; signaled. Also, better handling of various and
+;; different combinations of xml.el and url.el.
+
+;; 1.1 - Added support for boolean types. If the type of a
+;; returned value is not specified, string is assumed
+
+;; 1.0 - First version
+
+
+;;; Code:
+
+(require 'xml)
+(require 'url-http)
+(require 'timezone)
+(eval-when-compile
+ (require 'cl))
+
+(defconst xml-rpc-maintainer-address "mah@everybody.org"
+ "The address where bug reports should be sent.")
+
+(defcustom xml-rpc-load-hook nil
+ "*Hook run after loading xml-rpc."
+ :type 'hook :group 'xml-rpc)
+
+(defcustom xml-rpc-use-coding-system
+ (if (coding-system-p 'utf-8) 'utf-8 'iso-8859-1)
+ "The coding system to use."
+ :type 'symbol :group 'xml-rpc)
+
+(defcustom xml-rpc-allow-unicode-string (coding-system-p 'utf-8)
+ "If non-nil, non-ASCII data is composed as 'value' instead of 'base64'.
+And this option overrides `xml-rpc-base64-encode-unicode' and
+`xml-rpc-base64-decode-unicode' if set as non-nil."
+ :type 'boolean :group 'xml-rpc)
+
+(defcustom xml-rpc-base64-encode-unicode (coding-system-p 'utf-8)
+ "If non-nil, then strings with non-ascii characters will be turned
+into Base64."
+ :type 'boolean :group 'xml-rpc)
+
+(defcustom xml-rpc-base64-decode-unicode (coding-system-p 'utf-8)
+ "If non-nil, then base64 strings will be decoded using the
+utf-8 coding system."
+ :type 'boolean :group 'xml-rpc)
+
+(defcustom xml-rpc-debug 0
+ "Set this to 1 or greater to avoid killing temporary buffers.
+Set it higher to get some info in the *Messages* buffer"
+ :type 'integerp :group 'xml-rpc)
+
+(defvar xml-rpc-fault-string nil
+ "Contains the fault string if a fault is returned")
+
+(defvar xml-rpc-fault-code nil
+ "Contains the fault code if a fault is returned")
+
+;;
+;; Value type handling functions
+;;
+
+(defsubst xml-rpc-value-intp (value)
+ "Return t if VALUE is an integer."
+ (integerp value))
+
+(defsubst xml-rpc-value-doublep (value)
+ "Return t if VALUE is a double precision number."
+ (floatp value))
+
+(defsubst xml-rpc-value-stringp (value)
+ "Return t if VALUE is a string."
+ (stringp value))
+
+;; An XML-RPC struct is a list where every car is cons or a list of
+;; length 1 or 2 and has a string for car.
+(defsubst xml-rpc-value-structp (value)
+ "Return t if VALUE is an XML-RPC struct."
+ (and (listp value)
+ (let ((vals value)
+ (result t)
+ curval)
+ (while (and vals result)
+ (setq result (and
+ (setq curval (car-safe vals))
+ (consp curval)
+ (stringp (car-safe curval))))
+ (setq vals (cdr-safe vals)))
+ result)))
+
+;; A somewhat lazy predicate for arrays
+(defsubst xml-rpc-value-arrayp (value)
+ "Return t if VALUE is an XML-RPC struct."
+ (and (listp value)
+ (not (xml-rpc-value-datetimep value))
+ (not (xml-rpc-value-structp value))))
+
+(defun xml-rpc-submit-bug-report ()
+ "Submit a bug report on xml-rpc."
+ (interactive)
+ (require 'reporter)
+ (let ((xml-rpc-tz-pd-defined-in
+ (if (fboundp 'find-lisp-object-file-name)
+ (find-lisp-object-file-name
+ 'timezone-parse-date (symbol-function 'timezone-parse-date))
+ (symbol-file 'timezone-parse-date)))
+ (date-parses-as (timezone-parse-date "20091130T00:52:53")))
+ (reporter-submit-bug-report
+ xml-rpc-maintainer-address
+ (concat "xml-rpc.el " xml-rpc-version)
+ (list 'xml-rpc-tz-pd-defined-in
+ 'date-parses-as
+ 'xml-rpc-load-hook
+ 'xml-rpc-use-coding-system
+ 'xml-rpc-allow-unicode-string
+ 'xml-rpc-base64-encode-unicode
+ 'xml-rpc-base64-decode-unicode))))
+
+(defun xml-rpc-value-booleanp (value)
+ "Return t if VALUE is a boolean."
+ (or (eq value nil)
+ (eq value t)))
+
+(defun xml-rpc-value-datetimep (value)
+ "Return t if VALUE is a datetime. For Emacs XML-RPC
+implementation, you must put time keyword :datetime before the
+time, or it will be confused for a list."
+ (and (listp value)
+ (eq (car value) :datetime)))
+
+(defun xml-rpc-string-to-boolean (value)
+ "Return t if VALUE is a boolean"
+ (or (string-equal value "true") (string-equal value "1")))
+
+(defun xml-rpc-caddar-safe (list)
+ (car-safe (cdr-safe (cdr-safe (car-safe list)))))
+
+(defun xml-rpc-xml-list-to-value (xml-list)
+ "Convert an XML-RPC structure in an xml.el style XML-LIST to an elisp list, \
+interpreting and simplifying it while retaining its structure."
+ (let (valtype valvalue)
+ (cond
+ ((and (xml-rpc-caddar-safe xml-list)
+ (listp (car-safe (cdr-safe (cdr-safe (car-safe xml-list))))))
+
+ (setq valtype (car (caddar xml-list))
+ valvalue (caddr (caddar xml-list)))
+ (cond
+ ;; Base64
+ ((eq valtype 'base64)
+ (if xml-rpc-base64-decode-unicode
+ (decode-coding-string (base64-decode-string valvalue) 'utf-8)
+ (base64-decode-string valvalue)))
+ ;; Boolean
+ ((eq valtype 'boolean)
+ (xml-rpc-string-to-boolean valvalue))
+ ;; String
+ ((eq valtype 'string)
+ valvalue)
+ ;; Integer
+ ((or (eq valtype 'int) (eq valtype 'i4))
+ (string-to-number (or valvalue "0")))
+ ;; Double/float
+ ((eq valtype 'double)
+ (string-to-number valvalue))
+ ;; Struct
+ ((eq valtype 'struct)
+ (mapcar (lambda (member)
+ (let ((membername (cadr (cdaddr member)))
+ (membervalue (xml-rpc-xml-list-to-value
+ (cdddr member))))
+ (cons membername membervalue)))
+ (cddr (caddar xml-list))))
+ ;; Fault
+ ((eq valtype 'fault)
+ (let* ((struct (xml-rpc-xml-list-to-value (list valvalue)))
+ (fault-string (cdr (assoc "faultString" struct)))
+ (fault-code (cdr (assoc "faultCode" struct))))
+ (list 'fault fault-code fault-string)))
+ ;; DateTime
+ ((or (eq valtype 'dateTime.iso8601)
+ (eq valtype 'dateTime))
+ (list :datetime (date-to-time valvalue)))
+ ;; Array
+ ((eq valtype 'array)
+ (mapcar (lambda (arrval)
+ (xml-rpc-xml-list-to-value (list arrval)))
+ (cddr valvalue)))))
+ ((xml-rpc-caddar-safe xml-list)))))
+
+(defun xml-rpc-boolean-to-string (value)
+ "Convert a boolean value to a string"
+ (if value
+ "1"
+ "0"))
+
+(defun xml-rpc-datetime-to-string (value)
+ "Convert a date time to a valid XML-RPC date"
+ (format-time-string "%Y%m%dT%H:%M:%S" (cadr value)))
+
+(defun xml-rpc-value-to-xml-list (value)
+ "Return XML representation of VALUE properly formatted for use with the \
+functions in xml.el."
+ (cond
+ ;; ((not value)
+ ;; nil)
+ ((xml-rpc-value-booleanp value)
+ `((value nil (boolean nil ,(xml-rpc-boolean-to-string value)))))
+ ;; Date
+ ((xml-rpc-value-datetimep value)
+ `((value nil (dateTime.iso8601 nil ,(xml-rpc-datetime-to-string value)))))
+ ;; list
+ ((xml-rpc-value-arrayp value)
+ (let ((result nil)
+ (xmlval nil))
+ (while (setq xmlval (xml-rpc-value-to-xml-list (car value))
+ result (if result (append result xmlval)
+ xmlval)
+ value (cdr value)))
+ `((value nil (array nil ,(append '(data nil) result))))))
+ ;; struct
+ ((xml-rpc-value-structp value)
+ (let ((result nil)
+ (xmlval nil))
+ (while (setq xmlval `((member nil (name nil ,(caar value))
+ ,(car (xml-rpc-value-to-xml-list
+ (cdar value)))))
+ result (append result xmlval)
+ value (cdr value)))
+ `((value nil ,(append '(struct nil) result)))))
+ ;; Value is a scalar
+ ((xml-rpc-value-intp value)
+ `((value nil (int nil ,(int-to-string value)))))
+ ((xml-rpc-value-stringp value)
+ (let ((charset-list (find-charset-string value)))
+ (if (or xml-rpc-allow-unicode-string
+ (and (eq 1 (length charset-list))
+ (eq 'ascii (car charset-list)))
+ (not xml-rpc-base64-encode-unicode))
+ `((value nil (string nil ,value)))
+ `((value nil (base64 nil ,(if xml-rpc-base64-encode-unicode
+ (base64-encode-string
+ (encode-coding-string
+ value xml-rpc-use-coding-system))
+ (base64-encode-string value))))))))
+ ((xml-rpc-value-doublep value)
+ `((value nil (double nil ,(number-to-string value)))))
+ (t
+ `((value nil (base64 nil ,(base64-encode-string value)))))))
+
+(defun xml-rpc-xml-to-string (xml)
+ "Return a string representation of the XML tree as valid XML markup."
+ (let ((tree (xml-node-children xml))
+ (result (concat "<" (symbol-name (xml-node-name xml)) ">")))
+ (while tree
+ (cond
+ ((listp (car tree))
+ (setq result (concat result (xml-rpc-xml-to-string (car tree)))))
+ ((stringp (car tree))
+ (setq result (concat result (car tree))))
+ (t
+ (error "Invalid XML tree")))
+ (setq tree (cdr tree)))
+ (setq result (concat result "</" (symbol-name (xml-node-name xml)) ">"))
+ result))
+
+;;
+;; Response handling
+;;
+
+(defsubst xml-rpc-response-errorp (response)
+ "An 'xml-rpc-method-call' result value is always a list, where the first \
+element in RESPONSE is either nil or if an error occured, a cons pair \
+according to (errnum . \"Error string\"),"
+ (eq 'fault (car-safe (caddar response))))
+
+(defsubst xml-rpc-response-error-code (response)
+ "Return the error code from RESPONSE."
+ (and (xml-rpc-response-errorp response)
+ (nth 1 (xml-rpc-xml-list-to-value response))))
+
+(defsubst xml-rpc-response-error-string (response)
+ "Return the error code from RESPONSE."
+ (and (xml-rpc-response-errorp response)
+ (nth 2 (xml-rpc-xml-list-to-value response))))
+
+(defun xml-rpc-xml-to-response (xml)
+ "Convert an XML list to a method response list. An error is
+signaled if there is a fault or if the response does not appear
+to be an XML-RPC response (i.e. no methodResponse). Otherwise,
+the parsed XML response is returned."
+ ;; Check if we have a methodResponse
+ (cond
+ ((not (eq (car-safe (car-safe xml)) 'methodResponse))
+ (error "No methodResponse found"))
+
+ ;; Did we get a fault response
+ ((xml-rpc-response-errorp xml)
+ (let ((resp (xml-rpc-xml-list-to-value xml)))
+ (setq xml-rpc-fault-string (nth 2 resp))
+ (setq xml-rpc-fault-code (nth 1 resp))
+ (error "XML-RPC fault `%s'" xml-rpc-fault-string)))
+
+ ;; Interpret the XML list and produce a more useful data structure
+ (t
+ (let ((valpart (cdr (cdaddr (caddar xml)))))
+ (xml-rpc-xml-list-to-value valpart)))))
+
+;;
+;; Method handling
+;;
+
+(defun xml-rpc-request (server-url xml &optional async-callback-function)
+ "Perform http post request to SERVER-URL using XML.
+
+If ASYNC-CALLBACK-FUNCTION is non-nil, the request will be performed
+asynchronously and ASYNC-CALLBACK-FUNCTION should be a callback function to
+be called when the reuest is finished. ASYNC-CALLBACK-FUNCTION is called with
+a single argument being an xml.el style XML list.
+
+It returns an XML list containing the method response from the XML-RPC server,
+or nil if called with ASYNC-CALLBACK-FUNCTION."
+ (declare (special url-current-callback-data
+ url-current-callback-func
+ url-http-response-status))
+ (unwind-protect
+ (save-excursion
+ (let ((url-request-method "POST")
+ (url-package-name "xml-rpc.el")
+ (url-package-version xml-rpc-version)
+ (url-request-data (concat "<?xml version=\"1.0\""
+ " encoding=\"UTF-8\"?>\n"
+ (with-temp-buffer
+ (xml-print xml)
+ (when xml-rpc-allow-unicode-string
+ (encode-coding-region
+ (point-min) (point-max) 'utf-8))
+ (buffer-string))
+ "\n"))
+ (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5")
+ (url-request-coding-system xml-rpc-use-coding-system)
+ (url-http-attempt-keepalives t)
+ (url-request-extra-headers (list
+ (cons "Connection" "keep-alive")
+ (cons "Content-Type"
+ "text/xml; charset=utf-8"))))
+ (when (> xml-rpc-debug 1)
+ (print url-request-data (create-file-buffer "request-data")))
+
+ (cond ((boundp 'url-be-asynchronous) ; Sniff for w3 lib capability
+ (if async-callback-function
+ (setq url-be-asynchronous t
+ url-current-callback-data (list
+ async-callback-function
+ (current-buffer))
+ url-current-callback-func
+ 'xml-rpc-request-callback-handler)
+ (setq url-be-asynchronous nil))
+ (url-retrieve server-url t)
+
+ (when (not url-be-asynchronous)
+ (let ((result (xml-rpc-request-process-buffer
+ (current-buffer))))
+ (when (> xml-rpc-debug 1)
+ (with-current-buffer (create-file-buffer "result-data")
+ (insert result)))
+ result)))
+ (t ; Post emacs20 w3-el
+ (if async-callback-function
+ (url-retrieve server-url async-callback-function)
+ (let ((buffer (url-retrieve-synchronously server-url))
+ result)
+ (with-current-buffer buffer
+ (when (not (numberp url-http-response-status))
+ ;; this error may occur when keep-alive bug
+ ;; of url-http.el is not cleared.
+ (error "Why? url-http-response-status is %s"
+ url-http-response-status))
+ (when (> url-http-response-status 299)
+ (error "Error during request: %s"
+ url-http-response-status)))
+ (xml-rpc-request-process-buffer buffer)))))))))
+
+
+(defun xml-rpc-clean-string (s)
+ (if (string-match "\\`[ \t\n\r]*\\'" s)
+ ;;"^[ \t\n]*$" s)
+ nil
+ s))
+
+(defun xml-rpc-clean (l)
+ (cond
+ ((listp l)
+ (let ((remain l)
+ elem
+ (result nil))
+ (while l
+ ;; iterate
+ (setq elem (car l)
+ l (cdr l))
+ ;; test the head
+ (cond
+ ;; a string, so clean it.
+ ((stringp elem)
+ (let ((tmp (xml-rpc-clean-string elem)))
+ (when (and tmp xml-rpc-allow-unicode-string)
+ (setq tmp (decode-coding-string tmp xml-rpc-use-coding-system)))
+ (if tmp
+ (setq result (append result (list tmp)))
+ result)))
+ ;; a list, so recurse.
+ ((listp elem)
+ (setq result (append result (list (xml-rpc-clean elem)))))
+
+ ;; everthing else, as is.
+ (t
+ (setq result (append result (list elem))))))
+ result))
+
+ ((stringp l) ; will returning nil be acceptable ?
+ nil)
+
+ (t l)))
+
+(defun xml-rpc-request-process-buffer (xml-buffer)
+ "Process buffer XML-BUFFER."
+ (unwind-protect
+ (with-current-buffer xml-buffer
+ (when (fboundp 'url-uncompress)
+ (let ((url-working-buffer xml-buffer))
+ (url-uncompress)))
+ (goto-char (point-min))
+ (search-forward-regexp "<\\?xml" nil t)
+ (move-to-column 0)
+ ;; Gather the results
+ (let* ((status (if (boundp 'url-http-response-status)
+ ;; Old URL lib doesn't save the result.
+ url-http-response-status 200))
+ (result (cond
+ ;; A probable XML response
+ ((looking-at "<\\?xml ")
+ (xml-rpc-clean (xml-parse-region (point-min)
+ (point-max))))
+
+ ;; No HTTP status returned
+ ((not status)
+ (let ((errstart
+ (search-forward "\n---- Error was: ----\n")))
+ (and errstart
+ (buffer-substring errstart (point-max)))))
+
+ ;; Maybe they just gave us an the XML w/o PI?
+ ((search-forward "<methodResponse>" nil t)
+ (xml-rpc-clean (xml-parse-region (match-beginning 0)
+ (point-max))))
+
+ ;; Valid HTTP status
+ (t
+ (int-to-string status)))))
+ (when (< xml-rpc-debug 3)
+ (kill-buffer (current-buffer)))
+ result))))
+
+
+(defun xml-rpc-request-callback-handler (callback-fun xml-buffer)
+ "Marshall a callback function request to CALLBACK-FUN with the results \
+handled from XML-BUFFER."
+ (let ((xml-response (xml-rpc-request-process-buffer xml-buffer)))
+ (when (< xml-rpc-debug 1)
+ (kill-buffer xml-buffer))
+ (funcall callback-fun (xml-rpc-xml-to-response xml-response))))
+
+
+(defun xml-rpc-method-call-async (async-callback-func server-url method
+ &rest params)
+ "Call an XML-RPC method asynchronously at SERVER-URL named METHOD with \
+PARAMS as parameters. When the method returns, ASYNC-CALLBACK-FUNC will be \
+called with the result as parameter."
+ (let* ((m-name (if (stringp method)
+ method
+ (symbol-name method)))
+ (m-params (mapcar '(lambda (p)
+ `(param nil ,(car (xml-rpc-value-to-xml-list
+ p))))
+ (if async-callback-func
+ params
+ (car-safe params))))
+ (m-func-call `((methodCall nil (methodName nil ,m-name)
+ ,(append '(params nil) m-params)))))
+ (when (> xml-rpc-debug 1)
+ (print m-func-call (create-file-buffer "func-call")))
+ (xml-rpc-request server-url m-func-call async-callback-func)))
+
+(defun xml-rpc-method-call (server-url method &rest params)
+ "Call an XML-RPC method at SERVER-URL named METHOD with PARAMS as \
+parameters."
+ (let ((response
+ (xml-rpc-method-call-async nil server-url method params)))
+ (cond ((stringp response)
+ (list (cons nil (concat "URL/HTTP Error: " response))))
+ (t
+ (xml-rpc-xml-to-response response)))))
+
+(unless (fboundp 'xml-escape-string)
+ (defun xml-debug-print (xml &optional indent-string)
+ "Outputs the XML in the current buffer.
+XML can be a tree or a list of nodes.
+The first line is indented with the optional INDENT-STRING."
+ (setq indent-string (or indent-string ""))
+ (dolist (node xml)
+ (xml-debug-print-internal node indent-string)))
+
+ (defalias 'xml-print 'xml-debug-print)
+
+ (when (not (boundp 'xml-entity-alist))
+ (defvar xml-entity-alist
+ '(("lt" . "<")
+ ("gt" . ">")
+ ("apos" . "'")
+ ("quot" . "\"")
+ ("amp" . "&"))))
+
+ (defun xml-escape-string (string)
+ "Return the string with entity substitutions made from
+xml-entity-alist."
+ (mapconcat (lambda (byte)
+ (let ((char (char-to-string byte)))
+ (if (rassoc char xml-entity-alist)
+ (concat "&" (car (rassoc char xml-entity-alist)) ";")
+ char)))
+ ;; This differs from the non-unicode branch. Just
+ ;; grabbing the string works here.
+ string ""))
+
+ (defun xml-debug-print-internal (xml indent-string)
+ "Outputs the XML tree in the current buffer.
+The first line is indented with INDENT-STRING."
+ (let ((tree xml)
+ attlist)
+ (insert indent-string ?< (symbol-name (xml-node-name tree)))
+
+ ;; output the attribute list
+ (setq attlist (xml-node-attributes tree))
+ (while attlist
+ (insert ?\ (symbol-name (caar attlist)) "=\""
+ (xml-escape-string (cdar attlist)) ?\")
+ (setq attlist (cdr attlist)))
+
+ (setq tree (xml-node-children tree))
+
+ (if (null tree)
+ (insert ?/ ?>)
+ (insert ?>)
+
+ ;; output the children
+ (dolist (node tree)
+ (cond
+ ((listp node)
+ (insert ?\n)
+ (xml-debug-print-internal node (concat indent-string " ")))
+ ((stringp node)
+ (insert (xml-escape-string node)))
+ (t
+ (error "Invalid XML tree"))))
+
+ (when (not (and (null (cdr tree))
+ (stringp (car tree))))
+ (insert ?\n indent-string))
+ (insert ?< ?/ (symbol-name (xml-node-name xml)) ?>)))))
+
+(let ((tdate (timezone-parse-date "20090101T010101Z")))
+ (when (not (string-equal (aref tdate 0) "2009"))
+ (defun timezone-parse-date (date)
+ "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
+Two-digit dates are `windowed'. Those <69 have 2000 added; otherwise 1900
+is added. Three-digit dates have 1900 added.
+TIMEZONE is nil for DATEs without a zone field.
+
+Understands the following styles:
+ (1) 14 Apr 89 03:20[:12] [GMT]
+ (2) Fri, 17 Mar 89 4:01[:33] [GMT]
+ (3) Mon Jan 16 16:12[:37] [GMT] 1989
+ (4) 6 May 1992 1641-JST (Wednesday)
+ (5) 22-AUG-1993 10:59:12.82
+ (6) Thu, 11 Apr 16:17:12 91 [MET]
+ (7) Mon, 6 Jul 16:47:20 T 1992 [MET]
+ (8) 1996-06-24 21:13:12 [GMT]
+ (9) 1996-06-24 21:13-ZONE
+ (10) 19960624T211312"
+ ;; Get rid of any text properties.
+ (and (stringp date)
+ (or (text-properties-at 0 date)
+ (next-property-change 0 date))
+ (setq date (copy-sequence date))
+ (set-text-properties 0 (length date) nil date))
+ (let ((date (or date ""))
+ (year nil)
+ (month nil)
+ (day nil)
+ (time nil)
+ (zone nil)) ;This may be nil.
+ (cond ((string-match
+ "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
+ ;; Styles: (1) and (2) with timezone and buggy timezone
+ ;; This is most common in mail and news,
+ ;; so it is worth trying first.
+ (setq year 3 month 2 day 1 time 4 zone 5))
+ ((string-match
+ "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date)
+ ;; Styles: (1) and (2) without timezone
+ (setq year 3 month 2 day 1 time 4 zone nil))
+ ((string-match
+ "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date)
+ ;; Styles: (6) and (7) without timezone
+ (setq year 6 month 3 day 2 time 4 zone nil))
+ ((string-match
+ "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
+ ;; Styles: (6) and (7) with timezone and buggy timezone
+ (setq year 6 month 3 day 2 time 4 zone 7))
+ ((string-match
+ "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date)
+ ;; Styles: (3) without timezone
+ (setq year 4 month 1 day 2 time 3 zone nil))
+ ((string-match
+ "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date)
+ ;; Styles: (3) with timezone
+ (setq year 5 month 1 day 2 time 3 zone 4))
+ ((string-match
+ "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
+ ;; Styles: (4) with timezone
+ (setq year 3 month 2 day 1 time 4 zone 5))
+ ((string-match
+ "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
+ ;; Styles: (5) with timezone.
+ (setq year 3 month 2 day 1 time 4 zone 6))
+ ((string-match
+ "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?" date)
+ ;; Styles: (5) without timezone.
+ (setq year 3 month 2 day 1 time 4 zone nil))
+ ((string-match
+ "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
+ ;; Styles: (8) with timezone.
+ (setq year 1 month 2 day 3 time 4 zone 5))
+ ((string-match
+ "\\([0-9]\\{4\\}\\)-?\\([0-9]\\{0,2\\}\\)-?\\([0-9]\\{0,2\\}\\)[T \t]+\\([0-9]\\{0,2\\}:?[0-9]\\{0,2\\}:?[0-9]\\{0,2\\}\\)[ \t]*\\([-+a-zA-Z]+[0-9:]*\\)" date)
+ ;; Styles: (8) with timezone with a colon in it.
+ (setq year 1 month 2 day 3 time 4 zone 5))
+ ((string-match
+ "\\([0-9]\\{4\\}\\)-?\\([0-9]\\{0,2\\}\\)-?\\([0-9]\\{0,2\\}\\)[T \t]+\\([0-9]+:?[0-9]+:?[0-9]+\\)" date)
+ ;; Styles: (8) without timezone.
+ (setq year 1 month 2 day 3 time 4 zone nil)))
+
+ (when year
+ (setq year (match-string year date))
+ ;; Guess ambiguous years. Assume years < 69 don't predate the
+ ;; Unix Epoch, so are 2000+. Three-digit years are assumed to
+ ;; be relative to 1900.
+ (when (< (length year) 4)
+ (let ((y (string-to-number year)))
+ (when (< y 69)
+ (setq y (+ y 100)))
+ (setq year (int-to-string (+ 1900 y)))))
+ (setq month
+ (if (or (= (aref date (+ (match-beginning month) 2)) ?-)
+ (let ((n (string-to-number
+ (char-to-string
+ (aref date (+ (match-beginning month) 2))))))
+ (= (aref (number-to-string n) 0)
+ (aref date (+ (match-beginning month) 2)))))
+ ;; Handle numeric months, spanning exactly two digits.
+ (substring date
+ (match-beginning month)
+ (+ (match-beginning month) 2))
+ (let* ((string (substring date
+ (match-beginning month)
+ (+ (match-beginning month) 3)))
+ (monthnum
+ (cdr (assoc (upcase string) timezone-months-assoc))))
+ (when monthnum
+ (int-to-string monthnum)))))
+ (setq day (match-string day date))
+ (setq time (match-string time date)))
+ (when zone (setq zone (match-string zone date)))
+ ;; Return a vector.
+ (if (and year month)
+ (vector year month day time zone)
+ (vector "0" "0" "0" "0" nil))))))
+
+(provide 'xml-rpc)
+
+;; Local Variables:
+;; time-stamp-pattern: "20/^;; Last Modified: <%%>$"
+;; End:
+
+;;; xml-rpc.el ends here
(load "my-slime.el")
(load "my-twitter.el")
(load "my-python.el")
+(load "my-haskell.el")
+(load "my-swank-js.el")
;; setup font
(if (>= emacs-major-version 23)
;;; displays "\" at the end of lines that wrap
(setq longlines-show-hard-newlines t)
-;;; haskell mode
-(setq auto-mode-alist
- (append auto-mode-alist
- '(("\\.[hg]s$" . haskell-mode)
- ("\\.hic?$" . haskell-mode)
- ("\\.hsc$" . haskell-mode)
- ("\\.chs$" . haskell-mode)
- ("\\.l[hg]s$" . literate-haskell-mode))))
-(autoload 'haskell-mode "haskell-mode"
- "Major mode for editing Haskell scripts." t)
-(autoload 'literate-haskell-mode "haskell-mode"
- "Major mode for editing literate Haskell scripts." t)
-
-;adding the following lines according to which modules you want to use:
-(require 'inf-haskell)
-
-(add-hook 'haskell-mode-hook 'turn-on-font-lock)
-(add-hook 'haskell-mode-hook 'turn-on-haskell-ghci)
-(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode)
-(add-hook 'haskell-mode-hook 'turn-on-haskell-indent)
-(set-variable 'haskell-program-name "ghci")
-
;; javascript mode
(autoload 'js2-mode "js2-mode" nil t)
(add-to-list 'auto-mode-alist '("\\.js$" . js2-mode))
-;; swank-js
-(add-to-list 'load-path "~/src/swank-js/")
-(require 'slime-js)
-
;; geiser for Scheme programming
;(load-file "~/src/geiser/elisp/geiser.el")
(autoload 'sml-mode "sml-mode" "Major mode for editing SML." t)
(autoload 'run-sml "sml-proc" "Run an inferior SML process." t)
-;; notmuch for email/searching
-(require 'notmuch)
(require 'gnus-art)
;; sending email
(setq message-kill-buffer-on-exit t) ; kill buffer after sending mail)
-(setq notmuch-fcc-dirs "Gmail/Sent") ; stores sent mail to the specified directory
-(setq message-directory "Gmail/Drafts") ; stores postponed messages to the specified directory
+;; cursor
+(setq-default cursor-type '(bar . 2))
+(set-cursor-color "#ff0000")
--- /dev/null
+Subproject commit 3863263b04bd57092d2b15e0b0fe8b3057d5ffc9
--- /dev/null
+(require 'solarized)
+
+(deftheme solarized-dark "The dark variant of the Solarized colour theme")
+
+(create-solarized-theme 'dark 'solarized-dark)
+
+(provide-theme 'solarized-dark)
--- /dev/null
+(require 'solarized)
+
+(deftheme solarized-light "The light variant of the Solarized colour theme")
+
+(create-solarized-theme 'light 'solarized-light)
+
+(provide-theme 'solarized-light)
--- /dev/null
+Subproject commit 27cee3d6ccc586b4bc30fb322927a6d275e54c34
--- /dev/null
+;;; zenburn-theme.el --- A low contrast color theme for Emacs.
+
+;; Copyright (C) 2011-2013 Bozhidar Batsov
+
+;; Author: Bozhidar Batsov <bozhidar@batsov.com>
+;; URL: http://github.com/bbatsov/zenburn-emacs
+;; Version: 2.0
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; A port of the popular Vim theme Zenburn for Emacs 24, built on top
+;; of the new built-in theme support in Emacs 24.
+;;
+;;; Credits:
+;;
+;; Jani Nurminen created the original theme for vim on such this port
+;; is based.
+
+;;; Code:
+(deftheme zenburn "The Zenburn color theme")
+
+(let ((class '((class color) (min-colors 89)))
+ ;; Zenburn palette
+ ;; colors with +x are lighter, colors with -x are darker
+ (zenburn-fg "#dcdccc")
+ (zenburn-fg-1 "#656555")
+ (zenburn-bg-1 "#2b2b2b")
+ (zenburn-bg-05 "#383838")
+ (zenburn-bg "#3f3f3f")
+ (zenburn-bg+1 "#4f4f4f")
+ (zenburn-bg+2 "#5f5f5f")
+ (zenburn-bg+3 "#6f6f6f")
+ (zenburn-red+1 "#dca3a3")
+ (zenburn-red "#cc9393")
+ (zenburn-red-1 "#bc8383")
+ (zenburn-red-2 "#ac7373")
+ (zenburn-red-3 "#9c6363")
+ (zenburn-red-4 "#8c5353")
+ (zenburn-orange "#dfaf8f")
+ (zenburn-yellow "#f0dfaf")
+ (zenburn-yellow-1 "#e0cf9f")
+ (zenburn-yellow-2 "#d0bf8f")
+ (zenburn-green-1 "#5f7f5f")
+ (zenburn-green "#7f9f7f")
+ (zenburn-green+1 "#8fb28f")
+ (zenburn-green+2 "#9fc59f")
+ (zenburn-green+3 "#afd8af")
+ (zenburn-green+4 "#bfebbf")
+ (zenburn-cyan "#93e0e3")
+ (zenburn-blue+1 "#94bff3")
+ (zenburn-blue "#8cd0d3")
+ (zenburn-blue-1 "#7cb8bb")
+ (zenburn-blue-2 "#6ca0a3")
+ (zenburn-blue-3 "#5c888b")
+ (zenburn-blue-4 "#4c7073")
+ (zenburn-blue-5 "#366060")
+ (zenburn-magenta "#dc8cc3"))
+ (custom-theme-set-faces
+ 'zenburn
+ '(button ((t (:underline t))))
+ `(link ((t (:foreground ,zenburn-yellow :underline t :weight bold))))
+ `(link-visited ((t (:foreground ,zenburn-yellow-2 :underline t :weight normal))))
+
+ ;;; basic coloring
+ `(default ((t (:foreground ,zenburn-fg :background ,zenburn-bg))))
+ `(cursor ((t (:foreground ,zenburn-fg :background "white"))))
+ `(escape-glyph ((t (:foreground ,zenburn-yellow :bold t))))
+ `(fringe ((t (:foreground ,zenburn-fg :background ,zenburn-bg+1))))
+ `(header-line ((t (:foreground ,zenburn-yellow
+ :background ,zenburn-bg-1
+ :box (:line-width -1 :style released-button)))))
+ `(highlight ((t (:background ,zenburn-bg-05))))
+ `(success ((t (:foreground ,zenburn-green :weight bold))))
+ `(warning ((t (:foreground ,zenburn-orange :weight bold))))
+
+ ;;; compilation
+ `(compilation-column-face ((t (:foreground ,zenburn-yellow))))
+ `(compilation-enter-directory-face ((t (:foreground ,zenburn-green))))
+ `(compilation-error-face ((t (:foreground ,zenburn-red-1 :weight bold :underline t))))
+ `(compilation-face ((t (:foreground ,zenburn-fg))))
+ `(compilation-info-face ((t (:foreground ,zenburn-blue))))
+ `(compilation-info ((t (:foreground ,zenburn-green+4 :underline t))))
+ `(compilation-leave-directory-face ((t (:foreground ,zenburn-green))))
+ `(compilation-line-face ((t (:foreground ,zenburn-yellow))))
+ `(compilation-line-number ((t (:foreground ,zenburn-yellow))))
+ `(compilation-message-face ((t (:foreground ,zenburn-blue))))
+ `(compilation-warning-face ((t (:foreground ,zenburn-orange :weight bold :underline t))))
+ `(compilation-mode-line-exit ((t (:foreground ,zenburn-green+2 :weight bold))))
+ `(compilation-mode-line-fail ((t (:foreground ,zenburn-red :weight bold))))
+ `(compilation-mode-line-run ((t (:foreground ,zenburn-yellow :weight bold))))
+
+ ;;; grep
+ `(grep-context-face ((t (:foreground ,zenburn-fg))))
+ `(grep-error-face ((t (:foreground ,zenburn-red-1 :weight bold :underline t))))
+ `(grep-hit-face ((t (:foreground ,zenburn-blue))))
+ `(grep-match-face ((t (:foreground ,zenburn-orange :weight bold))))
+ `(match ((t (:background ,zenburn-bg-1 :foreground ,zenburn-orange :weight bold))))
+
+ ;; faces used by isearch
+ `(isearch ((t (:foreground ,zenburn-yellow-2 :weight bold :background ,zenburn-bg-1))))
+ `(isearch-fail ((t (:foreground ,zenburn-fg :background ,zenburn-red-4))))
+ `(lazy-highlight ((t (:foreground ,zenburn-yellow-2 :weight bold :background ,zenburn-bg-05))))
+
+ `(menu ((t (:foreground ,zenburn-fg :background ,zenburn-bg))))
+ `(minibuffer-prompt ((t (:foreground ,zenburn-yellow))))
+ `(mode-line
+ ((,class (:foreground ,zenburn-green+1
+ :background ,zenburn-bg-1
+ :box (:line-width -1 :style released-button)))
+ (t :inverse-video t)))
+ `(mode-line-buffer-id ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(mode-line-inactive
+ ((t (:foreground ,zenburn-green-1
+ :background ,zenburn-bg-05
+ :box (:line-width -1 :style released-button)))))
+ `(region ((,class (:background ,zenburn-bg-1))
+ (t :inverse-video t)))
+ `(secondary-selection ((t (:background ,zenburn-bg+2))))
+ `(trailing-whitespace ((t (:background ,zenburn-red))))
+ `(vertical-border ((t (:foreground ,zenburn-fg))))
+
+ ;;; font lock
+ `(font-lock-builtin-face ((t (:foreground ,zenburn-cyan))))
+ `(font-lock-comment-face ((t (:foreground ,zenburn-green))))
+ `(font-lock-comment-delimiter-face ((t (:foreground ,zenburn-green))))
+ `(font-lock-constant-face ((t (:foreground ,zenburn-green+4))))
+ `(font-lock-doc-face ((t (:foreground ,zenburn-green+1))))
+ `(font-lock-doc-string-face ((t (:foreground ,zenburn-blue-2))))
+ `(font-lock-function-name-face ((t (:foreground ,zenburn-blue))))
+ `(font-lock-keyword-face ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(font-lock-negation-char-face ((t (:foreground ,zenburn-fg))))
+ `(font-lock-preprocessor-face ((t (:foreground ,zenburn-blue+1))))
+ `(font-lock-string-face ((t (:foreground ,zenburn-red))))
+ `(font-lock-type-face ((t (:foreground ,zenburn-blue-1))))
+ `(font-lock-variable-name-face ((t (:foreground ,zenburn-orange))))
+ `(font-lock-warning-face ((t (:foreground ,zenburn-yellow-2 :weight bold))))
+
+ `(c-annotation-face ((t (:inherit font-lock-constant-face))))
+
+ ;;; newsticker
+ `(newsticker-date-face ((t (:foreground ,zenburn-fg))))
+ `(newsticker-default-face ((t (:foreground ,zenburn-fg))))
+ `(newsticker-enclosure-face ((t (:foreground ,zenburn-green+3))))
+ `(newsticker-extra-face ((t (:foreground ,zenburn-bg+2 :height 0.8))))
+ `(newsticker-feed-face ((t (:foreground ,zenburn-fg))))
+ `(newsticker-immortal-item-face ((t (:foreground ,zenburn-green))))
+ `(newsticker-new-item-face ((t (:foreground ,zenburn-blue))))
+ `(newsticker-obsolete-item-face ((t (:foreground ,zenburn-red))))
+ `(newsticker-old-item-face ((t (:foreground ,zenburn-bg+3))))
+ `(newsticker-statistics-face ((t (:foreground ,zenburn-fg))))
+ `(newsticker-treeview-face ((t (:foreground ,zenburn-fg))))
+ `(newsticker-treeview-immortal-face ((t (:foreground ,zenburn-green))))
+ `(newsticker-treeview-listwindow-face ((t (:foreground ,zenburn-fg))))
+ `(newsticker-treeview-new-face ((t (:foreground ,zenburn-blue :weight bold))))
+ `(newsticker-treeview-obsolete-face ((t (:foreground ,zenburn-red))))
+ `(newsticker-treeview-old-face ((t (:foreground ,zenburn-bg+3))))
+ `(newsticker-treeview-selection-face ((t (:foreground ,zenburn-yellow))))
+
+ ;;; external
+ `(ace-jump-face-background
+ ((t (:foreground ,zenburn-fg-1 :background ,zenburn-bg :inverse-video nil))))
+ `(ace-jump-face-foreground
+ ((t (:foreground ,zenburn-green+2 :background ,zenburn-bg :inverse-video nil))))
+
+ ;; full-ack
+ `(ack-separator ((t (:foreground ,zenburn-fg))))
+ `(ack-file ((t (:foreground ,zenburn-blue))))
+ `(ack-line ((t (:foreground ,zenburn-yellow))))
+ `(ack-match ((t (:foreground ,zenburn-orange :background ,zenburn-bg-1 :weight bold))))
+
+ ;; auctex
+ `(font-latex-bold ((t (:inherit bold))))
+ `(font-latex-warning ((t (:inherit font-lock-warning))))
+ `(font-latex-sedate ((t (:foreground ,zenburn-yellow :weight bold ))))
+ `(font-latex-title-4 ((t (:inherit variable-pitch :weight bold))))
+
+ ;; auto-complete
+ `(ac-candidate-face ((t (:background ,zenburn-bg+3 :foreground "black"))))
+ `(ac-selection-face ((t (:background ,zenburn-blue-4 :foreground ,zenburn-fg))))
+ `(popup-tip-face ((t (:background ,zenburn-yellow-2 :foreground "black"))))
+ `(popup-scroll-bar-foreground-face ((t (:background ,zenburn-blue-5))))
+ `(popup-scroll-bar-background-face ((t (:background ,zenburn-bg-1))))
+ `(popup-isearch-match ((t (:background ,zenburn-bg :foreground ,zenburn-fg))))
+
+ ;; android mode
+ `(android-mode-debug-face ((t (:foreground ,zenburn-green+1))))
+ `(android-mode-error-face ((t (:foreground ,zenburn-orange :weight bold))))
+ `(android-mode-info-face ((t (:foreground ,zenburn-fg))))
+ `(android-mode-verbose-face ((t (:foreground ,zenburn-green))))
+ `(android-mode-warning-face ((t (:foreground ,zenburn-yellow))))
+
+ ;; bm
+ `(bm-face ((t (:background ,zenburn-yellow-1 :foreground ,zenburn-bg))))
+ `(bm-fringe-face ((t (:background ,zenburn-yellow-1 :foreground ,zenburn-bg))))
+ `(bm-fringe-persistent-face ((t (:background ,zenburn-green-1 :foreground ,zenburn-bg))))
+ `(bm-persistent-face ((t (:background ,zenburn-green-1 :foreground ,zenburn-bg))))
+
+ ;; clojure-test-mode
+ `(clojure-test-failure-face ((t (:foreground ,zenburn-orange :weight bold :underline t))))
+ `(clojure-test-error-face ((t (:foreground ,zenburn-red :weight bold :underline t))))
+ `(clojure-test-success-face ((t (:foreground ,zenburn-green+1 :weight bold :underline t))))
+
+ ;; ctable
+ `(ctbl:face-cell-select ((t (:background ,zenburn-blue :foreground ,zenburn-bg))))
+ `(ctbl:face-continue-bar ((t (:background ,zenburn-bg-05 :foreground ,zenburn-bg))))
+ `(ctbl:face-row-select ((t (:background ,zenburn-cyan :foreground ,zenburn-bg))))
+
+ ;; diff
+ `(diff-added ((,class (:foreground ,zenburn-green+4 :background nil))
+ (t (:foreground ,zenburn-green-1 :background nil))))
+ `(diff-changed ((t (:foreground ,zenburn-yellow))))
+ `(diff-removed ((,class (:foreground ,zenburn-red :background nil))
+ (t (:foreground ,zenburn-red-3 :background nil))))
+ `(diff-refine-added ((t :inherit diff-added :weight bold)))
+ `(diff-refine-change ((t :inherit diff-changed :weight bold)))
+ `(diff-refine-removed ((t :inherit diff-removed :weight bold)))
+ `(diff-header ((,class (:background ,zenburn-bg+2))
+ (t (:background ,zenburn-fg :foreground ,zenburn-bg))))
+ `(diff-file-header
+ ((,class (:background ,zenburn-bg+2 :foreground ,zenburn-fg :bold t))
+ (t (:background ,zenburn-fg :foreground ,zenburn-bg :bold t))))
+
+ ;; dired+
+ `(diredp-display-msg ((t (:foreground ,zenburn-blue))))
+ `(diredp-compressed-file-suffix ((t (:foreground ,zenburn-orange))))
+ `(diredp-date-time ((t (:foreground ,zenburn-magenta))))
+ `(diredp-deletion ((t (:foreground ,zenburn-yellow))))
+ `(diredp-deletion-file-name ((t (:foreground ,zenburn-red))))
+ `(diredp-dir-heading ((t (:foreground ,zenburn-blue :background ,zenburn-bg-1))))
+ `(diredp-dir-priv ((t (:foreground ,zenburn-cyan))))
+ `(diredp-exec-priv ((t (:foreground ,zenburn-red))))
+ `(diredp-executable-tag ((t (:foreground ,zenburn-green+1))))
+ `(diredp-file-name ((t (:foreground ,zenburn-blue))))
+ `(diredp-file-suffix ((t (:foreground ,zenburn-green))))
+ `(diredp-flag-mark ((t (:foreground ,zenburn-yellow))))
+ `(diredp-flag-mark-line ((t (:foreground ,zenburn-orange))))
+ `(diredp-ignored-file-name ((t (:foreground ,zenburn-red))))
+ `(diredp-link-priv ((t (:foreground ,zenburn-yellow))))
+ `(diredp-mode-line-flagged ((t (:foreground ,zenburn-yellow))))
+ `(diredp-mode-line-marked ((t (:foreground ,zenburn-orange))))
+ `(diredp-no-priv ((t (:foreground ,zenburn-fg))))
+ `(diredp-number ((t (:foreground ,zenburn-green+1))))
+ `(diredp-other-priv ((t (:foreground ,zenburn-yellow-1))))
+ `(diredp-rare-priv ((t (:foreground ,zenburn-red-1))))
+ `(diredp-read-priv ((t (:foreground ,zenburn-green-1))))
+ `(diredp-symlink ((t (:foreground ,zenburn-yellow))))
+ `(diredp-write-priv ((t (:foreground ,zenburn-magenta))))
+
+ ;; ert
+ `(ert-test-result-expected ((t (:foreground ,zenburn-green+4 :background ,zenburn-bg))))
+ `(ert-test-result-unexpected ((t (:foreground ,zenburn-red :background ,zenburn-bg))))
+
+ ;; eshell
+ `(eshell-prompt ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(eshell-ls-archive ((t (:foreground ,zenburn-red-1 :weight bold))))
+ `(eshell-ls-backup ((t (:inherit font-lock-comment))))
+ `(eshell-ls-clutter ((t (:inherit font-lock-comment))))
+ `(eshell-ls-directory ((t (:foreground ,zenburn-blue+1 :weight bold))))
+ `(eshell-ls-executable ((t (:foreground ,zenburn-red+1 :weight bold))))
+ `(eshell-ls-unreadable ((t (:foreground ,zenburn-fg))))
+ `(eshell-ls-missing ((t (:inherit font-lock-warning))))
+ `(eshell-ls-product ((t (:inherit font-lock-doc))))
+ `(eshell-ls-special ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(eshell-ls-symlink ((t (:foreground ,zenburn-cyan :weight bold))))
+
+ ;; flycheck
+ `(flycheck-error-face ((t (:foreground ,zenburn-red-1 :weight bold :underline t))))
+ `(flycheck-warning-face ((t (:foreground ,zenburn-orange :weight bold :underline t))))
+
+ ;; flymake
+ `(flymake-errline ((t (:foreground ,zenburn-red-1 :weight bold :underline t))))
+ `(flymake-warnline ((t (:foreground ,zenburn-orange :weight bold :underline t))))
+
+ ;; flyspell
+ `(flyspell-duplicate ((t (:foreground ,zenburn-orange :weight bold :underline t))))
+ `(flyspell-incorrect ((t (:foreground ,zenburn-red-1 :weight bold :underline t))))
+
+ ;; erc
+ `(erc-action-face ((t (:inherit erc-default-face))))
+ `(erc-bold-face ((t (:weight bold))))
+ `(erc-current-nick-face ((t (:foreground ,zenburn-blue :weight bold))))
+ `(erc-dangerous-host-face ((t (:inherit font-lock-warning))))
+ `(erc-default-face ((t (:foreground ,zenburn-fg))))
+ `(erc-direct-msg-face ((t (:inherit erc-default))))
+ `(erc-error-face ((t (:inherit font-lock-warning))))
+ `(erc-fool-face ((t (:inherit erc-default))))
+ `(erc-highlight-face ((t (:inherit hover-highlight))))
+ `(erc-input-face ((t (:foreground ,zenburn-yellow))))
+ `(erc-keyword-face ((t (:foreground ,zenburn-blue :weight bold))))
+ `(erc-nick-default-face ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(erc-my-nick-face ((t (:foreground ,zenburn-red :weight bold))))
+ `(erc-nick-msg-face ((t (:inherit erc-default))))
+ `(erc-notice-face ((t (:foreground ,zenburn-green))))
+ `(erc-pal-face ((t (:foreground ,zenburn-orange :weight bold))))
+ `(erc-prompt-face ((t (:foreground ,zenburn-orange :background ,zenburn-bg :weight bold))))
+ `(erc-timestamp-face ((t (:foreground ,zenburn-green+1))))
+ `(erc-underline-face ((t (:underline t))))
+
+ ;; git-gutter
+ `(git-gutter:added ((t (:foreground ,zenburn-green :weight bold :inverse-video t))))
+ `(git-gutter:deleted ((t (:foreground ,zenburn-red :weight bold :inverse-video t))))
+ `(git-gutter:modified ((t (:foreground ,zenburn-magenta :weight bold :inverse-video t))))
+ `(git-gutter:unchanged ((t (:foreground ,zenburn-fg :weight bold :inverse-video t))))
+
+ ;; git-gutter-fr
+ `(git-gutter-fr:added ((t (:foreground ,zenburn-green :weight bold))))
+ `(git-gutter-fr:deleted ((t (:foreground ,zenburn-red :weight bold))))
+ `(git-gutter-fr:modified ((t (:foreground ,zenburn-magenta :weight bold))))
+
+ ;; gnus
+ `(gnus-group-mail-1 ((t (:bold t :inherit gnus-group-mail-1-empty))))
+ `(gnus-group-mail-1-empty ((t (:inherit gnus-group-news-1-empty))))
+ `(gnus-group-mail-2 ((t (:bold t :inherit gnus-group-mail-2-empty))))
+ `(gnus-group-mail-2-empty ((t (:inherit gnus-group-news-2-empty))))
+ `(gnus-group-mail-3 ((t (:bold t :inherit gnus-group-mail-3-empty))))
+ `(gnus-group-mail-3-empty ((t (:inherit gnus-group-news-3-empty))))
+ `(gnus-group-mail-4 ((t (:bold t :inherit gnus-group-mail-4-empty))))
+ `(gnus-group-mail-4-empty ((t (:inherit gnus-group-news-4-empty))))
+ `(gnus-group-mail-5 ((t (:bold t :inherit gnus-group-mail-5-empty))))
+ `(gnus-group-mail-5-empty ((t (:inherit gnus-group-news-5-empty))))
+ `(gnus-group-mail-6 ((t (:bold t :inherit gnus-group-mail-6-empty))))
+ `(gnus-group-mail-6-empty ((t (:inherit gnus-group-news-6-empty))))
+ `(gnus-group-mail-low ((t (:bold t :inherit gnus-group-mail-low-empty))))
+ `(gnus-group-mail-low-empty ((t (:inherit gnus-group-news-low-empty))))
+ `(gnus-group-news-1 ((t (:bold t :inherit gnus-group-news-1-empty))))
+ `(gnus-group-news-2 ((t (:bold t :inherit gnus-group-news-2-empty))))
+ `(gnus-group-news-3 ((t (:bold t :inherit gnus-group-news-3-empty))))
+ `(gnus-group-news-4 ((t (:bold t :inherit gnus-group-news-4-empty))))
+ `(gnus-group-news-5 ((t (:bold t :inherit gnus-group-news-5-empty))))
+ `(gnus-group-news-6 ((t (:bold t :inherit gnus-group-news-6-empty))))
+ `(gnus-group-news-low ((t (:bold t :inherit gnus-group-news-low-empty))))
+ `(gnus-header-content ((t (:inherit message-header-other))))
+ `(gnus-header-from ((t (:inherit message-header-from))))
+ `(gnus-header-name ((t (:inherit message-header-name))))
+ `(gnus-header-newsgroups ((t (:inherit message-header-other))))
+ `(gnus-header-subject ((t (:inherit message-header-subject))))
+ `(gnus-summary-cancelled ((t (:foreground ,zenburn-orange))))
+ `(gnus-summary-high-ancient ((t (:foreground ,zenburn-blue))))
+ `(gnus-summary-high-read ((t (:foreground ,zenburn-green :weight bold))))
+ `(gnus-summary-high-ticked ((t (:foreground ,zenburn-orange :weight bold))))
+ `(gnus-summary-high-unread ((t (:foreground ,zenburn-fg :weight bold))))
+ `(gnus-summary-low-ancient ((t (:foreground ,zenburn-blue))))
+ `(gnus-summary-low-read ((t (:foreground ,zenburn-green))))
+ `(gnus-summary-low-ticked ((t (:foreground ,zenburn-orange :weight bold))))
+ `(gnus-summary-low-unread ((t (:foreground ,zenburn-fg))))
+ `(gnus-summary-normal-ancient ((t (:foreground ,zenburn-blue))))
+ `(gnus-summary-normal-read ((t (:foreground ,zenburn-green))))
+ `(gnus-summary-normal-ticked ((t (:foreground ,zenburn-orange :weight bold))))
+ `(gnus-summary-normal-unread ((t (:foreground ,zenburn-fg))))
+ `(gnus-summary-selected ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(gnus-cite-1 ((t (:foreground ,zenburn-blue))))
+ `(gnus-cite-10 ((t (:foreground ,zenburn-yellow-1))))
+ `(gnus-cite-11 ((t (:foreground ,zenburn-yellow))))
+ `(gnus-cite-2 ((t (:foreground ,zenburn-blue-1))))
+ `(gnus-cite-3 ((t (:foreground ,zenburn-blue-2))))
+ `(gnus-cite-4 ((t (:foreground ,zenburn-green+2))))
+ `(gnus-cite-5 ((t (:foreground ,zenburn-green+1))))
+ `(gnus-cite-6 ((t (:foreground ,zenburn-green))))
+ `(gnus-cite-7 ((t (:foreground ,zenburn-red))))
+ `(gnus-cite-8 ((t (:foreground ,zenburn-red-1))))
+ `(gnus-cite-9 ((t (:foreground ,zenburn-red-2))))
+ `(gnus-group-news-1-empty ((t (:foreground ,zenburn-yellow))))
+ `(gnus-group-news-2-empty ((t (:foreground ,zenburn-green+3))))
+ `(gnus-group-news-3-empty ((t (:foreground ,zenburn-green+1))))
+ `(gnus-group-news-4-empty ((t (:foreground ,zenburn-blue-2))))
+ `(gnus-group-news-5-empty ((t (:foreground ,zenburn-blue-3))))
+ `(gnus-group-news-6-empty ((t (:foreground ,zenburn-bg+2))))
+ `(gnus-group-news-low-empty ((t (:foreground ,zenburn-bg+2))))
+ `(gnus-signature ((t (:foreground ,zenburn-yellow))))
+ `(gnus-x ((t (:background ,zenburn-fg :foreground ,zenburn-bg))))
+
+ ;; guide-key
+ `(guide-key/highlight-command-face ((t (:foreground ,zenburn-blue))))
+ `(guide-key/key-face ((t (:foreground ,zenburn-green))))
+ `(guide-key/prefix-command-face ((t (:foreground ,zenburn-green+1))))
+
+ ;; helm
+ `(helm-header
+ ((t (:foreground ,zenburn-green
+ :background ,zenburn-bg
+ :underline nil
+ :box nil))))
+ `(helm-source-header
+ ((t (:foreground ,zenburn-yellow
+ :background ,zenburn-bg-1
+ :underline nil
+ :weight bold
+ :box (:line-width -1 :style released-button)))))
+ `(helm-selection ((t (:background ,zenburn-bg+1 :underline nil))))
+ `(helm-selection-line ((t (:background ,zenburn-bg+1))))
+ `(helm-visible-mark ((t (:foreground ,zenburn-bg :background ,zenburn-yellow-2))))
+ `(helm-candidate-number ((t (:foreground ,zenburn-green+4 :background ,zenburn-bg-1))))
+ `(helm-ff-directory ((t (:foreground ,zenburn-magenta))))
+
+ ;; hl-line-mode
+ `(hl-line-face ((,class (:background ,zenburn-bg-05))
+ (t :weight bold)))
+ `(hl-line ((,class (:background ,zenburn-bg-05)) ; old emacsen
+ (t :weight bold)))
+
+ ;; hl-sexp
+ `(hl-sexp-face ((,class (:background ,zenburn-bg+1))
+ (t :weight bold)))
+
+ ;; ido-mode
+ `(ido-first-match ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(ido-only-match ((t (:foreground ,zenburn-orange :weight bold))))
+ `(ido-subdir ((t (:foreground ,zenburn-yellow))))
+
+ ;; js2-mode
+ `(js2-warning-face ((t (:underline ,zenburn-orange))))
+ `(js2-error-face ((t (:foreground ,zenburn-red :weight bold))))
+ `(js2-jsdoc-tag-face ((t (:foreground ,zenburn-green-1))))
+ `(js2-jsdoc-type-face ((t (:foreground ,zenburn-green+2))))
+ `(js2-jsdoc-value-face ((t (:foreground ,zenburn-green+3))))
+ `(js2-function-param-face ((t (:foreground, zenburn-green+3))))
+ `(js2-external-variable-face ((t (:foreground ,zenburn-orange))))
+
+ ;; jabber-mode
+ `(jabber-roster-user-away ((t (:foreground ,zenburn-green+2))))
+ `(jabber-roster-user-online ((t (:foreground ,zenburn-blue-1))))
+ `(jabber-roster-user-dnd ((t (:foreground ,zenburn-red+1))))
+ `(jabber-rare-time-face ((t (:foreground ,zenburn-green+1))))
+ `(jabber-chat-prompt-local ((t (:foreground ,zenburn-blue-1))))
+ `(jabber-chat-prompt-foreign ((t (:foreground ,zenburn-red+1))))
+ `(jabber-activity-face((t (:foreground ,zenburn-red+1))))
+ `(jabber-activity-personal-face ((t (:foreground ,zenburn-blue+1))))
+ `(jabber-title-small ((t (:height 1.1 :weight bold))))
+ `(jabber-title-medium ((t (:height 1.2 :weight bold))))
+ `(jabber-title-large ((t (:height 1.3 :weight bold))))
+
+ ;; linum-mode
+ `(linum ((t (:foreground ,zenburn-green+2 :background ,zenburn-bg))))
+
+ ;; macrostep
+ `(macrostep-gensym-1
+ ((t (:foreground ,zenburn-green+2 :background ,zenburn-bg-1))))
+ `(macrostep-gensym-2
+ ((t (:foreground ,zenburn-red+1 :background ,zenburn-bg-1))))
+ `(macrostep-gensym-3
+ ((t (:foreground ,zenburn-blue+1 :background ,zenburn-bg-1))))
+ `(macrostep-gensym-4
+ ((t (:foreground ,zenburn-magenta :background ,zenburn-bg-1))))
+ `(macrostep-gensym-5
+ ((t (:foreground ,zenburn-yellow :background ,zenburn-bg-1))))
+ `(macrostep-expansion-highlight-face
+ ((t (:inherit highlight))))
+ `(macrostep-macro-face
+ ((t (:underline t))))
+
+ ;; magit
+ `(magit-section-title ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(magit-branch ((t (:foreground ,zenburn-orange :weight bold))))
+ `(magit-item-highlight ((t (:background ,zenburn-bg+1))))
+
+ ;; egg
+ `(egg-text-base ((t (:foreground ,zenburn-fg))))
+ `(egg-help-header-1 ((t (:foreground ,zenburn-yellow))))
+ `(egg-help-header-2 ((t (:foreground ,zenburn-green+3))))
+ `(egg-branch ((t (:foreground ,zenburn-yellow))))
+ `(egg-branch-mono ((t (:foreground ,zenburn-yellow))))
+ `(egg-term ((t (:foreground ,zenburn-yellow))))
+ `(egg-diff-add ((t (:foreground ,zenburn-green+4))))
+ `(egg-diff-del ((t (:foreground ,zenburn-red+1))))
+ `(egg-diff-file-header ((t (:foreground ,zenburn-yellow-2))))
+ `(egg-section-title ((t (:foreground ,zenburn-yellow))))
+ `(egg-stash-mono ((t (:foreground ,zenburn-green+4))))
+
+ ;; message-mode
+ `(message-cited-text ((t (:inherit font-lock-comment))))
+ `(message-header-name ((t (:foreground ,zenburn-green+1))))
+ `(message-header-other ((t (:foreground ,zenburn-green))))
+ `(message-header-to ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(message-header-from ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(message-header-cc ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(message-header-newsgroups ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(message-header-subject ((t (:foreground ,zenburn-orange :weight bold))))
+ `(message-header-xheader ((t (:foreground ,zenburn-green))))
+ `(message-mml ((t (:foreground ,zenburn-yellow :weight bold))))
+ `(message-separator ((t (:inherit font-lock-comment))))
+
+ ;; mew
+ `(mew-face-header-subject ((t (:foreground ,zenburn-orange))))
+ `(mew-face-header-from ((t (:foreground ,zenburn-yellow))))
+ `(mew-face-header-date ((t (:foreground ,zenburn-green))))
+ `(mew-face-header-to ((t (:foreground ,zenburn-red))))
+ `(mew-face-header-key ((t (:foreground ,zenburn-green))))
+ `(mew-face-header-private ((t (:foreground ,zenburn-green))))
+ `(mew-face-header-important ((t (:foreground ,zenburn-blue))))
+ `(mew-face-header-marginal ((t (:foreground ,zenburn-fg :weight bold))))
+ `(mew-face-header-warning ((t (:foreground ,zenburn-red))))
+ `(mew-face-header-xmew ((t (:foreground ,zenburn-green))))
+ `(mew-face-header-xmew-bad ((t (:foreground ,zenburn-red))))
+ `(mew-face-body-url ((t (:foreground ,zenburn-orange))))
+ `(mew-face-body-comment ((t (:foreground ,zenburn-fg :slant italic))))
+ `(mew-face-body-cite1 ((t (:foreground ,zenburn-green))))
+ `(mew-face-body-cite2 ((t (:foreground ,zenburn-blue))))
+ `(mew-face-body-cite3 ((t (:foreground ,zenburn-orange))))
+ `(mew-face-body-cite4 ((t (:foreground ,zenburn-yellow))))
+ `(mew-face-body-cite5 ((t (:foreground ,zenburn-red))))
+ `(mew-face-mark-review ((t (:foreground ,zenburn-blue))))
+ `(mew-face-mark-escape ((t (:foreground ,zenburn-green))))
+ `(mew-face-mark-delete ((t (:foreground ,zenburn-red))))
+ `(mew-face-mark-unlink ((t (:foreground ,zenburn-yellow))))
+ `(mew-face-mark-refile ((t (:foreground ,zenburn-green))))
+ `(mew-face-mark-unread ((t (:foreground ,zenburn-red-2))))
+ `(mew-face-eof-message ((t (:foreground ,zenburn-green))))
+ `(mew-face-eof-part ((t (:foreground ,zenburn-yellow))))
+
+ ;; mic-paren
+ `(paren-face-match ((t (:foreground ,zenburn-cyan :background ,zenburn-bg :weight bold))))
+ `(paren-face-mismatch ((t (:foreground ,zenburn-bg :background ,zenburn-magenta :weight bold))))
+ `(paren-face-no-match ((t (:foreground ,zenburn-bg :background ,zenburn-red :weight bold))))
+
+ ;; mingus
+ `(mingus-directory-face ((t (:foreground ,zenburn-blue))))
+ `(mingus-pausing-face ((t (:foreground ,zenburn-magenta))))
+ `(mingus-playing-face ((t (:foreground ,zenburn-cyan))))
+ `(mingus-playlist-face ((t (:foreground ,zenburn-cyan ))))
+ `(mingus-song-file-face ((t (:foreground ,zenburn-yellow))))
+ `(mingus-stopped-face ((t (:foreground ,zenburn-red))))
+
+ ;; nav
+ `(nav-face-heading ((t (:foreground ,zenburn-yellow))))
+ `(nav-face-button-num ((t (:foreground ,zenburn-cyan))))
+ `(nav-face-dir ((t (:foreground ,zenburn-green))))
+ `(nav-face-hdir ((t (:foreground ,zenburn-red))))
+ `(nav-face-file ((t (:foreground ,zenburn-fg))))
+ `(nav-face-hfile ((t (:foreground ,zenburn-red-4))))
+
+ ;; mu4e
+ `(mu4e-cited-1-face ((t (:foreground ,zenburn-blue :slant italic))))
+ `(mu4e-cited-2-face ((t (:foreground ,zenburn-green+2 :slant italic))))
+ `(mu4e-cited-3-face ((t (:foreground ,zenburn-blue-2 :slant italic))))
+ `(mu4e-cited-4-face ((t (:foreground ,zenburn-green :slant italic))))
+ `(mu4e-cited-5-face ((t (:foreground ,zenburn-blue-4 :slant italic))))
+ `(mu4e-cited-6-face ((t (:foreground ,zenburn-green-1 :slant italic))))
+ `(mu4e-cited-7-face ((t (:foreground ,zenburn-blue :slant italic))))
+ `(mu4e-replied-face ((t (:foreground ,zenburn-bg+3))))
+ `(mu4e-trashed-face ((t (:foreground ,zenburn-bg+3 :strike-through t))))
+
+ ;; mumamo
+ `(mumamo-background-chunk-major ((t (:background nil))))
+ `(mumamo-background-chunk-submode1 ((t (:background ,zenburn-bg-1))))
+ `(mumamo-background-chunk-submode2 ((t (:background ,zenburn-bg+2))))
+ `(mumamo-background-chunk-submode3 ((t (:background ,zenburn-bg+3))))
+ `(mumamo-background-chunk-submode4 ((t (:background ,zenburn-bg+1))))
+
+ ;; org-mode
+ `(org-agenda-date-today
+ ((t (:foreground "white" :slant italic :weight bold))) t)
+ `(org-agenda-structure
+ ((t (:inherit font-lock-comment-face))))
+ `(org-archived ((t (:foreground ,zenburn-fg :weight bold))))
+ `(org-checkbox ((t (:background ,zenburn-bg+2 :foreground "white"
+ :box (:line-width 1 :style released-button)))))
+ `(org-date ((t (:foreground ,zenburn-blue :underline t))))
+ `(org-deadline-announce ((t (:foreground ,zenburn-red-1))))
+ `(org-done ((t (:bold t :weight bold :foreground ,zenburn-green+3))))
+ `(org-formula ((t (:foreground ,zenburn-yellow-2))))
+ `(org-headline-done ((t (:foreground ,zenburn-green+3))))
+ `(org-hide ((t (:foreground ,zenburn-bg-1))))
+ `(org-level-1 ((t (:foreground ,zenburn-orange))))
+ `(org-level-2 ((t (:foreground ,zenburn-green+4))))
+ `(org-level-3 ((t (:foreground ,zenburn-blue-1))))
+ `(org-level-4 ((t (:foreground ,zenburn-yellow-2))))
+ `(org-level-5 ((t (:foreground ,zenburn-cyan))))
+ `(org-level-6 ((t (:foreground ,zenburn-green+2))))
+ `(org-level-7 ((t (:foreground ,zenburn-red-4))))
+ `(org-level-8 ((t (:foreground ,zenburn-blue-4))))
+ `(org-link ((t (:foreground ,zenburn-yellow-2 :underline t))))
+ `(org-scheduled ((t (:foreground ,zenburn-green+4))))
+ `(org-scheduled-previously ((t (:foreground ,zenburn-red-4))))
+ `(org-scheduled-today ((t (:foreground ,zenburn-blue+1))))
+ `(org-special-keyword ((t (:foreground ,zenburn-fg-1 :weight normal))))
+ `(org-table ((t (:foreground ,zenburn-green+2))))
+ `(org-tag ((t (:bold t :weight bold))))
+ `(org-time-grid ((t (:foreground ,zenburn-orange))))
+ `(org-todo ((t (:bold t :foreground ,zenburn-red :weight bold))))
+ `(org-upcoming-deadline ((t (:inherit font-lock-keyword-face))))
+ `(org-warning ((t (:bold t :foreground ,zenburn-red :weight bold :underline nil))))
+ `(org-column ((t (:background ,zenburn-bg-1))))
+ `(org-column-title ((t (:background ,zenburn-bg-1 :underline t :weight bold))))
+
+ ;; outline
+ `(outline-1 ((t (:foreground ,zenburn-orange))))
+ `(outline-2 ((t (:foreground ,zenburn-green+4))))
+ `(outline-3 ((t (:foreground ,zenburn-blue-1))))
+ `(outline-4 ((t (:foreground ,zenburn-yellow-2))))
+ `(outline-5 ((t (:foreground ,zenburn-cyan))))
+ `(outline-6 ((t (:foreground ,zenburn-green+2))))
+ `(outline-7 ((t (:foreground ,zenburn-red-4))))
+ `(outline-8 ((t (:foreground ,zenburn-blue-4))))
+
+ ;; rainbow-delimiters
+ `(rainbow-delimiters-depth-1-face ((t (:foreground ,zenburn-fg))))
+ `(rainbow-delimiters-depth-2-face ((t (:foreground ,zenburn-green+2))))
+ `(rainbow-delimiters-depth-3-face ((t (:foreground ,zenburn-yellow-2))))
+ `(rainbow-delimiters-depth-4-face ((t (:foreground ,zenburn-cyan))))
+ `(rainbow-delimiters-depth-5-face ((t (:foreground ,zenburn-green-1))))
+ `(rainbow-delimiters-depth-6-face ((t (:foreground ,zenburn-blue+1))))
+ `(rainbow-delimiters-depth-7-face ((t (:foreground ,zenburn-yellow-1))))
+ `(rainbow-delimiters-depth-8-face ((t (:foreground ,zenburn-green+1))))
+ `(rainbow-delimiters-depth-9-face ((t (:foreground ,zenburn-blue-2))))
+ `(rainbow-delimiters-depth-10-face ((t (:foreground ,zenburn-orange))))
+ `(rainbow-delimiters-depth-11-face ((t (:foreground ,zenburn-green))))
+ `( rainbow-delimiters-depth-12-face ((t (:foreground ,zenburn-blue-5))))
+
+ ;;rcirc
+ `(rcirc-my-nick ((t (:foreground ,zenburn-blue))))
+ `(rcirc-other-nick ((t (:foreground ,zenburn-orange))))
+ `(rcirc-bright-nick ((t (:foreground ,zenburn-blue+1))))
+ `(rcirc-dim-nick ((t (:foreground ,zenburn-blue-2))))
+ `(rcirc-server ((t (:foreground ,zenburn-green))))
+ `(rcirc-server-prefix ((t (:foreground ,zenburn-green+1))))
+ `(rcirc-timestamp ((t (:foreground ,zenburn-green+2))))
+ `(rcirc-nick-in-message ((t (:foreground ,zenburn-yellow))))
+ `(rcirc-nick-in-message-full-line ((t (:bold t))))
+ `(rcirc-prompt ((t (:foreground ,zenburn-yellow :bold t))))
+ `(rcirc-track-nick ((t (:inverse-video t))))
+ `(rcirc-track-keyword ((t (:bold t))))
+ `(rcirc-url ((t (:bold t))))
+ `(rcirc-keyword ((t (:foreground ,zenburn-yellow :bold t))))
+
+ ;; rpm-mode
+ `(rpm-spec-dir-face ((t (:foreground ,zenburn-green))))
+ `(rpm-spec-doc-face ((t (:foreground ,zenburn-green))))
+ `(rpm-spec-ghost-face ((t (:foreground ,zenburn-red))))
+ `(rpm-spec-macro-face ((t (:foreground ,zenburn-yellow))))
+ `(rpm-spec-obsolete-tag-face ((t (:foreground ,zenburn-red))))
+ `(rpm-spec-package-face ((t (:foreground ,zenburn-red))))
+ `(rpm-spec-section-face ((t (:foreground ,zenburn-yellow))))
+ `(rpm-spec-tag-face ((t (:foreground ,zenburn-blue))))
+ `(rpm-spec-var-face ((t (:foreground ,zenburn-red))))
+
+ ;; rst-mode
+ `(rst-level-1-face ((t (:foreground ,zenburn-orange))))
+ `(rst-level-2-face ((t (:foreground ,zenburn-green+1))))
+ `(rst-level-3-face ((t (:foreground ,zenburn-blue-1))))
+ `(rst-level-4-face ((t (:foreground ,zenburn-yellow-2))))
+ `(rst-level-5-face ((t (:foreground ,zenburn-cyan))))
+ `(rst-level-6-face ((t (:foreground ,zenburn-green-1))))
+
+ ;; show-paren
+ `(show-paren-mismatch ((t (:foreground ,zenburn-red-3 :background ,zenburn-bg :weight bold))))
+ `(show-paren-match ((t (:foreground ,zenburn-blue-1 :background ,zenburn-bg :weight bold))))
+
+ ;; sml-mode-line
+ '(sml-modeline-end-face ((t :inherit default :width condensed)))
+
+ ;; SLIME
+ `(slime-repl-inputed-output-face ((t (:foreground ,zenburn-red))))
+
+ ;; tabbar
+ `(tabbar-button ((t (:foreground ,zenburn-fg
+ :background ,zenburn-bg))))
+ `(tabbar-selected ((t (:foreground ,zenburn-fg
+ :background ,zenburn-bg
+ :box (:line-width -1 :style pressed-button)))))
+ `(tabbar-unselected ((t (:foreground ,zenburn-fg
+ :background ,zenburn-bg+1
+ :box (:line-width -1 :style released-button)))))
+
+ ;; term
+ `(term-color-black ((t (:foreground ,zenburn-bg
+ :background ,zenburn-bg-1))))
+ `(term-color-red ((t (:foreground ,zenburn-red-2
+ :background ,zenburn-red-4))))
+ `(term-color-green ((t (:foreground ,zenburn-green
+ :background ,zenburn-green+2))))
+ `(term-color-yellow ((t (:foreground ,zenburn-orange
+ :background ,zenburn-yellow))))
+ `(term-color-blue ((t (:foreground ,zenburn-blue-1
+ :background ,zenburn-blue-4))))
+ `(term-color-magenta ((t (:foreground ,zenburn-magenta
+ :background ,zenburn-red))))
+ `(term-color-cyan ((t (:foreground ,zenburn-cyan
+ :background ,zenburn-blue))))
+ `(term-color-white ((t (:foreground ,zenburn-fg
+ :background ,zenburn-fg-1))))
+ '(term-default-fg-color ((t (:inherit term-color-white))))
+ '(term-default-bg-color ((t (:inherit term-color-black))))
+
+ ;; volatile-highlights
+ `(vhl/default-face ((t (:background ,zenburn-bg-05))))
+
+ ;; emacs-w3m
+ `(w3m-anchor ((t (:foreground ,zenburn-yellow :underline t
+ :weight bold))))
+ `(w3m-arrived-anchor ((t (:foreground ,zenburn-yellow-2
+ :underline t :weight normal))))
+ `(w3m-form ((t (:foreground ,zenburn-red-1 :underline t))))
+ `(w3m-header-line-location-title ((t (:foreground ,zenburn-yellow
+ :underline t :weight bold))))
+ '(w3m-history-current-url ((t (:inherit match))))
+ `(w3m-lnum ((t (:foreground ,zenburn-green+2 :background ,zenburn-bg))))
+ `(w3m-lnum-match ((t (:background ,zenburn-bg-1
+ :foreground ,zenburn-orange
+ :weight bold))))
+ `(w3m-lnum-minibuffer-prompt ((t (:foreground ,zenburn-yellow))))
+
+ ;; whitespace-mode
+ `(whitespace-space ((t (:background ,zenburn-bg+1 :foreground ,zenburn-bg+1))))
+ `(whitespace-hspace ((t (:background ,zenburn-bg+1 :foreground ,zenburn-bg+1))))
+ `(whitespace-tab ((t (:background ,zenburn-red-1))))
+ `(whitespace-newline ((t (:foreground ,zenburn-bg+1))))
+ `(whitespace-trailing ((t (:background ,zenburn-red))))
+ `(whitespace-line ((t (:background ,zenburn-bg :foreground ,zenburn-magenta))))
+ `(whitespace-space-before-tab ((t (:background ,zenburn-orange :foreground ,zenburn-orange))))
+ `(whitespace-indentation ((t (:background ,zenburn-yellow :foreground ,zenburn-red))))
+ `(whitespace-empty ((t (:background ,zenburn-yellow))))
+ `(whitespace-space-after-tab ((t (:background ,zenburn-yellow :foreground ,zenburn-red))))
+
+ ;; wanderlust
+ `(wl-highlight-folder-few-face ((t (:foreground ,zenburn-red-2))))
+ `(wl-highlight-folder-many-face ((t (:foreground ,zenburn-red-1))))
+ `(wl-highlight-folder-path-face ((t (:foreground ,zenburn-orange))))
+ `(wl-highlight-folder-unread-face ((t (:foreground ,zenburn-blue))))
+ `(wl-highlight-folder-zero-face ((t (:foreground ,zenburn-fg))))
+ `(wl-highlight-folder-unknown-face ((t (:foreground ,zenburn-blue))))
+ `(wl-highlight-message-citation-header ((t (:foreground ,zenburn-red-1))))
+ `(wl-highlight-message-cited-text-1 ((t (:foreground ,zenburn-red))))
+ `(wl-highlight-message-cited-text-2 ((t (:foreground ,zenburn-green+2))))
+ `(wl-highlight-message-cited-text-3 ((t (:foreground ,zenburn-blue))))
+ `(wl-highlight-message-cited-text-4 ((t (:foreground ,zenburn-blue+1))))
+ `(wl-highlight-message-header-contents-face ((t (:foreground ,zenburn-green))))
+ `(wl-highlight-message-headers-face ((t (:foreground ,zenburn-red+1))))
+ `(wl-highlight-message-important-header-contents ((t (:foreground ,zenburn-green+2))))
+ `(wl-highlight-message-header-contents ((t (:foreground ,zenburn-green+1))))
+ `(wl-highlight-message-important-header-contents2 ((t (:foreground ,zenburn-green+2))))
+ `(wl-highlight-message-signature ((t (:foreground ,zenburn-green))))
+ `(wl-highlight-message-unimportant-header-contents ((t (:foreground ,zenburn-fg))))
+ `(wl-highlight-summary-answered-face ((t (:foreground ,zenburn-blue))))
+ `(wl-highlight-summary-disposed-face ((t (:foreground ,zenburn-fg
+ :slant italic))))
+ `(wl-highlight-summary-new-face ((t (:foreground ,zenburn-blue))))
+ `(wl-highlight-summary-normal-face ((t (:foreground ,zenburn-fg))))
+ `(wl-highlight-summary-thread-top-face ((t (:foreground ,zenburn-yellow))))
+ `(wl-highlight-thread-indent-face ((t (:foreground ,zenburn-magenta))))
+ `(wl-highlight-summary-refiled-face ((t (:foreground ,zenburn-fg))))
+ `(wl-highlight-summary-displaying-face ((t (:underline t :weight bold))))
+
+ ;; which-func-mode
+ `(which-func ((t (:foreground ,zenburn-green+4))))
+
+ ;; yascroll
+ `(yascroll:thumb-text-area ((t (:background ,zenburn-bg-1))))
+ `(yascroll:thumb-fringe ((t (:background ,zenburn-bg-1 :foreground ,zenburn-bg-1)))))
+
+ ;;; custom theme variables
+ (custom-theme-set-variables
+ 'zenburn
+ `(ansi-color-names-vector [,zenburn-bg ,zenburn-red ,zenburn-green ,zenburn-yellow
+ ,zenburn-blue ,zenburn-magenta ,zenburn-cyan ,zenburn-fg])
+
+ ;; fill-column-indicator
+ `(fci-rule-color ,zenburn-bg-05)
+
+ ;; vc-annotate
+ `(vc-annotate-color-map
+ '(( 20. . ,zenburn-red-1)
+ ( 40. . ,zenburn-red)
+ ( 60. . ,zenburn-orange)
+ ( 80. . ,zenburn-yellow-2)
+ (100. . ,zenburn-yellow-1)
+ (120. . ,zenburn-yellow)
+ (140. . ,zenburn-green-1)
+ (160. . ,zenburn-green)
+ (180. . ,zenburn-green+1)
+ (200. . ,zenburn-green+2)
+ (220. . ,zenburn-green+3)
+ (240. . ,zenburn-green+4)
+ (260. . ,zenburn-cyan)
+ (280. . ,zenburn-blue-2)
+ (300. . ,zenburn-blue-1)
+ (320. . ,zenburn-blue)
+ (340. . ,zenburn-blue+1)
+ (360. . ,zenburn-magenta)))
+ `(vc-annotate-very-old-color ,zenburn-magenta)
+ `(vc-annotate-background ,zenburn-bg-1)
+ ))
+
+;;;###autoload
+(and load-file-name
+ (boundp 'custom-theme-load-path)
+ (add-to-list 'custom-theme-load-path
+ (file-name-as-directory
+ (file-name-directory load-file-name))))
+
+(provide-theme 'zenburn)
+
+;; Local Variables:
+;; no-byte-compile: t
+;; indent-tabs-mode: nil
+;; eval: (when (fboundp 'rainbow-mode) (rainbow-mode +1))
+;; End:
+
+;;; zenburn-theme.el ends here
--- /dev/null
+Subproject commit 4f91247ccb3d341732802b1faf819fd59e5e8c40
--- /dev/null
+Subproject commit 185e5e42f67f9591e6507fcc24330dad9d2e29fa
projects / .emacs.d.git / commitdiff
